diff options
54 files changed, 559 insertions, 573 deletions
diff --git a/compiler/aliases.nim b/compiler/aliases.nim index a09c4077d..fb2a39bc5 100644 --- a/compiler/aliases.nim +++ b/compiler/aliases.nim @@ -22,14 +22,14 @@ proc isPartOfAux(n: PNode, b: PType, marker: var IntSet): TAnalysisResult = result = arNo case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = isPartOfAux(n.sons[i], b, marker) if result == arYes: return of nkRecCase: assert(n.sons[0].kind == nkSym) result = isPartOfAux(n.sons[0], b, marker) if result == arYes: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = isPartOfAux(lastSon(n.sons[i]), b, marker) @@ -52,7 +52,7 @@ proc isPartOfAux(a, b: PType, marker: var IntSet): TAnalysisResult = of tyGenericInst, tyDistinct, tyAlias, tySink: result = isPartOfAux(lastSon(a), b, marker) of tyArray, tySet, tyTuple: - for i in 0 ..< sonsLen(a): + for i in 0 ..< len(a): result = isPartOfAux(a.sons[i], b, marker) if result == arYes: return else: discard diff --git a/compiler/ast.nim b/compiler/ast.nim index 758cd7cfe..addb2c33b 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -1023,7 +1023,9 @@ proc isCallExpr*(n: PNode): bool = proc discardSons*(father: PNode) -proc len*(n: PNode): int {.inline.} = +type Indexable = PNode | PType + +proc len*(n: Indexable): int {.inline.} = when defined(nimNoNilSeqs): result = len(n.sons) else: @@ -1047,8 +1049,6 @@ proc add*(father, son: PNode) = if isNil(father.sons): father.sons = @[] add(father.sons, son) -type Indexable = PNode | PType - template `[]`*(n: Indexable, i: int): Indexable = n.sons[i] template `[]=`*(n: Indexable, i: int; x: Indexable) = n.sons[i] = x @@ -1238,7 +1238,7 @@ proc newIntNode*(kind: TNodeKind, intVal: Int128): PNode = result = newNode(kind) result.intVal = castToInt64(intVal) -proc lastSon*(n: PType): PType = n.sons[^1] +proc lastSon*(n: Indexable): Indexable = n.sons[^1] proc skipTypes*(t: PType, kinds: TTypeKinds): PType = ## Used throughout the compiler code to test whether a type tree contains or @@ -1342,7 +1342,7 @@ proc mergeLoc(a: var TLoc, b: TLoc) = if a.lode == nil: a.lode = b.lode if a.r == nil: a.r = b.r -proc newSons*(father: PNode, length: int) = +proc newSons*(father: Indexable, length: int) = when defined(nimNoNilSeqs): setLen(father.sons, length) else: @@ -1351,20 +1351,6 @@ proc newSons*(father: PNode, length: int) = else: setLen(father.sons, length) -proc newSons*(father: PType, length: int) = - when defined(nimNoNilSeqs): - setLen(father.sons, length) - else: - if isNil(father.sons): - newSeq(father.sons, length) - else: - setLen(father.sons, length) - -proc sonsLen*(n: PType): int = n.sons.len -proc len*(n: PType): int = n.sons.len -proc sonsLen*(n: PNode): int = n.sons.len -proc lastSon*(n: PNode): PNode = n.sons[^1] - proc assignType*(dest, src: PType) = dest.kind = src.kind dest.flags = src.flags @@ -1382,8 +1368,8 @@ proc assignType*(dest, src: PType) = mergeLoc(dest.sym.loc, src.sym.loc) else: dest.sym = src.sym - newSons(dest, sonsLen(src)) - for i in 0 ..< sonsLen(src): dest.sons[i] = src.sons[i] + newSons(dest, len(src)) + for i in 0 ..< len(src): dest.sons[i] = src.sons[i] proc copyType*(t: PType, owner: PSym, keepId: bool): PType = result = newType(t.kind, owner) @@ -1537,7 +1523,7 @@ proc delSon*(father: PNode, idx: int) = if father.len == 0: return else: if isNil(father.sons): return - var length = sonsLen(father) + var length = len(father) for i in idx .. length - 2: father.sons[i] = father.sons[i + 1] setLen(father.sons, length - 1) @@ -1578,7 +1564,7 @@ proc shallowCopy*(src: PNode): PNode = of nkSym: result.sym = src.sym of nkIdent: result.ident = src.ident of nkStrLit..nkTripleStrLit: result.strVal = src.strVal - else: newSeq(result.sons, sonsLen(src)) + else: newSeq(result.sons, len(src)) proc copyTree*(src: PNode): PNode = # copy a whole syntax tree; performs deep copying @@ -1599,12 +1585,12 @@ proc copyTree*(src: PNode): PNode = of nkIdent: result.ident = src.ident of nkStrLit..nkTripleStrLit: result.strVal = src.strVal else: - newSeq(result.sons, sonsLen(src)) - for i in 0 ..< sonsLen(src): + newSeq(result.sons, len(src)) + for i in 0 ..< len(src): result.sons[i] = copyTree(src.sons[i]) proc hasSonWith*(n: PNode, kind: TNodeKind): bool = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n.sons[i].kind == kind: return true result = false @@ -1622,14 +1608,14 @@ proc containsNode*(n: PNode, kinds: TNodeKinds): bool = case n.kind of nkEmpty..nkNilLit: result = n.kind in kinds else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n.kind in kinds or containsNode(n.sons[i], kinds): return true proc hasSubnodeWith*(n: PNode, kind: TNodeKind): bool = case n.kind of nkEmpty..nkNilLit: result = n.kind == kind else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if (n.sons[i].kind == kind) or hasSubnodeWith(n.sons[i], kind): return true result = false diff --git a/compiler/astalgo.nim b/compiler/astalgo.nim index 700092e67..cfa1a67fd 100644 --- a/compiler/astalgo.nim +++ b/compiler/astalgo.nim @@ -160,14 +160,14 @@ proc lookupInRecord(n: PNode, field: PIdent): PSym = result = nil case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = lookupInRecord(n.sons[i], field) if result != nil: return of nkRecCase: if (n.sons[0].kind != nkSym): return nil result = lookupInRecord(n.sons[0], field) if result != nil: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = lookupInRecord(lastSon(n.sons[i]), field) @@ -183,7 +183,7 @@ proc getModule*(s: PSym): PSym = while result != nil and result.kind != skModule: result = result.owner proc getSymFromList*(list: PNode, ident: PIdent, start: int = 0): PSym = - for i in start ..< sonsLen(list): + for i in start ..< len(list): if list.sons[i].kind == nkSym: result = list.sons[i].sym if result.name.id == ident.id: return @@ -326,9 +326,9 @@ proc typeToYamlAux(conf: ConfigRef; n: PType, marker: var IntSet, indent: int, sonsRope = "\"$1 @$2\"" % [rope($n.kind), rope( strutils.toHex(cast[ByteAddress](n), sizeof(n) * 2))] else: - if sonsLen(n) > 0: + if len(n) > 0: sonsRope = rope("[") - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if i > 0: add(sonsRope, ",") addf(sonsRope, "$N$1$2", [rspaces(indent + 4), typeToYamlAux(conf, n.sons[i], marker, indent + 4, maxRecDepth - 1)]) @@ -375,9 +375,9 @@ proc treeToYamlAux(conf: ConfigRef; n: PNode, marker: var IntSet, indent: int, else: addf(result, ",$N$1\"ident\": null", [istr]) else: - if sonsLen(n) > 0: + if len(n) > 0: addf(result, ",$N$1\"sons\": [", [istr]) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if i > 0: add(result, ",") addf(result, "$N$1$2", [rspaces(indent + 4), treeToYamlAux(conf, n.sons[i], marker, indent + 4, maxRecDepth - 1)]) @@ -562,12 +562,12 @@ proc value(this: var DebugPrinter; value: PType) = this.key "n" this.value value.n - if sonsLen(value) > 0: + if len(value) > 0: this.key "sons" this.openBracket - for i in 0 ..< sonsLen(value): + for i in 0 ..< len(value): this.value value.sons[i] - if i != sonsLen(value) - 1: + if i != len(value) - 1: this.comma this.closeBracket @@ -615,12 +615,12 @@ proc value(this: var DebugPrinter; value: PNode) = if this.renderSymType and value.typ != nil: this.key "typ" this.value value.typ - if sonsLen(value) > 0: + if len(value) > 0: this.key "sons" this.openBracket - for i in 0 ..< sonsLen(value): + for i in 0 ..< len(value): this.value value.sons[i] - if i != sonsLen(value) - 1: + if i != len(value) - 1: this.comma this.closeBracket diff --git a/compiler/canonicalizer.nim b/compiler/canonicalizer.nim index 8c418b790..1cf6171c1 100644 --- a/compiler/canonicalizer.nim +++ b/compiler/canonicalizer.nim @@ -120,7 +120,7 @@ proc hashType(c: var MD5Context, t: PType) = case t.kind of tyGenericBody, tyGenericInst, tyGenericInvocation: - for i in 0 ..< sonsLen(t)-ord(t.kind != tyGenericInvocation): + for i in 0 ..< len(t)-ord(t.kind != tyGenericInvocation): c.hashType t.sons[i] of tyUserTypeClass: internalAssert t.sym != nil and t.sym.owner != nil @@ -128,7 +128,7 @@ proc hashType(c: var MD5Context, t: PType) = of tyUserTypeClassInst: let body = t.base c.hashSym body.sym - for i in 1 .. sonsLen(t) - 2: + for i in 1 .. len(t) - 2: c.hashType t.sons[i] of tyFromExpr: c.hashTree(t.n) @@ -137,15 +137,15 @@ proc hashType(c: var MD5Context, t: PType) = c.hashType(t.sons[1]) of tyTuple: if t.n != nil: - assert(sonsLen(t.n) == sonsLen(t)) - for i in 0 ..< sonsLen(t.n): + assert(len(t.n) == len(t)) + for i in 0 ..< len(t.n): assert(t.n.sons[i].kind == nkSym) c &= t.n.sons[i].sym.name.s c &= ":" c.hashType(t.sons[i]) c &= "," else: - for i in 0 ..< sonsLen(t): c.hashType t.sons[i] + for i in 0 ..< len(t): c.hashType t.sons[i] of tyRange: c.hashTree(t.n) c.hashType(t.sons[0]) @@ -238,7 +238,7 @@ proc encodeNode(w: PRodWriter, fInfo: TLineInfo, n: PNode, encodeVInt(n.sym.id, result) pushSym(w, n.sym) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): encodeNode(w, n.info, n.sons[i], result) add(result, ')') @@ -304,7 +304,7 @@ proc encodeType(w: PRodWriter, t: PType, result: var string) = add(result, '=') encodeVInt(t.align, result) encodeLoc(w, t.loc, result) - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): if t.sons[i] == nil: add(result, "^()") else: diff --git a/compiler/ccgcalls.nim b/compiler/ccgcalls.nim index 53ebc2806..84b59d632 100644 --- a/compiler/ccgcalls.nim +++ b/compiler/ccgcalls.nim @@ -186,7 +186,7 @@ proc genArgNoParam(p: BProc, n: PNode): Rope = result = rdLoc(a) template genParamLoop(params) {.dirty.} = - if i < sonsLen(typ): + if i < len(typ): assert(typ.n.sons[i].kind == nkSym) let paramType = typ.n.sons[i] if not paramType.typ.isCompileTimeOnly: @@ -209,8 +209,8 @@ proc genPrefixCall(p: BProc, le, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri.sons[0].typ, abstractInstOwned) assert(typ.kind == tyProc) - assert(sonsLen(typ) == sonsLen(typ.n)) - var length = sonsLen(ri) + assert(len(typ) == len(typ.n)) + var length = len(ri) for i in 1 ..< length: genParamLoop(params) var callee = rdLoc(op) @@ -234,9 +234,9 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = var typ = skipTypes(ri.sons[0].typ, abstractInst) assert(typ.kind == tyProc) - var length = sonsLen(ri) + var length = len(ri) for i in 1 ..< length: - assert(sonsLen(typ) == sonsLen(typ.n)) + assert(len(typ) == len(typ.n)) genParamLoop(pl) template genCallPattern {.dirty.} = @@ -248,7 +248,7 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = let rawProc = getRawProcType(p, typ) if typ.sons[0] != nil: if isInvalidReturnType(p.config, typ.sons[0]): - if sonsLen(ri) > 1: add(pl, ~", ") + if len(ri) > 1: add(pl, ~", ") # beware of 'result = p(result)'. We may need to allocate a temporary: if d.k in {locTemp, locNone} or not leftAppearsOnRightSide(le, ri): # Great, we can use 'd': @@ -280,7 +280,7 @@ proc genClosureCall(p: BProc, le, ri: PNode, d: var TLoc) = genCallPattern() proc genOtherArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = - if i < sonsLen(typ): + if i < len(typ): # 'var T' is 'T&' in C++. This means we ignore the request of # any nkHiddenAddr when it's a 'var T'. let paramType = typ.n.sons[i] @@ -357,7 +357,7 @@ proc genThisArg(p: BProc; ri: PNode; i: int; typ: PType): Rope = # for better or worse c2nim translates the 'this' argument to a 'var T'. # However manual wrappers may also use 'ptr T'. In any case we support both # for convenience. - internalAssert p.config, i < sonsLen(typ) + internalAssert p.config, i < len(typ) assert(typ.n.sons[i].kind == nkSym) # if the parameter is lying (tyVar) and thus we required an additional deref, # skip the deref: @@ -448,8 +448,8 @@ proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri.sons[0].typ, abstractInst) assert(typ.kind == tyProc) - var length = sonsLen(ri) - assert(sonsLen(typ) == sonsLen(typ.n)) + var length = len(ri) + assert(len(typ) == len(typ.n)) # don't call '$' here for efficiency: let pat = ri.sons[0].sym.loc.r.data internalAssert p.config, pat.len > 0 @@ -484,7 +484,7 @@ proc genInfixCall(p: BProc, le, ri: PNode, d: var TLoc) = var params: Rope for i in 2 ..< length: if params != nil: params.add(~", ") - assert(sonsLen(typ) == sonsLen(typ.n)) + assert(len(typ) == len(typ.n)) add(params, genOtherArg(p, ri, i, typ)) fixupCall(p, le, ri, d, pl, params) @@ -496,8 +496,8 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = # getUniqueType() is too expensive here: var typ = skipTypes(ri.sons[0].typ, abstractInst) assert(typ.kind == tyProc) - var length = sonsLen(ri) - assert(sonsLen(typ) == sonsLen(typ.n)) + var length = len(ri) + assert(len(typ) == len(typ.n)) # don't call '$' here for efficiency: let pat = ri.sons[0].sym.loc.r.data @@ -519,8 +519,8 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = add(pl, ~": ") add(pl, genArg(p, ri.sons[2], typ.n.sons[2].sym, ri)) for i in start ..< length: - assert(sonsLen(typ) == sonsLen(typ.n)) - if i >= sonsLen(typ): + assert(len(typ) == len(typ.n)) + if i >= len(typ): internalError(p.config, ri.info, "varargs for objective C method?") assert(typ.n.sons[i].kind == nkSym) var param = typ.n.sons[i].sym @@ -530,7 +530,7 @@ proc genNamedParamCall(p: BProc, ri: PNode, d: var TLoc) = add(pl, genArg(p, ri.sons[i], param, ri)) if typ.sons[0] != nil: if isInvalidReturnType(p.config, typ.sons[0]): - if sonsLen(ri) > 1: add(pl, ~" ") + if len(ri) > 1: add(pl, ~" ") # beware of 'result = p(result)'. We always allocate a temporary: if d.k in {locTemp, locNone}: # We already got a temp. Great, special case it: diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index fa3a1fb86..f29995202 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -797,7 +797,7 @@ proc genInExprAux(p: BProc, e: PNode, a, b, d: var TLoc) proc genFieldCheck(p: BProc, e: PNode, obj: Rope, field: PSym) = var test, u, v: TLoc - for i in 1 ..< sonsLen(e): + for i in 1 ..< len(e): var it = e.sons[i] assert(it.kind in nkCallKinds) assert(it.sons[0].kind == nkSym) @@ -1087,7 +1087,7 @@ proc genStrConcat(p: BProc, e: PNode, d: var TLoc) = var L = 0 var appends: Rope = nil var lens: Rope = nil - for i in 0 .. sonsLen(e) - 2: + for i in 0 .. len(e) - 2: # compute the length expression: initLocExpr(p, e.sons[i + 1], a) if skipTypes(e.sons[i + 1].typ, abstractVarRange).kind == tyChar: @@ -1126,7 +1126,7 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = assert(d.k == locNone) var L = 0 initLocExpr(p, e.sons[1], dest) - for i in 0 .. sonsLen(e) - 3: + for i in 0 .. len(e) - 3: # compute the length expression: initLocExpr(p, e.sons[i + 2], a) if skipTypes(e.sons[i + 2].typ, abstractVarRange).kind == tyChar: @@ -1402,7 +1402,7 @@ proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = elif d.k == locNone: getTemp(p, n.typ, d) - let l = intLiteral(sonsLen(n)) + let l = intLiteral(len(n)) if p.config.selectedGC == gcDestructors: let seqtype = n.typ linefmt(p, cpsStmts, "$1.len = $2; $1.p = ($4*) #newSeqPayload($2, sizeof($3));$n", @@ -1412,7 +1412,7 @@ proc genSeqConstr(p: BProc, n: PNode, d: var TLoc) = # generate call to newSeq before adding the elements per hand: genNewSeqAux(p, dest[], l, optNilSeqs notin p.options and n.len == 0) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): initLoc(arr, locExpr, n[i], OnHeap) arr.r = ropecg(p.module, "$1$3[$2]", [rdLoc(dest[]), intLiteral(i), dataField(p)]) arr.storage = OnHeap # we know that sequences are on the heap @@ -1728,7 +1728,7 @@ proc fewCmps(conf: ConfigRef; s: PNode): bool = elif elemType(s.typ).kind in {tyInt, tyInt16..tyInt64}: result = true # better not emit the set if int is basetype! else: - result = sonsLen(s) <= 8 # 8 seems to be a good value + result = len(s) <= 8 # 8 seems to be a good value template binaryExprIn(p: BProc, e: PNode, a, b, d: var TLoc, frmt: string) = putIntoDest(p, d, e, frmt % [rdLoc(a), rdSetElemLoc(p.config, b, a.t)]) @@ -1761,7 +1761,7 @@ proc genInOp(p: BProc, e: PNode, d: var TLoc) = e.sons[2] initLocExpr(p, ea, a) initLoc(b, locExpr, e, OnUnknown) - var length = sonsLen(e.sons[1]) + var length = len(e.sons[1]) if length > 0: b.r = rope("(") for i in 0 ..< length: @@ -2323,7 +2323,7 @@ proc genTupleConstr(p: BProc, n: PNode, d: var TLoc) = let t = n.typ discard getTypeDesc(p.module, t) # so that any fields are initialized if d.k == locNone: getTemp(p, t, d) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it.kind == nkExprColonExpr: it = it.sons[1] initLoc(rec, locExpr, it, d.storage) @@ -2365,7 +2365,7 @@ proc genArrayConstr(p: BProc, n: PNode, d: var TLoc) = var arr: TLoc if not handleConstExpr(p, n, d): if d.k == locNone: getTemp(p, n.typ, d) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): initLoc(arr, locExpr, lodeTyp elemType(skipTypes(n.typ, abstractInst)), d.storage) arr.r = "$1[$2]" % [rdLoc(d), intLiteral(i)] expr(p, n.sons[i], arr) @@ -2748,7 +2748,7 @@ proc getNullValueAux(p: BProc; t: PType; obj, cons: PNode, getNullValueAux(p, t, it, cons, result, count) of nkRecCase: getNullValueAux(p, t, obj.sons[0], cons, result, count) - for i in 1 ..< sonsLen(obj): + for i in 1 ..< len(obj): getNullValueAux(p, t, lastSon(obj.sons[i]), cons, result, count) of nkSym: if count > 0: result.add ", " @@ -2796,7 +2796,7 @@ proc genConstObjConstr(p: BProc; n: PNode): Rope = result = "{$1}$n" % [result] proc genConstSimpleList(p: BProc, n: PNode): Rope = - var length = sonsLen(n) + var length = len(n) result = rope("{") for i in 0 .. length - 2: addf(result, "$1,$n", [genNamedConstExpr(p, n.sons[i])]) diff --git a/compiler/ccgstmts.nim b/compiler/ccgstmts.nim index 29e245ef7..ec579d9e7 100644 --- a/compiler/ccgstmts.nim +++ b/compiler/ccgstmts.nim @@ -62,7 +62,7 @@ proc endBlock(p: BProc) proc genVarTuple(p: BProc, n: PNode) = var tup, field: TLoc if n.kind != nkVarTuple: internalError(p.config, n.info, "genVarTuple") - var L = sonsLen(n) + var L = len(n) # if we have a something that's been captured, use the lowering instead: for i in 0 .. L-3: @@ -326,7 +326,7 @@ proc genSingleVar(p: BProc, v: PSym; vn, value: PNode) = assert(typ.kind == tyProc) for i in 1..<value.len: if params != nil: params.add(~", ") - assert(sonsLen(typ) == sonsLen(typ.n)) + assert(len(typ) == len(typ.n)) add(params, genOtherArg(p, value, i, typ)) if params == nil: lineF(p, cpsStmts, "$#;$n", [decl]) @@ -429,7 +429,7 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = else: expr(p, it.sons[1], d) endBlock(p) - if sonsLen(n) > 1: + if len(n) > 1: lineF(p, cpsStmts, "goto $1;$n", [lend]) fixLabel(p, lelse) elif it.len == 1: @@ -437,7 +437,7 @@ proc genIf(p: BProc, n: PNode, d: var TLoc) = expr(p, it.sons[0], d) endBlock(p) else: internalError(p.config, n.info, "genIf()") - if sonsLen(n) > 1: fixLabel(p, lend) + if len(n) > 1: fixLabel(p, lend) proc genReturnStmt(p: BProc, t: PNode) = if nfPreventCg in t.flags: return @@ -565,7 +565,7 @@ proc genWhileStmt(p: BProc, t: PNode) = # significantly worse code var a: TLoc - assert(sonsLen(t) == 2) + assert(len(t) == 2) inc(p.withinLoop) genLineDir(p, t) @@ -612,7 +612,7 @@ proc genBlock(p: BProc, n: PNode, d: var TLoc) = endBlock(p) proc genParForStmt(p: BProc, t: PNode) = - assert(sonsLen(t) == 3) + assert(len(t) == 3) inc(p.withinLoop) genLineDir(p, t) @@ -623,12 +623,12 @@ proc genParForStmt(p: BProc, t: PNode) = #initLoc(forLoopVar.loc, locLocalVar, forLoopVar.typ, onStack) #discard mangleName(forLoopVar) let call = t.sons[1] - assert(sonsLen(call) in {4, 5}) + assert(len(call) in {4, 5}) initLocExpr(p, call.sons[1], rangeA) initLocExpr(p, call.sons[2], rangeB) # $n at the beginning because of #9710 - if call.sonsLen == 4: # `||`(a, b, annotation) + if call.len == 4: # `||`(a, b, annotation) lineF(p, cpsStmts, "$n#pragma omp $4$n" & "for ($1 = $2; $1 <= $3; ++$1)", [forLoopVar.loc.rdLoc, @@ -706,7 +706,7 @@ template genCaseGenericBranch(p: BProc, b: PNode, e: TLoc, rangeFormat, eqFormat: FormatStr, labl: TLabel) = var x, y: TLoc - var length = sonsLen(b) + var length = len(b) for i in 0 .. length - 2: if b.sons[i].kind == nkRange: initLocExpr(p, b.sons[i].sons[0], x) @@ -725,7 +725,7 @@ proc genCaseSecondPass(p: BProc, t: PNode, d: var TLoc, if d.k == locTemp and isEmptyType(t.typ): d.k = locNone lineF(p, cpsStmts, "LA$1_: ;$n", [rope(labId + i)]) if t.sons[i].kind == nkOfBranch: - var length = sonsLen(t.sons[i]) + var length = len(t.sons[i]) exprBlock(p, t.sons[i].sons[length - 1], d) lineF(p, cpsStmts, "goto $1;$n", [lend]) else: @@ -759,13 +759,13 @@ template genCaseGeneric(p: BProc, t: PNode, d: var TLoc, rangeFormat, eqFormat: FormatStr) = var a: TLoc initLocExpr(p, t.sons[0], a) - var lend = genIfForCaseUntil(p, t, d, rangeFormat, eqFormat, sonsLen(t)-1, a) + var lend = genIfForCaseUntil(p, t, d, rangeFormat, eqFormat, len(t)-1, a) fixLabel(p, lend) proc genCaseStringBranch(p: BProc, b: PNode, e: TLoc, labl: TLabel, branches: var openArray[Rope]) = var x: TLoc - var length = sonsLen(b) + var length = len(b) for i in 0 .. length - 2: assert(b.sons[i].kind != nkRange) initLocExpr(p, b.sons[i], x) @@ -777,8 +777,8 @@ proc genCaseStringBranch(p: BProc, b: PNode, e: TLoc, labl: TLabel, proc genStringCase(p: BProc, t: PNode, d: var TLoc) = # count how many constant strings there are in the case: var strings = 0 - for i in 1 ..< sonsLen(t): - if t.sons[i].kind == nkOfBranch: inc(strings, sonsLen(t.sons[i]) - 1) + for i in 1 ..< len(t): + if t.sons[i].kind == nkOfBranch: inc(strings, len(t.sons[i]) - 1) if strings > stringCaseThreshold: var bitMask = math.nextPowerOfTwo(strings) - 1 var branches: seq[Rope] @@ -786,7 +786,7 @@ proc genStringCase(p: BProc, t: PNode, d: var TLoc) = var a: TLoc initLocExpr(p, t.sons[0], a) # fist pass: gnerate ifs+goto: var labId = p.labels - for i in 1 ..< sonsLen(t): + for i in 1 ..< len(t): inc(p.labels) if t.sons[i].kind == nkOfBranch: genCaseStringBranch(p, t.sons[i], a, "LA" & rope(p.labels) & "_", @@ -802,16 +802,16 @@ proc genStringCase(p: BProc, t: PNode, d: var TLoc) = lineF(p, cpsStmts, "case $1: $n$2break;$n", [intLiteral(j), branches[j]]) lineF(p, cpsStmts, "}$n", []) # else statement: - if t.sons[sonsLen(t)-1].kind != nkOfBranch: + if t.sons[len(t)-1].kind != nkOfBranch: lineF(p, cpsStmts, "goto LA$1_;$n", [rope(p.labels)]) # third pass: generate statements - var lend = genCaseSecondPass(p, t, d, labId, sonsLen(t)-1) + var lend = genCaseSecondPass(p, t, d, labId, len(t)-1) fixLabel(p, lend) else: genCaseGeneric(p, t, d, "", "if (#eqStrings($1, $2)) goto $3;$n") proc branchHasTooBigRange(b: PNode): bool = - for i in 0 .. sonsLen(b)-2: + for i in 0 .. len(b)-2: # last son is block if (b.sons[i].kind == nkRange) and b.sons[i].sons[1].intVal - b.sons[i].sons[0].intVal > RangeExpandLimit: @@ -1023,7 +1023,7 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = else: linefmt(p, cpsStmts, "$1.status = setjmp($1.context);$n", [safePoint]) startBlock(p, "if ($1.status == 0) {$n", [safePoint]) - let length = sonsLen(t) + let length = len(t) let fin = if t[^1].kind == nkFinally: t[^1] else: nil add(p.nestedTryStmts, (fin, quirkyExceptions)) expr(p, t.sons[0], d) @@ -1042,7 +1042,7 @@ proc genTry(p: BProc, t: PNode, d: var TLoc) = while (i < length) and (t.sons[i].kind == nkExceptBranch): # bug #4230: avoid false sharing between branches: if d.k == locTemp and isEmptyType(t.typ): d.k = locNone - var blen = sonsLen(t.sons[i]) + var blen = len(t.sons[i]) if blen == 1: # general except section: if i > 1: lineF(p, cpsStmts, "else", []) diff --git a/compiler/ccgtrav.nim b/compiler/ccgtrav.nim index 221c7a139..9374648c4 100644 --- a/compiler/ccgtrav.nim +++ b/compiler/ccgtrav.nim @@ -28,7 +28,7 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; if n == nil: return case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): genTraverseProc(c, accessor, n.sons[i], typ) of nkRecCase: if (n.sons[0].kind != nkSym): internalError(c.p.config, n.info, "genTraverseProc") @@ -38,7 +38,7 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, n: PNode; if disc.loc.t == nil: internalError(c.p.config, n.info, "genTraverseProc()") lineF(p, cpsStmts, "switch ($1.$2) {$n", [accessor, disc.loc.r]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let branch = n.sons[i] assert branch.kind in {nkOfBranch, nkElse} if branch.kind == nkOfBranch: @@ -87,14 +87,14 @@ proc genTraverseProc(c: TTraversalClosure, accessor: Rope, typ: PType) = else: lineF(p, cpsStmts, "}$n", []) of tyObject: - for i in 0 ..< sonsLen(typ): + for i in 0 ..< len(typ): var x = typ.sons[i] if x != nil: x = x.skipTypes(skipPtrs) genTraverseProc(c, accessor.parentObj(c.p.module), x) if typ.n != nil: genTraverseProc(c, accessor, typ.n, typ) of tyTuple: let typ = getUniqueType(typ) - for i in 0 ..< sonsLen(typ): + for i in 0 ..< len(typ): genTraverseProc(c, ropecg(c.p.module, "$1.Field$2", [accessor, i]), typ.sons[i]) of tyRef: lineCg(p, cpsStmts, visitorFrmt, [accessor, c.visitorFrmt]) diff --git a/compiler/ccgtypes.nim b/compiler/ccgtypes.nim index 5c5999e82..3b8d93a5a 100644 --- a/compiler/ccgtypes.nim +++ b/compiler/ccgtypes.nim @@ -450,7 +450,7 @@ proc genProcParams(m: BModule, t: PType, rettype, params: var Rope, rettype = ~"void" else: rettype = getTypeDescAux(m, t.sons[0], check) - for i in 1 ..< sonsLen(t.n): + for i in 1 ..< len(t.n): if t.n.sons[i].kind != nkSym: internalError(m.config, t.n.info, "genProcParams") var param = t.n.sons[i].sym if isCompileTimeOnly(param.typ): continue @@ -511,7 +511,7 @@ proc genRecordFieldsAux(m: BModule, n: PNode, result = nil case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): add(result, genRecordFieldsAux(m, n.sons[i], rectype, check)) of nkRecCase: if n.sons[0].kind != nkSym: internalError(m.config, n.info, "genRecordFieldsAux") @@ -519,7 +519,7 @@ proc genRecordFieldsAux(m: BModule, n: PNode, # prefix mangled name with "_U" to avoid clashes with other field names, # since identifiers are not allowed to start with '_' var unionBody: Rope = nil - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: let k = lastSon(n.sons[i]) @@ -634,7 +634,7 @@ proc getTupleDesc(m: BModule, typ: PType, name: Rope, check: var IntSet): Rope = result = "$1 $2 {$n" % [structOrUnion(typ), name] var desc: Rope = nil - for i in 0 ..< sonsLen(typ): + for i in 0 ..< len(typ): addf(desc, "$1 Field$2;$n", [getTypeDescAux(m, typ.sons[i], check), rope(i)]) if desc == nil: add(result, "char dummy;\L") @@ -1028,7 +1028,7 @@ proc genTypeInfoAuxBase(m: BModule; typ, origType: PType; proc genTypeInfoAux(m: BModule, typ, origType: PType, name: Rope; info: TLineInfo) = var base: Rope - if sonsLen(typ) > 0 and typ.lastSon != nil: + if len(typ) > 0 and typ.lastSon != nil: var x = typ.lastSon if typ.kind == tyObject: x = x.skipTypes(skipPtrs) if typ.kind == tyPtr and x.kind == tyObject and incompleteType(x): @@ -1067,7 +1067,7 @@ proc genObjectFields(m: BModule, typ, origType: PType, n: PNode, expr: Rope; info: TLineInfo) = case n.kind of nkRecList: - var L = sonsLen(n) + var L = len(n) if L == 1: genObjectFields(m, typ, origType, n.sons[0], expr, info) elif L > 0: @@ -1098,15 +1098,15 @@ proc genObjectFields(m: BModule, typ, origType: PType, n: PNode, expr: Rope; makeCString(field.name.s), tmp, rope(L)]) addf(m.s[cfsData], "TNimNode* $1[$2];$n", [tmp, rope(L+1)]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var b = n.sons[i] # branch var tmp2 = getNimNode(m) genObjectFields(m, typ, origType, lastSon(b), tmp2, info) case b.kind of nkOfBranch: - if sonsLen(b) < 2: + if len(b) < 2: internalError(m.config, b.info, "genObjectFields; nkOfBranch broken") - for j in 0 .. sonsLen(b) - 2: + for j in 0 .. len(b) - 2: if b.sons[j].kind == nkRange: var x = toInt(getOrdValue(b.sons[j].sons[0])) var y = toInt(getOrdValue(b.sons[j].sons[1])) @@ -1155,7 +1155,7 @@ proc genObjectInfo(m: BModule, typ, origType: PType, name: Rope; info: TLineInfo proc genTupleInfo(m: BModule, typ, origType: PType, name: Rope; info: TLineInfo) = genTypeInfoAuxBase(m, typ, typ, name, rope("0"), info) var expr = getNimNode(m) - var length = sonsLen(typ) + var length = len(typ) if length > 0: var tmp = getTempName(m) & "_" & $length genTNimNodeArray(m, tmp, rope(length)) @@ -1181,7 +1181,7 @@ proc genEnumInfo(m: BModule, typ: PType, name: Rope; info: TLineInfo) = # anyway. We generate a cstring array and a loop over it. Exceptional # positions will be reset after the loop. genTypeInfoAux(m, typ, typ, name, info) - var length = sonsLen(typ.n) + var length = len(typ.n) var nodePtrs = getTempName(m) & "_" & $length genTNimNodeArray(m, nodePtrs, rope(length)) var enumNames, specialCases: Rope diff --git a/compiler/cgen.nim b/compiler/cgen.nim index ba240a020..625e48328 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -990,7 +990,7 @@ proc genProcAux(m: BModule, prc: PSym) = #incl(res.loc.flags, lfIndirect) res.loc.storage = OnUnknown - for i in 1 ..< sonsLen(prc.typ.n): + for i in 1 ..< len(prc.typ.n): let param = prc.typ.n.sons[i].sym if param.typ.isCompileTimeOnly: continue assignParam(p, param, prc.typ[0]) diff --git a/compiler/cgmeth.nim b/compiler/cgmeth.nim index d83ca3c55..180cfc334 100644 --- a/compiler/cgmeth.nim +++ b/compiler/cgmeth.nim @@ -48,7 +48,7 @@ proc methodCall*(n: PNode; conf: ConfigRef): PNode = if disp != nil: result.sons[0].sym = disp # change the arguments to up/downcasts to fit the dispatcher's parameters: - for i in 1 ..< sonsLen(result): + for i in 1 ..< len(result): result.sons[i] = genConv(result.sons[i], disp.typ.sons[i], true, conf) else: localError(conf, n.info, "'" & $result.sons[0] & "' lacks a dispatcher") @@ -58,10 +58,10 @@ type proc sameMethodBucket(a, b: PSym; multiMethods: bool): MethodResult = if a.name.id != b.name.id: return - if sonsLen(a.typ) != sonsLen(b.typ): + if len(a.typ) != len(b.typ): return - for i in 1 ..< sonsLen(a.typ): + for i in 1 ..< len(a.typ): var aa = a.typ.sons[i] var bb = b.typ.sons[i] while true: @@ -118,7 +118,7 @@ proc createDispatcher(s: PSym): PSym = disp.ast.sons[bodyPos] = newNodeI(nkEmpty, s.info) disp.loc.r = nil if s.typ.sons[0] != nil: - if disp.ast.sonsLen > resultPos: + if disp.ast.len > resultPos: disp.ast.sons[resultPos].sym = copySym(s.ast.sons[resultPos].sym) else: # We've encountered a method prototype without a filled-in @@ -136,7 +136,7 @@ proc fixupDispatcher(meth, disp: PSym; conf: ConfigRef) = # from later definitions, particularly the resultPos slot. Also, # the lock level of the dispatcher needs to be updated/checked # against that of the method. - if disp.ast.sonsLen > resultPos and meth.ast.sonsLen > resultPos and + if disp.ast.len > resultPos and meth.ast.len > resultPos and disp.ast.sons[resultPos].kind == nkEmpty: disp.ast.sons[resultPos] = copyTree(meth.ast.sons[resultPos]) @@ -198,7 +198,7 @@ proc relevantCol(methods: seq[PSym], col: int): bool = return true proc cmpSignatures(a, b: PSym, relevantCols: IntSet): int = - for col in 1 ..< sonsLen(a.typ): + for col in 1 ..< len(a.typ): if contains(relevantCols, col): var aa = skipTypes(a.typ.sons[col], skipPtrs) var bb = skipTypes(b.typ.sons[col], skipPtrs) @@ -228,7 +228,7 @@ proc sortBucket(a: var seq[PSym], relevantCols: IntSet) = proc genDispatcher(g: ModuleGraph; methods: seq[PSym], relevantCols: IntSet): PSym = var base = methods[0].ast[dispatcherPos].sym result = base - var paramLen = sonsLen(base.typ) + var paramLen = len(base.typ) var nilchecks = newNodeI(nkStmtList, base.info) var disp = newNodeI(nkIfStmt, base.info) var ands = getSysMagic(g, unknownLineInfo(), "and", mAnd) @@ -288,7 +288,7 @@ proc generateMethodDispatchers*(g: ModuleGraph): PNode = result = newNode(nkStmtList) for bucket in 0 ..< len(g.methods): var relevantCols = initIntSet() - for col in 1 ..< sonsLen(g.methods[bucket].methods[0].typ): + for col in 1 ..< len(g.methods[bucket].methods[0].typ): if relevantCol(g.methods[bucket].methods, col): incl(relevantCols, col) if optMultiMethods notin g.config.globalOptions: # if multi-methods are not enabled, we are interested only in the first field diff --git a/compiler/depends.nim b/compiler/depends.nim index 603f67e77..15d30dd5b 100644 --- a/compiler/depends.nim +++ b/compiler/depends.nim @@ -34,14 +34,14 @@ proc addDotDependency(c: PPassContext, n: PNode): PNode = let b = Backend(g.graph.backend) case n.kind of nkImportStmt: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var imported = getModuleName(g.config, n.sons[i]) addDependencyAux(b, g.module.name.s, imported) of nkFromStmt, nkImportExceptStmt: var imported = getModuleName(g.config, n.sons[0]) addDependencyAux(b, g.module.name.s, imported) of nkStmtList, nkBlockStmt, nkStmtListExpr, nkBlockExpr: - for i in 0 ..< sonsLen(n): discard addDotDependency(c, n.sons[i]) + for i in 0 ..< len(n): discard addDotDependency(c, n.sons[i]) else: discard diff --git a/compiler/docgen.nim b/compiler/docgen.nim index 3e2e5eac6..dc2e6ab3f 100644 --- a/compiler/docgen.nim +++ b/compiler/docgen.nim @@ -872,13 +872,13 @@ proc generateDoc*(d: PDoc, n, orig: PNode) = when useEffectSystem: documentRaises(d.cache, n) genItem(d, n, n.sons[namePos], skConverter) of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n.sons[i].kind != nkCommentStmt: # order is always 'type var let const': genItem(d, n.sons[i], n.sons[i].sons[0], succ(skType, ord(n.kind)-ord(nkTypeSection))) of nkStmtList: - for i in 0 ..< sonsLen(n): generateDoc(d, n.sons[i], orig) + for i in 0 ..< len(n): generateDoc(d, n.sons[i], orig) of nkWhenStmt: # generate documentation for the first branch only: if not checkForFalse(n.sons[0].sons[0]): @@ -926,13 +926,13 @@ proc generateJson*(d: PDoc, n: PNode, includeComments: bool = true) = when useEffectSystem: documentRaises(d.cache, n) d.add genJsonItem(d, n, n.sons[namePos], skConverter) of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n.sons[i].kind != nkCommentStmt: # order is always 'type var let const': d.add genJsonItem(d, n.sons[i], n.sons[i].sons[0], succ(skType, ord(n.kind)-ord(nkTypeSection))) of nkStmtList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): generateJson(d, n.sons[i], includeComments) of nkWhenStmt: # generate documentation for the first branch only: @@ -969,13 +969,13 @@ proc generateTags*(d: PDoc, n: PNode, r: var Rope) = when useEffectSystem: documentRaises(d.cache, n) r.add genTagsItem(d, n, n.sons[namePos], skConverter) of nkTypeSection, nkVarSection, nkLetSection, nkConstSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n.sons[i].kind != nkCommentStmt: # order is always 'type var let const': r.add genTagsItem(d, n.sons[i], n.sons[i].sons[0], succ(skType, ord(n.kind)-ord(nkTypeSection))) of nkStmtList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): generateTags(d, n.sons[i], r) of nkWhenStmt: # generate documentation for the first branch only: diff --git a/compiler/evalffi.nim b/compiler/evalffi.nim index b1decbc82..5fac138ac 100644 --- a/compiler/evalffi.nim +++ b/compiler/evalffi.nim @@ -138,13 +138,13 @@ proc pack(conf: ConfigRef, v: PNode, typ: PType, res: pointer) proc getField(conf: ConfigRef, n: PNode; position: int): PSym = case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = getField(conf, n.sons[i], position) if result != nil: return of nkRecCase: result = getField(conf, n.sons[0], position) if result != nil: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = getField(conf, lastSon(n.sons[i]), position) @@ -158,7 +158,7 @@ proc packObject(conf: ConfigRef, x: PNode, typ: PType, res: pointer) = internalAssert conf, x.kind in {nkObjConstr, nkPar, nkTupleConstr} # compute the field's offsets: discard getSize(conf, typ) - for i in ord(x.kind == nkObjConstr) ..< sonsLen(x): + for i in ord(x.kind == nkObjConstr) ..< len(x): var it = x.sons[i] if it.kind == nkExprColonExpr: internalAssert conf, it.sons[0].kind == nkSym @@ -245,7 +245,7 @@ proc unpack(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode proc unpackObjectAdd(conf: ConfigRef, x: pointer, n, result: PNode) = case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): unpackObjectAdd(conf, x, n.sons[i], result) of nkRecCase: globalError(conf, result.info, "case objects cannot be unpacked") @@ -275,7 +275,7 @@ proc unpackObject(conf: ConfigRef, x: pointer, typ: PType, n: PNode): PNode = globalError(conf, n.info, "cannot map value from FFI") if typ.n.isNil: globalError(conf, n.info, "cannot unpack unnamed tuple") - for i in ord(n.kind == nkObjConstr) ..< sonsLen(n): + for i in ord(n.kind == nkObjConstr) ..< len(n): var it = n.sons[i] if it.kind == nkExprColonExpr: internalAssert conf, it.sons[0].kind == nkSym diff --git a/compiler/evaltempl.nim b/compiler/evaltempl.nim index 8ac7d82be..1fc7fd3db 100644 --- a/compiler/evaltempl.nim +++ b/compiler/evaltempl.nim @@ -68,7 +68,7 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = # "declarative" context (bug #9235). if c.isDeclarative: var res = copyNode(c, templ, actual) - for i in 0 ..< sonsLen(templ): + for i in 0 ..< len(templ): evalTemplateAux(templ.sons[i], actual, c, res) result.add res else: @@ -82,7 +82,7 @@ proc evalTemplateAux(templ, actual: PNode, c: var TemplCtx, result: PNode) = c.isDeclarative = true isDeclarative = true var res = copyNode(c, templ, actual) - for i in 0 ..< sonsLen(templ): + for i in 0 ..< len(templ): evalTemplateAux(templ.sons[i], actual, c, res) result.add res if isDeclarative: c.isDeclarative = false diff --git a/compiler/filters.nim b/compiler/filters.nim index a2f7b6bbb..36fd25f2f 100644 --- a/compiler/filters.nim +++ b/compiler/filters.nim @@ -20,7 +20,7 @@ proc invalidPragma(conf: ConfigRef; n: PNode) = proc getArg(conf: ConfigRef; n: PNode, name: string, pos: int): PNode = result = nil if n.kind in {nkEmpty..nkNilLit}: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if n.sons[i].kind == nkExprEqExpr: if n.sons[i].sons[0].kind != nkIdent: invalidPragma(conf, n) if cmpIgnoreStyle(n.sons[i].sons[0].ident.s, name) == 0: diff --git a/compiler/guards.nim b/compiler/guards.nim index be23c1598..52e0a1bdd 100644 --- a/compiler/guards.nim +++ b/compiler/guards.nim @@ -442,8 +442,8 @@ proc sameTree*(a, b: PNode): bool = of nkType: result = a.typ == b.typ of nkEmpty, nkNilLit: result = true else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not sameTree(a.sons[i], b.sons[i]): return result = true diff --git a/compiler/importer.nim b/compiler/importer.nim index 2471f05aa..8d8034735 100644 --- a/compiler/importer.nim +++ b/compiler/importer.nim @@ -47,7 +47,7 @@ proc rawImportSymbol(c: PContext, s, origin: PSym) = if s.kind == skType: var etyp = s.typ if etyp.kind in {tyBool, tyEnum}: - for j in 0 ..< sonsLen(etyp.n): + for j in 0 ..< len(etyp.n): var e = etyp.n.sons[j].sym if e.kind != skEnumField: internalError(c.config, s.info, "rawImportSymbol") @@ -191,7 +191,7 @@ proc impMod(c: PContext; it: PNode; importStmtResult: PNode) = proc evalImport*(c: PContext, n: PNode): PNode = result = newNodeI(nkImportStmt, n.info) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): let it = n.sons[i] if it.kind == nkInfix and it.len == 3 and it[2].kind == nkBracket: let sep = it[0] @@ -221,7 +221,7 @@ proc evalFrom*(c: PContext, n: PNode): PNode = if m != nil: n.sons[0] = newSymNode(m) addDecl(c, m, n.info) # add symbol to symbol table of module - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if n.sons[i].kind != nkNilLit: importSymbol(c, n.sons[i], m) diff --git a/compiler/jsgen.nim b/compiler/jsgen.nim index 78373ea47..9e32805ed 100644 --- a/compiler/jsgen.nim +++ b/compiler/jsgen.nim @@ -528,7 +528,7 @@ proc arithAux(p: PProc, n: PNode, r: var TCompRes, op: TMagic) = xLoc,yLoc: Rope let i = ord(optOverflowCheck notin p.options) useMagic(p, jsMagics[op][i]) - if sonsLen(n) > 2: + if len(n) > 2: gen(p, n.sons[1], x) gen(p, n.sons[2], y) xLoc = x.rdLoc @@ -713,7 +713,7 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = r.res = getTemp(p) inc(p.unique) var i = 1 - var length = sonsLen(n) + var length = len(n) var catchBranchesExist = length > 1 and n.sons[i].kind == nkExceptBranch if catchBranchesExist: add(p.body, "++excHandler;\L") @@ -731,7 +731,7 @@ proc genTry(p: PProc, n: PNode, r: var TCompRes) = " lastJSError = EXC;$n --excHandler;$n", []) line(p, "framePtr = $1;$n" % [tmpFramePtr]) while i < length and n.sons[i].kind == nkExceptBranch: - let blen = sonsLen(n.sons[i]) + let blen = len(n.sons[i]) if blen == 1: # general except section: generalCatchBranchExists = true @@ -822,11 +822,11 @@ proc genCaseJS(p: PProc, n: PNode, r: var TCompRes) = if not isEmptyType(n.typ): r.kind = resVal r.res = getTemp(p) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let it = n.sons[i] case it.kind of nkOfBranch: - for j in 0 .. sonsLen(it) - 2: + for j in 0 .. len(it) - 2: let e = it.sons[j] if e.kind == nkRange: var v = copyNode(e.sons[0]) @@ -894,7 +894,7 @@ proc genBreakStmt(p: PProc, n: PNode) = proc genAsmOrEmitStmt(p: PProc, n: PNode) = genLineDir(p, n) p.body.add p.indentLine(nil) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): let it = n[i] case it.kind of nkStrLit..nkTripleStrLit: @@ -932,9 +932,9 @@ proc genIf(p: PProc, n: PNode, r: var TCompRes) = if not isEmptyType(n.typ): r.kind = resVal r.res = getTemp(p) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): let it = n.sons[i] - if sonsLen(it) != 1: + if len(it) != 1: if i > 0: lineF(p, "else {$n", []) inc(toClose) @@ -951,7 +951,7 @@ proc genIf(p: PProc, n: PNode, r: var TCompRes) = proc generateHeader(p: PProc, typ: PType): Rope = result = nil - for i in 1 ..< sonsLen(typ.n): + for i in 1 ..< len(typ.n): assert(typ.n.sons[i].kind == nkSym) var param = typ.n.sons[i].sym if isCompileTimeOnly(param.typ): continue @@ -964,7 +964,7 @@ proc generateHeader(p: PProc, typ: PType): Rope = add(result, "_Idx") proc countJsParams(typ: PType): int = - for i in 1 ..< sonsLen(typ.n): + for i in 1 ..< len(typ.n): assert(typ.n.sons[i].kind == nkSym) var param = typ.n.sons[i].sym if isCompileTimeOnly(param.typ): continue @@ -1405,13 +1405,13 @@ proc genArgs(p: PProc, n: PNode, r: var TCompRes; start=1) = var typ = skipTypes(n.sons[0].typ, abstractInst) assert(typ.kind == tyProc) - assert(sonsLen(typ) == sonsLen(typ.n)) + assert(len(typ) == len(typ.n)) var emitted = start-1 - for i in start ..< sonsLen(n): + for i in start ..< len(n): let it = n.sons[i] var paramType: PNode = nil - if i < sonsLen(typ): + if i < len(typ): assert(typ.n.sons[i].kind == nkSym) paramType = typ.n.sons[i] if paramType.typ.isCompileTimeOnly: continue @@ -1439,7 +1439,7 @@ proc genOtherArg(p: PProc; n: PNode; i: int; typ: PType; " but got only: " & $(n.len-1)) let it = n[i] var paramType: PNode = nil - if i < sonsLen(typ): + if i < len(typ): assert(typ.n.sons[i].kind == nkSym) paramType = typ.n.sons[i] if paramType.typ.isCompileTimeOnly: return @@ -1527,7 +1527,7 @@ proc genEcho(p: PProc, n: PNode, r: var TCompRes) = useMagic(p, "toJSStr") # Used in rawEcho useMagic(p, "rawEcho") add(r.res, "rawEcho(") - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): let it = n.sons[i] if it.typ.isCompileTimeOnly: continue if i > 0: add(r.res, ", ") @@ -1543,11 +1543,11 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope proc createRecordVarAux(p: PProc, rec: PNode, excludedFieldIDs: IntSet, output: var Rope) = case rec.kind of nkRecList: - for i in 0 ..< sonsLen(rec): + for i in 0 ..< len(rec): createRecordVarAux(p, rec.sons[i], excludedFieldIDs, output) of nkRecCase: createRecordVarAux(p, rec.sons[0], excludedFieldIDs, output) - for i in 1 ..< sonsLen(rec): + for i in 1 ..< len(rec): createRecordVarAux(p, lastSon(rec.sons[i]), excludedFieldIDs, output) of nkSym: # Do not produce code for void types @@ -1619,7 +1619,7 @@ proc createVar(p: PProc, typ: PType, indirect: bool): Rope = if indirect: result = "[$1]" % [result] of tyTuple: result = rope("{") - for i in 0..<t.sonsLen: + for i in 0..<t.len: if i > 0: add(result, ", ") addf(result, "Field$1: $2", [i.rope, createVar(p, t.sons[i], false)]) @@ -1720,7 +1720,7 @@ proc genVarInit(p: PProc, v: PSym, n: PNode) = lineF(p, "}$n") proc genVarStmt(p: PProc, n: PNode) = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind != nkCommentStmt: if a.kind == nkVarTuple: @@ -1778,15 +1778,15 @@ proc genConStrStr(p: PProc, n: PNode, r: var TCompRes) = else: r.res.add("($1 || []).concat(" % [a.res]) - for i in 2 .. sonsLen(n) - 2: + for i in 2 .. len(n) - 2: gen(p, n.sons[i], a) if skipTypes(n.sons[i].typ, abstractVarRange).kind == tyChar: r.res.add("[$1]," % [a.res]) else: r.res.add("$1 || []," % [a.res]) - gen(p, n.sons[sonsLen(n) - 1], a) - if skipTypes(n.sons[sonsLen(n) - 1].typ, abstractVarRange).kind == tyChar: + gen(p, n.sons[len(n) - 1], a) + if skipTypes(n.sons[len(n) - 1].typ, abstractVarRange).kind == tyChar: r.res.add("[$1])" % [a.res]) else: r.res.add("$1 || [])" % [a.res]) @@ -2043,7 +2043,7 @@ proc genSetConstr(p: PProc, n: PNode, r: var TCompRes) = useMagic(p, "setConstr") r.res = rope("setConstr(") r.kind = resExpr - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if i > 0: add(r.res, ", ") var it = n.sons[i] if it.kind == nkRange: @@ -2065,7 +2065,7 @@ proc genArrayConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes r.res = rope("[") r.kind = resExpr - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if i > 0: add(r.res, ", ") gen(p, n.sons[i], a) if a.typ == etyBaseIndex: @@ -2082,7 +2082,7 @@ proc genTupleConstr(p: PProc, n: PNode, r: var TCompRes) = var a: TCompRes r.res = rope("{") r.kind = resExpr - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if i > 0: add(r.res, ", ") var it = n.sons[i] if it.kind == nkExprColonExpr: it = it.sons[1] @@ -2102,7 +2102,7 @@ proc genObjConstr(p: PProc, n: PNode, r: var TCompRes) = r.kind = resExpr var initList : Rope var fieldIDs = initIntSet() - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if i > 1: add(initList, ", ") var it = n.sons[i] internalAssert p.config, it.kind == nkExprColonExpr @@ -2436,7 +2436,7 @@ proc gen(p: PProc, n: PNode, r: var TCompRes) = # this shows the distinction is nice for backends and should be kept # in the frontend let isExpr = not isEmptyType(n.typ) - for i in 0 ..< sonsLen(n) - isExpr.ord: + for i in 0 ..< len(n) - isExpr.ord: genStmt(p, n.sons[i]) if isExpr: gen(p, lastSon(n), r) @@ -2573,7 +2573,7 @@ proc wholeCode(graph: ModuleGraph; m: BModule): Rope = attachProc(p, prc) var disp = generateMethodDispatchers(graph) - for i in 0..sonsLen(disp)-1: + for i in 0..len(disp)-1: let prc = disp.sons[i].sym if not globals.generatedSyms.containsOrIncl(prc.id): var p = newProc(globals, m, nil, m.module.options) diff --git a/compiler/jstypes.nim b/compiler/jstypes.nim index c037fd22a..70d6c22ba 100644 --- a/compiler/jstypes.nim +++ b/compiler/jstypes.nim @@ -23,7 +23,7 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = result = nil case n.kind of nkRecList: - length = sonsLen(n) + length = len(n) if length == 1: result = genObjectFields(p, typ, n.sons[0]) else: @@ -41,7 +41,7 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = [mangleName(p.module, field), s, makeJSString(field.name.s)] of nkRecCase: - length = sonsLen(n) + length = len(n) if (n.sons[0].kind != nkSym): internalError(p.config, n.info, "genObjectFields") field = n.sons[0].sym s = genTypeInfo(p, field.typ) @@ -50,9 +50,9 @@ proc genObjectFields(p: PProc, typ: PType, n: PNode): Rope = u = nil case b.kind of nkOfBranch: - if sonsLen(b) < 2: + if len(b) < 2: internalError(p.config, b.info, "genObjectFields; nkOfBranch broken") - for j in 0 .. sonsLen(b) - 2: + for j in 0 .. len(b) - 2: if u != nil: add(u, ", ") if b.sons[j].kind == nkRange: addf(u, "[$1, $2]", [rope(getOrdValue(b.sons[j].sons[0])), @@ -105,7 +105,7 @@ proc genTupleInfo(p: PProc, typ: PType, name: Rope) = addf(p.g.typeInfo, "$1.node = NNI$2;$n", [name, rope(typ.id)]) proc genEnumInfo(p: PProc, typ: PType, name: Rope) = - let length = sonsLen(typ.n) + let length = len(typ.n) var s: Rope = nil for i in 0 ..< length: if (typ.n.sons[i].kind != nkSym): internalError(p.config, typ.n.info, "genEnumInfo") diff --git a/compiler/lookups.nim b/compiler/lookups.nim index 4de1fc371..df1d23b9c 100644 --- a/compiler/lookups.nim +++ b/compiler/lookups.nim @@ -430,7 +430,7 @@ proc nextOverloadIter*(o: var TOverloadIter, c: PContext, n: PNode): PSym = of oimOtherModule: result = nextIdentIter(o.it, o.m.tab).skipAlias(n, c.config) of oimSymChoice: - if o.symChoiceIndex < sonsLen(n): + if o.symChoiceIndex < len(n): result = n.sons[o.symChoiceIndex].sym incl(o.inSymChoice, result.id) inc o.symChoiceIndex diff --git a/compiler/lowerings.nim b/compiler/lowerings.nim index fff6c75ca..d372ac0c1 100644 --- a/compiler/lowerings.nim +++ b/compiler/lowerings.nim @@ -152,7 +152,7 @@ proc createObj*(g: ModuleGraph; owner: PSym, info: TLineInfo; final=true): PType proc rawAddField*(obj: PType; field: PSym) = assert field.kind == skField - field.position = sonsLen(obj.n) + field.position = len(obj.n) addSon(obj.n, newSymNode(field)) propagateToOwner(obj, field.typ) @@ -179,14 +179,14 @@ proc lookupInRecord(n: PNode, id: int): PSym = result = nil case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = lookupInRecord(n.sons[i], id) if result != nil: return of nkRecCase: if n.sons[0].kind != nkSym: return result = lookupInRecord(n.sons[0], id) if result != nil: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = lookupInRecord(lastSon(n.sons[i]), id) @@ -206,7 +206,7 @@ proc addField*(obj: PType; s: PSym; cache: IdentCache) = field.typ = t assert t.kind != tyTyped propagateToOwner(obj, t) - field.position = sonsLen(obj.n) + field.position = len(obj.n) addSon(obj.n, newSymNode(field)) proc addUniqueField*(obj: PType; s: PSym; cache: IdentCache): PSym {.discardable.} = @@ -219,7 +219,7 @@ proc addUniqueField*(obj: PType; s: PSym; cache: IdentCache): PSym {.discardable field.typ = t assert t.kind != tyTyped propagateToOwner(obj, t) - field.position = sonsLen(obj.n) + field.position = len(obj.n) addSon(obj.n, newSymNode(field)) result = field diff --git a/compiler/nimsets.nim b/compiler/nimsets.nim index bd070f2c7..5ae7ef590 100644 --- a/compiler/nimsets.nim +++ b/compiler/nimsets.nim @@ -17,7 +17,7 @@ proc inSet*(s: PNode, elem: PNode): bool = if s.kind != nkCurly: #internalError(s.info, "inSet") return false - for i in 0 ..< sonsLen(s): + for i in 0 ..< len(s): if s.sons[i].kind == nkRange: if leValue(s.sons[i].sons[0], elem) and leValue(elem, s.sons[i].sons[1]): @@ -47,7 +47,7 @@ proc someInSet*(s: PNode, a, b: PNode): bool = if s.kind != nkCurly: #internalError(s.info, "SomeInSet") return false - for i in 0 ..< sonsLen(s): + for i in 0 ..< len(s): if s.sons[i].kind == nkRange: if leValue(s.sons[i].sons[0], b) and leValue(b, s.sons[i].sons[1]) or leValue(s.sons[i].sons[0], a) and leValue(a, s.sons[i].sons[1]): @@ -62,7 +62,7 @@ proc toBitSet*(conf: ConfigRef; s: PNode, b: var TBitSet) = var first, j: Int128 first = firstOrd(conf, s.typ.sons[0]) bitSetInit(b, int(getSize(conf, s.typ))) - for i in 0 ..< sonsLen(s): + for i in 0 ..< len(s): if s.sons[i].kind == nkRange: j = getOrdValue(s.sons[i].sons[0], first) while j <= getOrdValue(s.sons[i].sons[1], first): @@ -149,7 +149,7 @@ proc setHasRange*(s: PNode): bool = assert s.kind == nkCurly if s.kind != nkCurly: return false - for i in 0 ..< sonsLen(s): + for i in 0 ..< len(s): if s.sons[i].kind == nkRange: return true result = false diff --git a/compiler/patterns.nim b/compiler/patterns.nim index 3f2e2e86e..7e66ae591 100644 --- a/compiler/patterns.nim +++ b/compiler/patterns.nim @@ -58,8 +58,8 @@ proc sameTrees*(a, b: PNode): bool = of nkEmpty, nkNilLit: result = true of nkType: result = sameTypeOrNil(a.typ, b.typ) else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not sameTrees(a.sons[i], b.sons[i]): return result = true @@ -112,7 +112,7 @@ proc matchNested(c: PPatternContext, p, n: PNode, rpn: bool): bool = rpn: bool): bool = result = true if n.kind in nkCallKinds and matches(c, op.sons[1], n.sons[0]): - for i in 1..sonsLen(n)-1: + for i in 1..len(n)-1: if not matchStarAux(c, op, n[i], arglist, rpn): return false if rpn: arglist.add(n.sons[0]) elif n.kind == nkHiddenStdConv and n.sons[1].kind == nkBracket: @@ -174,35 +174,35 @@ proc matches(c: PPatternContext, p, n: PNode): bool = of nkEmpty, nkNilLit, nkType: result = true else: - var plen = sonsLen(p) + var plen = len(p) # special rule for p(X) ~ f(...); this also works for stuff like # partial case statements, etc! - Not really ... :-/ let v = lastSon(p) if isPatternParam(c, v) and v.sym.typ.kind == tyVarargs: var arglist: PNode - if plen <= sonsLen(n): + if plen <= len(n): for i in 0 .. plen - 2: if not matches(c, p.sons[i], n.sons[i]): return - if plen == sonsLen(n) and lastSon(n).kind == nkHiddenStdConv and + if plen == len(n) and lastSon(n).kind == nkHiddenStdConv and lastSon(n).sons[1].kind == nkBracket: # unpack varargs: let n = lastSon(n).sons[1] arglist = newNodeI(nkArgList, n.info, n.len) for i in 0..<n.len: arglist.sons[i] = n.sons[i] else: - arglist = newNodeI(nkArgList, n.info, sonsLen(n) - plen + 1) + arglist = newNodeI(nkArgList, n.info, len(n) - plen + 1) # f(1, 2, 3) # p(X) - for i in 0 .. sonsLen(n) - plen: + for i in 0 .. len(n) - plen: arglist.sons[i] = n.sons[i + plen - 1] return bindOrCheck(c, v.sym, arglist) - elif plen-1 == sonsLen(n): + elif plen-1 == len(n): for i in 0 .. plen - 2: if not matches(c, p.sons[i], n.sons[i]): return arglist = newNodeI(nkArgList, n.info) return bindOrCheck(c, v.sym, arglist) - if plen == sonsLen(n): - for i in 0 ..< sonsLen(p): + if plen == len(n): + for i in 0 ..< len(p): if not matches(c, p.sons[i], n.sons[i]): return result = true @@ -250,7 +250,7 @@ proc applyRule*(c: PContext, s: PSym, n: PNode): PNode = var ctx: TPatternContext ctx.owner = s ctx.c = c - ctx.formals = sonsLen(s.typ)-1 + ctx.formals = len(s.typ)-1 var m = matchStmtList(ctx, s.ast.sons[patternPos], n) if isNil(m): return nil # each parameter should have been bound; we simply setup a call and diff --git a/compiler/pragmas.nim b/compiler/pragmas.nim index a314277be..e7517b6da 100644 --- a/compiler/pragmas.nim +++ b/compiler/pragmas.nim @@ -106,7 +106,7 @@ proc illegalCustomPragma*(c: PContext, n: PNode, s: PSym) = proc pragmaAsm*(c: PContext, n: PNode): char = result = '\0' if n != nil: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): let it = n.sons[i] if it.kind in nkPragmaCallKinds and it.len == 2 and it.sons[0].kind == nkIdent: case whichKeyword(it.sons[0].ident) @@ -425,7 +425,7 @@ proc processPush(c: PContext, n: PNode, start: int) = x.notes = c.config.notes x.features = c.features c.optionStack.add(x) - for i in start ..< sonsLen(n): + for i in start ..< len(n): if not tryProcessOption(c, n.sons[i], c.config.options): # simply store it somewhere: if x.otherPragmas.isNil: diff --git a/compiler/procfind.nim b/compiler/procfind.nim index f2f58fb75..7247bb301 100644 --- a/compiler/procfind.nim +++ b/compiler/procfind.nim @@ -14,8 +14,8 @@ import ast, astalgo, msgs, semdata, types, trees, strutils proc equalGenericParams(procA, procB: PNode): bool = - if sonsLen(procA) != sonsLen(procB): return false - for i in 0 ..< sonsLen(procA): + if len(procA) != len(procB): return false + for i in 0 ..< len(procA): if procA.sons[i].kind != nkSym: return false if procB.sons[i].kind != nkSym: @@ -95,9 +95,9 @@ proc searchForProc*(c: PContext, scope: PScope, fn: PSym): PSym = when false: proc paramsFitBorrow(child, parent: PNode): bool = - var length = sonsLen(child) + var length = len(child) result = false - if length == sonsLen(parent): + if length == len(parent): for i in 1 ..< length: var m = child.sons[i].sym var n = parent.sons[i].sym diff --git a/compiler/renderer.nim b/compiler/renderer.nim index dfe66de03..cdd0357ee 100644 --- a/compiler/renderer.nim +++ b/compiler/renderer.nim @@ -395,7 +395,7 @@ proc atom(g: TSrcGen; n: PNode): string = proc lcomma(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = assert(theEnd < 0) result = 0 - for i in start .. sonsLen(n) + theEnd: + for i in start .. len(n) + theEnd: let param = n.sons[i] if nfDefaultParam notin param.flags: inc(result, lsub(g, param)) @@ -406,7 +406,7 @@ proc lcomma(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = proc lsons(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): int = assert(theEnd < 0) result = 0 - for i in start .. sonsLen(n) + theEnd: inc(result, lsub(g, n.sons[i])) + for i in start .. len(n) + theEnd: inc(result, lsub(g, n.sons[i])) proc lsub(g: TSrcGen; n: PNode): int = # computes the length of a tree @@ -436,7 +436,7 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkTableConstr: result = if n.len > 0: lcomma(g, n) + 2 else: len("{:}") of nkClosedSymChoice, nkOpenSymChoice: - result = lsons(g, n) + len("()") + sonsLen(n) - 1 + result = lsons(g, n) + len("()") + len(n) - 1 of nkTupleTy: result = lcomma(g, n) + len("tuple[]") of nkTupleClassTy: result = len("tuple") of nkDotExpr: result = lsons(g, n) + 1 @@ -448,7 +448,7 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkDo: result = lsons(g, n) + len("do__:_") of nkConstDef, nkIdentDefs: result = lcomma(g, n, 0, - 3) - var L = sonsLen(n) + var L = len(n) if n.sons[L - 2].kind != nkEmpty: result = result + lsub(g, n.sons[L - 2]) + 2 if n.sons[L - 1].kind != nkEmpty: result = result + lsub(g, n.sons[L - 1]) + 3 of nkVarTuple: result = lcomma(g, n, 0, - 3) + len("() = ") + lsub(g, lastSon(n)) @@ -457,7 +457,7 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkChckRange: result = len("chckRange") + 2 + lcomma(g, n) of nkObjDownConv, nkObjUpConv: result = 2 - if sonsLen(n) >= 1: result = result + lsub(g, n.sons[0]) + if len(n) >= 1: result = result + lsub(g, n.sons[0]) result = result + lcomma(g, n, 1) of nkExprColonExpr: result = lsons(g, n) + 2 of nkInfix: result = lsons(g, n) + 2 @@ -491,16 +491,16 @@ proc lsub(g: TSrcGen; n: PNode): int = of nkIteratorTy: result = lsons(g, n) + len("iterator_") of nkSharedTy: result = lsons(g, n) + len("shared_") of nkEnumTy: - if sonsLen(n) > 0: + if len(n) > 0: result = lsub(g, n.sons[0]) + lcomma(g, n, 1) + len("enum_") else: result = len("enum") of nkEnumFieldDef: result = lsons(g, n) + 3 of nkVarSection, nkLetSection: - if sonsLen(n) > 1: result = MaxLineLen + 1 + if len(n) > 1: result = MaxLineLen + 1 else: result = lsons(g, n) + len("var_") of nkUsingStmt: - if sonsLen(n) > 1: result = MaxLineLen + 1 + if len(n) > 1: result = MaxLineLen + 1 else: result = lsons(g, n) + len("using_") of nkReturnStmt: if n.len > 0 and n[0].kind == nkAsgn: @@ -556,7 +556,7 @@ proc hasCom(n: PNode): bool = case n.kind of nkEmpty..nkNilLit: discard else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if hasCom(n.sons[i]): return true proc putWithSpace(g: var TSrcGen, kind: TTokType, s: string) = @@ -565,8 +565,8 @@ proc putWithSpace(g: var TSrcGen, kind: TTokType, s: string) = proc gcommaAux(g: var TSrcGen, n: PNode, ind: int, start: int = 0, theEnd: int = - 1, separator = tkComma) = - for i in start .. sonsLen(n) + theEnd: - var c = i < sonsLen(n) + theEnd + for i in start .. len(n) + theEnd: + var c = i < len(n) + theEnd var sublen = lsub(g, n.sons[i]) + ord(c) if not fits(g, sublen) and (ind + sublen < MaxLineLen): optNL(g, ind) let oldLen = g.tokens.len @@ -600,15 +600,15 @@ proc gsemicolon(g: var TSrcGen, n: PNode, start: int = 0, theEnd: int = - 1) = proc gsons(g: var TSrcGen, n: PNode, c: TContext, start: int = 0, theEnd: int = - 1) = - for i in start .. sonsLen(n) + theEnd: gsub(g, n.sons[i], c) + for i in start .. len(n) + theEnd: gsub(g, n.sons[i], c) proc gsection(g: var TSrcGen, n: PNode, c: TContext, kind: TTokType, k: string) = - if sonsLen(n) == 0: return # empty var sections are possible + if len(n) == 0: return # empty var sections are possible putWithSpace(g, kind, k) gcoms(g) indentNL(g) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): optNL(g) gsub(g, n.sons[i], c) gcoms(g) @@ -618,7 +618,7 @@ proc longMode(g: TSrcGen; n: PNode, start: int = 0, theEnd: int = - 1): bool = result = n.comment.len > 0 if not result: # check further - for i in start .. sonsLen(n) + theEnd: + for i in start .. len(n) + theEnd: if (lsub(g, n.sons[i]) > MaxLineLen): result = true break @@ -663,7 +663,7 @@ proc gif(g: var TSrcGen, n: PNode) = incl(c.flags, rfLongMode) gcoms(g) # a good place for comments gstmts(g, n.sons[0].sons[1], c) - var length = sonsLen(n) + var length = len(n) for i in 1 ..< length: optNL(g) gsub(g, n.sons[i], c) @@ -712,7 +712,7 @@ proc gtry(g: var TSrcGen, n: PNode) = proc gfor(g: var TSrcGen, n: PNode) = var c: TContext - var length = sonsLen(n) + var length = len(n) putWithSpace(g, tkFor, "for") initContext(c) if longMode(g, n) or @@ -730,7 +730,7 @@ proc gfor(g: var TSrcGen, n: PNode) = proc gcase(g: var TSrcGen, n: PNode) = var c: TContext initContext(c) - var length = sonsLen(n) + var length = len(n) if length == 0: return var last = if n.sons[length-1].kind == nkElse: -2 else: -1 if longMode(g, n, 0, last): incl(c.flags, rfLongMode) @@ -966,7 +966,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkColon, ":") gsub(g, n, n.len-1) else: - if sonsLen(n) >= 1: accentedName(g, n[0]) + if len(n) >= 1: accentedName(g, n[0]) put(g, tkParLe, "(") gcomma(g, n, 1) put(g, tkParRi, ")") @@ -1046,14 +1046,14 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gcomma(g, n) put(g, tkParRi, ")") of nkObjDownConv, nkObjUpConv: - if sonsLen(n) >= 1: gsub(g, n.sons[0]) + if len(n) >= 1: gsub(g, n.sons[0]) put(g, tkParLe, "(") gcomma(g, n, 1) put(g, tkParRi, ")") of nkClosedSymChoice, nkOpenSymChoice: if renderIds in g.flags: put(g, tkParLe, "(") - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if i > 0: put(g, tkOpr, "|") if n.sons[i].kind == nkSym: let s = n[i].sym @@ -1115,7 +1115,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n, bodyPos) of nkConstDef, nkIdentDefs: gcomma(g, n, 0, -3) - var L = sonsLen(n) + var L = len(n) if L >= 2 and n.sons[L - 2].kind != nkEmpty: putWithSpace(g, tkColon, ":") gsub(g, n, L - 2) @@ -1200,19 +1200,19 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = if n.len > 0: gsub(g, n.sons[0]) put(g, tkParRi, ")") of nkRefTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkRef, "ref") gsub(g, n.sons[0]) else: put(g, tkRef, "ref") of nkPtrTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkPtr, "ptr") gsub(g, n.sons[0]) else: put(g, tkPtr, "ptr") of nkVarTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkVar, "var") gsub(g, n.sons[0]) else: @@ -1243,7 +1243,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkEquals, "=") gsub(g, n.sons[2]) of nkObjectTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkObject, "object") gsub(g, n.sons[0]) gsub(g, n.sons[1]) @@ -1253,7 +1253,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = put(g, tkObject, "object") of nkRecList: indentNL(g) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): optNL(g) gsub(g, n.sons[i], c) gcoms(g) @@ -1263,14 +1263,14 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = putWithSpace(g, tkOf, "of") gsub(g, n, 0) of nkProcTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkProc, "proc") gsub(g, n, 0) gsub(g, n, 1) else: put(g, tkProc, "proc") of nkIteratorTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkIterator, "iterator") gsub(g, n, 0) gsub(g, n, 1) @@ -1283,7 +1283,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = gsub(g, n.sons[0]) put(g, tkBracketRi, "]") of nkEnumTy: - if sonsLen(n) > 0: + if len(n) > 0: putWithSpace(g, tkEnum, "enum") gsub(g, n.sons[0]) gcoms(g) @@ -1341,7 +1341,7 @@ proc gsub(g: var TSrcGen, n: PNode, c: TContext) = incl(a.flags, rfInConstExpr) gsection(g, n, a, tkConst, "const") of nkVarSection, nkLetSection, nkUsingStmt: - var L = sonsLen(n) + var L = len(n) if L == 0: return if n.kind == nkVarSection: putWithSpace(g, tkVar, "var") elif n.kind == nkLetSection: putWithSpace(g, tkLet, "let") @@ -1552,7 +1552,7 @@ proc renderModule*(n: PNode, infile, outfile: string, g: TSrcGen initSrcGen(g, renderFlags, conf) g.fid = fid - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): gsub(g, n.sons[i]) optNL(g) case n.sons[i].kind diff --git a/compiler/rodimpl.nim b/compiler/rodimpl.nim index 2c84111d8..94fd792bf 100644 --- a/compiler/rodimpl.nim +++ b/compiler/rodimpl.nim @@ -156,7 +156,7 @@ proc encodeNode(g: ModuleGraph; fInfo: TLineInfo, n: PNode, encodeVInt(n.sym.id, result) pushSym(w, n.sym) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): encodeNode(g, n.info, n.sons[i], result) add(result, ')') @@ -244,7 +244,7 @@ proc encodeType(g: ModuleGraph, t: PType, result: var string) = add(result, '\21') encodeVInt(t.typeInst.uniqueId, result) pushType(w, t.typeInst) - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): if t.sons[i] == nil: add(result, "^()") else: diff --git a/compiler/sem.nim b/compiler/sem.nim index ecf5e4f85..87f2444a3 100644 --- a/compiler/sem.nim +++ b/compiler/sem.nim @@ -575,7 +575,7 @@ proc semStmtAndGenerateGenerics(c: PContext, n: PNode): PNode = if c.lastGenericIdx < c.generics.len: var a = newNodeI(nkStmtList, n.info) addCodeForGenerics(c, a) - if sonsLen(a) > 0: + if len(a) > 0: # a generic has been added to `a`: if result.kind != nkEmpty: addSon(a, result) result = a diff --git a/compiler/semcall.nim b/compiler/semcall.nim index cf83c599e..76f0e39af 100644 --- a/compiler/semcall.nim +++ b/compiler/semcall.nim @@ -405,7 +405,7 @@ proc resolveOverloads(c: PContext, n, orig: PNode, elif c.config.errorCounter == 0: # don't cascade errors var args = "(" - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if i > 1: add(args, ", ") add(args, typeToString(n.sons[i].typ)) add(args, ")") @@ -577,7 +577,7 @@ proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = # binding has to stay 'nil' for this to work! initCandidate(c, m, s, nil) - for i in 1..sonsLen(n)-1: + for i in 1..len(n)-1: let formal = s.ast.sons[genericParamsPos].sons[i-1].typ var arg = n[i].typ # try transforming the argument into a static one before feeding it into @@ -599,7 +599,7 @@ proc explicitGenericSym(c: PContext, n: PNode, s: PSym): PNode = proc explicitGenericInstantiation(c: PContext, n: PNode, s: PSym): PNode = assert n.kind == nkBracketExpr - for i in 1..sonsLen(n)-1: + for i in 1..len(n)-1: let e = semExpr(c, n.sons[i]) if e.typ == nil: n.sons[i].typ = errorType(c) diff --git a/compiler/semdata.nim b/compiler/semdata.nim index 0d4d3ea48..97d17a3fa 100644 --- a/compiler/semdata.nim +++ b/compiler/semdata.nim @@ -410,10 +410,10 @@ proc illFormedAstLocal*(n: PNode; conf: ConfigRef) = localError(conf, n.info, errIllFormedAstX, renderTree(n, {renderNoComments})) proc checkSonsLen*(n: PNode, length: int; conf: ConfigRef) = - if sonsLen(n) != length: illFormedAst(n, conf) + if len(n) != length: illFormedAst(n, conf) proc checkMinSonsLen*(n: PNode, length: int; conf: ConfigRef) = - if sonsLen(n) < length: illFormedAst(n, conf) + if len(n) < length: illFormedAst(n, conf) proc isTopLevel*(c: PContext): bool {.inline.} = result = c.currentScope.depthLevel <= 2 diff --git a/compiler/semexprs.nim b/compiler/semexprs.nim index 1785ae143..bae660805 100644 --- a/compiler/semexprs.nim +++ b/compiler/semexprs.nim @@ -225,7 +225,7 @@ proc isOwnedSym(c: PContext; n: PNode): bool = result = s != nil and sfSystemModule in s.owner.flags and s.name.s == "owned" proc semConv(c: PContext, n: PNode): PNode = - if sonsLen(n) != 2: + if len(n) != 2: localError(c.config, n.info, "a type conversion takes exactly one argument") return n @@ -301,7 +301,7 @@ proc semConv(c: PContext, n: PNode): PNode = localError(c.config, n.info, errGenerated, value & " can't be converted to " & result.typ.typeToString) else: - for i in 0 ..< sonsLen(op): + for i in 0 ..< len(op): let it = op.sons[i] let status = checkConvertible(c, result.typ, it) if status in {convOK, convNotNeedeed}: @@ -331,7 +331,7 @@ proc semCast(c: PContext, n: PNode): PNode = proc semLowHigh(c: PContext, n: PNode, m: TMagic): PNode = const opToStr: array[mLow..mHigh, string] = ["low", "high"] - if sonsLen(n) != 2: + if len(n) != 2: localError(c.config, n.info, errXExpectsTypeOrValue % opToStr[m]) else: n.sons[1] = semExprWithType(c, n.sons[1], {efDetermineType}) @@ -369,7 +369,7 @@ proc fixupStaticType(c: PContext, n: PNode) = proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = internalAssert c.config, - n.sonsLen == 3 and + n.len == 3 and n[1].typ != nil and n[2].kind in {nkStrLit..nkTripleStrLit, nkType} @@ -408,7 +408,7 @@ proc isOpImpl(c: PContext, n: PNode, flags: TExprFlags): PNode = result.typ = n.typ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = - if sonsLen(n) != 3: + if len(n) != 3: localError(c.config, n.info, "'is' operator takes 2 arguments") let boolType = getSysType(c.graph, n.info, tyBool) @@ -452,9 +452,9 @@ proc semIs(c: PContext, n: PNode, flags: TExprFlags): PNode = proc semOpAux(c: PContext, n: PNode) = const flags = {efDetermineType} - for i in 1 ..< n.sonsLen: + for i in 1 ..< n.len: var a = n.sons[i] - if a.kind == nkExprEqExpr and sonsLen(a) == 2: + if a.kind == nkExprEqExpr and len(a) == 2: let info = a.sons[0].info a.sons[0] = newIdentNode(considerQuotedIdent(c, a.sons[0], a), info) a.sons[1] = semExprWithType(c, a.sons[1], flags) @@ -470,22 +470,22 @@ proc overloadedCallOpr(c: PContext, n: PNode): PNode = else: result = newNodeI(nkCall, n.info) addSon(result, newIdentNode(par, n.info)) - for i in 0 ..< sonsLen(n): addSon(result, n.sons[i]) + for i in 0 ..< len(n): addSon(result, n.sons[i]) result = semExpr(c, result) proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = case n.kind of nkCurly, nkBracket: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): changeType(c, n.sons[i], elemType(newType), check) of nkPar, nkTupleConstr: let tup = newType.skipTypes({tyGenericInst, tyAlias, tySink, tyDistinct}) if tup.kind != tyTuple: if tup.kind == tyObject: return globalError(c.config, n.info, "no tuple type for constructor") - elif sonsLen(n) > 0 and n.sons[0].kind == nkExprColonExpr: + elif len(n) > 0 and n.sons[0].kind == nkExprColonExpr: # named tuple? - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var m = n.sons[i].sons[0] if m.kind != nkSym: globalError(c.config, m.info, "invalid tuple constructor") @@ -499,7 +499,7 @@ proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = else: changeType(c, n.sons[i].sons[1], tup.sons[i], check) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): changeType(c, n.sons[i], tup.sons[i], check) when false: var m = n.sons[i] @@ -522,12 +522,12 @@ proc changeType(c: PContext; n: PNode, newType: PType, check: bool) = proc arrayConstrType(c: PContext, n: PNode): PType = var typ = newTypeS(tyArray, c) rawAddSon(typ, nil) # index type - if sonsLen(n) == 0: + if len(n) == 0: rawAddSon(typ, newTypeS(tyEmpty, c)) # needs an empty basetype! else: var t = skipTypes(n.sons[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal, tyAlias, tySink}) addSonSkipIntLit(typ, t) - typ.sons[0] = makeRangeType(c, 0, sonsLen(n) - 1, n.info) + typ.sons[0] = makeRangeType(c, 0, len(n) - 1, n.info) result = typ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = @@ -538,12 +538,12 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = firstIndex, lastIndex: Int128 indexType = getSysType(c.graph, n.info, tyInt) lastValidIndex = lastOrd(c.config, indexType) - if sonsLen(n) == 0: + if len(n) == 0: rawAddSon(result.typ, newTypeS(tyEmpty, c)) # needs an empty basetype! lastIndex = toInt128(-1) else: var x = n.sons[0] - if x.kind == nkExprColonExpr and sonsLen(x) == 2: + if x.kind == nkExprColonExpr and len(x) == 2: var idx = semConstExpr(c, x.sons[0]) if not isOrdinalType(idx.typ): localError(c.config, idx.info, "expected ordinal value for array " & @@ -559,7 +559,7 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = var typ = yy.typ addSon(result, yy) #var typ = skipTypes(result.sons[0].typ, {tyGenericInst, tyVar, tyLent, tyOrdinal}) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if lastIndex == lastValidIndex: let validIndex = makeRangeType(c, toInt64(firstIndex), toInt64(lastValidIndex), n.info, indexType) @@ -567,7 +567,7 @@ proc semArrayConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = "type '$1' by $2 elements" % [typeToString(validIndex), $(n.len-i)]) x = n.sons[i] - if x.kind == nkExprColonExpr and sonsLen(x) == 2: + if x.kind == nkExprColonExpr and len(x) == 2: var idx = semConstExpr(c, x.sons[0]) idx = fitNode(c, indexType, idx, x.info) if lastIndex+1 != getOrdValue(idx): @@ -683,8 +683,8 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = if n.sons[0].kind == nkSym and n.sons[0].sym.magic in FakeVarParams: # BUGFIX: check for L-Value still needs to be done for the arguments! # note sometimes this is eval'ed twice so we check for nkHiddenAddr here: - for i in 1 ..< sonsLen(n): - if i < sonsLen(t) and t.sons[i] != nil and + for i in 1 ..< len(n): + if i < len(t) and t.sons[i] != nil and skipTypes(t.sons[i], abstractInst-{tyTypeDesc}).kind == tyVar: let it = n[i] if isAssignable(c, it) notin {arLValue, arLocalLValue}: @@ -699,13 +699,13 @@ proc analyseIfAddressTakenInCall(c: PContext, n: PNode) = localError(c.config, n.info, errXStackEscape % renderTree(n[1], {renderNoComments})) return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let n = if n.kind == nkHiddenDeref: n[0] else: n if n.sons[i].kind == nkHiddenCallConv: # we need to recurse explicitly here as converters can create nested # calls and then they wouldn't be analysed otherwise analyseIfAddressTakenInCall(c, n.sons[i]) - if i < sonsLen(t) and + if i < len(t) and skipTypes(t.sons[i], abstractInst-{tyTypeDesc}).kind == tyVar: if n.sons[i].kind != nkHiddenAddr: n.sons[i] = analyseIfAddressTaken(c, n.sons[i]) @@ -887,7 +887,7 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = result = n0 result.kind = nkCall result.flags.incl nfExplicitCall - for i in 1 ..< sonsLen(n): addSon(result, n.sons[i]) + for i in 1 ..< len(n): addSon(result, n.sons[i]) return semExpr(c, result, flags) else: n.sons[0] = n0 @@ -918,7 +918,7 @@ proc semIndirectOp(c: PContext, n: PNode, flags: TExprFlags): PNode = else: var hasErrorType = false var msg = "type mismatch: got <" - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if i > 1: add(msg, ", ") let nt = n.sons[i].typ add(msg, typeToString(nt)) @@ -1006,7 +1006,7 @@ proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, result = nil case r.kind of nkRecList: - for i in 0 ..< sonsLen(r): + for i in 0 ..< len(r): result = lookupInRecordAndBuildCheck(c, n, r.sons[i], field, check) if result != nil: return of nkRecCase: @@ -1016,19 +1016,19 @@ proc lookupInRecordAndBuildCheck(c: PContext, n, r: PNode, field: PIdent, if result != nil: return let setType = createSetType(c, r.sons[0].typ) var s = newNodeIT(nkCurly, r.info, setType) - for i in 1 ..< sonsLen(r): + for i in 1 ..< len(r): var it = r.sons[i] case it.kind of nkOfBranch: result = lookupInRecordAndBuildCheck(c, n, lastSon(it), field, check) if result == nil: - for j in 0..sonsLen(it)-2: addSon(s, copyTree(it.sons[j])) + for j in 0..len(it)-2: addSon(s, copyTree(it.sons[j])) else: if check == nil: check = newNodeI(nkCheckedFieldExpr, n.info) addSon(check, c.graph.emptyNode) # make space for access node s = newNodeIT(nkCurly, n.info, setType) - for j in 0 .. sonsLen(it) - 2: addSon(s, copyTree(it.sons[j])) + for j in 0 .. len(it) - 2: addSon(s, copyTree(it.sons[j])) var inExpr = newNodeIT(nkCall, n.info, getSysType(c.graph, n.info, tyBool)) addSon(inExpr, newSymNode(c.graph.opContains, n.info)) addSon(inExpr, s) @@ -1424,7 +1424,7 @@ proc semDeref(c: PContext, n: PNode): PNode = proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = ## returns nil if not a built-in subscript operator; also called for the ## checking of assignments - if sonsLen(n) == 1: + if len(n) == 1: let x = semDeref(c, n) if x == nil: return nil result = newNodeIT(nkDerefExpr, x.info, x.typ) @@ -1451,7 +1451,7 @@ proc semSubscript(c: PContext, n: PNode, flags: TExprFlags): PNode = tyUncheckedArray: if n.len != 2: return nil n.sons[0] = makeDeref(n.sons[0]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): n.sons[i] = semExprWithType(c, n.sons[i], flags*{efInTypeof, efDetermineType}) # Arrays index type is dictated by the range's type @@ -1786,7 +1786,7 @@ proc semYieldVarResult(c: PContext, n: PNode, restype: PType) = n.sons[0] = n.sons[0].sons[1] n.sons[0] = takeImplicitAddr(c, n.sons[0], t.kind == tyLent) of tyTuple: - for i in 0..<t.sonsLen: + for i in 0..<t.len: let e = skipTypes(t.sons[i], {tyGenericInst, tyAlias, tySink}) if e.kind in {tyVar, tyLent}: e.flags.incl tfVarIsPtr # bugfix for #4048, #4910, #6892 @@ -1946,7 +1946,7 @@ proc semExpandToAst(c: PContext, n: PNode): PNode = proc semExpandToAst(c: PContext, n: PNode, magicSym: PSym, flags: TExprFlags = {}): PNode = - if sonsLen(n) == 2: + if len(n) == 2: n.sons[0] = newSymNode(magicSym, n.info) result = semExpandToAst(c, n) else: @@ -2076,14 +2076,14 @@ proc tryExpr(c: PContext, n: PNode, flags: TExprFlags = {}): PNode = proc semCompiles(c: PContext, n: PNode, flags: TExprFlags): PNode = # we replace this node by a 'true' or 'false' node: - if sonsLen(n) != 2: return semDirectOp(c, n, flags) + if len(n) != 2: return semDirectOp(c, n, flags) result = newIntNode(nkIntLit, ord(tryExpr(c, n[1], flags) != nil)) result.info = n.info result.typ = getSysType(c.graph, n.info, tyBool) proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode = - if sonsLen(n) == 3: + if len(n) == 3: # XXX ugh this is really a hack: shallowCopy() can be overloaded only # with procs that take not 2 parameters: result = newNodeI(nkFastAsgn, n.info) @@ -2120,7 +2120,7 @@ proc setMs(n: PNode, s: PSym): PNode = n.sons[0].info = n.info proc semSizeof(c: PContext, n: PNode): PNode = - if sonsLen(n) != 2: + if len(n) != 2: localError(c.config, n.info, errXExpectsTypeOrValue % "sizeof") else: n.sons[1] = semExprWithType(c, n.sons[1], {efDetermineType}) @@ -2266,7 +2266,7 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = whenNimvm = exprNode.sym.magic == mNimvm if whenNimvm: n.flags.incl nfLL - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] case it.kind of nkElifBranch, nkElifExpr: @@ -2304,12 +2304,12 @@ proc semWhen(c: PContext, n: PNode, semCheck = true): PNode = proc semSetConstr(c: PContext, n: PNode): PNode = result = newNodeI(nkCurly, n.info) result.typ = newTypeS(tySet, c) - if sonsLen(n) == 0: + if len(n) == 0: rawAddSon(result.typ, newTypeS(tyEmpty, c)) else: # only semantic checking for all elements, later type checking: var typ: PType = nil - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if isRange(n.sons[i]): checkSonsLen(n.sons[i], 3, c.config) n.sons[i].sons[1] = semExprWithType(c, n.sons[i].sons[1]) @@ -2333,7 +2333,7 @@ proc semSetConstr(c: PContext, n: PNode): PNode = elif lengthOrd(c.config, typ) > MaxSetElements: typ = makeRangeType(c, 0, MaxSetElements-1, n.info) addSonSkipIntLit(result.typ, typ) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var m: PNode let info = n.sons[i].info if isRange(n.sons[i]): @@ -2352,7 +2352,7 @@ proc semTableConstr(c: PContext, n: PNode): PNode = var lastKey = 0 for i in 0..n.len-1: var x = n.sons[i] - if x.kind == nkExprColonExpr and sonsLen(x) == 2: + if x.kind == nkExprColonExpr and len(x) == 2: for j in lastKey ..< i: var pair = newNodeI(nkTupleConstr, x.info) pair.add(n.sons[j]) @@ -2374,7 +2374,7 @@ type paNone, paSingle, paTupleFields, paTuplePositions proc checkPar(c: PContext; n: PNode): TParKind = - var length = sonsLen(n) + var length = len(n) if length == 0: result = paTuplePositions # () elif length == 1: @@ -2400,7 +2400,7 @@ proc semTupleFieldsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = var typ = newTypeS(tyTuple, c) typ.n = newNodeI(nkRecList, n.info) # nkIdentDefs var ids = initIntSet() - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n[i].kind != nkExprColonExpr: illFormedAst(n.sons[i], c.config) let id = considerQuotedIdent(c, n[i][0]) @@ -2426,7 +2426,7 @@ proc semTuplePositionsConstr(c: PContext, n: PNode, flags: TExprFlags): PNode = result = n # we don't modify n, but compute the type: result.kind = nkTupleConstr var typ = newTypeS(tyTuple, c) # leave typ.n nil! - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): n.sons[i] = semExprWithType(c, n.sons[i], flags*{efAllowDestructor}) addSonSkipIntLit(typ, n.sons[i].typ) result.typ = typ diff --git a/compiler/semfields.nim b/compiler/semfields.nim index 88d57576a..1480374dd 100644 --- a/compiler/semfields.nim +++ b/compiler/semfields.nim @@ -27,7 +27,7 @@ proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = of nkIdent, nkSym: result = n let ident = considerQuotedIdent(c.c, n) - var L = sonsLen(forLoop) + var L = len(forLoop) if c.replaceByFieldName: if ident.id == considerQuotedIdent(c.c, forLoop[0]).id: let fieldName = if c.tupleType.isNil: c.field.name.s @@ -54,8 +54,8 @@ proc instFieldLoopBody(c: TFieldInstCtx, n: PNode, forLoop: PNode): PNode = localError(c.c.config, n.info, "'continue' not supported in a 'fields' loop") result = copyNode(n) - newSons(result, sonsLen(n)) - for i in 0 ..< sonsLen(n): + newSons(result, len(n)) + for i in 0 ..< len(n): result.sons[i] = instFieldLoopBody(c, n.sons[i], forLoop) type @@ -120,9 +120,9 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = var stmts = newNodeI(nkStmtList, n.info) result.sons[1] = stmts - var length = sonsLen(n) + var length = len(n) var call = n.sons[length-2] - if length-2 != sonsLen(call)-1 + ord(m==mFieldPairs): + if length-2 != len(call)-1 + ord(m==mFieldPairs): localError(c.config, n.info, errWrongNumberOfVariables) return result @@ -139,7 +139,7 @@ proc semForFields(c: PContext, n: PNode, m: TMagic): PNode = inc(c.p.nestedLoopCounter) if tupleTypeA.kind == tyTuple: var loopBody = n.sons[length-1] - for i in 0..sonsLen(tupleTypeA)-1: + for i in 0..len(tupleTypeA)-1: openScope(c) var fc: TFieldInstCtx fc.tupleType = tupleTypeA diff --git a/compiler/semfold.nim b/compiler/semfold.nim index 81efc2436..3f9211e56 100644 --- a/compiler/semfold.nim +++ b/compiler/semfold.nim @@ -104,7 +104,7 @@ proc ordinalValToString*(a: PNode; g: ModuleGraph): string = result = $chr(toInt64(x) and 0xff) of tyEnum: var n = t.n - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if n.sons[i].kind != nkSym: internalError(g.config, a.info, "ordinalValToString") var field = n.sons[i].sym if field.position == x: @@ -194,7 +194,7 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; g: ModuleGraph): PNode = elif a.kind in {nkStrLit..nkTripleStrLit}: result = newIntNodeT(toInt128(a.strVal.len), n, g) else: - result = newIntNodeT(toInt128(sonsLen(a)), n, g) + result = newIntNodeT(toInt128(len(a)), n, g) of mUnaryPlusI, mUnaryPlusF64: result = a # throw `+` away # XXX: Hides overflow/underflow of mAbsI: result = foldAbs(getInt(a), n, g) @@ -371,7 +371,7 @@ proc evalOp(m: TMagic, n, a, b, c: PNode; g: ModuleGraph): PNode = proc getConstIfExpr(c: PSym, n: PNode; g: ModuleGraph): PNode = result = nil - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it.len == 2: var e = getConstExpr(c, it.sons[0], g) @@ -400,16 +400,16 @@ proc leValueConv*(a, b: PNode): bool = else: result = false # internalError(a.info, "leValueConv") proc magicCall(m: PSym, n: PNode; g: ModuleGraph): PNode = - if sonsLen(n) <= 1: return + if len(n) <= 1: return var s = n.sons[0].sym var a = getConstExpr(m, n.sons[1], g) var b, c: PNode if a == nil: return - if sonsLen(n) > 2: + if len(n) > 2: b = getConstExpr(m, n.sons[2], g) if b == nil: return - if sonsLen(n) > 3: + if len(n) > 3: c = getConstExpr(m, n.sons[3], g) if c == nil: return result = evalOp(s.magic, n, a, b, c, g) @@ -489,11 +489,11 @@ proc foldArrayAccess(m: PSym, n: PNode; g: ModuleGraph): PNode = var idx = toInt64(getOrdValue(y)) case x.kind of nkPar, nkTupleConstr: - if idx >= 0 and idx < sonsLen(x): + if idx >= 0 and idx < len(x): result = x.sons[idx] if result.kind == nkExprColonExpr: result = result.sons[1] else: - localError(g.config, n.info, formatErrorIndexBound(idx, sonsLen(x)-1) & $n) + localError(g.config, n.info, formatErrorIndexBound(idx, len(x)-1) & $n) of nkBracket: idx = idx - toInt64(firstOrd(g.config, x.typ)) if idx >= 0 and idx < x.len: result = x.sons[int(idx)] @@ -514,7 +514,7 @@ proc foldFieldAccess(m: PSym, n: PNode; g: ModuleGraph): PNode = if x == nil or x.kind notin {nkObjConstr, nkPar, nkTupleConstr}: return var field = n.sons[1].sym - for i in ord(x.kind == nkObjConstr) ..< sonsLen(x): + for i in ord(x.kind == nkObjConstr) ..< len(x): var it = x.sons[i] if it.kind != nkExprColonExpr: # lookup per index: @@ -529,7 +529,7 @@ proc foldFieldAccess(m: PSym, n: PNode; g: ModuleGraph): PNode = proc foldConStrStr(m: PSym, n: PNode; g: ModuleGraph): PNode = result = newNodeIT(nkStrLit, n.info, n.typ) result.strVal = "" - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let a = getConstExpr(m, n.sons[i], g) if a == nil: return nil result.strVal.add(getStrOrChar(a)) @@ -631,12 +631,12 @@ proc getConstExpr(m: PSym, n: PNode; g: ModuleGraph): PNode = var a = getArrayConstr(m, n.sons[1], g) if a.kind == nkBracket: # we can optimize it away: - result = newIntNodeT(sonsLen(a)-1, n, g) + result = newIntNodeT(len(a)-1, n, g) of mLengthOpenArray: var a = getArrayConstr(m, n.sons[1], g) if a.kind == nkBracket: # we can optimize it away! This fixes the bug ``len(134)``. - result = newIntNodeT(sonsLen(a), n, g) + result = newIntNodeT(len(a), n, g) else: result = magicCall(m, n, g) of mLengthArray: @@ -685,7 +685,7 @@ proc getConstExpr(m: PSym, n: PNode; g: ModuleGraph): PNode = addSon(result, b) #of nkObjConstr: # result = copyTree(n) - # for i in 1 ..< sonsLen(n): + # for i in 1 ..< len(n): # var a = getConstExpr(m, n.sons[i].sons[1]) # if a == nil: return nil # result.sons[i].sons[1] = a @@ -693,7 +693,7 @@ proc getConstExpr(m: PSym, n: PNode; g: ModuleGraph): PNode = of nkPar, nkTupleConstr: # tuple constructor result = copyNode(n) - if (sonsLen(n) > 0) and (n.sons[0].kind == nkExprColonExpr): + if (len(n) > 0) and (n.sons[0].kind == nkExprColonExpr): for i, expr in n.pairs: let exprNew = copyNode(expr) # nkExprColonExpr exprNew.add expr[0] diff --git a/compiler/semgnrc.nim b/compiler/semgnrc.nim index 4116df357..89051ec4c 100644 --- a/compiler/semgnrc.nim +++ b/compiler/semgnrc.nim @@ -316,13 +316,13 @@ proc semGenericStmt(c: PContext, n: PNode, withBracketExpr ctx, a.sons[0]: result = semGenericStmt(c, result, flags, ctx) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result.sons[i] = semGenericStmt(c, n.sons[i], flags, ctx) of nkIfStmt: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): n.sons[i] = semGenericStmtScope(c, n.sons[i], flags, ctx) of nkWhenStmt: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): # bug #8603: conditions of 'when' statements are not # in a 'mixin' context: let it = n[i] @@ -333,22 +333,22 @@ proc semGenericStmt(c: PContext, n: PNode, n.sons[i] = semGenericStmt(c, it, flags+{withinMixin}, ctx) of nkWhileStmt: openScope(c) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): n.sons[i] = semGenericStmt(c, n.sons[i], flags, ctx) closeScope(c) of nkCaseStmt: openScope(c) n.sons[0] = semGenericStmt(c, n.sons[0], flags, ctx) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var a = n.sons[i] checkMinSonsLen(a, 1, c.config) - var L = sonsLen(a) + var L = len(a) for j in 0 .. L-2: a.sons[j] = semGenericStmt(c, a.sons[j], flags, ctx) a.sons[L - 1] = semGenericStmtScope(c, a.sons[L-1], flags, ctx) closeScope(c) of nkForStmt, nkParForStmt: - var L = sonsLen(n) + var L = len(n) openScope(c) n.sons[L - 2] = semGenericStmt(c, n.sons[L-2], flags, ctx) for i in 0 .. L - 3: @@ -372,10 +372,10 @@ proc semGenericStmt(c: PContext, n: PNode, of nkTryStmt, nkHiddenTryStmt: checkMinSonsLen(n, 2, c.config) n.sons[0] = semGenericStmtScope(c, n.sons[0], flags, ctx) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var a = n.sons[i] checkMinSonsLen(a, 1, c.config) - var L = sonsLen(a) + var L = len(a) openScope(c) for j in 0 .. L-2: if a.sons[j].isInfixAs(): @@ -387,28 +387,28 @@ proc semGenericStmt(c: PContext, n: PNode, closeScope(c) of nkVarSection, nkLetSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var L = sonsLen(a) + var L = len(a) a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, ctx) a.sons[L-1] = semGenericStmt(c, a.sons[L-1], flags, ctx) for j in 0 .. L-3: addTempDecl(c, getIdentNode(c, a.sons[j]), skVar) of nkGenericParams: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var L = sonsLen(a) + var L = len(a) a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, ctx) # do not perform symbol lookup for default expressions for j in 0 .. L-3: addTempDecl(c, getIdentNode(c, a.sons[j]), skType) of nkConstSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkConstDef): illFormedAst(a, c.config) @@ -417,13 +417,13 @@ proc semGenericStmt(c: PContext, n: PNode, a.sons[1] = semGenericStmt(c, a.sons[1], flags+{withinTypeDesc}, ctx) a.sons[2] = semGenericStmt(c, a.sons[2], flags, ctx) of nkTypeSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.config) checkSonsLen(a, 3, c.config) addTempDecl(c, getIdentNode(c, a.sons[0]), skType) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.config) @@ -436,10 +436,10 @@ proc semGenericStmt(c: PContext, n: PNode, else: a.sons[2] = semGenericStmt(c, a.sons[2], flags+{withinTypeDesc}, ctx) of nkEnumTy: - if n.sonsLen > 0: + if n.len > 0: if n.sons[0].kind != nkEmpty: n.sons[0] = semGenericStmt(c, n.sons[0], flags+{withinTypeDesc}, ctx) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var a: PNode case n.sons[i].kind of nkEnumFieldDef: a = n.sons[i].sons[0] @@ -452,11 +452,11 @@ proc semGenericStmt(c: PContext, n: PNode, checkMinSonsLen(n, 1, c.config) if n.sons[0].kind != nkEmpty: n.sons[0] = semGenericStmt(c, n.sons[0], flags+{withinTypeDesc}, ctx) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var a = n.sons[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var L = sonsLen(a) + var L = len(a) a.sons[L-2] = semGenericStmt(c, a.sons[L-2], flags+{withinTypeDesc}, ctx) a.sons[L-1] = semGenericStmt(c, a.sons[L-1], flags, ctx) for j in 0 .. L-3: @@ -489,7 +489,7 @@ proc semGenericStmt(c: PContext, n: PNode, checkMinSonsLen(n, 2, c.config) result.sons[1] = semGenericStmt(c, n.sons[1], flags, ctx) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result.sons[i] = semGenericStmt(c, n.sons[i], flags, ctx) when defined(nimsuggest): diff --git a/compiler/semmacrosanity.nim b/compiler/semmacrosanity.nim index af740e518..890a521f5 100644 --- a/compiler/semmacrosanity.nim +++ b/compiler/semmacrosanity.nim @@ -16,14 +16,14 @@ proc ithField(n: PNode, field: var int): PSym = result = nil case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = ithField(n.sons[i], field) if result != nil: return of nkRecCase: if n.sons[0].kind != nkSym: return result = ithField(n.sons[0], field) if result != nil: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = ithField(lastSon(n.sons[i]), field) diff --git a/compiler/semmagic.nim b/compiler/semmagic.nim index ed0c12a95..29f51d578 100644 --- a/compiler/semmagic.nim +++ b/compiler/semmagic.nim @@ -180,7 +180,7 @@ proc semTypeTraits(c: PContext, n: PNode): PNode = checkMinSonsLen(n, 2, c.config) let t = n.sons[1].typ internalAssert c.config, t != nil and t.kind == tyTypeDesc - if t.sonsLen > 0: + if t.len > 0: # This is either a type known to sem or a typedesc # param to a regular proc (again, known at instantiation) result = evalTypeTrait(c, n, t, getCurrOwner(c)) @@ -293,7 +293,7 @@ proc semDynamicBindSym(c: PContext, n: PNode): PNode = proc semShallowCopy(c: PContext, n: PNode, flags: TExprFlags): PNode proc semOf(c: PContext, n: PNode): PNode = - if sonsLen(n) == 3: + if len(n) == 3: n.sons[1] = semExprWithType(c, n.sons[1]) n.sons[2] = semExprWithType(c, n.sons[2], {efDetermineType}) #restoreOldStyleType(n.sons[1]) diff --git a/compiler/sempass2.nim b/compiler/sempass2.nim index c31f86f98..9957e772e 100644 --- a/compiler/sempass2.nim +++ b/compiler/sempass2.nim @@ -380,7 +380,7 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = # Collect the exceptions caught by the except branches for i in 1 ..< n.len: let b = n.sons[i] - let blen = sonsLen(b) + let blen = len(b) if b.kind == nkExceptBranch: inc branches if blen == 1: @@ -398,7 +398,7 @@ proc trackTryStmt(tracked: PEffects, n: PNode) = # Add any other exception raised in the except bodies for i in 1 ..< n.len: let b = n.sons[i] - let blen = sonsLen(b) + let blen = len(b) if b.kind == nkExceptBranch: setLen(tracked.init, oldState) track(tracked, b.sons[blen-1]) @@ -430,7 +430,7 @@ proc isForwardedProc(n: PNode): bool = result = n.kind == nkSym and sfForward in n.sym.flags proc trackPragmaStmt(tracked: PEffects, n: PNode) = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if whichPragma(it) == wEffects: # list the computed effects up to here: diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index 1b7d61376..512dbca68 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -157,7 +157,7 @@ proc semIf(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n var typ = commonTypeBegin var hasElse = false - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it.len == 2: openScope(c) @@ -208,7 +208,7 @@ proc semTry(c: PContext, n: PNode; flags: TExprFlags): PNode = n[0] = semExprBranchScope(c, n[0]) typ = commonType(typ, n[0].typ) - var last = sonsLen(n) - 1 + var last = len(n) - 1 var catchAllExcepts = 0 for i in 1 .. last: @@ -363,13 +363,13 @@ proc isDiscardUnderscore(v: PSym): bool = proc semUsing(c: PContext; n: PNode): PNode = result = c.graph.emptyNode if not isTopLevel(c): localError(c.config, n.info, errXOnlyAtModuleScope % "using") - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) if a.kind == nkCommentStmt: continue if a.kind notin {nkIdentDefs, nkVarTuple, nkConstDef}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) + var length = len(a) if a.sons[length-2].kind != nkEmpty: let typ = semTypeNode(c, a.sons[length-2], nil) for j in 0 .. length-3: @@ -416,7 +416,7 @@ proc fillPartialObject(c: PContext; n: PNode; typ: PType) = if obj.kind == tyObject and tfPartial in obj.flags: let field = newSym(skField, getIdent(c.cache, y.s), obj.sym, n[1].info) field.typ = skipIntLit(typ) - field.position = sonsLen(obj.n) + field.position = len(obj.n) addSon(obj.n, newSymNode(field)) n.sons[0] = makeDeref x n.sons[1] = newSymNode(field) @@ -437,13 +437,13 @@ proc setVarType(c: PContext; v: PSym, typ: PType) = proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = var b: PNode result = copyNode(n) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) if a.kind == nkCommentStmt: continue if a.kind notin {nkIdentDefs, nkVarTuple, nkConstDef}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) + var length = len(a) var typ: PType = nil if a.sons[length-2].kind != nkEmpty: @@ -502,7 +502,7 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = if a.kind == nkVarTuple: if tup.kind != tyTuple: localError(c.config, a.info, errXExpected, "tuple") - elif length-2 != sonsLen(tup): + elif length-2 != len(tup): localError(c.config, a.info, errWrongNumberOfVariables) b = newNodeI(nkVarTuple, a.info) newSons(b, length) @@ -583,13 +583,13 @@ proc semVarOrLet(c: PContext, n: PNode, symkind: TSymKind): PNode = proc semConst(c: PContext, n: PNode): PNode = result = copyNode(n) inc c.inStaticContext - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if c.config.cmd == cmdIdeTools: suggestStmt(c, a) if a.kind == nkCommentStmt: continue if a.kind notin {nkConstDef, nkVarTuple}: illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) + var length = len(a) var typ: PType = nil if a.sons[length-2].kind != nkEmpty: @@ -632,7 +632,7 @@ proc semConst(c: PContext, n: PNode): PNode = if a.kind == nkVarTuple: if typ.kind != tyTuple: localError(c.config, a.info, errXExpected, "tuple") - elif length-2 != sonsLen(typ): + elif length-2 != len(typ): localError(c.config, a.info, errWrongNumberOfVariables) b = newNodeI(nkVarTuple, a.info) newSons(b, length) @@ -675,7 +675,7 @@ proc symForVar(c: PContext, n: PNode): PSym = proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = result = n - var length = sonsLen(n) + var length = len(n) let iterBase = n.sons[length-2].typ var iter = skipTypes(iterBase, {tyGenericInst, tyAlias, tySink}) var iterAfterVarLent = iter.skipTypes({tyLent, tyVar}) @@ -684,9 +684,9 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = if iterAfterVarLent.kind != tyTuple or length == 3: if length == 3: if n.sons[0].kind == nkVarTuple: - if sonsLen(n[0])-1 != sonsLen(iterAfterVarLent): + if len(n[0])-1 != len(iterAfterVarLent): localError(c.config, n[0].info, errWrongNumberOfVariables) - for i in 0 ..< sonsLen(n[0])-1: + for i in 0 ..< len(n[0])-1: var v = symForVar(c, n[0][i]) if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) case iter.kind @@ -717,7 +717,7 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = elif v.owner == nil: v.owner = getCurrOwner(c) else: localError(c.config, n.info, errWrongNumberOfVariables) - elif length-2 != sonsLen(iterAfterVarLent): + elif length-2 != len(iterAfterVarLent): localError(c.config, n.info, errWrongNumberOfVariables) else: for i in 0 .. length - 3: @@ -733,9 +733,9 @@ proc semForVars(c: PContext, n: PNode; flags: TExprFlags): PNode = iter[i].skipTypes({tyLent}) else: iter[i] - if sonsLen(n[i])-1 != sonsLen(iter[i]): + if len(n[i])-1 != len(iter[i]): localError(c.config, n[i].info, errWrongNumberOfVariables) - for j in 0 ..< sonsLen(n[i])-1: + for j in 0 ..< len(n[i])-1: var v = symForVar(c, n[i][j]) if getCurrOwner(c).kind == skModule: incl(v.flags, sfGlobal) if mutable: @@ -859,7 +859,7 @@ proc handleCaseStmtMacro(c: PContext; n: PNode): PNode = proc semFor(c: PContext, n: PNode; flags: TExprFlags): PNode = checkMinSonsLen(n, 3, c.config) - var length = sonsLen(n) + var length = len(n) if forLoopMacros in c.features: result = handleForLoopMacro(c, n) if result != nil: return result @@ -929,7 +929,7 @@ proc semCase(c: PContext, n: PNode; flags: TExprFlags): PNode = return result localError(c.config, n.sons[0].info, errSelectorMustBeOfCertainTypes) return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): setCaseContextIdx(c, i) var x = n.sons[i] when defined(nimsuggest): @@ -939,7 +939,7 @@ proc semCase(c: PContext, n: PNode; flags: TExprFlags): PNode = of nkOfBranch: checkMinSonsLen(x, 2, c.config) semCaseBranch(c, n, x, i, covered) - var last = sonsLen(x)-1 + var last = len(x)-1 x.sons[last] = semExprBranchScope(c, x.sons[last]) typ = commonType(typ, x.sons[last]) of nkElifBranch: @@ -1000,7 +1000,7 @@ proc semRaise(c: PContext, n: PNode): PNode = proc addGenericParamListToScope(c: PContext, n: PNode) = if n.kind != nkGenericParams: illFormedAst(n, c.config) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkSym: addDecl(c, a.sym) else: illFormedAst(a, c.config) @@ -1017,7 +1017,7 @@ proc typeSectionTypeName(c: PContext; n: PNode): PNode = proc typeSectionLeftSidePass(c: PContext, n: PNode) = # process the symbols on the left side for the whole type section, before # we even look at the type definitions on the right - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] when defined(nimsuggest): if c.config.cmd == cmdIdeTools: @@ -1149,7 +1149,7 @@ proc checkCovariantParamsUsages(c: PContext; genericType: PType) = discard traverseSubTypes(c, body) proc typeSectionRightSidePass(c: PContext, n: PNode) = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if a.kind != nkTypeDef: illFormedAst(a, c.config) @@ -1186,7 +1186,7 @@ proc typeSectionRightSidePass(c: PContext, n: PNode) = if body != nil: body.sym = s body.size = -1 # could not be computed properly - s.typ.sons[sonsLen(s.typ) - 1] = body + s.typ.sons[len(s.typ) - 1] = body if tfCovariant in s.typ.flags: checkCovariantParamsUsages(c, s.typ) # XXX: This is a temporary limitation: @@ -1276,7 +1276,7 @@ proc checkForMetaFields(c: PContext; n: PNode) = internalAssert c.config, false proc typeSectionFinalPass(c: PContext, n: PNode) = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue let name = typeSectionTypeName(c, a.sons[0]) @@ -1374,7 +1374,7 @@ proc semParamList(c: PContext, n, genericParams: PNode, s: PSym) = s.typ = semProcTypeNode(c, n, genericParams, nil, s.kind) proc addParams(c: PContext, n: PNode, kind: TSymKind) = - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if n.sons[i].kind == nkSym: addParamOrResult(c, n.sons[i].sym, kind) else: illFormedAst(n, c.config) @@ -1498,7 +1498,7 @@ proc semLambda(c: PContext, n: PNode, flags: TExprFlags): PNode = if n.sons[paramsPos].kind != nkEmpty: semParamList(c, n.sons[paramsPos], gp, s) # paramsTypeCheck(c, s.typ) - if sonsLen(gp) > 0 and n.sons[genericParamsPos].kind == nkEmpty: + if len(gp) > 0 and n.sons[genericParamsPos].kind == nkEmpty: # we have a list of implicit type parameters: n.sons[genericParamsPos] = gp else: @@ -1724,7 +1724,7 @@ type proc hasObjParam(s: PSym): bool = var t = s.typ - for col in 1 ..< sonsLen(t): + for col in 1 ..< len(t): if skipTypes(t.sons[col], skipPtrs).kind == tyObject: return true @@ -1738,7 +1738,7 @@ proc semMethodPrototype(c: PContext; s: PSym; n: PNode) = var foundObj = false # we start at 1 for now so that tparsecombnum continues to compile. # XXX Revisit this problem later. - for col in 1 ..< sonsLen(tt): + for col in 1 ..< len(tt): let t = tt.sons[col] if t != nil and t.kind == tyGenericInvocation: var x = skipTypes(t.sons[0], {tyVar, tyLent, tyPtr, tyRef, tyGenericInst, @@ -1811,7 +1811,7 @@ proc semProcAux(c: PContext, n: PNode, kind: TSymKind, # process parameters: if n.sons[paramsPos].kind != nkEmpty: semParamList(c, n.sons[paramsPos], gp, s) - if sonsLen(gp) > 0: + if len(gp) > 0: if n.sons[genericParamsPos].kind == nkEmpty: # we have a list of implicit type parameters: n.sons[genericParamsPos] = gp @@ -2035,7 +2035,7 @@ proc semConverterDef(c: PContext, n: PNode): PNode = var s = result.sons[namePos].sym var t = s.typ if t.sons[0] == nil: localError(c.config, n.info, errXNeedsReturnType % "converter") - if sonsLen(t) != 2: localError(c.config, n.info, "a converter takes exactly one argument") + if len(t) != 2: localError(c.config, n.info, "a converter takes exactly one argument") addConverter(c, s) proc semMacroDef(c: PContext, n: PNode): PNode = @@ -2069,7 +2069,7 @@ proc incMod(c: PContext, n: PNode, it: PNode, includeStmtResult: PNode) = proc evalInclude(c: PContext, n: PNode): PNode = result = newNodeI(nkStmtList, n.info) addSon(result, n) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var imp: PNode let it = n.sons[i] if it.kind == nkInfix and it.len == 3 and it[0].ident.s != "/": @@ -2150,7 +2150,7 @@ proc semStmtList(c: PContext, n: PNode, flags: TExprFlags): PNode = LastBlockStmts = {nkRaiseStmt, nkReturnStmt, nkBreakStmt, nkContinueStmt} result = n result.kind = nkStmtList - var length = sonsLen(n) + var length = len(n) var voidContext = false var last = length-1 # by not allowing for nkCommentStmt etc. we ensure nkStmtListExpr actually diff --git a/compiler/semtempl.nim b/compiler/semtempl.nim index bb8748460..8c39a7676 100644 --- a/compiler/semtempl.nim +++ b/compiler/semtempl.nim @@ -34,7 +34,7 @@ type spNone, spGenSym, spInject proc symBinding(n: PNode): TSymBinding = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] var key = if it.kind == nkExprColonExpr: it.sons[0] else: it if key.kind == nkIdent: @@ -207,7 +207,7 @@ proc addLocalDecl(c: var TemplCtx, n: var PNode, k: TSymKind) = else: replaceIdentBySym(c.c, n, ident) else: - if (n.kind == nkPragmaExpr and sonsLen(n) >= 2 and n.sons[1].kind == nkPragma): + if (n.kind == nkPragmaExpr and len(n) >= 2 and n.sons[1].kind == nkPragma): let pragmaNode = n.sons[1] for i in 0..<pragmaNode.sons.len: openScope(c) @@ -314,12 +314,12 @@ proc semRoutineInTemplBody(c: var TemplCtx, n: PNode, k: TSymKind): PNode = closeScope(c) proc semTemplSomeDecl(c: var TemplCtx, n: PNode, symKind: TSymKind; start=0) = - for i in start ..< sonsLen(n): + for i in start ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkIdentDefs) and (a.kind != nkVarTuple): illFormedAst(a, c.c.config) checkMinSonsLen(a, 3, c.c.config) - var L = sonsLen(a) + var L = len(a) when defined(nimsuggest): inc c.c.inTypeContext a.sons[L-2] = semTemplBody(c, a.sons[L-2]) @@ -371,7 +371,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkEmpty, nkSym..nkNilLit, nkComesFrom: discard of nkIfStmt: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it.len == 2: openScope(c) @@ -382,27 +382,27 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = n.sons[i] = semTemplBodyScope(c, it) of nkWhileStmt: openScope(c) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): n.sons[i] = semTemplBody(c, n.sons[i]) closeScope(c) of nkCaseStmt: openScope(c) n.sons[0] = semTemplBody(c, n.sons[0]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var a = n.sons[i] checkMinSonsLen(a, 1, c.c.config) - var L = sonsLen(a) + var L = len(a) for j in 0 .. L-2: a.sons[j] = semTemplBody(c, a.sons[j]) a.sons[L-1] = semTemplBodyScope(c, a.sons[L-1]) closeScope(c) of nkForStmt, nkParForStmt: - var L = sonsLen(n) + var L = len(n) openScope(c) n.sons[L-2] = semTemplBody(c, n.sons[L-2]) for i in 0 .. L - 3: if n[i].kind == nkVarTuple: - for j in 0 ..< sonsLen(n[i])-1: + for j in 0 ..< len(n[i])-1: addLocalDecl(c, n[i][j], skForVar) else: addLocalDecl(c, n.sons[i], skForVar) @@ -427,10 +427,10 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = of nkTryStmt, nkHiddenTryStmt: checkMinSonsLen(n, 2, c.c.config) n.sons[0] = semTemplBodyScope(c, n.sons[0]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var a = n.sons[i] checkMinSonsLen(a, 1, c.c.config) - var L = sonsLen(a) + var L = len(a) openScope(c) for j in 0 .. L-2: if a.sons[j].isInfixAs(): @@ -447,7 +447,7 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = n.sons[0] = semTemplBody(c, n.sons[0]) semTemplSomeDecl(c, n, skParam, 1) of nkConstSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkConstDef): illFormedAst(a, c.c.config) @@ -456,13 +456,13 @@ proc semTemplBody(c: var TemplCtx, n: PNode): PNode = a.sons[1] = semTemplBody(c, a.sons[1]) a.sons[2] = semTemplBody(c, a.sons[2]) of nkTypeSection: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.c.config) checkSonsLen(a, 3, c.c.config) addLocalDecl(c, a.sons[0], skType) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind == nkCommentStmt: continue if (a.kind != nkTypeDef): illFormedAst(a, c.c.config) @@ -596,7 +596,7 @@ proc semTemplBodyDirty(c: var TemplCtx, n: PNode): PNode = if s != nil and contains(c.toBind, s.id): return symChoice(c.c, n, s, scClosed) result = n - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result.sons[i] = semTemplBodyDirty(c, n.sons[i]) proc semTemplateDef(c: PContext, n: PNode): PNode = @@ -642,7 +642,7 @@ proc semTemplateDef(c: PContext, n: PNode): PNode = if optNimV019 in c.config.globalOptions: param.flags.excl sfGenSym if param.typ.kind != tyUntyped: allUntyped = false - if sonsLen(gp) > 0: + if len(gp) > 0: if n.sons[genericParamsPos].kind == nkEmpty: # we have a list of implicit type parameters: n.sons[genericParamsPos] = gp @@ -755,7 +755,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = if stupidStmtListExpr(n): result = semPatternBody(c, n.lastSon) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result.sons[i] = semPatternBody(c, n.sons[i]) of nkCallKinds: let s = qualifiedLookUp(c.c, n.sons[0], {}) @@ -788,7 +788,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = result.sons[1] = semPatternBody(c, n.sons[1]) return - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result.sons[i] = semPatternBody(c, n.sons[i]) else: # dotExpr is ambiguous: note that we explicitly allow 'x.TemplateParam', @@ -804,7 +804,7 @@ proc semPatternBody(c: var TemplCtx, n: PNode): PNode = of nkPar: if n.len == 1: return semPatternBody(c, n.sons[0]) else: discard - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result.sons[i] = semPatternBody(c, n.sons[i]) proc semPattern(c: PContext, n: PNode): PNode = diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index 0894267b9..896db5c3c 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -54,8 +54,8 @@ proc newConstraint(c: PContext, k: TTypeKind): PType = result.addSonSkipIntLit(newTypeS(k, c)) proc semEnum(c: PContext, n: PNode, prev: PType): PType = - if n.sonsLen == 0: return newConstraint(c, tyEnum) - elif n.sonsLen == 1: + if n.len == 0: return newConstraint(c, tyEnum) + elif n.len == 1: # don't create an empty tyEnum; fixes #3052 return errorType(c) var @@ -77,7 +77,7 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = var symbols: TStrTable if isPure: initStrTable(symbols) var hasNull = false - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): if n.sons[i].kind == nkEmpty: continue case n.sons[i].kind of nkEnumFieldDef: @@ -90,7 +90,7 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = var strVal: PNode = nil case skipTypes(v.typ, abstractInst-{tyTypeDesc}).kind of tyTuple: - if sonsLen(v) == 2: + if len(v) == 2: strVal = v.sons[1] # second tuple part is the string value if skipTypes(strVal.typ, abstractInst).kind in {tyString, tyCString}: if not isOrdinalType(v.sons[0].typ, allowEnumWithHoles=true): @@ -143,7 +143,7 @@ proc semEnum(c: PContext, n: PNode, prev: PType): PType = proc semSet(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tySet, prev, c) - if sonsLen(n) == 2 and n.sons[1].kind != nkEmpty: + if len(n) == 2 and n.sons[1].kind != nkEmpty: var base = semTypeNode(c, n.sons[1], nil) addSonSkipIntLit(result, base) if base.kind in {tyGenericInst, tyAlias, tySink}: base = lastSon(base) @@ -157,7 +157,7 @@ proc semSet(c: PContext, n: PNode, prev: PType): PType = addSonSkipIntLit(result, errorType(c)) proc semContainerArg(c: PContext; n: PNode, kindStr: string; result: PType) = - if sonsLen(n) == 2: + if len(n) == 2: var base = semTypeNode(c, n.sons[1], nil) if base.kind == tyVoid: localError(c.config, n.info, errTIsNotAConcreteType % typeToString(base)) @@ -173,17 +173,17 @@ proc semContainer(c: PContext, n: PNode, kind: TTypeKind, kindStr: string, proc semVarargs(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyVarargs, prev, c) - if sonsLen(n) == 2 or sonsLen(n) == 3: + if len(n) == 2 or len(n) == 3: var base = semTypeNode(c, n.sons[1], nil) addSonSkipIntLit(result, base) - if sonsLen(n) == 3: + if len(n) == 3: result.n = newIdentNode(considerQuotedIdent(c, n.sons[2]), n.sons[2].info) else: localError(c.config, n.info, errXExpectsOneTypeParam % "varargs") addSonSkipIntLit(result, errorType(c)) proc semVarType(c: PContext, n: PNode, prev: PType): PType = - if sonsLen(n) == 1: + if len(n) == 1: result = newOrPrevType(tyVar, prev, c) var base = semTypeNode(c, n.sons[0], nil).skipTypes({tyTypeDesc}) if base.kind == tyVar: @@ -249,7 +249,7 @@ proc semRangeAux(c: PContext, n: PNode, prev: PType): PType = proc semRange(c: PContext, n: PNode, prev: PType): PType = result = nil - if sonsLen(n) == 2: + if len(n) == 2: if isRange(n[1]): result = semRangeAux(c, n[1], prev) let n = result.n @@ -315,7 +315,7 @@ proc semArrayIndex(c: PContext, n: PNode): PType = proc semArray(c: PContext, n: PNode, prev: PType): PType = var base: PType - if sonsLen(n) == 3: + if len(n) == 3: # 3 = length(array indx base) let indx = semArrayIndex(c, n[1]) var indxB = indx @@ -341,7 +341,7 @@ proc semArray(c: PContext, n: PNode, prev: PType): PType = proc semOrdinal(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyOrdinal, prev, c) - if sonsLen(n) == 2: + if len(n) == 2: var base = semTypeNode(c, n.sons[1], nil) if base.kind != tyGenericParam: if not isOrdinalType(base): @@ -414,7 +414,7 @@ proc semTypeIdent(c: PContext, n: PNode): PSym = result = errorSym(c, n) proc semAnonTuple(c: PContext, n: PNode, prev: PType): PType = - if sonsLen(n) == 0: + if len(n) == 0: localError(c.config, n.info, errTypeExpected) result = newOrPrevType(tyTuple, prev, c) for it in n: @@ -426,11 +426,11 @@ proc semTuple(c: PContext, n: PNode, prev: PType): PType = result.n = newNodeI(nkRecList, n.info) var check = initIntSet() var counter = 0 - for i in ord(n.kind == nkBracketExpr) ..< sonsLen(n): + for i in ord(n.kind == nkBracketExpr) ..< len(n): var a = n.sons[i] if (a.kind != nkIdentDefs): illFormedAst(a, c.config) checkMinSonsLen(a, 3, c.config) - var length = sonsLen(a) + var length = len(a) if a.sons[length - 2].kind != nkEmpty: typ = semTypeNode(c, a.sons[length - 2], nil) else: @@ -460,7 +460,7 @@ proc semIdentVis(c: PContext, kind: TSymKind, n: PNode, allowed: TSymFlags): PSym = # identifier with visibility if n.kind == nkPostfix: - if sonsLen(n) == 2: + if len(n) == 2: # for gensym'ed identifiers the identifier may already have been # transformed to a symbol and we need to use that here: result = newSymG(kind, n.sons[1], c) @@ -497,7 +497,7 @@ proc semIdentWithPragma(c: PContext, kind: TSymKind, n: PNode, proc checkForOverlap(c: PContext, t: PNode, currentEx, branchIndex: int) = let ex = t[branchIndex][currentEx].skipConv for i in 1 .. branchIndex: - for j in 0 .. sonsLen(t.sons[i]) - 2: + for j in 0 .. len(t.sons[i]) - 2: if i == branchIndex and j == currentEx: break if overlap(t.sons[i].sons[j].skipConv, ex): localError(c.config, ex.info, errDuplicateCaseLabel) @@ -534,7 +534,7 @@ proc semCaseBranchSetElem(c: PContext, t, b: PNode, proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, covered: var Int128) = - let lastIndex = sonsLen(branch) - 2 + let lastIndex = len(branch) - 2 for i in 0..lastIndex: var b = branch.sons[i] if b.kind == nkRange: @@ -544,7 +544,7 @@ proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, else: # constant sets and arrays are allowed: var r = semConstExpr(c, b) - if r.kind in {nkCurly, nkBracket} and len(r) == 0 and sonsLen(branch)==2: + if r.kind in {nkCurly, nkBracket} and len(r) == 0 and len(branch)==2: # discarding ``{}`` and ``[]`` branches silently delSon(branch, 0) return @@ -570,13 +570,13 @@ proc semCaseBranch(c: PContext, t, branch: PNode, branchIndex: int, checkForOverlap(c, t, i, branchIndex) # Elements added above needs to be checked for overlaps. - for i in lastIndex.succ..(sonsLen(branch) - 2): + for i in lastIndex.succ..(len(branch) - 2): checkForOverlap(c, t, i, branchIndex) proc toCover(c: PContext, t: PType): Int128 = let t2 = skipTypes(t, abstractVarRange-{tyTypeDesc}) if t2.kind == tyEnum and enumHasHoles(t2): - result = toInt128(sonsLen(t2.n)) + result = toInt128(len(t2.n)) else: # <---- let t = skipTypes(t, abstractVar-{tyTypeDesc}) @@ -635,7 +635,7 @@ proc semRecordCase(c: PContext, n: PNode, check: var IntSet, pos: var int, errorUndeclaredIdentifier(c, n.sons[0].info, typ.sym.name.s) elif not isOrdinalType(typ): localError(c.config, n.sons[0].info, "selector must be of an ordinal type, float or string") - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var b = copyTree(n.sons[i]) addSon(a, b) case n.sons[i].kind @@ -648,7 +648,7 @@ proc semRecordCase(c: PContext, n: PNode, check: var IntSet, pos: var int, localError(c.config, b.info, "invalid else, all cases are already covered") chckCovered = false else: illFormedAst(n, c.config) - delSon(b, sonsLen(b) - 1) + delSon(b, len(b) - 1) semRecordNodeAux(c, lastSon(n.sons[i]), check, pos, b, rectype, hasCaseFields = true) if chckCovered and covered != toCover(c, a.sons[0].typ): if a.sons[0].typ.kind == tyEnum: @@ -664,7 +664,7 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, case n.kind of nkRecWhen: var branch: PNode = nil # the branch to take - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it == nil: illFormedAst(n, c.config) var idx = 1 @@ -701,12 +701,12 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, of nkRecList: # attempt to keep the nesting at a sane level: var a = if father.kind == nkRecList: father else: copyNode(n) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): semRecordNodeAux(c, n.sons[i], check, pos, a, rectype) if a != father: addSon(father, a) of nkIdentDefs: checkMinSonsLen(n, 3, c.config) - var length = sonsLen(n) + var length = len(n) var a: PNode if father.kind != nkRecList and length>=4: a = newNodeI(nkRecList, n.info) else: a = newNodeI(nkEmpty, n.info) @@ -721,7 +721,7 @@ proc semRecordNodeAux(c: PContext, n: PNode, check: var IntSet, pos: var int, propagateToOwner(rectype, typ) var fieldOwner = if c.inGenericContext > 0: c.getCurrOwner else: rectype.sym - for i in 0 .. sonsLen(n)-3: + for i in 0 .. len(n)-3: var f = semIdentWithPragma(c, skField, n.sons[i], {sfExported}) suggestSym(c.config, n.sons[i].info, f, c.graph.usageSym) f.typ = typ @@ -756,13 +756,13 @@ proc addInheritedFieldsAux(c: PContext, check: var IntSet, pos: var int, of nkRecCase: if (n.sons[0].kind != nkSym): internalError(c.config, n.info, "addInheritedFieldsAux") addInheritedFieldsAux(c, check, pos, n.sons[0]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: addInheritedFieldsAux(c, check, pos, lastSon(n.sons[i])) else: internalError(c.config, n.info, "addInheritedFieldsAux(record case branch)") of nkRecList, nkRecWhen, nkElifBranch, nkElse: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): addInheritedFieldsAux(c, check, pos, n.sons[i]) of nkSym: incl(check, n.sym.name.id) @@ -779,12 +779,12 @@ proc skipGenericInvocation(t: PType): PType {.inline.} = proc addInheritedFields(c: PContext, check: var IntSet, pos: var int, obj: PType) = assert obj.kind == tyObject - if (sonsLen(obj) > 0) and (obj.sons[0] != nil): + if (len(obj) > 0) and (obj.sons[0] != nil): addInheritedFields(c, check, pos, obj.sons[0].skipGenericInvocation) addInheritedFieldsAux(c, check, pos, obj.n) proc semObjectNode(c: PContext, n: PNode, prev: PType; isInheritable: bool): PType = - if n.sonsLen == 0: + if n.len == 0: return newConstraint(c, tyObject) var check = initIntSet() var pos = 0 @@ -982,7 +982,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, result = addImplicitGeneric(c, t, paramTypId, info, genericParams, paramName) of tyDistinct: - if paramType.sonsLen == 1: + if paramType.len == 1: # disable the bindOnce behavior for the type class result = recurse(paramType.base, true) @@ -1014,7 +1014,7 @@ proc liftParamType(c: PContext, procKind: TSymKind, genericParams: PNode, result = newTypeS(tyGenericInvocation, c) result.rawAddSon(paramType) - for i in 0 .. paramType.sonsLen - 2: + for i in 0 .. paramType.len - 2: if paramType.sons[i].kind == tyStatic: var staticCopy = paramType.sons[i].exactReplica staticCopy.flags.incl tfInferrableStatic @@ -1131,7 +1131,7 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, typ: PType = nil def: PNode = nil constraint: PNode = nil - length = sonsLen(a) + length = len(a) hasType = a.sons[length-2].kind != nkEmpty hasDefault = a.sons[length-1].kind != nkEmpty @@ -1281,7 +1281,7 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, proc semStmtListType(c: PContext, n: PNode, prev: PType): PType = checkMinSonsLen(n, 1, c.config) - var length = sonsLen(n) + var length = len(n) for i in 0 .. length - 2: n.sons[i] = semStmt(c, n.sons[i], {}) if length > 0: @@ -1346,7 +1346,7 @@ proc semGeneric(c: PContext, n: PNode, s: PSym, prev: PType): PType = else: addSonSkipIntLit(result, typ) if t.kind == tyForward: - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var elem = semGenericParamInInvocation(c, n.sons[i]) addToResult(elem) return @@ -1458,7 +1458,7 @@ template modifierTypeKindOfNode(n: PNode): TTypeKind = else: tyNone proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = - # if n.sonsLen == 0: return newConstraint(c, tyTypeClass) + # if n.len == 0: return newConstraint(c, tyTypeClass) let pragmas = n[1] inherited = n[2] @@ -1569,7 +1569,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = semTypeof(c, n.sons[0], prev) if result.kind == tyTypeDesc: result.flags.incl tfExplicit of nkPar: - if sonsLen(n) == 1: result = semTypeNode(c, n.sons[0], prev) + if len(n) == 1: result = semTypeNode(c, n.sons[0], prev) else: result = semAnonTuple(c, n, prev) of nkTupleConstr: result = semAnonTuple(c, n, prev) @@ -1786,7 +1786,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = of nkDistinctTy: result = semDistinct(c, n, prev) of nkStaticTy: result = semStaticType(c, n[0], prev) of nkIteratorTy: - if n.sonsLen == 0: + if n.len == 0: result = newTypeS(tyBuiltInTypeClass, c) let child = newTypeS(tyProc, c) child.flags.incl tfIterator @@ -1799,7 +1799,7 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = else: result.callConv = ccClosure of nkProcTy: - if n.sonsLen == 0: + if n.len == 0: result = newConstraint(c, tyProc) else: result = semProcTypeWithScope(c, n, prev, skProc) @@ -1928,7 +1928,7 @@ proc semGenericParamList(c: PContext, n: PNode, father: PType = nil): PNode = if n.kind != nkGenericParams: illFormedAst(n, c.config) return - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var a = n.sons[i] if a.kind != nkIdentDefs: illFormedAst(n, c.config) let L = a.len diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index 7e4587658..ccabce155 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -169,7 +169,7 @@ proc replaceObjBranches(cl: TReplTypeVars, n: PNode): PNode = discard of nkRecWhen: var branch: PNode = nil # the branch to take - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it == nil: illFormedAst(n, cl.c.config) case it.kind @@ -189,7 +189,7 @@ proc replaceObjBranches(cl: TReplTypeVars, n: PNode): PNode = else: result = newNodeI(nkRecList, n.info) else: - for i in 0..<n.sonsLen: + for i in 0..<n.len: n.sons[i] = replaceObjBranches(cl, n.sons[i]) proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = @@ -209,7 +209,7 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = result = newNode(nkRecList, n.info) of nkRecWhen: var branch: PNode = nil # the branch to take - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it == nil: illFormedAst(n, cl.c.config) case it.kind @@ -234,7 +234,7 @@ proc replaceTypeVarsN(cl: var TReplTypeVars, n: PNode; start=0): PNode = result = if cl.allowMetaTypes: n else: cl.c.semExpr(cl.c, n) else: - var length = sonsLen(n) + var length = len(n) if length > 0: newSons(result, length) if start > 0: @@ -331,7 +331,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = when defined(reportCacheHits): echo "Generic instantiation cached ", typeToString(result), " for ", typeToString(t) return - for i in 1 ..< sonsLen(t): + for i in 1 ..< len(t): var x = t.sons[i] if x.kind in {tyGenericParam}: x = lookupTypeVar(cl, x) @@ -371,14 +371,14 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = var typeMapLayer = newTypeMapLayer(cl) cl.typeMap = addr(typeMapLayer) - for i in 1 ..< sonsLen(t): + for i in 1 ..< len(t): var x = replaceTypeVarsT(cl, t.sons[i]) assert x.kind != tyGenericInvocation header.sons[i] = x propagateToOwner(header, x) cl.typeMap.put(body.sons[i-1], x) - for i in 1 ..< sonsLen(t): + for i in 1 ..< len(t): # if one of the params is not concrete, we cannot do anything # but we already raised an error! rawAddSon(result, header.sons[i]) @@ -446,11 +446,11 @@ proc eraseVoidParams*(t: PType) = if t.sons[0] != nil and t.sons[0].kind == tyVoid: t.sons[0] = nil - for i in 1 ..< t.sonsLen: + for i in 1 ..< t.len: # don't touch any memory unless necessary if t.sons[i].kind == tyVoid: var pos = i - for j in i+1 ..< t.sonsLen: + for j in i+1 ..< t.len: if t.sons[j].kind != tyVoid: t.sons[pos] = t.sons[j] t.n.sons[pos] = t.n.sons[j] @@ -460,7 +460,7 @@ proc eraseVoidParams*(t: PType) = break proc skipIntLiteralParams*(t: PType) = - for i in 0 ..< t.sonsLen: + for i in 0 ..< t.len: let p = t.sons[i] if p == nil: continue let skipped = p.skipIntLit @@ -573,7 +573,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = bailout() result = instCopyType(cl, t) idTablePut(cl.localCache, t, result) - for i in 1 ..< result.sonsLen: + for i in 1 ..< result.len: result.sons[i] = replaceTypeVarsT(cl, result.sons[i]) propagateToOwner(result, result.lastSon) @@ -586,7 +586,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = #if not cl.allowMetaTypes: idTablePut(cl.localCache, t, result) - for i in 0 ..< sonsLen(result): + for i in 0 ..< len(result): if result.sons[i] != nil: if result.sons[i].kind == tyGenericBody: localError(cl.c.config, t.sym.info, @@ -693,10 +693,10 @@ proc recomputeFieldPositions*(t: PType; obj: PNode; currPosition: var int) = recomputeFieldPositions(b, b.n, currPosition) case obj.kind of nkRecList: - for i in 0 ..< sonsLen(obj): recomputeFieldPositions(nil, obj.sons[i], currPosition) + for i in 0 ..< len(obj): recomputeFieldPositions(nil, obj.sons[i], currPosition) of nkRecCase: recomputeFieldPositions(nil, obj.sons[0], currPosition) - for i in 1 ..< sonsLen(obj): + for i in 1 ..< len(obj): recomputeFieldPositions(nil, lastSon(obj.sons[i]), currPosition) of nkSym: obj.sym.position = currPosition diff --git a/compiler/sighashes.nim b/compiler/sighashes.nim index a9d911e27..90b7001a5 100644 --- a/compiler/sighashes.nim +++ b/compiler/sighashes.nim @@ -93,7 +93,7 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = case t.kind of tyGenericInvocation: - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): c.hashType t.sons[i], flags of tyDistinct: if CoDistinct in flags: @@ -180,15 +180,15 @@ proc hashType(c: var MD5Context, t: PType; flags: set[ConsiderFlag]) = of tyTuple: c &= char(t.kind) if t.n != nil and CoType notin flags: - assert(sonsLen(t.n) == sonsLen(t)) - for i in 0 ..< sonsLen(t.n): + assert(len(t.n) == len(t)) + for i in 0 ..< len(t.n): assert(t.n.sons[i].kind == nkSym) c &= t.n.sons[i].sym.name.s c &= ':' c.hashType(t.sons[i], flags+{CoIgnoreRange}) c &= ',' else: - for i in 0 ..< sonsLen(t): c.hashType t.sons[i], flags+{CoIgnoreRange} + for i in 0 ..< len(t): c.hashType t.sons[i], flags+{CoIgnoreRange} of tyRange: if CoIgnoreRange notin flags: c &= char(t.kind) diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 2c22620da..10141e645 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -167,7 +167,7 @@ proc initCandidate*(ctx: PContext, c: var TCandidate, callee: PSym, initIdTable(c.bindings) if binding != nil and callee.kind in routineKinds: var typeParams = callee.ast[genericParamsPos] - for i in 1..min(sonsLen(typeParams), sonsLen(binding)-1): + for i in 1..min(len(typeParams), len(binding)-1): var formalTypeParam = typeParams.sons[i-1].typ var bound = binding[i].typ if bound != nil: @@ -334,7 +334,7 @@ proc describeArgs*(c: PContext, n: PNode, startIdx = 1; n.sons[i] = arg if arg.typ != nil and arg.typ.kind == tyError: return add(result, argTypeToString(arg, prefer)) - if i != sonsLen(n) - 1: add(result, ", ") + if i != len(n) - 1: add(result, ", ") proc typeRel*(c: var TCandidate, f, aOrig: PType, flags: TTypeRelFlags = {}): TTypeRelation @@ -440,7 +440,7 @@ proc handleFloatRange(f, a: PType): TTypeRelation = proc genericParamPut(c: var TCandidate; last, fGenericOrigin: PType) = if fGenericOrigin != nil and last.kind == tyGenericInst and last.len-1 == fGenericOrigin.len: - for i in 1 ..< sonsLen(fGenericOrigin): + for i in 1 ..< len(fGenericOrigin): let x = PType(idTableGet(c.bindings, fGenericOrigin.sons[i])) if x == nil: put(c, fGenericOrigin.sons[i], last.sons[i]) @@ -518,16 +518,16 @@ proc recordRel(c: var TCandidate, f, a: PType): TTypeRelation = result = isNone if sameType(f, a): result = isEqual - elif sonsLen(a) == sonsLen(f): + elif len(a) == len(f): result = isEqual let firstField = if f.kind == tyTuple: 0 else: 1 - for i in firstField ..< sonsLen(f): + for i in firstField ..< len(f): var m = typeRel(c, f.sons[i], a.sons[i]) if m < isSubtype: return isNone result = minRel(result, m) if f.n != nil and a.n != nil: - for i in 0 ..< sonsLen(f.n): + for i in 0 ..< len(f.n): # check field names: if f.n.sons[i].kind != nkSym: return isNone elif a.n.sons[i].kind != nkSym: return isNone @@ -607,7 +607,7 @@ proc procParamTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = case a.kind of tyProc: - if sonsLen(f) != sonsLen(a): return + if len(f) != len(a): return result = isEqual # start with maximum; also correct for no # params at all @@ -617,7 +617,7 @@ proc procTypeRel(c: var TCandidate, f, a: PType): TTypeRelation = # Note: We have to do unification for the parameters before the # return type! - for i in 1 ..< f.sonsLen: + for i in 1 ..< f.len: checkParam(f.sons[i], a.sons[i]) if f.sons[0] != nil: @@ -943,7 +943,7 @@ proc isCovariantPtr(c: var TCandidate, f, a: PType): bool = of tyGenericInst: let body = f.base return body == a.base and - a.sonsLen == 3 and + a.len == 3 and tfWeakCovariant notin body.sons[0].flags and baseTypesCheck(f.sons[1], a.sons[1]) else: @@ -1416,7 +1416,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # YYYY result = isEqual - for i in 1 .. rootf.sonsLen-2: + for i in 1 .. rootf.len-2: let ff = rootf.sons[i] let aa = roota.sons[i] let res = typeRel(c, ff, aa, nextFlags) @@ -1497,8 +1497,8 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # simply no match for now: discard elif x.kind == tyGenericInst and f.sons[0] == x.sons[0] and - sonsLen(x) - 1 == sonsLen(f): - for i in 1 ..< sonsLen(f): + len(x) - 1 == len(f): + for i in 1 ..< len(f): if x.sons[i].kind == tyGenericParam: internalError(c.c.graph.config, "wrong instantiated type!") elif typeRel(c, f.sons[i], x.sons[i]) <= isSubtype: @@ -1506,7 +1506,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if f.sons[i].kind != tyTypeDesc: return result = isGeneric elif x.kind == tyGenericInst and isGenericSubtype(c, x, f, depth, f) and - (sonsLen(x) - 1 == sonsLen(f)): + (len(x) - 1 == len(f)): # do not recurse here in order to not K bind twice for this code: # # type @@ -1538,7 +1538,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, # var it1 = internalFind(root, 312) # cannot instantiate: 'D' # # we steal the generic parameters from the tyGenericBody: - for i in 1 ..< sonsLen(f): + for i in 1 ..< len(f): let x = PType(idTableGet(c.bindings, genericBody.sons[i-1])) if x == nil: discard "maybe fine (for eg. a==tyNil)" @@ -1643,7 +1643,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, 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: + for i in 1 .. rootf.len-2: let ff = rootf.sons[i] let aa = roota.sons[i] result = typeRel(c, ff, aa) @@ -1667,7 +1667,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, if tfWildcard in a.flags: result = isGeneric elif a.kind == tyTypeDesc: - if f.sonsLen == 0: + if f.len == 0: result = isGeneric else: internalAssert c.c.graph.config, a.len > 0 @@ -1689,7 +1689,7 @@ proc typeRel(c: var TCandidate, f, aOrig: PType, result = isNone else: # check if 'T' has a constraint as in 'proc p[T: Constraint](x: T)' - if f.sonsLen > 0 and f.sons[0].kind != tyNone: + if f.len > 0 and f.sons[0].kind != tyNone: let oldInheritancePenalty = c.inheritancePenalty result = typeRel(c, f.sons[0], a, flags + {trDontBind}) if doBind and result notin {isNone, isGeneric}: @@ -2523,7 +2523,7 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = if m.state == csNoMatch: return # check that every formal parameter got a value: var f = 1 - while f < sonsLen(m.callee.n): + while f < len(m.callee.n): var formal = m.callee.n.sons[f].sym if not containsOrIncl(marker, formal.position): if formal.ast == nil: @@ -2562,7 +2562,7 @@ proc matches*(c: PContext, n, nOrig: PNode, m: var TCandidate) = # forget all inferred types if the overload matching failed if m.state == csNoMatch: for t in m.inferredTypes: - if t.sonsLen > 1: t.sons.setLen 1 + if t.len > 1: t.sons.setLen 1 proc argtypeMatches*(c: PContext, f, a: PType, fromHlo = false): bool = var m: TCandidate diff --git a/compiler/sizealignoffsetimpl.nim b/compiler/sizealignoffsetimpl.nim index 66b8ba1c9..fdca01136 100644 --- a/compiler/sizealignoffsetimpl.nim +++ b/compiler/sizealignoffsetimpl.nim @@ -80,7 +80,7 @@ proc computeSubObjectAlign(conf: ConfigRef; n: PNode): BiggestInt = of nkRecCase: assert(n.sons[0].kind == nkSym) result = computeSubObjectAlign(conf, n.sons[0]) - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let child = n.sons[i] case child.kind of nkOfBranch, nkElse: @@ -123,7 +123,7 @@ proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode, packed: bool, a computeObjectOffsetsFoldFunction(conf, n.sons[0], packed, accum) var maxChildAlign: int = if accum.offset == szUnknownSize: szUnknownSize else: 1 if not packed: - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let child = n.sons[i] case child.kind of nkOfBranch, nkElse: @@ -140,7 +140,7 @@ proc computeObjectOffsetsFoldFunction(conf: ConfigRef; n: PNode, packed: bool, a # the union neds to be aligned first, before the offsets can be assigned accum.align(maxChildAlign) let accumRoot = accum # copy, because each branch should start af the same offset - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): var branchAccum = accumRoot computeObjectOffsetsFoldFunction(conf, n.sons[i].lastSon, packed, branchAccum) accum.mergeBranch(branchAccum) @@ -316,7 +316,7 @@ proc computeSizeAlign(conf: ConfigRef; typ: PType) = of tyTuple: try: var accum = OffsetAccum(maxAlign: 1) - for i in 0 ..< sonsLen(typ): + for i in 0 ..< len(typ): let child = typ.sons[i] computeSizeAlign(conf, child) accum.align(child.align) diff --git a/compiler/suggest.nim b/compiler/suggest.nim index 5cb365a4a..a254c1f13 100644 --- a/compiler/suggest.nim +++ b/compiler/suggest.nim @@ -275,7 +275,7 @@ template wholeSymTab(cond, section: untyped) {.dirty.} = pm, c.inTypeContext > 0, scopeN)) proc suggestSymList(c: PContext, list, f: PNode; info: TLineInfo, outputs: var Suggestions) = - for i in 0 ..< sonsLen(list): + for i in 0 ..< len(list): if list.sons[i].kind == nkSym: suggestField(c, list.sons[i].sym, f, info, outputs) #else: InternalError(list.info, "getSymFromList") @@ -283,9 +283,9 @@ proc suggestSymList(c: PContext, list, f: PNode; info: TLineInfo, outputs: var S proc suggestObject(c: PContext, n, f: PNode; info: TLineInfo, outputs: var Suggestions) = case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): suggestObject(c, n.sons[i], f, info, outputs) + for i in 0 ..< len(n): suggestObject(c, n.sons[i], f, info, outputs) of nkRecCase: - var L = sonsLen(n) + var L = len(n) if L > 0: suggestObject(c, n.sons[0], f, info, outputs) for i in 1 ..< L: suggestObject(c, lastSon(n.sons[i]), f, info, outputs) @@ -318,7 +318,7 @@ proc suggestCall(c: PContext, n, nOrig: PNode, outputs: var Suggestions) = ideCon) proc typeFits(c: PContext, s: PSym, firstArg: PType): bool {.inline.} = - if s.typ != nil and sonsLen(s.typ) > 1 and s.typ.sons[1] != nil: + if s.typ != nil and len(s.typ) > 1 and s.typ.sons[1] != nil: # special rule: if system and some weird generic match via 'tyUntyped' # or 'tyGenericParam' we won't list it either to reduce the noise (nobody # wants 'system.`-|` as suggestion @@ -595,7 +595,7 @@ proc suggestExprNoCheck*(c: PContext, n: PNode) = var x = safeSemExpr(c, n.sons[0]) if x.kind == nkEmpty or x.typ == nil: x = n.sons[0] addSon(a, x) - for i in 1..sonsLen(n)-1: + for i in 1..len(n)-1: # use as many typed arguments as possible: var x = safeSemExpr(c, n.sons[i]) if x.kind == nkEmpty or x.typ == nil: break diff --git a/compiler/transf.nim b/compiler/transf.nim index dc700278f..f1c89939f 100644 --- a/compiler/transf.nim +++ b/compiler/transf.nim @@ -71,7 +71,7 @@ proc newTransNode(kind: TNodeKind, n: PNode, result = x.PTransNode proc add(a, b: PTransNode) {.inline.} = addSon(PNode(a), PNode(b)) -proc len(a: PTransNode): int {.inline.} = sonsLen(a.PNode) +proc len(a: PTransNode): int {.inline.} = len(a.PNode) proc `[]=`(a: PTransNode, i: int, x: PTransNode) {.inline.} = var n = PNode(a) @@ -119,7 +119,7 @@ proc transform(c: PTransf, n: PNode): PTransNode proc transformSons(c: PTransf, n: PNode): PTransNode = result = newTransNode(n) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result[i] = transform(c, n.sons[i]) proc newAsgnStmt(c: PTransf, kind: TNodeKind, le: PNode, ri: PTransNode): PTransNode = @@ -176,7 +176,7 @@ proc freshVar(c: PTransf; v: PSym): PNode = proc transformVarSection(c: PTransf, v: PNode): PTransNode = result = newTransNode(v) - for i in 0 ..< sonsLen(v): + for i in 0 ..< len(v): var it = v.sons[i] if it.kind == nkCommentStmt: result[i] = PTransNode(it) @@ -201,7 +201,7 @@ proc transformVarSection(c: PTransf, v: PNode): PTransNode = else: if it.kind != nkVarTuple: internalError(c.graph.config, it.info, "transformVarSection: not nkVarTuple") - var L = sonsLen(it) + var L = len(it) var defs = newTransNode(it.kind, it.info, L) for j in 0 .. L-3: if it[j].kind == nkSym: @@ -219,7 +219,7 @@ proc transformConstSection(c: PTransf, v: PNode): PTransNode = result = PTransNode(v) when false: result = newTransNode(v) - for i in 0 ..< sonsLen(v): + for i in 0 ..< len(v): var it = v.sons[i] if it.kind == nkCommentStmt: result[i] = PTransNode(it) @@ -236,7 +236,7 @@ proc hasContinue(n: PNode): bool = of nkEmpty..nkNilLit, nkForStmt, nkParForStmt, nkWhileStmt: discard of nkContinueStmt: result = true else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): if hasContinue(n.sons[i]): return true proc newLabel(c: PTransf, n: PNode): PSym = @@ -318,7 +318,7 @@ proc introduceNewLocalVars(c: PTransf, n: PNode): PTransNode = return PTransNode(n) else: result = newTransNode(n) - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result[i] = introduceNewLocalVars(c, n.sons[i]) proc transformAsgn(c: PTransf, n: PNode): PTransNode = @@ -374,11 +374,11 @@ proc transformYield(c: PTransf, n: PNode): PTransNode = if c.transCon.forStmt.len != 3: e = skipConv(e) if e.kind in {nkPar, nkTupleConstr}: - for i in 0 ..< sonsLen(e): + for i in 0 ..< len(e): var v = e.sons[i] if v.kind == nkExprColonExpr: v = v.sons[1] if c.transCon.forStmt[i].kind == nkVarTuple: - for j in 0 ..< sonsLen(c.transCon.forStmt[i])-1: + for j in 0 ..< len(c.transCon.forStmt[i])-1: let lhs = c.transCon.forStmt[i][j] let rhs = transform(c, newTupleAccess(c.graph, v, j)) add(result, asgnTo(lhs, rhs)) @@ -389,13 +389,13 @@ proc transformYield(c: PTransf, n: PNode): PTransNode = else: # Unpack the tuple into the loop variables # XXX: BUG: what if `n` is an expression with side-effects? - for i in 0 .. sonsLen(c.transCon.forStmt) - 3: + for i in 0 .. len(c.transCon.forStmt) - 3: let lhs = c.transCon.forStmt.sons[i] let rhs = transform(c, newTupleAccess(c.graph, e, i)) add(result, asgnTo(lhs, rhs)) else: if c.transCon.forStmt.sons[0].kind == nkVarTuple: - for i in 0 ..< sonsLen(c.transCon.forStmt[0])-1: + for i in 0 ..< len(c.transCon.forStmt[0])-1: let lhs = c.transCon.forStmt[0][i] let rhs = transform(c, newTupleAccess(c.graph, e, i)) add(result, asgnTo(lhs, rhs)) @@ -575,7 +575,7 @@ proc putArgInto(arg: PNode, formal: PType): TPutArgInto = result = paDirectMapping of nkPar, nkTupleConstr, nkCurly, nkBracket: result = paFastAsgn - for i in 0 ..< sonsLen(arg): + for i in 0 ..< len(arg): if putArgInto(arg.sons[i], formal) != paDirectMapping: return result = paDirectMapping else: @@ -596,7 +596,7 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = # put mapping from formal parameters to actual parameters if n.kind != nkForStmt: internalError(c.graph.config, n.info, "transformFor") - var length = sonsLen(n) + var length = len(n) var call = n.sons[length - 2] let labl = newLabel(c, n) @@ -627,7 +627,7 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = var v = newNodeI(nkVarSection, n.info) for i in 0 .. length - 3: if n[i].kind == nkVarTuple: - for j in 0 ..< sonsLen(n[i])-1: + for j in 0 ..< len(n[i])-1: addVar(v, copyTree(n[i][j])) # declare new vars else: addVar(v, copyTree(n.sons[i])) # declare new vars @@ -643,7 +643,7 @@ proc transformFor(c: PTransf, n: PNode): PTransNode = if iter.kind != skIterator: return result # generate access statements for the parameters (unless they are constant) pushTransCon(c, newC) - for i in 1 ..< sonsLen(call): + for i in 1 ..< len(call): var arg = transform(c, call.sons[i]).PNode let ff = skipTypes(iter.typ, abstractInst) # can happen for 'nim check': @@ -694,7 +694,7 @@ proc transformCase(c: PTransf, n: PNode): PTransNode = # adds ``else: nil`` if needed for the code generator result = newTransNode(nkCaseStmt, n, 0) var ifs = PTransNode(nil) - for i in 0 .. sonsLen(n)-1: + for i in 0 .. len(n)-1: var it = n.sons[i] var e = transform(c, it) case it.kind @@ -744,7 +744,7 @@ proc flattenTreeAux(d, a: PNode, op: PSym) = let op2 = getMergeOp(a) if op2 != nil and (op2.id == op.id or op.magic != mNone and op2.magic == op.magic): - for i in 1 ..< sonsLen(a): flattenTreeAux(d, a.sons[i], op) + for i in 1 ..< len(a): flattenTreeAux(d, a.sons[i], op) else: addSon(d, copyTree(a)) @@ -765,11 +765,11 @@ proc transformCall(c: PTransf, n: PNode): PTransNode = result = newTransNode(nkCall, n, 0) add(result, transform(c, n.sons[0])) var j = 1 - while j < sonsLen(n): + while j < len(n): var a = transform(c, n.sons[j]).PNode inc(j) if isConstExpr(a): - while (j < sonsLen(n)): + while (j < len(n)): let b = transform(c, n.sons[j]).PNode if not isConstExpr(b): break a = evalOp(op.magic, n, a, b, nil, c.graph) @@ -844,17 +844,17 @@ proc commonOptimizations*(g: ModuleGraph; c: PSym, n: PNode): PNode = for i in 0 ..< n.safeLen: result.sons[i] = commonOptimizations(g, c, n.sons[i]) var op = getMergeOp(n) - if (op != nil) and (op.magic != mNone) and (sonsLen(n) >= 3): + if (op != nil) and (op.magic != mNone) and (len(n) >= 3): result = newNodeIT(nkCall, n.info, n.typ) add(result, n.sons[0]) var args = newNode(nkArgList) flattenTreeAux(args, n, op) var j = 0 - while j < sonsLen(args): + while j < len(args): var a = args.sons[j] inc(j) if isConstExpr(a): - while j < sonsLen(args): + while j < len(args): let b = args.sons[j] if not isConstExpr(b): break a = evalOp(op.magic, result, a, b, nil, g) diff --git a/compiler/trees.nim b/compiler/trees.nim index 87ab7c00e..fd06425cb 100644 --- a/compiler/trees.nim +++ b/compiler/trees.nim @@ -44,8 +44,8 @@ proc exprStructuralEquivalent*(a, b: PNode; strictSymEquality=false): bool = of nkCommentStmt: result = a.comment == b.comment of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not exprStructuralEquivalent(a.sons[i], b.sons[i], strictSymEquality): return result = true @@ -68,8 +68,8 @@ proc sameTree*(a, b: PNode): bool = of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not sameTree(a.sons[i], b.sons[i]): return result = true @@ -127,7 +127,7 @@ proc findPragma*(n: PNode, which: TSpecialWord): PNode = return son proc effectSpec*(n: PNode, effectType: TSpecialWord): PNode = - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): var it = n.sons[i] if it.kind == nkExprColonExpr and whichPragma(it) == effectType: result = it.sons[1] diff --git a/compiler/treetab.nim b/compiler/treetab.nim index 7d654509c..f346d8d97 100644 --- a/compiler/treetab.nim +++ b/compiler/treetab.nim @@ -31,7 +31,7 @@ proc hashTree(n: PNode): Hash = of nkStrLit..nkTripleStrLit: result = result !& hash(n.strVal) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = result !& hashTree(n.sons[i]) proc treesEquivalent(a, b: PNode): bool = @@ -46,8 +46,8 @@ proc treesEquivalent(a, b: PNode): bool = of nkFloatLit..nkFloat64Lit: result = a.floatVal == b.floatVal of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not treesEquivalent(a.sons[i], b.sons[i]): return result = true if result: result = sameTypeOrNil(a.typ, b.typ) diff --git a/compiler/types.nim b/compiler/types.nim index a05625327..1ed882cb8 100644 --- a/compiler/types.nim +++ b/compiler/types.nim @@ -132,13 +132,13 @@ proc getProcHeader*(conf: ConfigRef; sym: PSym; prefer: TPreferedDesc = preferNa if sym.kind in routineKinds: result.add '(' var n = sym.typ.n - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): let p = n.sons[i] if p.kind == nkSym: add(result, p.sym.name.s) add(result, ": ") add(result, typeToString(p.sym.typ, prefer)) - if i != sonsLen(n)-1: add(result, ", ") + if i != len(n)-1: add(result, ", ") else: result.add renderTree(p) add(result, ')') @@ -180,7 +180,7 @@ proc iterOverNode(marker: var IntSet, n: PNode, iter: TTypeIter, # a leaf result = iterOverTypeAux(marker, n.typ, iter, closure) else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = iterOverNode(marker, n.sons[i], iter, closure) if result: return @@ -195,7 +195,7 @@ proc iterOverTypeAux(marker: var IntSet, t: PType, iter: TTypeIter, of tyGenericInst, tyGenericBody, tyAlias, tySink, tyInferred: result = iterOverTypeAux(marker, lastSon(t), iter, closure) else: - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): result = iterOverTypeAux(marker, t.sons[i], iter, closure) if result: return if t.n != nil and t.kind != tyProc: result = iterOverNode(marker, t.n, iter, closure) @@ -212,14 +212,14 @@ proc searchTypeNodeForAux(n: PNode, p: TTypePredicate, result = false case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = searchTypeNodeForAux(n.sons[i], p, marker) if result: return of nkRecCase: assert(n.sons[0].kind == nkSym) result = searchTypeNodeForAux(n.sons[0], p, marker) if result: return - for i in 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = searchTypeNodeForAux(lastSon(n.sons[i]), p, marker) @@ -245,7 +245,7 @@ proc searchTypeForAux(t: PType, predicate: TTypePredicate, of tyGenericInst, tyDistinct, tyAlias, tySink: result = searchTypeForAux(lastSon(t), predicate, marker) of tyArray, tySet, tyTuple: - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): result = searchTypeForAux(t.sons[i], predicate, marker) if result: return else: @@ -282,7 +282,7 @@ proc analyseObjectWithTypeFieldAux(t: PType, if t.n != nil: if searchTypeNodeForAux(t.n, isObjectWithTypeFieldPredicate, marker): return frEmbedded - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): var x = t.sons[i] if x != nil: x = x.skipTypes(skipPtrs) res = analyseObjectWithTypeFieldAux(x, marker) @@ -294,7 +294,7 @@ proc analyseObjectWithTypeFieldAux(t: PType, of tyGenericInst, tyDistinct, tyAlias, tySink: result = analyseObjectWithTypeFieldAux(lastSon(t), marker) of tyArray, tyTuple: - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): res = analyseObjectWithTypeFieldAux(t.sons[i], marker) if res != frNone: return frEmbedded @@ -344,7 +344,7 @@ proc canFormAcycleNode(marker: var IntSet, n: PNode, startId: int): bool = of nkNone..nkNilLit: discard else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): result = canFormAcycleNode(marker, n.sons[i], startId) if result: return @@ -355,7 +355,7 @@ proc canFormAcycleAux(marker: var IntSet, typ: PType, startId: int): bool = case t.kind of tyTuple, tyObject, tyRef, tySequence, tyArray, tyOpenArray, tyVarargs: if not containsOrIncl(marker, t.id): - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): result = canFormAcycleAux(marker, t.sons[i], startId) if result: return if t.n != nil: result = canFormAcycleNode(marker, t.n, startId) @@ -391,7 +391,7 @@ proc mutateNode(marker: var IntSet, n: PNode, iter: TTypeMutator, # a leaf discard else: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): addSon(result, mutateNode(marker, n.sons[i], iter, closure)) proc mutateTypeAux(marker: var IntSet, t: PType, iter: TTypeMutator, @@ -400,7 +400,7 @@ proc mutateTypeAux(marker: var IntSet, t: PType, iter: TTypeMutator, if t == nil: return result = iter(t, closure) if not containsOrIncl(marker, t.id): - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): result.sons[i] = mutateTypeAux(marker, result.sons[i], iter, closure) if t.n != nil: result.n = mutateNode(marker, t.n, iter, closure) assert(result != nil) @@ -491,7 +491,7 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = elif prefer in {preferName, preferTypeName} or t.sym.owner.isNil: # note: should probably be: {preferName, preferTypeName, preferGenericArg} result = t.sym.name.s - if t.kind == tyGenericParam and t.sonsLen > 0: + if t.kind == tyGenericParam and t.len > 0: result.add ": " var first = true for son in t.sons: @@ -513,13 +513,13 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = result = "int literal(" & $t.n.intVal & ")" of tyGenericInst, tyGenericInvocation: result = typeToString(t.sons[0]) & '[' - for i in 1 ..< sonsLen(t)-ord(t.kind != tyGenericInvocation): + for i in 1 ..< len(t)-ord(t.kind != tyGenericInvocation): if i > 1: add(result, ", ") add(result, typeToString(t.sons[i], preferGenericArg)) add(result, ']') of tyGenericBody: result = typeToString(t.lastSon) & '[' - for i in 0 .. sonsLen(t)-2: + for i in 0 .. len(t)-2: if i > 0: add(result, ", ") add(result, typeToString(t.sons[i], preferTypeName)) add(result, ']') @@ -560,7 +560,7 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = of tyUserTypeClassInst: let body = t.base result = body.sym.name.s & "[" - for i in 1 .. sonsLen(t) - 2: + for i in 1 .. len(t) - 2: if i > 1: add(result, ", ") add(result, typeToString(t.sons[i])) result.add "]" @@ -610,29 +610,29 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = # we iterate over t.sons here, because t.n may be nil if t.n != nil: result = "tuple[" - assert(sonsLen(t.n) == sonsLen(t)) - for i in 0 ..< sonsLen(t.n): + assert(len(t.n) == len(t)) + for i in 0 ..< len(t.n): assert(t.n.sons[i].kind == nkSym) add(result, t.n.sons[i].sym.name.s & ": " & typeToString(t.sons[i])) - if i < sonsLen(t.n) - 1: add(result, ", ") + if i < len(t.n) - 1: add(result, ", ") add(result, ']') - elif sonsLen(t) == 0: + elif len(t) == 0: result = "tuple[]" else: if prefer == preferTypeName: result = "(" else: result = "tuple of (" - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") + if i < len(t) - 1: add(result, ", ") add(result, ')') of tyPtr, tyRef, tyVar, tyLent: result = typeToStr[t.kind] if t.len >= 2: setLen(result, result.len-1) result.add '[' - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") + if i < len(t) - 1: add(result, ", ") result.add ']' else: result.add typeToString(t.sons[0]) @@ -654,12 +654,12 @@ proc typeToString(typ: PType, prefer: TPreferedDesc = preferName): string = "proc " if tfUnresolved in t.flags: result.add "[*missing parameters*]" result.add "(" - for i in 1 ..< sonsLen(t): + for i in 1 ..< len(t): if t.n != nil and i < t.n.len and t.n[i].kind == nkSym: add(result, t.n[i].sym.name.s) add(result, ": ") add(result, typeToString(t.sons[i])) - if i < sonsLen(t) - 1: add(result, ", ") + if i < len(t) - 1: add(result, ", ") add(result, ')') if t.len > 0 and t.sons[0] != nil: add(result, ": " & typeToString(t.sons[0])) var prag = if t.callConv == ccDefault: "" else: CallingConvToStr[t.callConv] @@ -706,7 +706,7 @@ proc firstOrd*(conf: ConfigRef; t: PType): Int128 = of tyUInt..tyUInt64: result = Zero of tyEnum: # if basetype <> nil then return firstOrd of basetype - if sonsLen(t) > 0 and t.sons[0] != nil: + if len(t) > 0 and t.sons[0] != nil: result = firstOrd(conf, t.sons[0]) else: assert(t.n.sons[0].kind == nkSym) @@ -766,8 +766,8 @@ proc lastOrd*(conf: ConfigRef; t: PType): Int128 = of tyUInt64: result = toInt128(0xFFFFFFFFFFFFFFFF'u64) of tyEnum: - assert(t.n.sons[sonsLen(t.n) - 1].kind == nkSym) - result = toInt128(t.n.sons[sonsLen(t.n) - 1].sym.position) + assert(t.n.sons[len(t.n) - 1].kind == nkSym) + result = toInt128(t.n.sons[len(t.n) - 1].sym.position) of tyGenericInst, tyDistinct, tyTypeDesc, tyAlias, tySink, tyStatic, tyInferred, tyUserTypeClasses: result = lastOrd(conf, lastSon(t)) @@ -908,8 +908,8 @@ proc sameConstraints(a, b: PNode): bool = proc equalParams(a, b: PNode): TParamsEquality = result = paramsEqual - var length = sonsLen(a) - if length != sonsLen(b): + var length = len(a) + if length != len(b): result = paramsNotEqual else: for i in 1 ..< length: @@ -939,9 +939,9 @@ proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = # two tuples are equivalent iff the names, types and positions are the same; # however, both types may not have any field names (t.n may be nil) which # complicates the matter a bit. - if sonsLen(a) == sonsLen(b): + if len(a) == len(b): result = true - for i in 0 ..< sonsLen(a): + for i in 0 ..< len(a): var x = a.sons[i] var y = b.sons[i] if IgnoreTupleFields in c.flags: @@ -951,7 +951,7 @@ proc sameTuple(a, b: PType, c: var TSameTypeClosure): bool = result = sameTypeAux(x, y, c) if not result: return if a.n != nil and b.n != nil and IgnoreTupleFields notin c.flags: - for i in 0 ..< sonsLen(a.n): + for i in 0 ..< len(a.n): # check field names: if a.n.sons[i].kind == nkSym and b.n.sons[i].kind == nkSym: var x = a.n.sons[i].sym @@ -1014,23 +1014,23 @@ proc sameObjectTree(a, b: PNode, c: var TSameTypeClosure): bool = of nkStrLit..nkTripleStrLit: result = a.strVal == b.strVal of nkEmpty, nkNilLit, nkType: result = true else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not sameObjectTree(a.sons[i], b.sons[i], c): return result = true proc sameObjectStructures(a, b: PType, c: var TSameTypeClosure): bool = # check base types: - if sonsLen(a) != sonsLen(b): return - for i in 0 ..< sonsLen(a): + if len(a) != len(b): return + for i in 0 ..< len(a): if not sameTypeOrNilAux(a.sons[i], b.sons[i], c): return if not sameObjectTree(a.n, b.n, c): return result = true proc sameChildrenAux(a, b: PType, c: var TSameTypeClosure): bool = - if sonsLen(a) != sonsLen(b): return false + if len(a) != len(b): return false result = true - for i in 0 ..< sonsLen(a): + for i in 0 ..< len(a): result = sameTypeOrNilAux(a.sons[i], b.sons[i], c) if not result: return @@ -1239,7 +1239,7 @@ proc typeAllowedNode(marker: var IntSet, n: PNode, kind: TSymKind, else: #if n.kind == nkRecCase and kind in {skProc, skFunc, skConst}: # return n[0].typ - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): let it = n.sons[i] result = typeAllowedNode(marker, it, kind, flags) if result != nil: break @@ -1249,7 +1249,7 @@ proc matchType*(a: PType, pattern: openArray[tuple[k:TTypeKind, i:int]], var a = a for k, i in pattern.items: if a.kind != k: return false - if i >= a.sonsLen or a.sons[i] == nil: return false + if i >= a.len or a.sons[i] == nil: return false a = a.sons[i] result = a.kind == last @@ -1284,7 +1284,7 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, else: result = typeAllowedAux(marker, t2, kind, flags) of tyProc: let f = if kind in {skProc, skFunc}: flags+{taNoUntyped} else: flags - for i in 1 ..< sonsLen(t): + for i in 1 ..< len(t): result = typeAllowedAux(marker, t.sons[i], skParam, f-{taIsOpenArray}) if result != nil: break if result.isNil and t.sons[0] != nil: @@ -1346,7 +1346,7 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, of tyPtr: result = typeAllowedAux(marker, t.lastSon, kind, flags+{taHeap}) of tySet: - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): result = typeAllowedAux(marker, t.sons[i], kind, flags) if result != nil: break of tyObject, tyTuple: @@ -1355,7 +1355,7 @@ proc typeAllowedAux(marker: var IntSet, typ: PType, kind: TSymKind, result = t else: let flags = flags+{taField} - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): result = typeAllowedAux(marker, t.sons[i], kind, flags) if result != nil: break if result.isNil and t.n != nil: @@ -1490,7 +1490,7 @@ proc isCompileTimeOnly*(t: PType): bool {.inline.} = proc containsCompileTimeOnly*(t: PType): bool = if isCompileTimeOnly(t): return true - for i in 0 ..< t.sonsLen: + for i in 0 ..< t.len: if t.sons[i] != nil and isCompileTimeOnly(t.sons[i]): return true return false diff --git a/compiler/vm.nim b/compiler/vm.nim index 130027edd..a7980ae1d 100644 --- a/compiler/vm.nim +++ b/compiler/vm.nim @@ -200,8 +200,8 @@ proc copyValue(src: PNode): PNode = of nkIdent: result.ident = src.ident of nkStrLit..nkTripleStrLit: result.strVal = src.strVal else: - newSeq(result.sons, sonsLen(src)) - for i in 0 ..< sonsLen(src): + newSeq(result.sons, len(src)) + for i in 0 ..< len(src): result.sons[i] = copyValue(src.sons[i]) proc asgnComplex(x: var TFullReg, y: TFullReg) = @@ -782,7 +782,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = addSon(b, regs[rb].regToNode) var r = diffSets(c.config, regs[ra].node, b) discardSons(regs[ra].node) - for i in 0 ..< sonsLen(r): addSon(regs[ra].node, r.sons[i]) + for i in 0 ..< len(r): addSon(regs[ra].node, r.sons[i]) of opcCard: decodeB(rkInt) regs[ra].intVal = nimsets.cardSet(c.config, regs[rb].node) @@ -1164,7 +1164,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = # we know the next instruction is a 'fjmp': let branch = c.constants[instr.regBx-wordExcess] var cond = false - for j in 0 .. sonsLen(branch) - 2: + for j in 0 .. len(branch) - 2: if overlap(regs[ra].regToNode, branch.sons[j]): cond = true break @@ -1589,7 +1589,7 @@ proc rawExecute(c: PCtx, start: int, tos: PStackFrame): TFullReg = error = formatMsg(conf, info, msg, arg)) if error.len > 0: c.errorFlag = error - elif sonsLen(ast) != 1: + elif len(ast) != 1: c.errorFlag = formatMsg(c.config, c.debug[pc], errGenerated, "expected expression, but got multiple statements") else: diff --git a/compiler/vmgen.nim b/compiler/vmgen.nim index 8863b2dc9..648ab926c 100644 --- a/compiler/vmgen.nim +++ b/compiler/vmgen.nim @@ -377,7 +377,7 @@ proc genIf(c: PCtx, n: PNode; dest: var TDest) = elsePos = c.xjmp(it.sons[0], opcFJmp, tmp) # if false c.clearDest(n, dest) c.gen(it.sons[1], dest) # then part - if i < sonsLen(n)-1: + if i < len(n)-1: endings.add(c.xjmp(it.sons[1], opcJmp, 0)) c.patch(elsePos) else: @@ -433,8 +433,8 @@ proc sameConstant*(a, b: PNode): bool = of nkType, nkNilLit: result = a.typ == b.typ of nkEmpty: result = true else: - if sonsLen(a) == sonsLen(b): - for i in 0 ..< sonsLen(a): + if len(a) == len(b): + for i in 0 ..< len(a): if not sameConstant(a.sons[i], b.sons[i]): return result = true @@ -479,7 +479,7 @@ proc genCase(c: PCtx; n: PNode; dest: var TDest) = c.gABx(it, opcBranch, tmp, b) let elsePos = c.xjmp(it.lastSon, opcFJmp, tmp) c.gen(it.lastSon, dest) - if i < sonsLen(n)-1: + if i < len(n)-1: endings.add(c.xjmp(it.lastSon, opcJmp, 0)) c.patch(elsePos) c.clearDest(n, dest) @@ -517,7 +517,7 @@ proc genTry(c: PCtx; n: PNode; dest: var TDest) = c.gABx(it, opcExcept, 0, 0) c.gen(it.lastSon, dest) c.clearDest(n, dest) - if i < sonsLen(n): + if i < len(n): endings.add(c.xjmp(it, opcJmp, 0)) c.patch(endExcept) let fin = lastSon(n) @@ -564,7 +564,7 @@ proc genCall(c: PCtx; n: PNode; dest: var TDest) = # varargs need 'opcSetType' for the FFI support: let fntyp = skipTypes(n.sons[0].typ, abstractInst) for i in 0..<n.len: - #if i > 0 and i < sonsLen(fntyp): + #if i > 0 and i < len(fntyp): # let paramType = fntyp.n.sons[i] # if paramType.typ.isCompileTimeOnly: continue var r: TRegister = x+i @@ -1716,10 +1716,10 @@ proc getNullValueAux(t: PType; obj: PNode, result: PNode; conf: ConfigRef; currP getNullValueAux(b, b.n, result, conf, currPosition) case obj.kind of nkRecList: - for i in 0 ..< sonsLen(obj): getNullValueAux(nil, obj.sons[i], result, conf, currPosition) + for i in 0 ..< len(obj): getNullValueAux(nil, obj.sons[i], result, conf, currPosition) of nkRecCase: getNullValueAux(nil, obj.sons[0], result, conf, currPosition) - for i in 1 ..< sonsLen(obj): + for i in 1 ..< len(obj): getNullValueAux(nil, lastSon(obj.sons[i]), result, conf, currPosition) of nkSym: let field = newNodeI(nkExprColonExpr, result.info) @@ -1764,7 +1764,7 @@ proc getNullValue(typ: PType, info: TLineInfo; conf: ConfigRef): PNode = addSon(result, getNullValue(elemType(t), info, conf)) of tyTuple: result = newNodeIT(nkTupleConstr, info, t) - for i in 0 ..< sonsLen(t): + for i in 0 ..< len(t): addSon(result, getNullValue(t.sons[i], info, conf)) of tySet: result = newNodeIT(nkCurly, info, t) diff --git a/compiler/vmmarshal.nim b/compiler/vmmarshal.nim index 2a81cb14d..8443890e5 100644 --- a/compiler/vmmarshal.nim +++ b/compiler/vmmarshal.nim @@ -18,13 +18,13 @@ proc ptrToInt(x: PNode): int {.inline.} = proc getField(n: PNode; position: int): PSym = case n.kind of nkRecList: - for i in 0 ..< sonsLen(n): + for i in 0 ..< len(n): 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 1 ..< sonsLen(n): + for i in 1 ..< len(n): case n.sons[i].kind of nkOfBranch, nkElse: result = getField(lastSon(n.sons[i]), position) @@ -39,7 +39,7 @@ proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet; conf: Confi proc storeObj(s: var string; typ: PType; x: PNode; stored: var IntSet; conf: ConfigRef) = assert x.kind == nkObjConstr let start = 1 - for i in start ..< sonsLen(x): + for i in start ..< len(x): if i > start: s.add(", ") var it = x.sons[i] if it.kind == nkExprColonExpr: diff --git a/compiler/writetracking.nim b/compiler/writetracking.nim index b310701ca..635224723 100644 --- a/compiler/writetracking.nim +++ b/compiler/writetracking.nim @@ -77,11 +77,11 @@ proc allRoots(n: PNode; result: var seq[ptr TSym]; info: var set[RootInfo]) = if typ != nil: typ = skipTypes(typ, abstractInst) if typ.kind != tyProc: typ = nil - else: assert(sonsLen(typ) == sonsLen(typ.n)) + else: assert(len(typ) == len(typ.n)) for i in 1 ..< n.len: let it = n.sons[i] - if typ != nil and i < sonsLen(typ): + if typ != nil and i < len(typ): assert(typ.n.sons[i].kind == nkSym) let paramType = typ.n.sons[i] if paramType.typ.isCompileTimeOnly: continue @@ -157,10 +157,10 @@ proc depsArgs(w: var W; n: PNode) = var typ = skipTypes(n.sons[0].typ, abstractInst) if typ.kind != tyProc: return # echo n.info, " ", n, " ", w.owner.name.s, " ", typeToString(typ) - assert(sonsLen(typ) == sonsLen(typ.n)) + assert(len(typ) == len(typ.n)) for i in 1 ..< n.len: let it = n.sons[i] - if i < sonsLen(typ): + if i < len(typ): assert(typ.n.sons[i].kind == nkSym) let paramType = typ.n.sons[i] if paramType.typ.isCompileTimeOnly: continue |