From 6bdcb2f1e009a7749533fa3adf977f7390b7261b Mon Sep 17 00:00:00 2001 From: Smooth Operator Date: Tue, 17 May 2022 23:30:18 -0400 Subject: [PATCH] so-called calling convention feature (#261) * wip * undo #258 pending alternatives This reverts commit e1f829eced7c9839273790436c39953a0ac9a394. * move a thing * fix some embedded urls * progress... or not * add some tests * rm spam * take the easy way out * rm spam * add a couple more tests for conversation * another take * enable the vtable functionality * tweaks to show off callback types * fixup for exporting the shim * clarify the test * naming, add more docs, test * rename result() to recover() * untyped pass to support "natural" in-cps syntax * same same but different * only rewrite calls in proc bodies * more green balls * another hackish workaround * fixup for rebase snafu * disable the untyped pass for now * implement call syntax in the worst possible way * work around newSeq interaction with `()`() --- cps.nim | 59 +++++++++++++++---- cps/environment.nim | 41 +++++++++++--- cps/exprs.nim | 10 ++-- cps/spec.nim | 71 ++++++++++++++++++++++- cps/transform.nim | 109 ++++++++++++++++++++++++++++++++--- examples/threadpool.nim | 3 +- tests/tcc.nim | 123 ++++++++++++++++++++++++++++++++++++++++ 7 files changed, 382 insertions(+), 34 deletions(-) create mode 100644 tests/tcc.nim diff --git a/cps.nim b/cps.nim index 1fb58e6d..1f332dde 100644 --- a/cps.nim +++ b/cps.nim @@ -3,7 +3,7 @@ import cps/[spec, transform, rewrites, hooks, exprs, normalizedast] import std/macros except newStmtList, newTree export Continuation, ContinuationProc, State export cpsCall, cpsMagicCall, cpsVoodooCall, cpsMustJump -export cpsMagic, cpsVoodoo, trampoline, trampolineIt +export cpsMagic, cpsVoodoo, trampoline, trampolineIt, call, recover export writeStackFrames, writeTraceDeque export renderStackFrames, renderTraceDeque @@ -19,7 +19,7 @@ when not(defined(gcArc) or defined(gcOrc)): # we only support panics because we don't want to run finally on defect when not defined(nimPanics): {.warning: "cps supports --panics:on only; " & - " see https://github.com/disruptek/cps/issues/110".} + " see https://github.com/nim-works/cps/issues/110".} proc state*(c: Continuation): State {.inline.} = ## Get the current state of a continuation @@ -46,8 +46,8 @@ template dismissed*(c: Continuation): bool = {.pop.} -macro cps*(T: typed, n: typed): untyped = - ## This is the .cps. macro performing the proc transformation +macro cpsTyped(T: typed, n: typed): untyped = + ## This is the typed CPS transformation pass which follows the untyped pass below. when defined(nimdoc): n else: @@ -63,9 +63,26 @@ macro cps*(T: typed, n: typed): untyped = # Add the flattening phase which will be run first newCall(bindSym"cpsFlattenExpr"): n + of nnkProcTy: + # converting a cps callback + result = cpsCallbackTypeDef(T, n) else: result = getAst(cpsTransform(T, n)) +macro cps*(T: typed, n: untyped): untyped = + ## When applied to a procedure, rewrites the procedure into a continuation form. + ## When applied to a procedure type definition, rewrites the type into a callback + ## form. + result = n + when not defined(nimdoc): + # add the application of the typed transformation pass + n.addPragma: + nnkExprColonExpr.newTree(bindSym"cpsTyped", T) + # let the untyped pass do what it will with this input + # XXX: currently disabled because it's a slipperly slope of regret + #result = performUntypedPass(T, n) + result = n + proc adaptArguments(sym: NormNode; args: seq[NormNode]): seq[NormNode] = ## convert any arguments in the list as necessary to match those of ## the provided callable symbol. @@ -110,13 +127,22 @@ template wrapWhelpIt(call: typed; logic: untyped): untyped = logic macro whelp*(call: typed): untyped = - ## Instantiate the given continuation call but do not begin - ## running it; instead, return the continuation as a value. - wrapWhelpIt call: - it = - sym.ensimilate: - Head.hook: - newCall(base, it) + ## Instantiate the given continuation call but do not begin running it; + ## instead, return the continuation as a value. + ## + ## If you pass `whelp` a continuation procedure _symbol_ instead, the + ## result is a `Callback` which you can use to create many individual + ## continuations or recover the `result` of an extant continuation. + result = + case call.kind + of nnkSym: + createCallback call + else: + wrapWhelpIt call: + it = + sym.ensimilate: + Head.hook: + newCall(base, it) macro whelp*(parent: Continuation; call: typed): untyped = ## As in `whelp(call(...))`, but also links the new continuation to the @@ -274,3 +300,14 @@ proc dealloc*[T: Continuation](c: sink T; E: typedesc[T]): E {.used, inline.} = template recover*(c: Continuation): untyped {.used.} = ## Returns the result, i.e. the return value, of a continuation. discard + +{.push experimental: "callOperator".} + +macro `()`*[C; R; P](callback: Callback[C, R, P]; arguments: varargs[typed]): R = + ## Allows for natural use of call syntax to invoke a callback and + ## recover its result in a single statement, inside a continuation. + let call = bindSym"call" + result = newCall(call, callback) + for argument in arguments.items: + result.add argument + result = newCall(bindSym"recover", callback, result) diff --git a/cps/environment.nim b/cps/environment.nim index 5bf20ee8..a1531e5d 100644 --- a/cps/environment.nim +++ b/cps/environment.nim @@ -329,7 +329,6 @@ proc localSection*(e: var Env; n: VarLet, into: NimNode = nil) = let defs = n.asVarLetTuple() child = e.castToChild(e.first) - rhs = defs.typ tups = nnkTupleConstr.newTree for index, name in defs.indexNamePairs: let name = asSym(name) @@ -432,6 +431,12 @@ proc createRecover*(env: Env, exported = false): ProcDef = nnkDiscardStmt.newTree: newEmptyNode() # the return value is void + # the result fetcher used in the Callback shim + var fetcher = nskProc.genSym"result" + let naked = copyNimNode fetcher # so that we can call it without `*` + if exported: + fetcher = NormNode postfix(fetcher, "*") + # compose the (exported?) symbol let name = NimNode ident"recover" var ename = @@ -441,10 +446,13 @@ proc createRecover*(env: Env, exported = false): ProcDef = name result = ProcDef: - genAstOpt({}, name, ename, field, c = env.first.NimNode, - cont = env.identity.NimNode, tipe = env.rs.typ.NimNode, - dismissed=Dismissed, finished=Finished, running=Running): - proc ename(c: cont): tipe {.used.} = + genAstOpt({}, ename = ename.NimNode, cont = env.identity.NimNode, + field = field.NimNode, c = env.first.NimNode, + fetcher = fetcher.NimNode, contBase = env.inherits.NimNode, + naked = naked.NimNode, tipe = env.rs.typ.NimNode, + dismissed=Dismissed, finished=Finished, running=Running): + + proc fetcher(c: contBase): tipe {.used, nimcall.} = case c.state of dismissed: raise Defect.newException: @@ -452,14 +460,20 @@ proc createRecover*(env: Env, exported = false): ProcDef = of finished: field of running: - name(trampoline c) + naked(trampoline c) + + {.push experimental: "callOperator".} + proc ename(c: cont): tipe {.used, nimcall.} = + naked(contBase c) + {.pop.} -proc createWhelp*(env: Env; n: ProcDef, goto: NormNode): ProcDef = +proc createWhelp*(env: Env; n: ProcDef; goto: NormNode): ProcDef = ## the whelp needs to create a continuation let resultName = "result".asName result = clone(n, newStmtList()) result.addPragma "used" # avoid gratuitous warnings + result.addPragma "nimcall" result.returnParam = env.identity result.name = genSymProc"whelp" result.introduce {Alloc, Boot, Stack} @@ -479,10 +493,23 @@ proc createWhelp*(env: Env; n: ProcDef, goto: NormNode): ProcDef = for defs in result.callingParams: result = desym(result, defs.name) +proc createCallbackShim*(env: Env; whelp: ProcDef): ProcDef = + ## this is a version of whelp that returns the base continuation type + result = clone(whelp, newStmtList()) + result.returnParam = env.inherits + result.name = genSymProc"whelp shim" + # whelp_234(a, b, c) + result.body = newCall whelp.name + for defs in result.callingParams: + result.body.add defs.name + # C: whelp_234(a, b, c) + result.body = newCall(result.returnParam, result.body) + proc createBootstrap*(env: Env; n: ProcDef, goto: NormNode): ProcDef = ## the bootstrap needs to create a continuation and trampoline it result = clone(n, newStmtList()) result.addPragma "used" # avoid gratuitous warnings + result.addPragma "nimcall" result.introduce {Alloc, Boot, Stack} let c = genSymVar("c", info = n) diff --git a/cps/exprs.nim b/cps/exprs.nim index 5f735ba5..ce212504 100644 --- a/cps/exprs.nim +++ b/cps/exprs.nim @@ -702,7 +702,7 @@ func annotate(n: NormNode): NormNode = else: child exprType = getTypeInst(expr) - var result = Operand( + var op = Operand( node: child, typ: exprType, mutable: child.isMutable ) @@ -716,14 +716,14 @@ func annotate(n: NormNode): NormNode = # for `var` parameters, thus making regular analysis incorrect. # # As a workaround, we have to obtain this information directly from the symbol definition. - if magicType.typeKind == ntyVar and not magicType.sameType(result.typ): + if magicType.typeKind == ntyVar and not magicType.sameType(op.typ): # If the parameter is a `var T` but the type differs from the operand. # Modify the operand type to `var operand.typ`. - result.typ = TypeExpr nnkVarTy.newTree(result.typ) + op.typ = TypeExpr nnkVarTy.newTree(op.typ) # Modify the mutable analysis to check whether the operand location is mutable instead. - result.mutable = child.isMutableLocation + op.mutable = child.isMutableLocation - yield result + yield op # Put the annotated operation under the expr lifter result.add: diff --git a/cps/spec.nim b/cps/spec.nim index 108eca90..12569f80 100644 --- a/cps/spec.nim +++ b/cps/spec.nim @@ -25,9 +25,16 @@ template cpsContinue*() {.pragma.} ## ## this is a continue statement in a cps block template cpsCont*() {.pragma.} ## this is a continuation template cpsBootstrap*(whelp: typed) {.pragma.} ## -## the symbol for creating a continuation +## the symbol for creating a continuation -- technically, a whelp() +template cpsCallback*() {.pragma.} ## this is a callback typedef +template cpsCallbackShim*(whelp: typed) {.pragma.} ## +## the symbol for creating a continuation which returns a continuation base template cpsEnvironment*(tipe: typed) {.pragma.} ## ## the environment type that composed the target +template cpsResult*(result: typed) {.pragma.} ## +## the procedure that returns the result of the continuation +template cpsReturnType*(tipe: typed) {.pragma.} ## +## the return type of the continuation template cpsTerminate*() {.pragma.} ## this is the end of this procedure template cpsHasException*(cont, ex: typed) {.pragma.} ## ## the continuation has an exception stored in `ex`, with `cont` being the @@ -54,6 +61,12 @@ type ContinuationProc*[T] = proc(c: T): T {.nimcall.} + Callback*[C; R; P] = object + fn*: P ## + ## the bootstrap for continuation C + rs*: proc (c: C): R {.nimcall.} ## + ## the result fetcher for continuation C + TraceFrame* = object ## a record of where the continuation has been hook*: Hook ## the hook that provoked the trace entry fun*: string ## a short label for the notable symbol @@ -532,3 +545,59 @@ macro etype*(e: enum): string = if sym.intVal == e.intVal: return newLit sym.strVal error "unexpected" + +proc copyOrVoid*(n: NimNode): NimNode = + ## if the node is empty, `ident"void"`; else, a copy of the node + if n.isEmpty: + ident"void" + else: + copyNimTree n + +proc createCallback*(sym: NimNode): NimNode = + ## create a new Callback object construction + let fn = sym.getImpl.ProcDef.pragmaArgument"cpsCallbackShim" + let impl = fn.getImpl.ProcDef # convenience + let rs = impl.pragmaArgument"cpsResult" + let tipe = nnkBracketExpr.newTree bindSym"Callback" + tipe.add impl.returnParam # the base cps environment type + tipe.add: # the return type of the result fetcher + copyOrVoid impl.pragmaArgument"cpsReturnType" + var params = copyNimTree impl.formalParams # prepare params list + # consider desym'ing foo(a: int; b = a) before deleting this loop + for defs in impl.callingParams: + params = desym(params, defs.name) + tipe.add: # the proc() type of the bootstrap + nnkProcTy.newTree(params, nnkPragma.newTree ident"nimcall") + result = + NimNode: + nnkObjConstr.newTree(tipe, "fn".colon fn.NimNode, "rs".colon rs.NimNode) + +proc cpsCallbackTypeDef*(T: NimNode, n: NimNode): NimNode = + ## looks like cpsTransformProc but applies to proc typedefs; + ## this is where we create our calling convention concept + let params = copyNimTree n[0] + let R = copyOrVoid params[0] + params[0] = T + let P = nnkProcTy.newTree(params, + nnkPragma.newTree(ident"nimcall", bindSym"cpsCallback")) + result = nnkBracketExpr.newTree(bindSym"Callback", T, R, P) + result = workaroundRewrites result.NormNode + +proc recover*[C, R, P](callback: Callback[C, R, P]; continuation: C): R = + ## Using a `callback`, recover the `result` of the given `continuation`. + ## This is equivalent to running `()` on a continuation which was + ## created with `whelp` against a procedure call. + ## + ## If the continuation is in the `running` `State`, this operation will + ## `trampoline` the continuation until it is `finished`. The `result` + ## will then be recovered from the continuation environment. + ## + ## It is a `Defect` to attempt to recover the `result` of a `dismissed` + ## `continuation`. + callback.rs(continuation) + +macro call*[C; R; P](callback: Callback[C, R, P]; arguments: varargs[typed]): C = + ## Invoke a `callback` with the given `arguments`; returns a continuation. + result = newCall(callback.dot ident"fn") + for argument in arguments.items: + result.add argument diff --git a/cps/transform.nim b/cps/transform.nim index 6777e6d5..8eb7ad2e 100644 --- a/cps/transform.nim +++ b/cps/transform.nim @@ -1095,8 +1095,12 @@ macro cpsHandleUnhandledException(contType: typed; n: typed): untyped = body except: cont.ex = getCurrentException() - return Continuation: unwind(contType(cont), cont.ex) - + # A continuation body created with makeContProc (which is all of + # them) will have a terminator in the body, thus this part can + # only be reached iff the except branch happened to deter the jump + # + # Workaround for https://github.com/nim-lang/Nim/issues/18411 + return Continuation: unwind(contType(cont), cont.ex) result = fnDef debugAnnotation cpsHandleUnhandledException, n: @@ -1133,6 +1137,7 @@ proc cpsTransformProc(T: NimNode, n: NimNode): NormNode = # the whelp is a limited bootstrap that merely creates # the continuation without invoking it in a trampoline let whelp = env.createWhelp(n, name) + let whelpShim = env.createCallbackShim(whelp) # setup the bootstrap using the old proc name, # but the first leg will be the new proc name @@ -1141,6 +1146,9 @@ proc cpsTransformProc(T: NimNode, n: NimNode): NormNode = # we store a pointer to the whelp on the bootstrap booty.addPragma(bindName"cpsBootstrap", whelp.name) + # we store a pointer to the whelp shim on the bootstrap + booty.addPragma(bindName"cpsCallbackShim", whelpShim.name) + # like magics, the bootstrap must jump booty.addPragma "cpsMustJump" @@ -1185,7 +1193,7 @@ proc cpsTransformProc(T: NimNode, n: NimNode): NormNode = n.body = env.annotate n.body if n.body.firstReturn.isNil: - # fixes https://github.com/disruptek/cps/issues/145 + # fixes https://github.com/nim-works/cps/issues/145 # by ensuring that we always rewrite termination n.body.add newCpsPending() @@ -1201,21 +1209,34 @@ proc cpsTransformProc(T: NimNode, n: NimNode): NormNode = newCall(bindSym"cpsHandleUnhandledException", NimNode env.root): NormNode n - # storing the source environment on helpers - for p in [whelp, booty]: - p.addPragma(bindName"cpsEnvironment", env.identity) - # the `recover` operator recovers the result of a continuation # # copy the exported-ness from the original proc so that it can be used # from other modules let recover = env.createRecover(exported = originalProcSym.isExported) + # pluck out the FIRST procedure from the list; this is the shim + let recoverProc = recover.NimNode.findChild(it.kind == nnkProcDef) + + for p in [whelp, booty]: + # storing the source environment on helpers + p.addPragma(bindName"cpsEnvironment", env.identity) + + for p in [booty]: + # storing the result fetcher on the booty + p.addPragma(bindName"cpsResult", recoverProc.name) + + for p in [whelp, whelpShim]: + # storing the result fetcher on the whelp and whelp shim + p.addPragma(bindName"cpsResult", recoverProc.name) + # storing the return type on the whelp and whelp shim + p.addPragma(bindName"cpsReturnType", copyOrVoid recoverProc.params[0]) # "encouraging" a write of the current accumulating type env = env.storeType(force = off) - # generated proc bodies, remaining proc, whelp, bootstrap - result = newStmtList(types, processMainContinuation, recover, whelp, booty) + # generated proc bodies, remaining proc, result fetchers, whelp, bootstrap + result = newStmtList(types, processMainContinuation, recover.NormNode, + whelp, whelpShim, booty) # this is something that happens a lot in cps-generated code, so hide it # here to not spam the user with hints. @@ -1237,3 +1258,73 @@ macro cpsTransform*(T, n: typed): untyped = debug("cpsTransform", n, Original) result = cpsTransformProc(T, n) debug("cpsTransform", result, Transformed, n) + +proc looksLikeCallback(n: NimNode): bool = + ## true if the symbol appears to be of the Callback persuasion. + case n.kind + of nnkEmpty: + false + of nnkDotExpr: + looksLikeCallback(n.last) + of nnkSym: + looksLikeCallback(getTypeImpl n) + of nnkObjectTy: + looksLikeCallback(n.last) + of nnkRecList: + looksLikeCallback(n[0]) + of nnkIdentDefs: + if n[0].repr == "fn": + looksLikeCallback(n[1]) + else: + false + of nnkProcTy: + for node in n.pragma: + if node.kind == nnkCall: + if node[0].strVal == "cpsCallback": + return true + false + else: + false + +macro naturalize(kind: static[NimNodeKind]; callback: typed; + args: varargs[untyped]): untyped = + ## perform a conditional typed rewrite for natural callback syntax inside cps + if callback.looksLikeCallback: + # convert it to callback.call(...) + result = macros.newTree(kind, newDotExpr(callback, bindSym"call")) + for arg in args.items: + result.add arg + # wrap that in recover(callback, ...) + result = newCall(bindSym"recover", callback, result) + else: + result = kind.newTree(desym callback) + for arg in args.items: + result.add arg + +proc unwrapAnyDotExpr(n: NimNode): seq[NimNode] = + ## turn a caller like foo.inc into @[inc, foo] so that we can flatten/reorder + ## arguments correctly + case n.kind + of nnkDotExpr: + @[n[1], n[0]] + else: + @[n] + +proc rewriteCalls*(n: NimNode): NimNode = + ## rewriting `callback(x)` into `recover(callback, call(callback, x))` for use + ## inside of an untyped pass; this should be applied only to Callback symbols... + proc recall(n: NimNode): NimNode = + case n.kind + of CallNodes: + result = newCall(bindSym"naturalize", newLit(n.kind)) + result.add unwrapAnyDotExpr(n[0]) # help foo.inc(...) into inc(foo, ...) + result.add n[1..^1] + else: + discard + result = filter(n, recall) + +proc performUntypedPass*(T: NimNode; n: NimNode): NimNode = + ## Perform any rewrites needed prior to a `.cps: T.` transformation. + if n.kind != nnkProcDef: return n + result = n + result.body = rewriteCalls result.body diff --git a/examples/threadpool.nim b/examples/threadpool.nim index cf5fd562..a6b128f8 100644 --- a/examples/threadpool.nim +++ b/examples/threadpool.nim @@ -46,7 +46,8 @@ proc doWork(pool: Pool) {.thread.} = proc work(nThreads: int) = - var threads = newSeq[Thread[Pool]](nThreads) + var threads: seq[Thread[Pool]] + newSeq(threads, nThreads) for i in 0..