diff --git a/compiler/ast/ast_query.nim b/compiler/ast/ast_query.nim index 8b613c6c876..43e3f9e7838 100644 --- a/compiler/ast/ast_query.nim +++ b/compiler/ast/ast_query.nim @@ -625,6 +625,14 @@ proc isSinkParam*(s: PSym): bool {.inline.} = proc isSinkType*(t: PType): bool {.inline.} = t.kind == tySink +proc isCoroutineConstr*(prc: PSym): bool {.inline.} = + ## Returns whether `prc` is the symbol of a coroutine *constructor*. + sfCoroutine in prc.flags and tfCoroutine in prc.typ.flags + +proc isCoroutine*(prc: PSym): bool {.inline.} = + ## Returns whether `prc` is the symbol of a coroutine. + sfCoroutine in prc.flags and tfCoroutine notin prc.typ.flags + const magicsThatCanRaise* = { mNone, mParseExprToAst, mParseStmtToAst, mEcho, mChckRange } diff --git a/compiler/ast/ast_types.nim b/compiler/ast/ast_types.nim index e4fc830088c..30512ee3b2d 100644 --- a/compiler/ast/ast_types.nim +++ b/compiler/ast/ast_types.nim @@ -413,6 +413,7 @@ type sfUsedInFinallyOrExcept ## symbol is used inside an 'except' or 'finally' sfNoalias ## 'noalias' annotation, means C's 'restrict' sfEffectsDelayed ## an 'effectsDelayed' parameter + sfCoroutine ## the routine is a coroutine TSymFlags* = set[TSymFlag] @@ -640,6 +641,7 @@ type tfByCopy, ## pass object/tuple by copy (C backend) tfByRef, ## pass object/tuple by reference (C backend) tfIterator, ## type is really an iterator, not a tyProc + tfCoroutine, ## type is that of a coroutine tfNotNil, ## type cannot be 'nil' tfRequiresInit, ## type constains a "not nil" constraint somewhere or ## a `requiresInit` field, so the default zero init @@ -799,6 +801,7 @@ type mIsMainModule, mCompileDate, mCompileTime, mProcCall, mCpuEndian, mHostOS, mHostCPU, mBuildOS, mBuildCPU, mAppType, mCompileOption, mCompileOptionArg, + mSuspend, mNLen, mNChild, mNSetChild, mNAdd, mNAddMultiple, mNDel, mNKind, mNSymKind, diff --git a/compiler/ast/trees.nim b/compiler/ast/trees.nim index 24473ece706..b91f7d77430 100644 --- a/compiler/ast/trees.nim +++ b/compiler/ast/trees.nim @@ -183,6 +183,16 @@ proc effectSpec*(n: PNode, effectType: TSpecialWord): PNode = result.add(it[1]) return +proc coroutineSpec*(n: PNode): PType = + ## Returns the instance type specified by the ``.coroutine`` pragma in + ## pragma list `n`, or nil, if no instance type is specified. + let p = findPragma(n, wCoroutine) + assert p != nil, "has no coroutine specification" + if p.kind == nkExprColonExpr: + p[1].typ + else: + nil + proc unnestStmts(n, result: PNode) = case n.kind of nkStmtList: diff --git a/compiler/ast/types.nim b/compiler/ast/types.nim index 92e7b05be53..d7bbe4346a4 100644 --- a/compiler/ast/types.nim +++ b/compiler/ast/types.nim @@ -1227,6 +1227,11 @@ proc getProcConvMismatch*( result[0].incl pcmNotIterator result[1] = isNone + if (tfCoroutine in f.flags) != (tfCoroutine in a.flags): + # TODO: use the a dedicated enum field + result[0].incl pcmNotIterator + result[1] = isNone + if f.callConv != a.callConv: # valid to pass a 'nimcall' thingie to 'closure': if f.callConv == ccClosure and a.callConv == ccNimCall: @@ -1544,3 +1549,14 @@ proc classifyBackendView*(t: PType): BackendViewKind = tyGenericParam, tyForward, tyBuiltInTypeClass, tyCompositeTypeClass, tyAnd, tyOr, tyNot, tyAnything, tyFromExpr: unreachable() + +proc lookupInType*(typ: PType, field: PIdent): PSym = + ## Searches for a field with the given identifier (`field`) in the object + ## type hierarchy of `typ`. + var typ = typ + while typ != nil: + typ = typ.skipTypes(skipPtrs) + result = lookupInRecord(typ.n, field) + if result != nil: + return + typ = typ.base diff --git a/compiler/ast/typesrenderer.nim b/compiler/ast/typesrenderer.nim index 50d8f4922ab..c56e8aebc71 100644 --- a/compiler/ast/typesrenderer.nim +++ b/compiler/ast/typesrenderer.nim @@ -406,6 +406,9 @@ proc typeToString*(typ: PType, prefer: TPreferedDesc = preferName): string = result.add(')') if t.len > 0 and t[0] != nil: result.add(": " & typeToString(t[0])) var prag = if t.callConv == ccNimCall and tfExplicitCallConv notin t.flags: "" else: $t.callConv + if tfCoroutine in t.flags: + addSep(prag) + prag.add "coroutine" if tfNoSideEffect in t.flags: addSep(prag) prag.add("noSideEffect") diff --git a/compiler/ast/wordrecg.nim b/compiler/ast/wordrecg.nim index 28588529886..c7c581b169c 100644 --- a/compiler/ast/wordrecg.nim +++ b/compiler/ast/wordrecg.nim @@ -101,7 +101,7 @@ type wStdIn = "stdin", wStdOut = "stdout", wStdErr = "stderr", wInOut = "inout", wByCopy = "bycopy", wByRef = "byref", wOneWay = "oneway", - wBitsize = "bitsize", wImportHidden = "all", + wBitsize = "bitsize", wImportHidden = "all", wCoroutine = "coroutine" TSpecialWords* = set[TSpecialWord] diff --git a/compiler/front/condsyms.nim b/compiler/front/condsyms.nim index 9746de20026..1c11bfb83b4 100644 --- a/compiler/front/condsyms.nim +++ b/compiler/front/condsyms.nim @@ -77,3 +77,4 @@ proc initDefines*(symbols: StringTableRef) = defineSymbol("nimskullNewExceptionRt") defineSymbol("nimskullNoNkStmtListTypeAndNkBlockType") defineSymbol("nimskullNoNkNone") + defineSymbol("nimskullHasCoroutines") diff --git a/compiler/sem/coroutines.nim b/compiler/sem/coroutines.nim new file mode 100644 index 00000000000..40235be0b5a --- /dev/null +++ b/compiler/sem/coroutines.nim @@ -0,0 +1,195 @@ +## Implements the coroutine-related transformations. Despite being a separate +## module, the coroutine transformation(s) is heavily intertwined with +## `transf <#transf>`_. + +import + compiler/ast/[ + ast, + idents, + types + ], + compiler/modules/[ + magicsys, + modulegraphs + ], + compiler/sem/[ + closureiters, + lambdalifting, + lowerings + ], + compiler/utils/[ + idioms, + ] + +proc computeFieldStart(t: PType, pos: var int) = + ## Recursively traverses `t` and updates `pos` to the field position + ## of the first field a type inheriting from `t` would have. + proc aux(n: PNode, p: var int) = + case n.kind + of nkRecCase: + inc p # discriminator + for i in 1.. 0 and t.base != nil: + computeFieldStart(t.base, pos) + + aux(t.n, pos) + +proc preTransformConstr*(g: ModuleGraph, idgen: IdGenerator, prc: PSym, body: PNode): PNode = + ## Transforms the `body` of coroutine constructor `prc` into: + ## + ## .. code-block:: nim + ## + ## discard (proc inner() {.closure.} = + ## body + ## ) + ## + ## Since the owner of the locals within `body` is not changed, the lambda- + ## lifting pass will lift them into the environment type. + let cache = g.cache + let base = g.getCompilerProc("CoroutineBase").typ + + # setup the actual coroutine: + let inner = newSym(skProc, prc.name, nextSymId idgen, prc, prc.info, + prc.options) + inner.flags.incl sfCoroutine + inner.ast = newProcNode(nkLambda, prc.info, body, + newTree(nkFormalParams, newNodeIT(nkType, prc.info, base)), + newSymNode(inner), + newNode(nkEmpty), + newNode(nkEmpty), + newNode(nkEmpty), + newNode(nkEmpty)) + inner.typ = newProcType(prc.info, nextTypeId idgen, inner) + inner.typ[0] = base # return type + # temporarily mark the procedure as a closure procedure, so that the lambda- + # lifting pass visits it + inner.typ.callConv = ccClosure + + # temporarily stash the ``self`` symbol node in the inner procedure's + # dispatcher slot + inner.ast.sons.setLen(dispatcherPos + 1) + inner.ast[dispatcherPos] = move prc.ast[dispatcherPos] + + # result symbol for the coroutine: + inner.ast[resultPos] = newSymNode: + newSym(skResult, cache.getIdent("result"), nextSymId idgen, inner, + inner.info, base) + + # place the instance base type in the constructor's dispatcher + # slot, for the lambda-lifting pass to later fetch it + prc.ast[dispatcherPos] = newNodeIT(nkType, prc.info, prc.typ[0]) + + # fix the result variable for the constructor: + prc.ast[resultPos] = newSymNode: + newSym(skResult, cache.getIdent("result"), nextSymId idgen, prc, + prc.info, prc.typ[0]) + + let body = copyNodeWithKids(inner.ast) + body.typ = inner.typ + result = nkDiscardStmt.newTree(body) + +proc transformCoroutineConstr*(g: ModuleGraph, idgen: IdGenerator, prc: PSym, + body: PNode): PNode = + ## Post-processes the transformed coroutine instance constructor procedure, + ## completing the body of the constructor. + ## + ## The `body` is expected to have undergone the transf pass, including + ## lambda-lifting. + let + cache = g.cache + base = g.getCompilerProc("CoroutineBase").typ + # this is a bit brittle. We rely on the exact positions in the AST + inner = body.lastSon[0][0].sym + selfSym = move inner.ast[dispatcherPos] + res = prc.ast[resultPos].sym + + result = body + + # remove the discard statement injected earlier: + result.delSon(result.len - 1) + + let + envLocal = body[0][0][0] # the local injected by lambda-lifting + constr = body[0][0][2] # the env construction expression + + # patch the environment construction: + constr.add nkExprColonExpr.newTree( + newSymNode lookupInType(base, cache.getIdent("fn")), + newSymNode inner + ) + # the state needs to be initialized to -4, to signal that the instance is + # suspended: + constr.add nkExprColonExpr.newTree( + newSymNode lookupInType(base, cache.getIdent("state")), + newIntTypeNode(-4, g.getSysType(prc.info, tyInt32)) + ) + + # add the result assignment: + result.add newAsgnStmt(newSymNode(res), + newTreeIT(nkObjDownConv, prc.info, res.typ, envLocal)) + # init the lifted ``self`` symbol: + if getFieldFromObj(envLocal.typ.base, selfSym.sym) != nil: + result.add newAsgnStmt(indirectAccess(envLocal, selfSym.sym, selfSym.info), + newSymNode res) + +proc transformCoroutine*(g: ModuleGraph, idgen: IdGenerator, prc: PSym, + body: PNode): PNode = + ## Given the ``trans``formed and lambda-lifted `body`, applies the + ## transformation for turning the coroutine `prc` into a resumable procedure + ## (uses `closureiters <#closureiters>`_ underneath). + ## + ## Also takes care of fixing the signature of `prc`. + let + base = g.getCompilerProc("CoroutineBase").typ + body = transformClosureIterator(g, idgen, prc, body) + param = prc.getEnvParam() + + # replace the hidden parameter with one that has the correct type: + let newParam = copySym(param, nextSymId idgen) + newParam.typ = base + + # the original parameter is turned into a cursor local and is injected + # into the body. Reusing the symbol means that body doesn't need + # to be patched + param.kind = skLet + param.flags.incl sfCursor + + # fix the signature. It needs to be ``CoroutineBase -> CoroutineBase`` + prc.typ.callConv = ccNimCall + prc.typ.rawAddSon(base) # first parameter type + prc.typ.n.add newSymNode(newParam) + # replace the hidden parameter (it's no longer hidden): + prc.ast[paramsPos][^1] = newSymNode(newParam) + + # inject a definition for the local and emit ``result`` initialization + result = nkStmtList.newTree( + nkLetSection.newTree( + newIdentDefs(newSymNode(param), + newTreeIT(nkObjDownConv, body.info, param.typ, + newSymNode(newParam)))), + # XXX: always assigning the continuation to the result is inefficient; it + # should happen on return + newAsgnStmt(prc.ast[resultPos], + indirectAccess(newSymNode(newParam), "next", newParam.info, + g.cache)), + body + ) + + # the fields in the constructed environment are wrong, they need to be + # patched + let obj = param.typ.base + var start = 0 + computeFieldStart(obj.base, start) + for it in obj.n.items: + it.sym.position += start diff --git a/compiler/sem/lambdalifting.nim b/compiler/sem/lambdalifting.nim index e26d7eb50eb..557cf10c0b8 100644 --- a/compiler/sem/lambdalifting.nim +++ b/compiler/sem/lambdalifting.nim @@ -167,7 +167,10 @@ proc createStateField(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = result.typ = createClosureIterStateType(g, iter, idgen) proc createEnvObj(g: ModuleGraph; idgen: IdGenerator; owner: PSym; info: TLineInfo): PType = - result = createObj(g, idgen, owner, info, final=false) + if sfCoroutine in owner.flags: + result = createObj(g, idgen, owner, info, owner.ast[dispatcherPos].typ) + else: + result = createObj(g, idgen, owner, info, g.getCompilerProc("RootObj").typ) proc getClosureIterResult*(g: ModuleGraph; iter: PSym; idgen: IdGenerator): PSym = if resultPos < iter.ast.len: @@ -591,7 +594,12 @@ proc accessEnv(available: PSym, wanted: PType, info: TLineInfo, result = rawIndirectAccess(result, upField, info) proc getStateField*(g: ModuleGraph; owner: PSym): PSym = - getHiddenParam(g, owner).typ.base.n[0].sym + if sfCoroutine in owner.flags: + # for coroutines, the ``state`` field symbol comes from the + # ``CoroutineBase`` type + g.getCompilerProc("CoroutineBase").typ.base.n[1].sym + else: + getHiddenParam(g, owner).typ.base.n[0].sym proc symToClosure(n: PNode; graph: ModuleGraph; idgen: IdGenerator; c: LiftingPass): PNode = @@ -682,9 +690,10 @@ proc liftCapturedVars(n: PNode, graph: ModuleGraph, idgen: IdGenerator, n[1] = liftCapturedVars(n[1], graph, idgen, c) if n[1].kind == nkClosure: result = n[1] of nkReturnStmt: - if n[0].kind in {nkAsgn, nkFastAsgn}: + if n[0].kind in {nkAsgn, nkFastAsgn} and sfCoroutine notin c.owner.flags: # let's not touch the LHS in order to make the lifting pass - # correct when `result` is lifted + # correct when `result` is lifted. For coroutines, the LHS needs to + # be rewritten too! n[0][1] = liftCapturedVars(n[0][1], graph, idgen, c) else: n[0] = liftCapturedVars(n[0], graph, idgen, c) @@ -775,6 +784,19 @@ proc liftLambdas*(g: ModuleGraph; fn: PSym, body: PNode; # callsite result.body = liftCapturedVars(body, g, idgen, initLiftingPass(d, param)) result.env = param + elif fn.isCoroutine and fn.typ.callConv == ccClosure: + # coroutines are somewhat special. In the context of lambda-lifting, + # they're similar to closure iterators, with the difference that the + # environment parameter type is already correct + var d = initDetectionPass(g, fn, idgen) + detectCapturedVars(body, fn, d) + + let param = getEnvParam(fn) + assert param != nil + + prepareInnerRoutines(d, idgen, param.typ, fn.info) + result.body = liftCapturedVars(body, g, idgen, initLiftingPass(d, param)) + result.env = param elif body.kind != nkEmpty: assert fn.typ.callConv != ccClosure or getEnvParam(fn) != nil, "missing environment parameter" @@ -895,7 +917,7 @@ proc liftForLoop*(g: ModuleGraph; body: PNode; idgen: IdGenerator; callee = newSym(skLet, op[0].sym.name, nextSymId(idgen), owner, op.info) callee.typ = op.typ - if owner.isIterator: + if owner.isIterator or owner.isCoroutine: # meh, we have to add the local to the environment; it might be used # across yields op = freshVarForClosureIter(g, callee, idgen, owner) diff --git a/compiler/sem/lowerings.nim b/compiler/sem/lowerings.nim index de3f68b39ed..f0fd53fb37a 100644 --- a/compiler/sem/lowerings.nim +++ b/compiler/sem/lowerings.nim @@ -134,13 +134,12 @@ proc lowerTupleUnpackingForAsgn*(g: ModuleGraph; n: PNode; idgen: IdGenerator; o for i in 0.. resultPos and n[resultPos] != nil: + # ensure that the result slot exists: + if n.len <= resultPos: + n.sons.setLen(resultPos + 1) + + if n[resultPos] != nil: if n[resultPos].sym.kind != skResult: localReport(c.config, n, reportSem rsemIncorrectResultProcSymbol) @@ -2157,7 +2161,7 @@ proc addResult(c: PContext, n: PNode, t: PType) = else: genResSym(s) c.p.resultSym = s - n.add newSymNode(c.p.resultSym) + n[resultPos] = newSymNode(c.p.resultSym) addParamOrResult(c, c.p.resultSym) @@ -2230,7 +2234,13 @@ proc activate(c: PContext, n: PNode) = discard proc maybeAddResult(c: PContext, s: PSym, n: PNode) = - if s.typ[0] != nil and not isInlineIterator(s.typ): + if sfCoroutine in s.flags: + if n[resultPos].kind != nkEmpty: + # destrutively move the type node out of the result slot, so + # that ``addResult`` creates a new result type + addResult(c, n, move(n[resultPos]).typ) + + elif s.typ[0] != nil and not isInlineIterator(s.typ): addResult(c, n, s.typ[0]) proc canonType(c: PContext, t: PType): PType = @@ -2412,6 +2422,83 @@ proc semMethodPrototype(c: PContext; s: PSym; n: PNode) = localReport(c.config, n.info, reportSym( rsemExpectedObjectForMethod, s)) +proc getCoroutineInstType(c: PContext, info: TLineInfo, rtyp: PType): PType = + ## Instantiates the ``Coroutine[T]`` type with `rtyp` bound to ``T``. + let + rtyp = + if rtyp.isNil: c.graph.getSysType(info, tyVoid) + else: rtyp + t = c.graph.getCompilerProc("Coroutine").typ + result = newTypeS(tyGenericInvocation, c) + result.rawAddSon(t) # generic body + result.rawAddSon(rtyp) # type argument + var map: TIdTable + result = generateTypeInstance(c, map, info, result) + +proc semCoroutine(c: PContext, n: PNode, ptyp: PType) = + ## Given the partially analysed routine definition production AST `n` (the + ## parameter list has to be typed already), makes sure that the routine + ## header is valid for a coroutine. A coroutine is not a standalone + ## entity -- instead, routines can be marked as being coroutines. + + # fetch the user-specified type, if any: + var typ = coroutineSpec(n[pragmasPos]) + + # instantiate the generic instance type ``Coroutine[T]``. `T` is replaced + # with the procedure's return type + # TODO: support generic routines... + let inst = getCoroutineInstType(c, n.info, ptyp[0]) + + if typ.isNil: + # no custom instance type specificed + typ = inst + else: + # the custom instance type must be a sub-type of inst + if inheritanceDiff(inst, typ) <= 0: + # TODO: use a proper diagnostic + internalError(c.config, "instance type must be a sub-type of 'Coroutine[T]'") + + let refTyp = skipTypes(inst, {tyGenericInst, tyAlias, tySink}) + # it must also be a ref type + if refTyp.kind != tyRef: + # TODO: maybe the specification is too strict here? A 'ref' type could + # be created automatically + internalError(c.config, "instance type must be a 'ref' type") + + # it must be extendable + if isFinal(refTyp.base): + internalError(c.config, "instance type must be non-final") + + # all good, the type is correct + + # no transformation of the procedure is performed here, so as to keep the + # shape of the AST and not interfere with typed macros. Instead, the + # transformations are applied later during ``transf``. Here, we only + # replace the result *type* with the instance type, but make sure that the + # actual result variable that's injected stays as the as-specified type + + n.sons.setLen(resultPos + 1) + # TODO: handle the result slot being non-empty (happens during re-sem) + if ptyp[0].isEmptyType(): + n[resultPos] = c.graph.emptyNode + else: + n[resultPos] = newNodeIT(nkType, n.info, ptyp[0]) + + ptyp[0] = typ + + # XXX: the below is quite the hack + let selfSym = newSym(skLet, c.cache.getIdent("self"), nextSymId c.idgen, + c.getCurrOwner, n[namePos].info) + selfSym.typ = typ + # the self local is always outlived by the instance, so it's marked as a + # cursor. This also prevents reference cycles, should the local be lifted + # into the instance + selfSym.flags.incl sfCursor + # the ``self`` parameter symbol is stashed in the routine's dispatcher + # slot + n.sons.setLen(dispatcherPos + 1) + n[dispatcherPos] = newSymNode(selfSym) + proc semRoutineName(c: PContext, n: PNode, kind: TSymKind; allowAnon = true): PNode = ## Semantically analyse the AST `n` appearing in the name slot of the ## definition of a callable @@ -2616,6 +2703,9 @@ proc semProcAux(c: PContext, n: PNode, validPragmas: TSpecialWords, popOwner(c) return wrapErrorAndUpdate(c.config, result, s) + if sfCoroutine in s.flags: + semCoroutine(c, result, s.typ) + if result[pragmasPos].kind != nkEmpty and sfBorrow notin s.flags: setEffectsForProcType(c.graph, s.typ, result[pragmasPos], s) s.typ.flags.incl tfEffectSystemWorkaround @@ -2680,6 +2770,10 @@ proc semProcAux(c: PContext, n: PNode, validPragmas: TSpecialWords, result[namePos] = checkSpecialOperators(c, result[namePos]) hasError = hasError or result[namePos].kind == nkError + if sfCoroutine in s.flags: + # inject the ``self`` parameter symbol + addDecl(c, s.ast[dispatcherPos].sym) + if n[bodyPos].kind != nkEmpty and sfError notin s.flags: # for DLL generation we allow sfImportc to have a body, for use in VM if sfBorrow in s.flags: @@ -2696,7 +2790,7 @@ proc semProcAux(c: PContext, n: PNode, validPragmas: TSpecialWords, # absolutely no generics (empty) or a single generic return type are # allowed, everything else, including a nullary generic is an error. pushProcCon(c, s) - addResult(c, result, s.typ[0]) + maybeAddResult(c, s, result) s.ast[bodyPos] = hloBody(c, semProcBody(c, n[bodyPos])) s.ast[bodyPos] = foldInAst(c.module, s.ast[bodyPos], c.idgen, c.graph) trackProc(c, s, s.ast[bodyPos]) diff --git a/compiler/sem/semtypes.nim b/compiler/sem/semtypes.nim index 6dbd5dc5a31..3b76de22ad5 100644 --- a/compiler/sem/semtypes.nim +++ b/compiler/sem/semtypes.nim @@ -1870,6 +1870,8 @@ proc semTypeClass(c: PContext, n: PNode, prev: PType): PType = localReport(c.config, result.n[3]) closeScope(c) +proc getCoroutineInstType(c: PContext, info: TLineInfo, rtyp: PType): PType + proc semProcTypeWithScope(c: PContext, n: PNode, prev: PType, kind: TSymKind): PType = checkSonsLen(n, 2, c.config) @@ -1892,6 +1894,12 @@ proc semProcTypeWithScope(c: PContext, n: PNode, # we're still interested in implicit tags and raises pragmas n[1] = implicitPragmas(c, s, n[1], {wTags, wRaises}) + if tfCoroutine in result.flags: + # replace the return type with the instance type + # TODO: the specified instance type needs to be used instead, and it also + # needs to be validated + result[0] = getCoroutineInstType(c, n.info, result[0]) + when true: # check if we got any errors and if so report them for e in ifErrorWalkErrors(c.config, n[1]): diff --git a/compiler/sem/transf.nim b/compiler/sem/transf.nim index 0728f544adb..053263255a0 100644 --- a/compiler/sem/transf.nim +++ b/compiler/sem/transf.nim @@ -40,6 +40,7 @@ import compiler/sem/[ ast_analysis, closureiters, + coroutines, semfold, lambdalifting, lowerings @@ -109,7 +110,7 @@ proc newTemp(c: PTransf, typ: PType, info: TLineInfo): PNode = r.typ = typ #skipTypes(typ, {tyGenericInst, tyAlias, tySink}) incl(r.flags, sfFromGeneric) let owner = getCurrOwner(c) - if owner.isIterator: + if owner.isIterator or owner.isCoroutine: result = freshVarForClosureIter(c.graph, r, c.idgen, owner) else: result = newSymNode(r) @@ -188,7 +189,7 @@ proc freshVar(c: PTransf; v: PSym): PNode = # following after ``transf`` expects that the set of existing globals # stays unchanged result = newSymNode(v) - elif owner.isIterator: + elif owner.isIterator or owner.isCoroutine: result = freshVarForClosureIter(c.graph, v, c.idgen, owner) else: var newVar = copySym(v, nextSymId(c.idgen)) @@ -815,7 +816,7 @@ proc transformFor(c: PTransf, n: PNode): PNode = sym.flags.incl sfShadowed result = - if owner.isIterator: + if owner.isIterator or owner.isCoroutine: freshVarForClosureIter(c.graph, sym, c.idgen, owner) else: newSymNode(sym) @@ -1066,6 +1067,14 @@ proc transformCall(c: PTransf, n: PNode): PNode = result = transform(c, n[1]) elif magic == mExpandToAst: result = transformExpandToAst(c, n) + elif magic == mSuspend: + let x = transformSons(c, n) + result = newNodeI(nkYieldStmt, n.info) + if x.len > 1: + result.add x[1] + else: + let typ = c.graph.getCompilerProc("CoroutineBase").typ + result.add newNodeIT(nkNilLit, n.info, typ) else: let s = transformSons(c, n) # bugfix: check after 'transformSons' if it's still a method call: @@ -1270,6 +1279,11 @@ proc transform(c: PTransf, n: PNode): PNode = result[1] = transformSymAux(c, a) else: result = n + + if n[0].kind == nkSym and n[0].sym.isCoroutine: + # the coroutine needs to be transformed eagerly, so that its signature + # is correct before first reaching code generation + discard transformBody(c.graph, c.idgen, n[0].sym, true) of nkOfBranch: result = shallowCopy(n) # don't transform the label nodes: @@ -1360,7 +1374,12 @@ proc transformBody*(g: ModuleGraph, idgen: IdGenerator, prc: PSym, body: PNode): ## ## Application always happens in that exact order. var c = PTransf(graph: g, module: prc.getModule, idgen: idgen) - (result, c.env) = liftLambdas(g, prc, body, c.idgen) + if prc.isCoroutineConstr: + result = preTransformConstr(g, idgen, prc, body) + else: + result = body + + (result, c.env) = liftLambdas(g, prc, result, c.idgen) result = processTransf(c, result, prc) liftDefer(c, result) @@ -1369,6 +1388,10 @@ proc transformBody*(g: ModuleGraph, idgen: IdGenerator, prc: PSym, body: PNode): # the environment type is closed for modification, meaning that we can # safely create the type-bound operators now finishClosureIterator(c.graph, c.idgen, prc) + elif prc.isCoroutineConstr: + result = g.transformCoroutineConstr(c.idgen, prc, result) + elif prc.isCoroutine: + result = g.transformCoroutine(c.idgen, prc, result) incl(result.flags, nfTransf) diff --git a/lib/system.nim b/lib/system.nim index 72927a6b123..dc4d8a91ba6 100644 --- a/lib/system.nim +++ b/lib/system.nim @@ -3049,3 +3049,6 @@ when defined(nimDebugUtils): proc `not`*[T: ref or ptr](a: typedesc[T], b: typeof(nil)): typedesc {.magic: "TypeTrait", noSideEffect.} ## Constructs a `not nil` type. + +when defined(nimskullHasCoroutines): + include "system/coroutines" diff --git a/lib/system/coroutines.nim b/lib/system/coroutines.nim new file mode 100644 index 00000000000..d68b074a4b5 --- /dev/null +++ b/lib/system/coroutines.nim @@ -0,0 +1,187 @@ +## Internal module included by the system module. Implements the basic +## compiler interface for coroutines, plus a low-level API for working +## with them. + +type + CoroutineBase* {.compilerproc.} = ref object of RootObj + ## The internal base type of all coroutine instance types. Carries the + ## state all coroutine instances have. + fn: proc(c: CoroutineBase): CoroutineBase {.nimcall.} + ## internal procedure + state: int32 + ## internal state value + next: CoroutineBase + ## the instance to continue with (i.e., the *continuation*) once + ## control-flow leaves the current coroutine + exc: ref Exception + ## the "current exception" of the coroutine instance + + Coroutine*[T] {.compilerproc.} = ref object of CoroutineBase + ## The public base type of all coroutine instance types. + when T isnot void: + result: T + + CoroutineState* = enum + ## Identifies the status of a coroutine instance. + csSuspended + csRunning + csAborted + csPending + csFinished + + CoroutineError* = object of ValueError + # XXX: derive from ``CatchableError`` directly? + +const + StateOffset = 4 + ## the number of special values `state` can have + 1 + +# compiler interface +# ------------------ + +proc suspend*() {.magic: "Suspend".} + ## Suspend the active coroutine, yielding control back to the callsite of + ## the `resume <#resume,CoroutineBase>` that earlier resumed it. The resume + ## call will return the same instance it was invoked on. + +proc suspend(next: sink CoroutineBase) {.magic: "Suspend".} + ## Internal-only suspend. Sets the instance returned by the coroutine + ## procedure to `next` + +# low-level API +# ------------- + +proc status*(c: CoroutineBase): CoroutineState = + case c.state + of -3: + csFinished + of -2: + csAborted + of -1: + csPending + elif c.state >= 0: + csRunning + else: + csSuspended + +{.push checks: off.} + +proc resume*(c: CoroutineBase): CoroutineBase {.discardable.} = + ## Yields control to the given suspendend coroutine instance `c`, which is + ## then executed until the first suspension point is reached. Returns + ## the coroutine instance in which a suspension point was reached. + if c.state >= 0: + # already running + discard "TODO: raise an error" + + # run the coroutine and its continuations until a suspension point is + # reached: + var c = c + while true: + if c.state <= -StateOffset: + # mark as running: + c.state = -(c.state + StateOffset) + + var next: CoroutineBase + try: + next = c.fn(c) + except CatchableError as e: + c.state = -2 # aborted + c.exc = e + next = c.next + + if next.isNil: + break # nothing to continue with + c = next + + # mark the exit instance as suspended, if not pending or aborted: + if c.state >= 0: + c.state = -(c.state + StateOffset) + + result = c + +{.pop.} + +proc finish*[T](c: sink Coroutine[T]): T = + case c.status + of csPending: + when T isnot void: + result = move c.result + c.state = -3 # done + else: + raise CoroutineError.newException("not pending") + +proc unwrap*(c: sink CoroutineBase): ref Exception = + # XXX: unwrap is not a descriptive name for what the procedure does + case c.status + of csAborted: + result = move c.exc + c.state = -3 + else: + raise CoroutineError.newException("not aborted") + +proc getOrRaise[T](c: Coroutine[T]): T = + case c.status + of csAborted: + c.state = -3 + raise move(c.exc) + of csPending: + when T isnot void: + result = move c.result + c.state = -3 + else: + raise CoroutineError.newException("not pending") + +template tail*[T](c: Coroutine[T]): untyped = + ## Passes control to coroutine instance `c`. When `c` logically returns, + ## control is passed back to the currently running coroutine, without + ## original `resume <#resume,CoroutineBase>`_ returning. + # TODO: move the checks and setup into a separate procedure + let x = c + case x.status + of csRunning: + raise CoroutineError.newException("tail-call target already running") + of csSuspended: + # XXX: an error is not strictly necessary, we could also take over the + # continuation + if x.next != nil: + raise CoroutineError.newException("cannot tail-call again") + x.next = self + suspend(x) # pass control to the coroutine + else: + discard "okay, do nothing" + getOrRaise(x) + +proc trampoline*[T](c: sink Coroutine[T]): T = + ## Runs the instance until control is yielded to a not-suspended instance. + ## For an instance aborted with an exception, the exception is re-raised, + ## otherwise the result (if any) is extracted via ``finish``. + # XXX: unrelated to the coroutine compiler interface. This should either be + # directly in the system module, or in a separate standard library + # module. + var c = CoroutineBase(c) + while c != nil and c.status == csSuspended: + c = c.resume() + + if c.isNil: + raise CoroutineError.newException("coroutine was dismissed") + + case c.status + of csSuspended: + doAssert false # not possible + of csAborted: + # raise for + raise c.exc + of csPending: + when T is void: + finish(Coroutine[T](c)) + else: + result = finish(Coroutine[T](c)) + of csRunning: + # the coroutine must have yielded to a another, running coroutine + # TODO: report an error + discard + of csFinished: + # the coroutine must have yielded to a finished coroutine + # TODO: report an error + discard diff --git a/tests/lang/s02_core/s99_coroutines/t01_coroutine_definition.nim b/tests/lang/s02_core/s99_coroutines/t01_coroutine_definition.nim new file mode 100644 index 00000000000..3dfbaabb944 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t01_coroutine_definition.nim @@ -0,0 +1,11 @@ +discard """ +""" + +## Normal `proc`s and `func`s become coroutines by applying the `.coroutine` +## pragma to their definition. + +proc coro1() {.coroutine.} = + discard + +func coro2() {.coroutine.} = + discard \ No newline at end of file diff --git a/tests/lang/s02_core/s99_coroutines/t02_signature_restrictions_1.nim b/tests/lang/s02_core/s99_coroutines/t02_signature_restrictions_1.nim new file mode 100644 index 00000000000..35ec50ae7e0 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t02_signature_restrictions_1.nim @@ -0,0 +1,13 @@ +discard """ +""" + +## Except for `openArray` and `var` types, there are no restrictions on the +## number or type of the parameters, compared to non-coroutine procedures. + +proc a(x: int, y: seq[float], z: string) {.coroutine.} = + discard + +## Coroutines cannot return views, but there are no other restrictions. + +proc b(): float {.coroutine.} = + discard \ No newline at end of file diff --git a/tests/lang/s02_core/s99_coroutines/t02_signature_restrictions_2.nim b/tests/lang/s02_core/s99_coroutines/t02_signature_restrictions_2.nim new file mode 100644 index 00000000000..7f0b78ac1ff --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t02_signature_restrictions_2.nim @@ -0,0 +1,12 @@ +discard """ + matrix: "--errorMax:2" + action: reject +""" + +proc a(x: openArray[int]) {.coroutine.} = #[tt.Error + ^ invalid type: 'openArray[int]']# + discard + +proc b(x: var int) {.coroutine.} = #[tt.Error + ^ invalid type: 'var int']# + discard diff --git a/tests/lang/s02_core/s99_coroutines/t03_converter_cannot_be_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t03_converter_cannot_be_coroutine.nim new file mode 100644 index 00000000000..2bf303fb43e --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t03_converter_cannot_be_coroutine.nim @@ -0,0 +1,10 @@ +discard """ + description: "Converters cannot be coroutines" + action: reject +""" + +# XXX: maybe to restrictive, there's nothing preventing converters from being +# coroutines, even though there's likely little use of them being one + +converter conv(x: int): float {.coroutine.} = + discard diff --git a/tests/lang/s02_core/s99_coroutines/t03_macro_cannot_be_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t03_macro_cannot_be_coroutine.nim new file mode 100644 index 00000000000..d4479556a81 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t03_macro_cannot_be_coroutine.nim @@ -0,0 +1,9 @@ +discard """ + description: "Macros cannot be coroutines" + action: reject +""" + +# XXX: perhaps too restrictive; it's not impossible to implement + +macro m() {.coroutine.} = + discard diff --git a/tests/lang/s02_core/s99_coroutines/t03_method_cannot_be_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t03_method_cannot_be_coroutine.nim new file mode 100644 index 00000000000..c3c1164cbfd --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t03_method_cannot_be_coroutine.nim @@ -0,0 +1,11 @@ +discard """ + description: "Methods cannot be coroutines" + action: reject +""" + +type + Base = object of RootObj + Sub = object of RootObj + +method m(x: ref Object) {.coroutine.} = + discard diff --git a/tests/lang/s02_core/s99_coroutines/t04_launch_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t04_launch_coroutine.nim new file mode 100644 index 00000000000..2d434f4ff72 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t04_launch_coroutine.nim @@ -0,0 +1,28 @@ + +## To launch a coroutine, the syntax for routine invocation is used. Unlike a +## normal procedure, this doesn't call the coroutine; instead, it constructs +## a coroutine instance. The expression is referred to as a *coroutine +## construction* (coroutine instantiation?). +## +## What happens is, in the following order: +## 1. a managed heap cell of the coroutine's internal environment type is +## allocated +## 2. the provided arguments are captured in the internal environment, either +## by copying or moving, depending on the parameter +## 3. the status of the couroutine instance is set to the "suspended" state +## +## The instantiated coroutine is returned as the built-in ``Coroutine[T]`` +## type (where `T` is the return type of the coroutine), which is a +## polymorphic ``ref`` type. A coroutine's internal environment type is always +## derived from the ``Coroutine[T]`` type. +## +## The body of the coroutine is not executed yet. + +proc coro(x: int) {.coroutine.} = + discard + +let instance = coro(1) +doAssert instance is Coroutine[void] +doAssert instance.status == csSuspended + +## It is legal to do nothing with an instantiated coroutine. diff --git a/tests/lang/s02_core/s99_coroutines/t05_resume_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t05_resume_coroutine.nim new file mode 100644 index 00000000000..39385b76f41 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t05_resume_coroutine.nim @@ -0,0 +1,22 @@ +discard """ + output: "here" +""" + +## To resume a coroutine instance (that is, run it until the next suspension +## point is reached), the built-in nullary ``resume`` procedure is used. The +## ``resume`` procedure returns the coroutine instance that the coroutine +## suspended with. Only an instance that is in the "suspended" state can be +## resumed. +## +## Before passing control to the coroutine, ``resume`` sets the instance's +## status to "running" + +proc coro() {.coroutine.} = + echo "here" + +let instance = coro() +discard resume(instance) # the echo will be executed + +## When a suspension point is reached, ``resume`` returns. If there's no more +## code to run within the coroutine, prior to returning from ``resume``, the +## status is set to "pending", otherwise it's set to "suspendend". diff --git a/tests/lang/s02_core/s99_coroutines/t06_cancel_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t06_cancel_coroutine.nim new file mode 100644 index 00000000000..8af53eb2f73 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t06_cancel_coroutine.nim @@ -0,0 +1,28 @@ + +## A coroutine can be cancelled, by raising an exception and letting it +## propagate to the edge of the coroutine. Upon cancellation, the +## ``resume`` call that started execution changes the state of the instance +## to "aborted" and returns the instance. + +proc coro(cancel: bool) {.coroutine.} = + if cancel: + raise CatchableError.newException("fail") + +let instance = coro(true) +doAssert instance.status == csSuspended + +resume(instance) +doAssert instance.status == csAborted + +## If a coroutine instance is cancelled, the exception that caused +## cancellation is stored in the coroutine instance object. It can be +## extracted by using the built-in ``unwrap``. + +# XXX: unwrap needs a better name + +let error = unwrap(instance) +doAssert error of CatchableError +doAssert error.msg == "fail" + +## The call to ``unwrap`` moves the instance into the "finished" state. +doAssert instance.status == csFinished diff --git a/tests/lang/s02_core/s99_coroutines/t07_finish_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t07_finish_coroutine.nim new file mode 100644 index 00000000000..518bd38d66f --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t07_finish_coroutine.nim @@ -0,0 +1,37 @@ +## Much like normal procedures, a coroutine can yield a result. The `result` +## variable is stored as part of the coroutine instance object. To extract, +## the result value, the built-in ``finish`` procedure needs to be called +## on a "pending" instance. An instance enters the "pending" state when +## the end of the coroutine's body is reached. + +proc coro(): int {.coroutine.} = + result = 1 + +let instance = coro() +resume(instance) # run to completion +doAssert instance.status == csPending + +doAssert finish(instance) == 1 + +## A successful call to ``finish`` moves the instance into the "finished" +## state. +doAssert instance.status == csFinished + +## An instance also enters the "pending" state when the coroutine exits due to +## a ``return`` being executed. + +proc coro2(early: bool): int {.coroutine.} = + if early: + return 2 + return 1 + +var instance2 = coro2(true) + +resume(instance2) +doAssert instance2.status == csPending + +doAssert finish(instance2) == 2 +doAssert instance2.status == csFinished + +## "finished" is the terminal state. There's no other state that the instance +## can change to from it. diff --git a/tests/lang/s02_core/s99_coroutines/t08_finish_with_void.nim b/tests/lang/s02_core/s99_coroutines/t08_finish_with_void.nim new file mode 100644 index 00000000000..5b25196bedb --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t08_finish_with_void.nim @@ -0,0 +1,15 @@ + +## If a coroutine has no result (i.e., the return type is ``void``), then +## ``finish`` returns nothing and only changes the status from "pending" to +## "finished". + +proc coro() {.coroutine.} = + discard + +var instance = coro() + +resume(instance) +doAssert instance.status == csPending + +finish(instance) +doAssert instance.status == csFinished diff --git a/tests/lang/s02_core/s99_coroutines/t09_finish_does_move.nim b/tests/lang/s02_core/s99_coroutines/t09_finish_does_move.nim new file mode 100644 index 00000000000..be59537bc40 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t09_finish_does_move.nim @@ -0,0 +1,18 @@ + +## Calling ``finish`` moves the result value out of the instance. + +type Object = object + value: int + +# copying is disallowed +proc `=copy`(x: var Object, y: Object) {.error.} + +proc coro(): Object {.coroutine.} = + result = Object(value: 1) + +var instance = coro() +resume(instance) + +# the value is moved out of the instance, no copy is made +let o = finish(instance) +doAssert o.value == 1 diff --git a/tests/lang/s02_core/s99_coroutines/t10_self_parameter.nim b/tests/lang/s02_core/s99_coroutines/t10_self_parameter.nim new file mode 100644 index 00000000000..6eeb6dd48b7 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t10_self_parameter.nim @@ -0,0 +1,17 @@ +discard """ + output: "Coroutine[system.void]\ncsRunning" +""" + +## To access the active *instance* within the body of a coroutine, the hidden +## ``self`` parameter is made available. + +# XXX: not a good solution, either the ``self`` parameter should be explicit +# (somehow), or there should be a magic procedure + +proc coro() {.coroutine.} = + # the self parameter is of type ``Coroutine[void]`` + echo typeof(self) + echo self.status + +var instance = coro() +resume(instance) diff --git a/tests/lang/s02_core/s99_coroutines/t11_suspend_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t11_suspend_coroutine.nim new file mode 100644 index 00000000000..41b2dc868ad --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t11_suspend_coroutine.nim @@ -0,0 +1,44 @@ +discard """ + output: ''' +outside: 1 +coro: 1 +outside: 2 +coro: 2 +outside: 3 +coro: 3''' +""" + +## A coroutine can be suspended without returning or raising an exception. +## This is achieved by calling the built-in ``suspend`` routine. On calling +## ``suspend``, execution of the coroutine halts, and control is given back to +## the callsite of the ``resume`` call that previously resumed execution of +## the instance. +## +## When suspended this way, the ``resume`` that control is given back to +## returns the suspended instance. + +# IDEA: instead of the ``suspend`` routine, the ``yield`` keyword could be +# re-used, which could be much more convenient to use. It'd also be +# a bit easier to implement + +proc coro() {.coroutine.} = + echo "coro: 1" + suspend() + echo "coro: 2" + suspend() + echo "coro: 3" + +var instance = coro() + +echo "outside: 1" +doAssert resume(instance) == instance + +## After suspending, the coroutine is in the "suspended" state. +doAssert instance.status == csSuspended + +echo "outside: 2" +doAssert resume(instance) == instance +echo "outside: 3" +doAssert resume(instance) == instance + +doAssert instance.status == csPending diff --git a/tests/lang/s02_core/s99_coroutines/t12_tail_call.nim b/tests/lang/s02_core/s99_coroutines/t12_tail_call.nim new file mode 100644 index 00000000000..f75e41b0fdb --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t12_tail_call.nim @@ -0,0 +1,34 @@ +discard """ + output: "1\n2\n3\n4\n" +""" + +## The built-in ``tail`` routine is used for passing control to a coroutine +## from within another coroutine, without yielding control back to the +## ``resume`` call. A ``suspend`` within a tail-called coroutine then yields +## control to the original ``resume``. +## +## Only coroutine instances where the return type is known can be passed to +## ``tail``. + +proc a() {.coroutine.} = + echo "2" + suspend() + echo "3" + +proc b() {.coroutine.} = + echo "1" + tail a() + echo "4" + +var instance = b() +var c = resume(instance) + +## The originally resumed coroutine instance is still running in this case. +doAssert c != instance +doAssert instance.status == csRunning +doAssert c.status == csSuspended + +doAssert resume(c) == instance + +## Upon returning from tail-called instance, it is automatically finished. +doAssert c.status == csFinished diff --git a/tests/lang/s02_core/s99_coroutines/t12_tail_call_exception_propagation.nim b/tests/lang/s02_core/s99_coroutines/t12_tail_call_exception_propagation.nim new file mode 100644 index 00000000000..2952c38e3d6 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t12_tail_call_exception_propagation.nim @@ -0,0 +1,37 @@ +discard """ + output: "caught: a" +""" + +# TODO: fix the test order + +## Exceptions propagate across tail call boundaries into the calling coroutine. + +proc a() {.coroutine.} = + suspend() + raise CatchableError.newException("a") + +proc b(catch: bool) {.coroutine.} = + if catch: + try: + tail a() + except CatchableError as e: + echo "caught: ", e.msg + else: + tail a() + +var instance = b(false) +var c = resume(instance) + +doAssert resume(c) == instance +## Upon exception propagation leaving the tail call, the raising tail-called +## coroutine instance moves into the "finished" state. +doAssert c.status == csFinished +## If not caught within the calling coroutine, the raised exception aborts the +## latter. +doAssert instance.status == csAborted +doAssert unwrap(instance).msg == "a" + +instance = b(true) +resume(resume(instance)) +## Catching the exception stops error propagation, as usual. +doAssert instance.status == csPending \ No newline at end of file diff --git a/tests/lang/s02_core/s99_coroutines/t12_tail_call_only_once.nim b/tests/lang/s02_core/s99_coroutines/t12_tail_call_only_once.nim new file mode 100644 index 00000000000..203e5624a2c --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t12_tail_call_only_once.nim @@ -0,0 +1,15 @@ +## A coroutine instance can only be tail-called once. + +proc first() {.coroutine.} = + suspend() + +proc coro(other: Coroutine[void]) {.coroutine.} = + tail(other) + +var f = first() +resume(coro(f)) +doAssert f.status == csSuspended + +var instance = resume(coro(f)) +doAssert instance.status == csAborted +doAssert unwrap(instance).msg == "cannot tail-call again" diff --git a/tests/lang/s02_core/s99_coroutines/t12_tail_call_partial.nim b/tests/lang/s02_core/s99_coroutines/t12_tail_call_partial.nim new file mode 100644 index 00000000000..c68b9ed9256 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t12_tail_call_partial.nim @@ -0,0 +1,79 @@ +discard """ + output: ''' +1 +2 +3 +4 +5 +caught: a +got: 1 +caught: cannot tail call +''' +""" + +# XXX: consider splitting this test into multiple files + +## The coroutine instance passed to ``tail`` doesn't have to be in the +## initial, never-ran state. + +proc a() {.coroutine.} = + echo "2" + suspend() + echo "4" + +proc b() {.coroutine.} = + echo "1" + var coro = a() + resume(coro) + echo "3" + tail(coro) + echo "5" + +resume(b()) + +## It also allowed to tail-call pending or aborted instances. + +proc c(doRaise: bool): int {.coroutine.} = + if doRaise: + raise CatchableError.newException("a") + else: + return 1 + +proc d() {.coroutine.} = + var coro = c(true) + resume(coro) + try: + discard tail(coro) + except CatchableError as e: + echo "caught: ", e.msg + + coro = c(false) + resume(coro) + echo "got: ", tail(coro) + +resume(d()) + +## It is not allowed to tail-call a finished or running instance. On doing so, +## a ``CoroutineError`` exception is raised. + +proc e() {.coroutine.} = + try: + tail(e) + except CoroutineError as e: + echo "caught: ", e.msg # already running + +resume(e()) + +proc f() {.coroutine.} = + discard "returns immediately" + +proc g() {.coroutine.} = + var coro = f() + resume(coro) + finish(coro) + try: + tail(coro) + except CoroutineError as e: + echo "caught: ", e.msg + +resume(g()) diff --git a/tests/lang/s02_core/s99_coroutines/t12_tail_call_with_value.nim b/tests/lang/s02_core/s99_coroutines/t12_tail_call_with_value.nim new file mode 100644 index 00000000000..06cab280532 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t12_tail_call_with_value.nim @@ -0,0 +1,20 @@ +discard """ + output: "1\n2\n3\n4\n" +""" + +# TODO: fix the test order + +## If the coroutine that control is passed to returns a value, the ``tail`` +## call will return it. + +proc a(): int {.coroutine.} = + echo "2" + return 3 + +proc b() {.coroutine.} = + echo "1" + echo tail(a()) + echo "4" + +var instance = resume b() +doAssert instance.status == csPending diff --git a/tests/lang/s02_core/s99_coroutines/t13_custom_suspend.nim b/tests/lang/s02_core/s99_coroutines/t13_custom_suspend.nim new file mode 100644 index 00000000000..56c61e58108 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t13_custom_suspend.nim @@ -0,0 +1,19 @@ +discard """ + output: "custom" +""" + +## The ``suspend`` built-in procedure is not special-cased with regards to +## lookup. It can be overloaded like any other routine. + +template suspend() = + echo "custom" + system.suspend() + +# XXX: this could be a problem. A module could export a routine such as the +# above and thus override all suspend calls in the importing module! + +proc coro() {.coroutine.} = + suspend() + +var instance = coro() +resume(instance) diff --git a/tests/lang/s02_core/s99_coroutines/t14_illegal_operation.nim b/tests/lang/s02_core/s99_coroutines/t14_illegal_operation.nim new file mode 100644 index 00000000000..8e945b3300e --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t14_illegal_operation.nim @@ -0,0 +1,24 @@ + +## What operations are valid on a coroutine instance depends on its state. +## If performing an operation on a coroutine while in a state where the +## operation is not applicable, a ``CoroutineError`` is raised. The coroutine +## instance is not modified in this case. + +# XXX: a catchable error could be annoying in `.raises: []` routines where +# it's guaranteed that the operation is valid. Perhaps it should +# be a defect? + +proc coro() {.coroutine.} = + discard + +let instance = coro() +doAssert instance.status == csSuspended + +var wasError = false +# unwrap only legal when instance was aborted +try: + discard unwrap(instance) +except CoroutineError as e: + wasError = true + +doAssert wasError diff --git a/tests/lang/s02_core/s99_coroutines/t15_custom_coroutine_instance_type.nim b/tests/lang/s02_core/s99_coroutines/t15_custom_coroutine_instance_type.nim new file mode 100644 index 00000000000..2de83abb5fb --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t15_custom_coroutine_instance_type.nim @@ -0,0 +1,23 @@ +discard """ + output: "0" +""" + +## The ``.coroutine`` pragma can be supplied with a type, which the internal +## coroutine instance object then derives from. The type must be a non- +## final ``ref`` sub-type of ``Coroutine[T]``, where `T` is the return type +## of the coroutine. + +# TODO: a negative test is missing + +type Custom = ref object of Coroutine[void] + value: int + +proc coro() {.coroutine: Custom.} = + # the hidden `self` parameter is also of type ``Custom`` + echo self.value + +## The constructed instance is of the provided custom instance type. +var instance = coro() +resume(instance) +doAssert typeof(instance) is Custom +doAssert instance.value == 0 diff --git a/tests/lang/s02_core/s99_coroutines/t16_generic_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t16_generic_coroutine.nim new file mode 100644 index 00000000000..6ac81f9a8ac --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t16_generic_coroutine.nim @@ -0,0 +1,12 @@ +discard """ + output: "1" +""" + +## A coroutine can be a generic routine. + +proc coro[T](x: T) {.coroutine.} = + echo x + +var instance = coro(1) +doAssert instance is Coroutine[int] +resume(instance) diff --git a/tests/lang/s02_core/s99_coroutines/t17_custom_generic_coroutine_instance_type.nim b/tests/lang/s02_core/s99_coroutines/t17_custom_generic_coroutine_instance_type.nim new file mode 100644 index 00000000000..74a9c3119a5 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t17_custom_generic_coroutine_instance_type.nim @@ -0,0 +1,11 @@ + +## The custom type to use for the coroutine instance can be generic too. + +type Custom[T] = ref object of Coroutine[void] + value: T + +proc coro[T]() {.coroutine: Custom[T].} = + discard + +var instance = coro[int]() +doAssert instance is Custom[int] diff --git a/tests/lang/s02_core/s99_coroutines/t18_closure_coroutine.nim b/tests/lang/s02_core/s99_coroutines/t18_closure_coroutine.nim new file mode 100644 index 00000000000..280b6aab0cd --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t18_closure_coroutine.nim @@ -0,0 +1,24 @@ + +## A coroutine can be an inner procedure that closes over locals of the outer +## procedure. + +proc outer() = + var x = 0 + + proc coro(): int {.closure, coroutine.} = + x = 1 + suspend() + result = x + + var instance = coro() + + doAssert x == 0 + resume(instance) + doAssert x == 1 + + # change the variable from the outer procedure + x = 2 + resume(instance) + doAssert finish(instance) == 2 + +outer() diff --git a/tests/lang/s02_core/s99_coroutines/t20_coroutine_type.nim b/tests/lang/s02_core/s99_coroutines/t20_coroutine_type.nim new file mode 100644 index 00000000000..f3c78acede9 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t20_coroutine_type.nim @@ -0,0 +1,18 @@ + +## A coroutine (not a coroutine *instance*) has a type itself. + +proc coro() {.coroutine.} = + discard + +doAssert coro is (proc() {.nimcall, coroutine.}) +doAssert coro isnot (proc(x: int) {.nimcall, coroutine.}) +doAssert coro isnot (proc(): int {.nimcall, coroutine.}) + +## Same as with non-coroutine procedural types, a coroutine procedural type +## without an explicit calling convention is a closure, by default. + +doAssert coro isnot (proc() {.coroutine.}) +doAssert (proc() {.coroutine.}) is (proc() {.closure, coroutine.}) + +## If the coroutine doesn't close over outer locals, it's not a closure +## coroutine. diff --git a/tests/lang/s02_core/s99_coroutines/t21_coroutine_value.nim b/tests/lang/s02_core/s99_coroutines/t21_coroutine_value.nim new file mode 100644 index 00000000000..532f1711da6 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t21_coroutine_value.nim @@ -0,0 +1,25 @@ + +# XXX: maybe coroutine values should be named "first-class coroutine symbol"? + +proc coro() {.coroutine.} = + discard + +## Coroutines can be assigned to locals... + +proc p() = + var local = coro + +## ... globals ... + +var global = coro + +## ... stored in aggregates ... + +var aggregate = (coro, 1) + +## ..., and passed as parameters + +proc test(param: proc() {.coroutine.}) = + discard + +test(coro) diff --git a/tests/lang/s02_core/s99_coroutines/t22_coroutine_value_usage.nim b/tests/lang/s02_core/s99_coroutines/t22_coroutine_value_usage.nim new file mode 100644 index 00000000000..e27a0681c84 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t22_coroutine_value_usage.nim @@ -0,0 +1,26 @@ +discard """ + output: "here\n1\n2" +""" + +## A coroutine value can be used the same way as the immediate symbol of a +## coroutine. + +proc coro() {.coroutine.} = + echo "here" + +let c = coro +resume(c()) + +## The same is true for closure coroutine values. + +proc make(): (proc() {.coroutine.}) = + var x = 1 + proc coro() {.coroutine.} = + echo x + inc x + + result = coro + +let cc = make() +resume(cc()) +resume(cc()) diff --git a/tests/lang/s02_core/s99_coroutines/t23_coroutine_forward_declaration.nim b/tests/lang/s02_core/s99_coroutines/t23_coroutine_forward_declaration.nim new file mode 100644 index 00000000000..9ec1e028d48 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t23_coroutine_forward_declaration.nim @@ -0,0 +1,22 @@ +discard """ + output: "1\nhere" +""" + +## Same as with normal routines, coroutines can be forward declared. + +proc coroInt(x: int): int {.coroutine.} +proc coroVoid() {.coroutine.} + +var instance = coroInt(1) +resume(instance) + +var instance2 = coroVoid() +resume(instance2) + +## Their body must be specified before the module is closed. + +proc coroInt(x: int): int {.coroutine.} = + echo x + +proc coroVoid() {.coroutine.} = + echo "here" diff --git a/tests/lang/s02_core/s99_coroutines/t24_coroutine_inner_procedure.nim b/tests/lang/s02_core/s99_coroutines/t24_coroutine_inner_procedure.nim new file mode 100644 index 00000000000..6d4025b9258 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t24_coroutine_inner_procedure.nim @@ -0,0 +1,28 @@ +## Coroutines can have inner procedures that close over the coroutines' +## locals. + +type Instance = ref object of Coroutine[int] + callback: proc(): int + +proc coro(): int {.coroutine: Instance.} = + var x = 1 + proc inner(): int = + result = x + inc x + + self.callback = inner + inc x + suspend() + + result = x + +## For coroutines, the created closure uses the instance type as it's +## environment, meaning that no extra allocation happens, and that the created +## closure keeps the coroutine instance alive. + +var instance = coro() +resume(instance) +doAssert instance.callback() == 2 + +resume(instance) +doAssert finish(instance) == 3 diff --git a/tests/lang/s02_core/s99_coroutines/t25_anonymous_coroutines.nim b/tests/lang/s02_core/s99_coroutines/t25_anonymous_coroutines.nim new file mode 100644 index 00000000000..3f623d72cb9 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t25_anonymous_coroutines.nim @@ -0,0 +1,8 @@ +## An anonymous routine be turned into a coroutine too. + +let coro = proc (x: int): int {.coroutine.} = + result = x + +var instance = coro(1) +resume(instance) +doAssert finish(instance) == 1 diff --git a/tests/lang/s02_core/s99_coroutines/t26_suspend_only_in_coroutines.nim b/tests/lang/s02_core/s99_coroutines/t26_suspend_only_in_coroutines.nim new file mode 100644 index 00000000000..fcb83ab3806 --- /dev/null +++ b/tests/lang/s02_core/s99_coroutines/t26_suspend_only_in_coroutines.nim @@ -0,0 +1,11 @@ +## The ``suspend`` routine can only be called within the immediate context of +## a coroutine. + +suspend() #[tt.Error + ^ 'suspend' is only allowed within a coroutine]# + +proc coro() {.coroutine.} = + proc inner() = + # not in the immediate context of a coroutine + suspend() #[tt.Error + ^ 'suspend' is only allowed within a coroutine]# diff --git a/tests/lang_callable/coroutine/tfor_with_inline_iterator.nim b/tests/lang_callable/coroutine/tfor_with_inline_iterator.nim new file mode 100644 index 00000000000..42b50f4323d --- /dev/null +++ b/tests/lang_callable/coroutine/tfor_with_inline_iterator.nim @@ -0,0 +1,21 @@ +discard """ + description: ''' + Ensure that inlining an inline iterator into a coroutine works. Suspending + within the for-loop must work + ''' + output: "1" +""" + +# echo is used to prevent doAssert from interfering with the +# transformation + +iterator iter(): int {.inline.} = + var x = 1 + yield x + echo x + +proc test() {.coroutine.} = + for it in iter(): + suspend(self) + +trampoline test() diff --git a/tests/lang_callable/coroutine/ttry_except_finally.nim b/tests/lang_callable/coroutine/ttry_except_finally.nim new file mode 100644 index 00000000000..78c97901f5a --- /dev/null +++ b/tests/lang_callable/coroutine/ttry_except_finally.nim @@ -0,0 +1,25 @@ +discard """ + description: ''' + Ensure that a basic try/except/finally within a coroutine works, with each + clause supporting being suspended from + ''' + output: "1\n2\n3" +""" + +import std/vmutils + +static: + vmTrace(true) + proc test() {.coroutine.} = + try: + echo "1" + suspend(self) + raise CatchableError.newException("a") + except CatchableError as e: + echo "2" + suspend(self) + finally: + echo "3" + suspend(self) + + trampoline test()