Added generator sequences

Basic hack of in-cycle and in-indexed
This commit is contained in:
Linus 2020-11-09 22:57:18 +01:00
parent 30b73286b3
commit 17d72f2cea
2 changed files with 71 additions and 7 deletions

View file

@ -35,7 +35,9 @@
(use-modules (helpers)
(srfi srfi-71))
((srfi srfi-1) #:select (circular-list))
(srfi srfi-71)
(rnrs io simple))
(define-aux-syntaxes
;; Auxiliary syntax for the loop clauses
@ -101,13 +103,9 @@
(cl orig name l a v c r f ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub (clauses ...) . body))
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub (:let* (id id* ... expr) clauses ...) . body)
(cl orig name l a v c r f ((cur-ul ... (:let* id id* ... expr)) . ul-rest) (clauses ...) . body))
;; Explicit subloop. Shorthand for (:when #t)
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub (:subloop clauses ...) . body)
(cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ub (clauses ...) . body))
;; :for-clauses
;; found a for clause when we have a :when or :unless clause. Push new subloop
((_ orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((for-rest ...) clauses ...) . body)

View file

@ -47,7 +47,7 @@
(n () () ((var init step)) (stop) () () . rest))))
(define-syntax in-list
(syntax-rules ()
(syntax-rules (:gen)
((_ ((var) source) next . rest)
(in-list ((var cursor) source) next . rest))
((_ ((var cursor) source) next . rest)
@ -71,9 +71,25 @@
;; final bindings: things bound in the final function.
()
;; the continuation.
. rest))))
. rest))
;; Generator-clauses
((_ lst)
(gen-list lst))
((_ :gen (var) (expr step))
(gen-list lst step))))
(define gen-list
(case-lambda
((lst)
(gen-list lst cdr))
((lst by)
(lambda ()
(if (null? lst)
(eof-object)
(let ((res (car lst)))
(set! lst (by lst))
res))))))
(define-syntax in-lists
@ -342,3 +358,53 @@
(syntax-rules ()
((multiplying args next . rest)
(accumulating (* (lambda (x) x) 1) args next . rest))))
;;; Here starts generator clauses.
(define (generator->list gen)
(let ((res (gen)))
(if (eof-object? res)
'()
(cons res (generator->list gen)))))
(define (generator-cycle gen)
(let ((circle (apply circular-list (generator->list gen))))
(lambda ()
(let ((res (car circle)))
(set! circle (cdr circle))
res))))
(define-syntax in-cycle
(syntax-rules ()
((_ ((id) (source)) n . rest)
(n ((gen (generator-cycle source)))
()
((id (gen) (gen)))
((eof-object? id))
()
()
. rest))))
(define (generator-indexed gen)
(let ((i 0))
(lambda ()
(let ((res (gen)) (index i))
(if (eof-object? res)
(values res res)
(begin
(set! i (+ i 1))
(values index res)))))))
;; Somewhat of a hack :)
(define-syntax in-indexed
(syntax-rules ()
((_ ((i val) (source)) n . rest)
(n ((gen (generator-indexed source)))
()
((i 0 i))
((eof-object? i))
((i val (gen)))
()
. rest))))