From aa7ad8897895acaee9e2999652050d5bc52921a7 Mon Sep 17 00:00:00 2001 From: Araq Date: Sun, 13 Jan 2019 15:52:50 +0100 Subject: fixes #10075 [backport] --- compiler/sigmatch.nim | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'compiler/sigmatch.nim') diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 0915f303b..9aae254f3 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -2267,8 +2267,7 @@ proc matchesAux(c: PContext, n, nOrig: PNode, if n.sons[a].kind == nkHiddenStdConv: doAssert n.sons[a].sons[0].kind == nkEmpty and - n.sons[a].sons[1].kind == nkArgList and - n.sons[a].sons[1].len == 0 + n.sons[a].sons[1].kind in {nkBracket, nkArgList} # Steal the container and pass it along setSon(m.call, formal.position + 1, n.sons[a].sons[1]) else: -- cgit 1.4.1-2-gfad0 From ee89ba6bdb664fe4972f2917499cff1afdac0bab Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Mon, 21 Jan 2019 19:12:17 +0100 Subject: Fix subtype conversion w/ varargs arguments (#10402) The type matching is done on the `T` of the `varargs[T]` so the conversion must be performed to `T` and not to the whole type. This problem is only noticeable with the cpp backend since C doesn't give a damn shit about your fucking (wrong) types. Fixes #9845 --- compiler/sigmatch.nim | 5 +++-- tests/typerel/t4799.nim | 1 + tests/typerel/t4799_1.nim | 1 + tests/typerel/t4799_2.nim | 1 + tests/typerel/t4799_3.nim | 1 + 5 files changed, 7 insertions(+), 2 deletions(-) (limited to 'compiler/sigmatch.nim') diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index 9aae254f3..e08559db6 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -2071,6 +2071,7 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, # constructor in a call: if result == nil and f.kind == tyVarargs: if f.n != nil: + # Forward to the varargs converter result = localConvMatch(c, m, f, a, arg) else: r = typeRel(m, base(f), a) @@ -2083,10 +2084,10 @@ proc paramTypesMatchAux(m: var TCandidate, f, a: PType, # bug #4799, varargs accepting subtype relation object elif r == isSubtype: inc(m.subtypeMatches) - if f.kind == tyTypeDesc: + if base(f).kind == tyTypeDesc: result = arg else: - result = implicitConv(nkHiddenSubConv, f, arg, m, c) + result = implicitConv(nkHiddenSubConv, base(f), arg, m, c) m.baseTypeMatch = true else: result = userConvMatch(c, m, base(f), a, arg) diff --git a/tests/typerel/t4799.nim b/tests/typerel/t4799.nim index 075893476..814ad361d 100644 --- a/tests/typerel/t4799.nim +++ b/tests/typerel/t4799.nim @@ -1,4 +1,5 @@ discard """ + targets: "c cpp" output: "OK" """ diff --git a/tests/typerel/t4799_1.nim b/tests/typerel/t4799_1.nim index 549b6bf3c..e66aa1a9a 100644 --- a/tests/typerel/t4799_1.nim +++ b/tests/typerel/t4799_1.nim @@ -1,4 +1,5 @@ discard """ + targets: "c cpp" outputsub: '''ObjectAssignmentError''' exitcode: "1" """ diff --git a/tests/typerel/t4799_2.nim b/tests/typerel/t4799_2.nim index cfd399a6e..ff20c2426 100644 --- a/tests/typerel/t4799_2.nim +++ b/tests/typerel/t4799_2.nim @@ -1,4 +1,5 @@ discard """ + targets: "c cpp" outputsub: '''ObjectAssignmentError''' exitcode: "1" """ diff --git a/tests/typerel/t4799_3.nim b/tests/typerel/t4799_3.nim index 784eee8fc..4a8a158dd 100644 --- a/tests/typerel/t4799_3.nim +++ b/tests/typerel/t4799_3.nim @@ -1,4 +1,5 @@ discard """ + targets: "c cpp" outputsub: '''ObjectAssignmentError''' exitcode: "1" """ -- cgit 1.4.1-2-gfad0 From 68254308312ce352612b11af164d82d930a1bf68 Mon Sep 17 00:00:00 2001 From: LemonBoy Date: Tue, 22 Jan 2019 11:17:20 +0100 Subject: Restrict ptr/ref to ptr/ref implicit conversion (#10411) * Restrict ptr/ref to ptr/ref implicit conversion Fixes #10409 * Make the ptr conversions explicit in db_odbc --- compiler/sigmatch.nim | 2 +- lib/impure/db_odbc.nim | 14 +++++++++----- tests/typerel/tptrs.nim | 8 ++++++++ 3 files changed, 18 insertions(+), 6 deletions(-) create mode 100644 tests/typerel/tptrs.nim (limited to 'compiler/sigmatch.nim') diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index e08559db6..fa4ab3703 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -1316,7 +1316,7 @@ proc typeRelImpl(c: var TCandidate, f, aOrig: PType, if typeRel(c, f.sons[i], a.sons[i]) == isNone: return isNone result = typeRel(c, f.lastSon, a.lastSon, flags + {trNoCovariance}) subtypeCheck() - if result <= isConvertible: result = isNone + if result <= isIntConv: result = isNone elif tfNotNil in f.flags and tfNotNil notin a.flags: result = isNilConversion elif a.kind == tyNil: result = f.allowsNil diff --git a/lib/impure/db_odbc.nim b/lib/impure/db_odbc.nim index b7af5128a..a533a28ff 100644 --- a/lib/impure/db_odbc.nim +++ b/lib/impure/db_odbc.nim @@ -128,7 +128,7 @@ proc getErrInfo(db: var DbConn): tuple[res: int, ss, ne, msg: string] {. cast[PSQLCHAR](sqlState.addr), cast[PSQLCHAR](nativeErr.addr), cast[PSQLCHAR](errMsg.addr), - 511.TSqlSmallInt, retSz.addr.PSQLSMALLINT) + 511.TSqlSmallInt, retSz.addr.PSQLINTEGER) except: discard return (res.int, $(addr sqlState), $(addr nativeErr), $(addr errMsg)) @@ -297,7 +297,8 @@ iterator fastRows*(db: var DbConn, query: SqlQuery, for colId in 1..cCnt: buf[0] = '\0' db.sqlCheck(SQLGetData(db.stmt, colId.SqlUSmallInt, SQL_C_CHAR, - cast[cstring](buf.addr), 4095.TSqlSmallInt, sz.addr)) + cast[cstring](buf.addr), 4095.TSqlSmallInt, + sz.addr.PSQLINTEGER)) rowRes[colId-1] = $(addr buf) cCnt = tempcCnt yield rowRes @@ -332,7 +333,8 @@ iterator instantRows*(db: var DbConn, query: SqlQuery, for colId in 1..cCnt: buf[0] = '\0' db.sqlCheck(SQLGetData(db.stmt, colId.SqlUSmallInt, SQL_C_CHAR, - cast[cstring](buf.addr), 4095.TSqlSmallInt, sz.addr)) + cast[cstring](buf.addr), 4095.TSqlSmallInt, + sz.addr.PSQLINTEGER)) rowRes[colId-1] = $(addr buf) cCnt = tempcCnt yield (row: rowRes, len: cCnt.int) @@ -374,7 +376,8 @@ proc getRow*(db: var DbConn, query: SqlQuery, for colId in 1..cCnt: buf[0] = '\0' db.sqlCheck(SQLGetData(db.stmt, colId.SqlUSmallInt, SQL_C_CHAR, - cast[cstring](buf.addr), 4095.TSqlSmallInt, sz.addr)) + cast[cstring](buf.addr), 4095.TSqlSmallInt, + sz.addr.PSQLINTEGER)) rowRes[colId-1] = $(addr buf) cCnt = tempcCnt res = SQLFetch(db.stmt) @@ -409,7 +412,8 @@ proc getAllRows*(db: var DbConn, query: SqlQuery, for colId in 1..cCnt: buf[0] = '\0' db.sqlCheck(SQLGetData(db.stmt, colId.SqlUSmallInt, SQL_C_CHAR, - cast[cstring](buf.addr), 4095.TSqlSmallInt, sz.addr)) + cast[cstring](buf.addr), 4095.TSqlSmallInt, + sz.addr.PSQLINTEGER)) rowRes[colId-1] = $(addr buf) cCnt = tempcCnt rows.add(rowRes) diff --git a/tests/typerel/tptrs.nim b/tests/typerel/tptrs.nim new file mode 100644 index 000000000..3505a7736 --- /dev/null +++ b/tests/typerel/tptrs.nim @@ -0,0 +1,8 @@ +discard """ + errormsg: "type mismatch: got but expected 'ptr int'" + line: 8 +""" + +var + n: int16 + p: ptr int = addr n -- cgit 1.4.1-2-gfad0 From dee8e6e98ae868b8d933a718250c8e471bc125ea Mon Sep 17 00:00:00 2001 From: Andreas Rumpf Date: Tue, 29 Jan 2019 15:12:16 +0100 Subject: gc: destructors is beginning to work (#10483) * kochdocs.nim: code cleanup * docgen: nicer indentation * parser.nim: code cleanup * fixes #10458 * make tests green again * make =destroy mixins * gc:destructors: produced C code is almost working * --gc:destructors simple program compiles (but leaks memory) * gc:destructors make examples compile in C++ mode * destructors: string implementation bugfixes * strs.nim: minor code cleanup * destructors: builtin seqs are beginning to work * remove debugging helpers --- compiler/ast.nim | 1 - compiler/ccgexprs.nim | 6 ++--- compiler/cgen.nim | 6 +++++ compiler/destroyer.nim | 14 +++++++++-- compiler/parser.nim | 48 +++++++++++++++++-------------------- compiler/semasgn.nim | 5 ++++ compiler/semstmts.nim | 3 ++- compiler/semtypes.nim | 17 +++++++------ compiler/semtypinst.nim | 37 ++++++++++++++++++---------- compiler/sigmatch.nim | 5 ++++ lib/core/seqs.nim | 10 +++++--- lib/core/strs.nim | 17 ++++++------- lib/system.nim | 36 ++++++++++++++-------------- lib/system/excpt.nim | 21 +++++++++------- lib/system/gc_regions.nim | 20 ++++++++++++---- lib/system/helpers2.nim | 4 ++-- tests/misc/tinvalidarrayaccess.nim | 2 +- tests/misc/tinvalidarrayaccess2.nim | 2 +- tests/parser/tprecedence.nim | 9 +++++++ 19 files changed, 162 insertions(+), 101 deletions(-) (limited to 'compiler/sigmatch.nim') diff --git a/compiler/ast.nim b/compiler/ast.nim index 24891d6d3..fc470b7a8 100644 --- a/compiler/ast.nim +++ b/compiler/ast.nim @@ -1352,7 +1352,6 @@ proc copySym*(s: PSym): PSym = result = newSym(s.kind, s.name, s.owner, s.info, s.options) #result.ast = nil # BUGFIX; was: s.ast which made problems result.typ = s.typ - result.id = getID() when debugIds: registerId(result) result.flags = s.flags result.magic = s.magic diff --git a/compiler/ccgexprs.nim b/compiler/ccgexprs.nim index ed6255004..5bcbcda1c 100644 --- a/compiler/ccgexprs.nim +++ b/compiler/ccgexprs.nim @@ -460,7 +460,7 @@ proc binaryStmtAddr(p: BProc, e: PNode, d: var TLoc, frmt: string) = if d.k != locNone: internalError(p.config, e.info, "binaryStmtAddr") initLocExpr(p, e.sons[1], a) initLocExpr(p, e.sons[2], b) - lineCg(p, cpsStmts, frmt, addrLoc(p.config, a), rdLoc(b)) + lineCg(p, cpsStmts, frmt, byRefLoc(p, a), rdLoc(b)) proc unaryStmt(p: BProc, e: PNode, d: var TLoc, frmt: string) = var a: TLoc @@ -1028,7 +1028,7 @@ proc gcUsage(conf: ConfigRef; n: PNode) = proc strLoc(p: BProc; d: TLoc): Rope = if p.config.selectedGc == gcDestructors: - result = addrLoc(p.config, d) + result = byRefLoc(p, d) else: result = rdLoc(d) @@ -1110,7 +1110,7 @@ proc genStrAppend(p: BProc, e: PNode, d: var TLoc) = strLoc(p, dest), rdLoc(a))) if p.config.selectedGC == gcDestructors: linefmt(p, cpsStmts, "#prepareAdd($1, $2$3);$n", - addrLoc(p.config, dest), lens, rope(L)) + byRefLoc(p, dest), lens, rope(L)) else: initLoc(call, locCall, e, OnHeap) call.r = ropecg(p.module, "#resizeString($1, $2$3)", [rdLoc(dest), lens, rope(L)]) diff --git a/compiler/cgen.nim b/compiler/cgen.nim index 2d9814621..d020b1bd7 100644 --- a/compiler/cgen.nim +++ b/compiler/cgen.nim @@ -264,6 +264,12 @@ proc addrLoc(conf: ConfigRef; a: TLoc): Rope = if lfIndirect notin a.flags and mapType(conf, a.t) != ctArray: result = "(&" & result & ")" +proc byRefLoc(p: BProc; a: TLoc): Rope = + result = a.r + if lfIndirect notin a.flags and mapType(p.config, a.t) != ctArray and not + p.module.compileToCpp: + result = "(&" & result & ")" + proc rdCharLoc(a: TLoc): Rope = # read a location that may need a char-cast: result = rdLoc(a) diff --git a/compiler/destroyer.nim b/compiler/destroyer.nim index e21d532ea..22ace3634 100644 --- a/compiler/destroyer.nim +++ b/compiler/destroyer.nim @@ -244,7 +244,10 @@ proc patchHead(n: PNode) = proc patchHead(s: PSym) = if sfFromGeneric in s.flags: - patchHead(s.ast[bodyPos]) + # do not patch the builtin type bound operators for seqs: + let dest = s.typ.sons[1].skipTypes(abstractVar) + if dest.kind != tySequence: + patchHead(s.ast[bodyPos]) proc checkForErrorPragma(c: Con; t: PType; ri: PNode; opname: string) = var m = "'" & opname & "' is not available for type <" & typeToString(t) & ">" @@ -267,7 +270,8 @@ template genOp(opr, opname, ri) = globalError(c.graph.config, dest.info, "internal error: '" & opname & "' operator not found for type " & typeToString(t)) elif op.ast[genericParamsPos].kind != nkEmpty: - globalError(c.graph.config, dest.info, "internal error: '" & opname & "' operator is generic") + globalError(c.graph.config, dest.info, "internal error: '" & opname & + "' operator is generic") patchHead op if sfError in op.flags: checkForErrorPragma(c, t, ri, opname) let addrExp = newNodeIT(nkHiddenAddr, dest.info, makePtrType(c, dest.typ)) @@ -275,6 +279,12 @@ template genOp(opr, opname, ri) = result = newTree(nkCall, newSymNode(op), addrExp) proc genSink(c: Con; t: PType; dest, ri: PNode): PNode = + when false: + if t.kind != tyString: + echo "this one ", c.graph.config$dest.info, " for ", typeToString(t, preferDesc) + debug t.sink.typ.sons[2] + echo t.sink.id, " owner ", t.id + quit 1 let t = t.skipTypes({tyGenericInst, tyAlias, tySink}) genOp(if t.sink != nil: t.sink else: t.assignment, "=sink", ri) diff --git a/compiler/parser.nim b/compiler/parser.nim index c9626c527..01a3ce4d0 100644 --- a/compiler/parser.nim +++ b/compiler/parser.nim @@ -724,6 +724,14 @@ const tkTypeClasses = {tkRef, tkPtr, tkVar, tkStatic, tkType, tkEnum, tkTuple, tkObject, tkProc} +proc commandExpr(p: var TParser; r: PNode; mode: TPrimaryMode): PNode = + result = newNodeP(nkCommand, p) + addSon(result, r) + var isFirstParam = true + # progress NOT guaranteed + p.hasProgress = false + addSon result, commandParam(p, isFirstParam, mode) + proc primarySuffix(p: var TParser, r: PNode, baseIndent: int, mode: TPrimaryMode): PNode = #| primarySuffix = '(' (exprColonEqExpr comma?)* ')' doBlocks? @@ -734,8 +742,6 @@ proc primarySuffix(p: var TParser, r: PNode, #| | &( '`'|IDENT|literal|'cast'|'addr'|'type') expr # command syntax result = r - template somePar() = - if p.tok.strongSpaceA > 0: break # progress guaranteed while p.tok.indent < 0 or (p.tok.tokType == tkDot and p.tok.indent >= baseIndent): @@ -749,6 +755,8 @@ proc primarySuffix(p: var TParser, r: PNode, result = newNodeP(nkCommand, p) result.addSon r result.addSon primary(p, pmNormal) + else: + result = commandExpr(p, result, mode) break result = namedParams(p, result, nkCall, tkParRi) if result.len > 1 and result.sons[1].kind == nkExprColonExpr: @@ -759,39 +767,27 @@ proc primarySuffix(p: var TParser, r: PNode, result = parseGStrLit(p, result) of tkBracketLe: # progress guaranteed - somePar() + if p.tok.strongSpaceA > 0: + result = commandExpr(p, result, mode) + break result = namedParams(p, result, nkBracketExpr, tkBracketRi) of tkCurlyLe: # progress guaranteed - somePar() + if p.tok.strongSpaceA > 0: + result = commandExpr(p, result, mode) + break result = namedParams(p, result, nkCurlyExpr, tkCurlyRi) of tkSymbol, tkAccent, tkIntLit..tkCharLit, tkNil, tkCast, tkOpr, tkDotDot, tkTypeClasses - {tkRef, tkPtr}: - # XXX: In type sections we allow the free application of the - # command syntax, with the exception of expressions such as - # `foo ref` or `foo ptr`. Unfortunately, these two are also - # used as infix operators for the memory regions feature and - # the current parsing rules don't play well here. + # XXX: In type sections we allow the free application of the + # command syntax, with the exception of expressions such as + # `foo ref` or `foo ptr`. Unfortunately, these two are also + # used as infix operators for the memory regions feature and + # the current parsing rules don't play well here. if p.inPragma == 0 and (isUnary(p) or p.tok.tokType notin {tkOpr, tkDotDot}): # actually parsing {.push hints:off.} as {.push(hints:off).} is a sweet # solution, but pragmas.nim can't handle that - let a = result - result = newNodeP(nkCommand, p) - addSon(result, a) - var isFirstParam = true - when true: - # progress NOT guaranteed - p.hasProgress = false - addSon result, commandParam(p, isFirstParam, mode) - if not p.hasProgress: break - else: - while p.tok.tokType != tkEof: - let x = parseExpr(p) - addSon(result, x) - if p.tok.tokType != tkComma: break - getTok(p) - optInd(p, x) - result = postExprBlocks(p, result) + result = commandExpr(p, result, mode) break else: break diff --git a/compiler/semasgn.nim b/compiler/semasgn.nim index 9f1ef313b..41b0879e6 100644 --- a/compiler/semasgn.nim +++ b/compiler/semasgn.nim @@ -316,6 +316,11 @@ proc liftBody(g: ModuleGraph; typ: PType; kind: TTypeAttachedOp; info: TLineInfo): PSym = if typ.kind == tyDistinct: return liftBodyDistinctType(g, typ, kind, info) + when false: + var typ = typ + if c.config.selectedGC == gcDestructors and typ.kind == tySequence: + # use the canonical type to access the =sink and =destroy etc. + typ = c.graph.sysTypes[tySequence] var a: TLiftCtx a.info = info diff --git a/compiler/semstmts.nim b/compiler/semstmts.nim index 5e9d5d9c5..f1778e816 100644 --- a/compiler/semstmts.nim +++ b/compiler/semstmts.nim @@ -168,7 +168,7 @@ proc semIf(c: PContext, n: PNode; flags: TExprFlags): PNode = else: illFormedAst(it, c.config) if isEmptyType(typ) or typ.kind in {tyNil, tyExpr} or (not hasElse and efInTypeof notin flags): - for it in n: + for it in n: it.sons[^1] = discardCheck(c, it.sons[^1], flags) result.kind = nkIfStmt # propagate any enforced VoidContext: @@ -1563,6 +1563,7 @@ proc semOverride(c: PContext, s: PSym, n: PNode) = if obj.kind in {tyObject, tyDistinct, tySequence, tyString} and sameType(obj, objB): # attach these ops to the canonical tySequence obj = canonType(c, obj) + #echo "ATTACHING TO ", obj.id, " ", s.name.s, " ", cast[int](obj) let opr = if s.name.s == "=": addr(obj.assignment) else: addr(obj.sink) if opr[].isNil: opr[] = s diff --git a/compiler/semtypes.nim b/compiler/semtypes.nim index fbf363834..744746323 100644 --- a/compiler/semtypes.nim +++ b/compiler/semtypes.nim @@ -1159,7 +1159,7 @@ proc semProcTypeNode(c: PContext, n, genericParams: PNode, # compiler only checks for 'nil': if skipTypes(r, {tyGenericInst, tyAlias, tySink}).kind != tyVoid: if kind notin {skMacro, skTemplate} and r.kind in {tyStmt, tyExpr}: - localError(c.config, n.sons[0].info, "return type '" & typeToString(r) & + localError(c.config, n.sons[0].info, "return type '" & typeToString(r) & "' is only valid for macros and templates") # 'auto' as a return type does not imply a generic: elif r.kind == tyAnything: @@ -1577,11 +1577,16 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = assert s != nil assert prev == nil result = copyType(s, s.owner, keepId=false) - # XXX figure out why this has children already... + # Remove the 'T' parameter from tySequence: result.sons.setLen 0 result.n = nil result.flags = {tfHasAsgn} semContainerArg(c, n, "seq", result) + if result.len > 0: + var base = result[0] + if base.kind in {tyGenericInst, tyAlias, tySink}: base = lastSon(base) + if base.kind != tyGenericParam: + c.typesWithOps.add((result, result)) else: result = semContainer(c, n, tySequence, "seq", prev) if c.config.selectedGc == gcDestructors: @@ -1714,11 +1719,9 @@ proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = result = newOrPrevType(tyError, prev, c) n.typ = result dec c.inTypeContext - if c.inTypeContext == 0: instAllTypeBoundOp(c, n.info) - -when false: - proc semTypeNode(c: PContext, n: PNode, prev: PType): PType = - result = semTypeNodeInner(c, n, prev) + if c.inTypeContext == 0: + #if $n == "var seq[StackTraceEntry]": + # echo "begin ", n instAllTypeBoundOp(c, n.info) proc setMagicType(conf: ConfigRef; m: PSym, kind: TTypeKind, size: int) = diff --git a/compiler/semtypinst.nim b/compiler/semtypinst.nim index 027ffd4aa..ebe822cdf 100644 --- a/compiler/semtypinst.nim +++ b/compiler/semtypinst.nim @@ -297,12 +297,6 @@ proc instCopyType*(cl: var TReplTypeVars, t: PType): PType = #result.destructor = nil result.sink = nil -template typeBound(c, newty, oldty, field, info) = - let opr = newty.field - if opr != nil and sfFromGeneric notin opr.flags: - # '=' needs to be instantiated for generics when the type is constructed: - newty.field = c.instTypeBoundOp(c, opr, oldty, info, attachedAsgn, 1) - proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = # tyGenericInvocation[A, tyGenericInvocation[A, B]] # is difficult to handle: @@ -317,7 +311,10 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = else: result = searchInstTypes(t) - if result != nil and eqFlags*result.flags == eqFlags*t.flags: return + if result != nil and eqFlags*result.flags == eqFlags*t.flags: + when defined(reportCacheHits): + echo "Generic instantiation cached ", typeToString(result), " for ", typeToString(t) + return for i in countup(1, sonsLen(t) - 1): var x = t.sons[i] if x.kind in {tyGenericParam}: @@ -332,7 +329,11 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = if header != t: # search again after first pass: result = searchInstTypes(header) - if result != nil and eqFlags*result.flags == eqFlags*t.flags: return + if result != nil and eqFlags*result.flags == eqFlags*t.flags: + when defined(reportCacheHits): + echo "Generic instantiation cached ", typeToString(result), " for ", + typeToString(t), " header ", typeToString(header) + return else: header = instCopyType(cl, t) @@ -384,7 +385,7 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = rawAddSon(result, newbody) checkPartialConstructedType(cl.c.config, cl.info, newbody) let dc = newbody.deepCopy - if cl.allowMetaTypes == false: + if not cl.allowMetaTypes: if dc != nil and sfFromGeneric notin newbody.deepCopy.flags: # 'deepCopy' needs to be instantiated for # generics *when the type is constructed*: @@ -402,6 +403,11 @@ proc handleGenericInvocation(cl: var TReplTypeVars, t: PType): PType = discard else: newbody.lastSon.typeInst = result + # DESTROY: adding object|opt for opt[topttree.Tree] + # sigmatch: Formal opt[=destroy.T] real opt[topttree.Tree] + # adding myseq for myseq[system.int] + # sigmatch: Formal myseq[=destroy.T] real myseq[system.int] + #echo "DESTROY: adding ", typeToString(newbody), " for ", typeToString(result, preferDesc) cl.c.typesWithOps.add((newbody, result)) let mm = skipTypes(bbody, abstractPtrs) if tfFromGeneric notin mm.flags: @@ -432,7 +438,7 @@ proc eraseVoidParams*(t: PType) = inc pos setLen t.sons, pos setLen t.n.sons, pos - return + break proc skipIntLiteralParams*(t: PType) = for i in 0 ..< t.sonsLen: @@ -561,9 +567,7 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = for i in countup(0, sonsLen(result) - 1): if result.sons[i] != nil: if result.sons[i].kind == tyGenericBody: - localError( - cl.c.config, - t.sym.info, + localError(cl.c.config, t.sym.info, "cannot instantiate '" & typeToString(result.sons[i], preferDesc) & "' inside of type definition: '" & @@ -603,6 +607,13 @@ proc replaceTypeVarsTAux(cl: var TReplTypeVars, t: PType): PType = result.size = -1 result.n = replaceObjBranches(cl, result.n) +template typeBound(c, newty, oldty, field, info) = + let opr = newty.field + if opr != nil and sfFromGeneric notin opr.flags: + # '=' needs to be instantiated for generics when the type is constructed: + #echo "DESTROY: instantiating ", astToStr(field), " for ", typeToString(oldty) + newty.field = c.instTypeBoundOp(c, opr, oldty, info, attachedAsgn, 1) + proc instAllTypeBoundOp*(c: PContext, info: TLineInfo) = var i = 0 while i < c.typesWithOps.len: diff --git a/compiler/sigmatch.nim b/compiler/sigmatch.nim index fa4ab3703..3eaac06e5 100644 --- a/compiler/sigmatch.nim +++ b/compiler/sigmatch.nim @@ -2505,6 +2505,11 @@ proc instTypeBoundOp*(c: PContext; dc: PSym; t: PType; info: TLineInfo; if f.kind in {tyRef, tyPtr}: f = f.lastSon else: if f.kind == tyVar: f = f.lastSon + #if c.config.selectedGC == gcDestructors and f.kind == tySequence: + # use the canonical type to access the =sink and =destroy etc. + # f = c.graph.sysTypes[tySequence] + #echo "YUP_---------Formal ", typeToString(f, preferDesc), " real ", typeToString(t, preferDesc), " ", f.id, " ", t.id + if typeRel(m, f, t) == isNone: localError(c.config, info, "cannot instantiate: '" & dc.name.s & "'") else: diff --git a/lib/core/seqs.nim b/lib/core/seqs.nim index 977b23b26..1a81b89ea 100644 --- a/lib/core/seqs.nim +++ b/lib/core/seqs.nim @@ -15,7 +15,7 @@ proc supportsCopyMem(t: typedesc): bool {.magic: "TypeTrait".} ## Default seq implementation used by Nim's core. type - NimSeqPayload {.core.}[T] = object + NimSeqPayload[T] = object cap: int region: Allocator data: UncheckedArray[T] @@ -40,6 +40,7 @@ proc `=destroy`[T](s: var seq[T]) = var x = cast[ptr NimSeqV2[T]](addr s) var p = x.p if p != nil: + mixin `=destroy` when not supportsCopyMem(T): for i in 0.. 0: # also copy the \0 terminator: copyMem(unsafeAddr dest.p.data[dest.len], unsafeAddr src.p.data[0], src.len+1) + inc dest.len, src.len proc appendChar(dest: var NimStringV2; c: char) {.compilerproc, inline.} = dest.p.data[dest.len] = c @@ -166,7 +164,6 @@ proc mnewString(len: int): NimStringV2 {.compilerProc.} = proc setLengthStrV2(s: var NimStringV2, newLen: int) {.compilerRtl.} = if newLen > s.len: prepareAdd(s, newLen - s.len) - else: - s.len = newLen - # this also only works because the destructor - # looks at s.p and not s.len + s.len = newLen + # this also only works because the destructor + # looks at s.p and not s.len diff --git a/lib/system.nim b/lib/system.nim index 4951961ca..a7cf251f6 100644 --- a/lib/system.nim +++ b/lib/system.nim @@ -3049,6 +3049,19 @@ else: if x < 0: -x else: x {.pop.} +when defined(nimNewRoof): + iterator `..<`*[T](a, b: T): T = + var i = T(a) + while i < b: + yield i + inc i +else: + iterator `..<`*[S, T](a: S, b: T): T = + var i = T(a) + while i < b: + yield i + inc i + when not defined(JS): proc likelyProc(val: bool): bool {.importc: "likely", nodecl, nosideeffect.} proc unlikelyProc(val: bool): bool {.importc: "unlikely", nodecl, nosideeffect.} @@ -3144,7 +3157,7 @@ when not defined(JS): #and not defined(nimscript): # ----------------- IO Part ------------------------------------------------ type CFile {.importc: "FILE", header: "", - final, incompletestruct.} = object + incompletestruct.} = object File* = ptr CFile ## The type representing a file handle. FileMode* = enum ## The file mode when opening a file. @@ -3392,6 +3405,10 @@ when not defined(JS): #and not defined(nimscript): ## returns the OS file handle of the file ``f``. This is only useful for ## platform specific programming. + when defined(gcDestructors) and not defined(nimscript): + include "core/strs" + include "core/seqs" + when declared(newSeq): proc cstringArrayToSeq*(a: cstringArray, len: Natural): seq[string] = ## converts a ``cstringArray`` to a ``seq[string]``. `a` is supposed to be @@ -3483,10 +3500,6 @@ when not defined(JS): #and not defined(nimscript): when defined(memtracker): include "system/memtracker" - when defined(gcDestructors): - include "core/strs" - include "core/seqs" - when hostOS == "standalone": include "system/embedded" else: @@ -3716,19 +3729,6 @@ template `..<`*(a, b: untyped): untyped = ## a shortcut for 'a .. (when b is BackwardsIndex: succ(b) else: pred(b))'. a .. (when b is BackwardsIndex: succ(b) else: pred(b)) -when defined(nimNewRoof): - iterator `..<`*[T](a, b: T): T = - var i = T(a) - while i < b: - yield i - inc i -else: - iterator `..<`*[S, T](a: S, b: T): T = - var i = T(a) - while i < b: - yield i - inc i - template spliceImpl(s, a, L, b: untyped): untyped = # make room for additional elements or cut: var shift = b.len - max(0,L) # ignore negative slice size diff --git a/lib/system/excpt.nim b/lib/system/excpt.nim index cc0c1f54b..f2f82c3b8 100644 --- a/lib/system/excpt.nim +++ b/lib/system/excpt.nim @@ -220,11 +220,12 @@ proc auxWriteStackTrace(f: PFrame; s: var seq[StackTraceEntry]) = inc(i) it = it.prev var last = i-1 - if s.len == 0: - s = newSeq[StackTraceEntry](i) - else: - last = s.len + i - 1 - s.setLen(last+1) + when true: # not defined(gcDestructors): + if s.len == 0: + s = newSeq[StackTraceEntry](i) + else: + last = s.len + i - 1 + s.setLen(last+1) it = f while it != nil: s[last] = StackTraceEntry(procname: it.procname, @@ -440,11 +441,13 @@ proc getStackTrace(e: ref Exception): string = else: result = "" -when not defined(gcDestructors): - proc getStackTraceEntries*(e: ref Exception): seq[StackTraceEntry] = - ## Returns the attached stack trace to the exception ``e`` as - ## a ``seq``. This is not yet available for the JS backend. +proc getStackTraceEntries*(e: ref Exception): seq[StackTraceEntry] = + ## Returns the attached stack trace to the exception ``e`` as + ## a ``seq``. This is not yet available for the JS backend. + when not defined(gcDestructors): shallowCopy(result, e.trace) + else: + result = move(e.trace) const nimCallDepthLimit {.intdefine.} = 2000 diff --git a/lib/system/gc_regions.nim b/lib/system/gc_regions.nim index 59f68918f..797eeeebf 100644 --- a/lib/system/gc_regions.nim +++ b/lib/system/gc_regions.nim @@ -195,6 +195,19 @@ proc runFinalizers(c: Chunk) = (cast[Finalizer](it.typ.finalizer))(it+!sizeof(ObjHeader)) it = it.nextFinal +proc runFinalizers(c: Chunk; newbump: pointer) = + var it = c.head + var prev: ptr ObjHeader = nil + while it != nil: + let nxt = it.nextFinal + if it >= newbump: + if it.typ != nil and it.typ.finalizer != nil: + (cast[Finalizer](it.typ.finalizer))(it+!sizeof(ObjHeader)) + elif prev != nil: + prev.nextFinal = nil + prev = it + it = nxt + proc dealloc(r: var MemRegion; p: pointer; size: int) = let it = cast[ptr ObjHeader](p-!sizeof(ObjHeader)) if it.typ != nil and it.typ.finalizer != nil: @@ -237,16 +250,15 @@ template computeRemaining(r): untyped = proc setObstackPtr*(r: var MemRegion; sp: StackPtr) = # free everything after 'sp': - if sp.current.next != nil: + if sp.current != nil and sp.current.next != nil: deallocAll(r, sp.current.next) sp.current.next = nil when false: # better leak this memory than be sorry: for i in 0..high(r.freeLists): r.freeLists[i] = nil r.holes = nil - #else: - # deallocAll(r, r.head) - # r.head = nil + if r.tail != nil: runFinalizers(r.tail, sp.bump) + r.bump = sp.bump r.tail = sp.current r.remaining = sp.remaining diff --git a/lib/system/helpers2.nim b/lib/system/helpers2.nim index c67a2c278..8bd69ad71 100644 --- a/lib/system/helpers2.nim +++ b/lib/system/helpers2.nim @@ -1,7 +1,7 @@ # imported by other modules, unlike helpers.nim which is included template formatErrorIndexBound*[T](i, a, b: T): string = - "index out of bounds: (a:" & $a & ") <= (i:" & $i & ") <= (b:" & $b & ") " + "index out of bounds: (a: " & $a & ") <= (i: " & $i & ") <= (b: " & $b & ") " template formatErrorIndexBound*[T](i, n: T): string = - "index out of bounds: (i:" & $i & ") <= (n:" & $n & ") " + "index out of bounds: (i: " & $i & ") <= (n: " & $n & ") " diff --git a/tests/misc/tinvalidarrayaccess.nim b/tests/misc/tinvalidarrayaccess.nim index 57ad38b85..ab44d98e8 100644 --- a/tests/misc/tinvalidarrayaccess.nim +++ b/tests/misc/tinvalidarrayaccess.nim @@ -1,5 +1,5 @@ discard """ - errormsg: "index out of bounds: (a:0) <= (i:2) <= (b:1) " + errormsg: "index out of bounds: (a: 0) <= (i: 2) <= (b: 1) " line: 18 """ diff --git a/tests/misc/tinvalidarrayaccess2.nim b/tests/misc/tinvalidarrayaccess2.nim index 86d349457..a791dc4e7 100644 --- a/tests/misc/tinvalidarrayaccess2.nim +++ b/tests/misc/tinvalidarrayaccess2.nim @@ -1,5 +1,5 @@ discard """ - errormsg: "index out of bounds: (a:0) <= (i:3) <= (b:1) " + errormsg: "index out of bounds: (a: 0) <= (i: 3) <= (b: 1) " line: 9 """ diff --git a/tests/parser/tprecedence.nim b/tests/parser/tprecedence.nim index aff7c6aca..3e1c03dd1 100644 --- a/tests/parser/tprecedence.nim +++ b/tests/parser/tprecedence.nim @@ -40,3 +40,12 @@ proc getX(x: MyObject): lent MyField {.inline.} = let a = MyObject() echo a.getX.b.len + + +# bug #10458 +template t(x: untyped): untyped = "x" + +let + aaa = t 2 + 4 + ccc = t (1, 1) + 6 + ddd = t [0, 1, 2] + 5 -- cgit 1.4.1-2-gfad0 parameter than &quot;<CODE>sent</CODE>.&quot; (The result from <CODE>every</CODE> is always a sentence, because <CODE>sentence</CODE> is used to construct the result.) <P> <P><H2>The Difference between <CODE><B>Map</B></CODE> and <CODE><B>Every</B></CODE></H2> <P>Here's the definition of the <CODE>map</CODE> procedure: <P><PRE>(define (<A NAME="g11"></A>map fn lst) (if (null? lst) '() (cons (fn (car lst)) (map fn (cdr lst))))) </PRE> <P>The structure here is identical to that of <CODE>every</CODE>; the only difference is that we use <CODE>cons</CODE>, <CODE>car</CODE>, and <CODE>cdr</CODE> instead of <CODE>se</CODE>, <CODE>first</CODE>, and <CODE>butfirst</CODE>. <P>One implication of this is that you can't use <CODE>map</CODE> with a word, since it's an error to take the <CODE>car</CODE> of a word. When is it advantageous to use <CODE>map</CODE> instead of <CODE>every</CODE>? Suppose you're using <CODE>map</CODE> with a structured list, like this: <P><PRE>&gt; (map (lambda (flavor) (se flavor '(is great))) '(ginger (ultra chocolate) pumpkin (rum raisin))) ((GINGER IS GREAT) (ULTRA CHOCOLATE IS GREAT) (PUMPKIN IS GREAT) (RUM RAISIN IS GREAT)) </PRE> <P><PRE>&gt; (every (lambda (flavor) (se flavor '(is great))) '(ginger (ultra chocolate) pumpkin (rum raisin))) (GINGER IS GREAT ULTRA CHOCOLATE IS GREAT PUMPKIN IS GREAT RUM RAISIN IS GREAT) </PRE> <P>Why does <CODE>map</CODE> preserve the structure of the sublists while <CODE>every</CODE> doesn't? <CODE>Map</CODE> uses <CODE>cons</CODE> to combine the elements of the result, whereas <CODE>every</CODE> uses <CODE>sentence</CODE>: <P><PRE>&gt; (cons '(pumpkin is great) (cons '(rum raisin is great) '())) ((PUMPKIN IS GREAT) (RUM RAISIN IS GREAT)) &gt; (se '(pumpkin is great) (se '(rum raisin is great) '())) (PUMPKIN IS GREAT RUM RAISIN IS GREAT) </PRE> <P><H2><CODE><B>Filter</B></CODE></H2> <P>Here's the implementation of <A NAME="g12"></A><CODE>filter</CODE>: <P><PRE>(define (<A NAME="g13"></A>filter pred lst) (cond ((null? lst) '()) ((pred (car lst)) (cons (car lst) (filter pred (cdr lst)))) (else (filter pred (cdr lst))))) </PRE> <P>Like <CODE>map</CODE>, this uses <CODE>cons</CODE> as the constructor so that it will work properly on structured lists. We're leaving the definition of <CODE>keep</CODE>, the version for words and sentences, as an exercise. <P>(Aside from the difference between lists and sentences, this is just like the <CODE>keep</CODE> template on page <A HREF="../ssch14/recur-patterns.html#keeptemplate">there</A>.) <P><H2><CODE><B>Accumulate</B></CODE> and <CODE><B>Reduce</B></CODE></H2> <P>Here are the examples of the <A NAME="g14"></A><CODE>accumulate</CODE> pattern that we showed you before: <P><PRE>(define (addup nums) (if (empty? nums) 0 (+ (first nums) (addup (bf nums))))) (define (scrunch-words sent) (if (empty? sent) &quot;" (word (first sent) (scrunch-words (bf sent))))) </PRE> <P>What are the similarities and differences? There are <EM>two</EM> important differences between these procedures: the combiners (<CODE>+</CODE> versus <CODE>word</CODE>) and the values returned in the base cases (zero versus the empty word). According to what we said about generalizing patterns, you might expect that we'd need two extra arguments. You'd invoke <CODE>three-arg-accumulate</CODE> like this: <P><PRE>&gt; (three-arg-accumulate + 0 '(6 7 8)) 21 &gt; (three-arg-accumulate word &quot;&quot; '(come together)) COMETOGETHER </PRE> <P>But we've actually defined <CODE>accumulate</CODE> and <A NAME="g15"></A><CODE>reduce</CODE> so that only two arguments are required, the procedure and the sentence or list. We thought it would be too much trouble to have to provide the identity element all the time. How did we manage to avoid it? <P>The trick is that in our <CODE>reduce</CODE> and <CODE>accumulate</CODE> the base case is a one-element argument, rather than an empty argument. When we're down to one element in the argument, we just return that element: <P><PRE>(define (accumulate combiner stuff) ;; first version (if (empty? (bf stuff)) (first stuff) (combiner (first stuff) (accumulate combiner (bf stuff))))) </PRE> <P>This version is a simplification of the one we actually provide. What happens if <CODE>stuff</CODE> is empty? This version blows up, since it tries to take the <CODE>butfirst</CODE> of <CODE>stuff</CODE> immediately. Our final version has a specific check for empty arguments: <P><PRE>(define (<A NAME="g16"></A>accumulate combiner stuff) (cond ((not (empty? stuff)) (real-accumulate combiner stuff)) ((member combiner (list + * word se append)) (combiner)) (else (error &quot;Can't accumulate empty input with that combiner&quot;)))) (define (<A NAME="g17"></A>real-accumulate combiner stuff) (if (empty? (bf stuff)) (first stuff) (combiner (first stuff) (real-accumulate combiner (bf stuff))))) </PRE> <P>This version works just like the earlier version as long as <CODE>stuff</CODE> isn't empty. (<CODE>Reduce</CODE> is the same, except that it uses <CODE>null?</CODE>, <CODE>car</CODE>, and <CODE>cdr</CODE>.) <P>As we mentioned in Chapter 8, many of Scheme's primitive procedures return their identity element when invoked with no arguments. We can take advantage of this; if <CODE>accumulate</CODE> is invoked with an empty second argument and one of the procedures <CODE>+</CODE>, <CODE>*</CODE>, <CODE>word</CODE>, <CODE>sentence</CODE>, <CODE>append</CODE> or <CODE>list</CODE>, we invoke the combiner with no arguments to produce the return value. <P> <P>On the other hand, if <CODE>accumulate</CODE>'s combiner argument is something like <CODE>(lambda (x y) (word x '- y))</CODE> or <CODE>max</CODE>, then there's nothing <CODE>accumulate</CODE> can return, so we give an error message. (But it's a more descriptive error message than the first version; what message do you get when you call that first version with an empty second argument?) <P>It's somewhat of a kludge that we have to include in our procedure a list of the functions that can be called without arguments. What we'd like to do is invoke the combiner and find out if that causes an error, but Scheme doesn't provide a mechanism for causing errors on purpose and recovering from them. (Some dialects of Lisp do have that capability.) <P><H2>Robustness</H2> <P>Instead of providing a special error message for empty-argument cases that <CODE>accumulate</CODE> can't handle, we could have just let it blow up: <P><PRE>(define (accumulate combiner stuff) ;; non-robust version (if (not (empty? stuff)) (real-accumulate combiner stuff) (combiner))) </PRE> <P>Some questions about programming have clear right and wrong answers&mdash;if your program doesn't work, it's wrong! But the decision about whether to include the extra check for a procedure that's usable with an empty argument is a matter of judgment. <P>Here is the reasoning in favor of this simpler version: In either version, the user who tries to evaluate an expression like <P><PRE>(accumulate max '()) </PRE> <P>is going to get an error message. In the longer version we've spent both our own programming effort and a little of the computer's time on every invocation just to give a <EM>different</EM> error message from the one that Scheme would have given anyway. What's the point? <P>Here is the reasoning in favor of the longer version: In practice, the empty-argument situation isn't going to arise because someone uses a quoted empty sentence; instead the second argument to <CODE>accumulate</CODE> will be some expression whose value happens to be empty under certain conditions. The user will then have to debug the program that caused those conditions. Debugging is hard; we should make it easier for the user, if we can, by giving an error message that points clearly to the problem. <P>A program that behaves politely when given incorrect input is called <EM>robust.</EM> It's not always a matter of better or worse error messages. For example, a program that reads input from a human user might offer the chance to try again if some input value is incorrect. A robust program will also be alert for hardware problems, such as running out of space on a disk, or getting garbled information over a telephone connection to another machine because of noise on the line. <P>It's possible to pay either too little or too much attention to program robustness. If you're a professional programmer, your employer will expect your programs to survive errors that are likely to happen. On the other hand, your programs will be hard to read and debug if the error checking swamps the real work! As a student, unless you are specifically asked to &quot;bulletproof&quot; your program, don't answer exam questions by writing procedures like this one: <P><PRE>(define (even? num) ;; silly example (cond ((not (number? num)) (error &quot;Not a number.&quot;)) ((not (integer? num)) (error &quot;Not an integer.&quot;)) ((&lt; num 0) (error &quot;Argument must be positive.&quot;)) (else (= (remainder num 2) 0)))) </PRE> <P>In the case of <CODE>accumulate</CODE>, we decided to be extra robust because we were writing a procedure for use in a beginning programming course. If we were writing this tool just for our own use, we might have chosen the non-robust version. Deciding how robust a program will be is a matter of taste. <P><H2>Higher-Order Functions for Structured Lists</H2> <P>We've given you a fairly standard set of higher-order functions, but there's no law that says these are the only ones. Any time you notice yourself writing what feels like the same procedure over again, but with different details, consider inventing a higher-order function. <P>For example, here's a procedure we defined in Chapter 17. <P><PRE>(define (<A NAME="g18"></A>deep-pigl structure) (cond ((word? structure) (pigl structure)) ((null? structure) '()) (else (cons (deep-pigl (car structure)) (deep-pigl (cdr structure)))))) </PRE> <P>This procedure converts every word in a <A NAME="g19"></A><A NAME="g20"></A>structured list to Pig Latin. Suppose we have a structure full of numbers and we want to compute all of their squares. We could write a specific procedure <CODE>deep-square</CODE>, but instead, we'll write a higher-order procedure: <P><PRE>(define (<A NAME="g21"></A>deep-map f structure) (cond ((word? structure) (f structure)) ((null? structure) '()) (else (cons (deep-map f (car structure)) (deep-map f (cdr structure)))))) </PRE> <P><H2>The Zero-Trip Do Loop</H2> <P>The first programming language that provided a level of abstraction over the instructions understood directly by computer hardware was Fortran, a language that is still widely used today despite the advances in programming language design since then. Fortran remains popular because of the enormous number of useful programs that have already been written in it; if an improvement is needed, it's easier to modify the Fortran program than to start again in some more modern language. <P>Fortran includes a control mechanism called <CODE>do</CODE>, a sort of higher-order procedure that carries out a computation repeatedly, as <CODE>every</CODE> does. But instead of carrying out the computation once for each element of a given collection of data (like the sentence argument to <CODE>every</CODE>), <CODE>do</CODE> performs a computation once for each integer in a range specified by its endpoints. &quot;For every number between 4 and 16, do such-and-such.&quot; <P>What if you specify endpoints such that the starting value is greater than the ending value? In the first implementation of Fortran, nobody thought very hard about this question, and they happened to implement <CODE>do</CODE> in such a way that if you specified a backward range, the computation was done once, for the given starting value, before Fortran noticed that it was past the ending value. <P>Twenty years later, a bunch of computer scientists argued that this behavior was wrong&mdash;that a <CODE>do</CODE> loop with its starting value greater than its ending value should not carry out its computation at all. This proposal for a &quot;zero-trip <CODE>do</CODE> loop&quot; was strongly opposed by Fortran old-timers, not because of any principle but because of all the thousands of Fortran programs that had been written to rely on the one-trip behavior. <P>The point of this story is that the Fortran users had to debate the issue so heatedly because they are stuck with only the control mechanisms that are built into the language. Fortran doesn't have the idea of function as data, so Fortran programmers can't write their own higher-order procedures. But you, using the techniques of this chapter, can create precisely the control mechanism that you need for whatever problem you happen to be working on. <P><H2>Pitfalls</H2> <P>The most crucial point in inventing a higher-order function is to make sure that the pattern you have in mind really does generalize. For example, if you want to write a higher-order function for structured data, what is the base case? Will you use the tree abstract data type, or will you use <CODE>car</CODE>/<CODE>cdr</CODE> recursion? <P>When you generalize a pattern by adding a new argument (typically a procedure), be sure you add it to the recursive invocation(s) as well as to the formal parameter list! <P><H2>Boring Exercises</H2> <P><B>19.1</B>&nbsp;&nbsp;What happens if you say the following? <P><PRE>(every cdr '((john lennon) (paul mccartney) (george harrison) (ringo starr))) </PRE> <P>How is this different from using <CODE>map</CODE>, and why? How about <CODE>cadr</CODE> instead of <CODE>cdr</CODE>? <P> <H2>Real Exercises</H2> <P><B>19.2</B>&nbsp;&nbsp;Write <CODE>keep</CODE>. Don't forget that <CODE>keep</CODE> has to return a sentence if its second argument is a sentence, and a word if its second argument is a word. <P>(Hint: it might be useful to write a <CODE>combine</CODE> procedure that uses either <CODE>word</CODE> or <CODE>sentence</CODE> depending on the types of its arguments.) <P> <B>19.3</B>&nbsp;&nbsp;Write the three-argument version of <CODE>accumulate</CODE> that we described. <P><PRE>&gt; (three-arg-accumulate + 0 '(4 5 6)) 15 &gt; (three-arg-accumulate + 0 '()) 0 &gt; (three-arg-accumulate cons '() '(a b c d e)) (A B C D E) </PRE> <P> <B>19.4</B>&nbsp;&nbsp;Our <CODE>accumulate</CODE> combines elements from right to left. That is, <P><PRE>(accumulate - '(2 3 4 5)) </PRE> <P>computes 2&minus;(3&minus;(4&minus;5)). Write <CODE>left-accumulate</CODE>, which will compute ((2&minus;3)&minus;4)&minus;5 instead. (The result will be the same for an operation such as <CODE>+</CODE>, for which grouping order doesn't matter, but will be different for <CODE>-</CODE>.) <P> <B>19.5</B>&nbsp;&nbsp;Rewrite the <CODE>true-for-all?</CODE> procedure from Exercise <A HREF="../ssch8/higher.html#trueforall">8.10</A>. Do not use <CODE>every</CODE>, <CODE>keep</CODE>, or <CODE>accumulate</CODE>. <P> <B>19.6</B>&nbsp;&nbsp;Write a procedure <CODE><A NAME="g22"></A>true-for-any-pair?</CODE> that takes a predicate and a sentence as arguments. The predicate must accept two words as its arguments. Your procedure should return <CODE>#t</CODE> if the argument predicate will return true for any two adjacent words in the sentence: <A NAME="exanypair"></A> <P><PRE>&gt; (true-for-any-pair? equal? '(a b c b a)) #F &gt; (true-for-any-pair? equal? '(a b c c d)) #T &gt; (true-for-any-pair? &lt; '(20 16 5 8 6)) ;; 5 is less than 8 #T </PRE> <P> <B>19.7</B>&nbsp;&nbsp;Write a procedure <CODE><A NAME="g23"></A>true-for-all-pairs?</CODE> that takes a predicate and a sentence as arguments. The predicate must accept two words as its arguments. Your procedure should return <CODE>#t</CODE> if the argument predicate will return true for <EM>every</EM> two adjacent words in the sentence: <A NAME="exallpairs"></A> <P><PRE>&gt; (true-for-all-pairs? equal? '(a b c c d)) #F &gt; (true-for-all-pairs? equal? '(a a a a a)) #T &gt; (true-for-all-pairs? &lt; '(20 16 5 8 6)) #F &gt; (true-for-all-pairs? &lt; '(3 7 19 22 43)) #T </PRE> <P> <B>19.8</B>&nbsp;&nbsp;Rewrite <CODE>true-for-all-pairs?</CODE> (Exercise <A HREF="implement-hof.html#exallpairs">19.7</A>) using <CODE>true-for-any-pair?</CODE> (Exercise <A HREF="implement-hof.html#exanypair">19.6</A>) as a helper procedure. Don't use recursion in solving this problem (except for the recursion you've already used to write <CODE>true-for-any-pair?</CODE>). Hint: You'll find the <CODE>not</CODE> procedure helpful. <P> <B>19.9</B>&nbsp;&nbsp;Rewrite either of the sort procedures from Chapter 15 to take two arguments, a list and a predicate. It should sort the elements of that list according to the given predicate: <P><PRE>&gt; (sort '(4 23 7 5 16 3) &lt;) (3 4 5 7 16 23) &gt; (sort '(4 23 7 5 16 3) &gt;) (23 16 7 5 4 3) &gt; (sort '(john paul george ringo) before?) (GEORGE JOHN PAUL RINGO) </PRE> <P> <B>19.10</B>&nbsp;&nbsp;Write <CODE>tree-map</CODE>, analogous to our <CODE>deep-map</CODE>, but for trees, using the <CODE>datum</CODE> and <CODE>children</CODE> selectors. <P> <B>19.11</B>&nbsp;&nbsp;Write <CODE>repeated</CODE>. (This is a hard exercise!) <P> <B>19.12</B>&nbsp;&nbsp;Write <CODE>tree-reduce</CODE>. You may assume that the combiner argument can be invoked with no arguments. <P><PRE>&gt; (tree-reduce + (make-node 3 (list (make-node 4 '()) (make-node 7 '()) (make-node 2 (list (make-node 3 '()) (make-node 8 '())))))) 27 </PRE> <P> <B>19.13</B>&nbsp;&nbsp;Write <CODE>deep-reduce</CODE>, similar to <CODE>tree-reduce</CODE>, but for structured lists: <P><PRE>&gt; (deep-reduce word '(r ((a (m b) (l)) (e (r))))) RAMBLER </PRE> <P> <HR> <P><A HREF="../ss-toc2.html">(back to Table of Contents)</A><P> <A HREF="../ssch18/trees.html"><STRONG>BACK</STRONG></A> chapter thread <A HREF="../ssch20/part6.html"><STRONG>NEXT</STRONG></A> <P> <ADDRESS> <A HREF="../index.html">Brian Harvey</A>, <CODE>bh@cs.berkeley.edu</CODE> </ADDRESS> </BODY> </HTML>
generated by cgit-pink 1.4.1-2-gfad0 (git 2.36.2.497.gbbea4dcf42) at 2025-04-13 18:23:14 +0000