Added generator sequences
Basic hack of in-cycle and in-indexed
This commit is contained in:
parent
30b73286b3
commit
17d72f2cea
2 changed files with 71 additions and 7 deletions
8
goof.scm
8
goof.scm
|
@ -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)
|
||||
|
|
|
@ -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))))
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue