From 590ef97a4e5c6738accc97db6c441de9ce804bfa Mon Sep 17 00:00:00 2001 From: Linus Date: Mon, 1 Mar 2021 22:02:58 +0100 Subject: [PATCH] First commit. I found this code on my hdd. I wrote it while drunk, and I don't remember writing it. When I tried to extend it, I broke a lot of things but now I brought it back to basic. I believe it works. --- README.md | 88 ++++++++++++++++++ awesome-coroutine-generators/base.scm | 126 ++++++++++++++++++++++++++ 2 files changed, 214 insertions(+) create mode 100644 README.md create mode 100644 awesome-coroutine-generators/base.scm diff --git a/README.md b/README.md new file mode 100644 index 0000000..f9567eb --- /dev/null +++ b/README.md @@ -0,0 +1,88 @@ + # awesome-coroutine-generators + +Welcome. Did you ever feel limited by the strict dogma of srfi-158 generators? Me neither. I just read Mark's thoughts about srfi-158 and thought I would implement them properly. This library is multi-way incompatible with srfi-158. + +They allow you to write coroutine generators without having to deal with any nitty gritty details: + +``` +(import (awesome-coroutine-generators base)) +(define simple-gen + (simple-generator + (let loop ((a 0)) + (when (< a 100) + (yield a) + (loop (+ a 1)))) + "Happy end!")) + +;; We can now call a and it will yield the values 0 to 99. +(simple-gen) ;; => 0 +(simple-gen) ;; => 1 +... +(simple-gen) ;; => 99 +(simple-gen) ;; => #< list-of-returned-values ("Happy end!")> + +;; This looks very much like the coroutine-generators of srfi-158, but wait, there is more: + +(define g + (generator (a b) + (let loop ((a a) (b b)) + (yield a) + (loop b (+ a b))))) + +;; prime the generator (if we use 1 1 it will generate the common fibonacci sequence) +(g 2 1) +;; Now it yields lucas numbers. +(g) ; => 2 +(g) ; => 1 +(g) ; => 3 + +;; +;; We can also pass values INTO the generator + +(define g + (generator () + (let loop ((start (yield))) + (when (>= start 0) + (yield start) + (loop (- start 1)))))) + +;; First, prime the generator. This is done to reach the point where it accepts +;; input: +(g) +;; Then we pass start into it: +(g 2) +(g) ; => 2 +(g) ; => 1 +(g) ; => 0 +(g) ; + +;; We can also pass control over to another generator + +(define generate-3-values + (generator () + (let ((next (yield 1))) + (yield next) + (yield 'the-end)))) + +(define g + (generator (g2) + (yield-from g2) + (yield "banana"))) + +(g generate-3-values) +(g) ;; => 1 +(g 55) ; => 55 +(g) ; => 'the-end +(g) ; => "banana" + + +``` +# Details +(yield ...) returns a "none"-value if no values are passed into the generator. You can test for it by using the none? procedure. Doing anything with this value unless testing if it is returned from yield is stupid. + +# Make it better? +I would prefer to have an API more like python and make it possible to be more explicit about when you pass values in or out. This works though. + +# Licence +Public domain, or CC0. Whichever work best in your jurisdiction. If you build something from this, i'd be delighted to be mentioned by name. + diff --git a/awesome-coroutine-generators/base.scm b/awesome-coroutine-generators/base.scm new file mode 100644 index 0000000..87787c4 --- /dev/null +++ b/awesome-coroutine-generators/base.scm @@ -0,0 +1,126 @@ +;; I, Linus Björnstam, release this into the public domain. +;; If public domain is not applicable in your jurisdiction +;; you may use this under the Creative Commons 0 licence. +;; I hope you have fun, though. + +(define-module (awesome-coroutine-generators base) + #:use-module (ice-9 receive) + #:use-module (srfi srfi-9) + #:replace (yield) ;; why is this necessary? shouldn't yield be in ice-9 threads? + #:export (generator-end? + generator-end-values + yield + yield-from + current-yielder + %tag + + maybe-none + + none? + + make-generator + make-simple-generator + generator + simple-generator)) + +(define-record-type + (make-generator-end end-values) + generator-end? + (end-values generator-end-values)) + +(define-record-type + (make-none) %none?) + +;; the none value is not exported +(define the-none (make-none)) +(define (none? x) + (eq? x the-none)) + +(define %tag (make-prompt-tag)) + +(define current-yielder + (make-parameter (lambda vals (apply abort-to-prompt %tag vals)))) + +(define (%yield . args) + (apply (current-yielder) args)) + +(define-syntax-parameter yield + (lambda (stx) + (syntax-violation 'yield "Yield used outside of a generator" stx))) + +(define (make-generator proc) + (define (run . args) + (receive vals (apply proc args) + (if (none? (car vals)) + (make-generator-end '()) + (make-generator-end vals)))) + (lambda args + (call-with-prompt %tag + (lambda () (apply run args)) + (lambda (k . ret) + (set! run k) + (apply values ret))))) + +(define (make-simple-generator proc) + (define (run) + (proc) + (make-generator-end (if #f #f))) + (lambda () + (call-with-prompt %tag + run + (lambda (k ret) + (set! run k) + ret)))) + +(define-syntax generator + (syntax-rules () + ((_ formals body body* ...) + (let ((run (lambda formals + (receive ret-vals + (syntax-parameterize ((yield (syntax-rules () + ((yield vals (... ...)) (%yield vals (... ...)))))) + (let () + body body* ...)) + (if (or (null? ret-vals) (none? (car ret-vals))) + (make-generator-end '()) + (make-generator-end ret-vals)))))) + (lambda args + (call-with-prompt %tag + (lambda () (apply run args)) + (lambda (k . ret) + (set! run k) + (apply values ret)))))))) + +(define-syntax simple-generator + (syntax-rules () + ((_ body body* ...) + (let ((run (lambda () body body* ... (make-generator-end (if #f #f))))) + (lambda () + (call-with-prompt %tag + run + (lambda (k val) + (set! run k) + val))))))) + +(define-syntax maybe-none + (syntax-rules () + ((_ expr) + (maybe-none 1 expr)) + ((_ no expr) + (receive vals expr + (if (pair? vals) + (apply values vals) + (apply values (map (lambda (x) the-none) (iota no)))))))) + +;; In a perfect world, I would be intelligent enough to write this +;; in an efficient way. +(define (yield-from g) + (define (int . vals) + (cond ((and (pair? vals) (generator-end? (car vals))) + (car vals)) + (else + (receive vals2 (apply %yield vals) + (receive vals3 (apply g vals2) + (apply int vals3)))))) + + (call-with-values int g))