Simplified the iterator protocol.

There is no need for :acc clauses to intoduce loop variables, or for :for clauses to introduce acc clauses.
They are now changed.

 * goof.scm (cl-next/acc cl-next/for): removed the unused matchings for loop-vars and acc-vars respectively.
 * goof/iterators.scm (all iterators): simplified it.
This commit is contained in:
Linus 2021-01-06 21:24:15 +01:00
parent 7311da2ec2
commit 93aa5aa439
2 changed files with 26 additions and 53 deletions

View file

@ -209,11 +209,11 @@
(define-syntax cl-next/acc (define-syntax cl-next/acc
(syntax-rules (:acc) (syntax-rules (:acc)
;; :acc clause without any subloops ;; :acc clause without any subloops
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name orig name
((lets ...)) ((lets ...))
((accs ...)) ((accs ...))
((vars ...)) vars
((checks ...)) ((checks ...))
((refs ...)) ((refs ...))
(finals ...) (finals ...)
@ -221,17 +221,17 @@
(cl orig name (cl orig name
((lets ... new-lets ...)) ((lets ... new-lets ...))
((accs ... (accvar accinit accupdate) ...)) ((accs ... (accvar accinit accupdate) ...))
((vars ... new-vars ...)) vars
((checks ... new-checks ...)) ((checks ... new-checks ...))
((refs ... new-refs ...)) ((refs ... new-refs ...))
(finals ... new-finals ...) (finals ... new-finals ...)
ff ul uw ub uf clauses . body)) ff ul uw ub uf clauses . body))
;; We have ONE subloop! ;; We have ONE subloop!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name orig name
(lets ... (outermost-lets ...)) (lets ... (outermost-lets ...))
((accs ...) ((oldacc oldinit oldupdate) ...)) ((accs ...) ((oldacc oldinit oldupdate) ...))
((vars ...) . vars-rest) vars
((checks ...) . checks-rest) ((checks ...) . checks-rest)
((refs ...) . refs-rest) ((refs ...) . refs-rest)
(finals ...) (finals ...)
@ -239,17 +239,17 @@
(cl orig name (cl orig name
(lets ... (outermost-lets ... new-lets ...)) (lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...)) ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest) vars
((checks ... new-checks ...) . checks-rest) ((checks ... new-checks ...) . checks-rest)
((refs ... new-refs ...) . refs-rest) ((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...) (finals ... new-finals ...)
ff ul uw ub uf clauses . body)) ff ul uw ub uf clauses . body))
;; We have several subloops! ;; We have several subloops!
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-finals ...) ((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
orig name orig name
(lets ... (outermost-lets ...)) (lets ... (outermost-lets ...))
((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...)) ((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...))
((vars ...) . vars-rest) vars
((checks ...) . checks-rest) ((checks ...) . checks-rest)
((refs ...) . refs-rest) ((refs ...) . refs-rest)
(finals ...) (finals ...)
@ -258,7 +258,7 @@
(lets ... (outermost-lets ... new-lets ...)) (lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ... ((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...)) ((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest) vars
((checks ... new-checks ...) . checks-rest) ((checks ... new-checks ...) . checks-rest)
((refs ... new-refs ...) . refs-rest) ((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...) (finals ... new-finals ...)
@ -268,7 +268,7 @@
;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop ;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop
(define-syntax cl-next/for (define-syntax cl-next/for
(syntax-rules () (syntax-rules ()
((_ (new-lets ...) () (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...) ((_ (new-lets ...) (new-vars ...) (new-checks ...) (new-refs ...) (new-for-finals ...)
orig name orig name
((lets ...) . lets-rest) ((lets ...) . lets-rest)
accs accs

View file

@ -28,23 +28,15 @@
;; TODO iterators ;; TODO iterators
;; in-stream ;; in-stream
;; in-naturals
;; in-hash with variations
;; TODO: accumulators
;; vectoring
;; hashing
;; hashqing
;; hashving
(define-syntax in (define-syntax in
(syntax-rules () (syntax-rules ()
((_ ((var) (init)) n . rest) ((_ ((var) (init)) n . rest)
(n () () ((var init var)) () () () . rest)) (n () ((var init var)) () () () . rest))
((_ ((var) (init step)) n . rest) ((_ ((var) (init step)) n . rest)
(n () () ((var init step)) () () () . rest)) (n () ((var init step)) () () () . rest))
((_ ((var) (init step stop)) n . rest) ((_ ((var) (init step stop)) n . rest)
(n () () ((var init step)) (stop) () () . rest)))) (n () ((var init step)) (stop) () () . rest))))
(define-syntax in-list (define-syntax in-list
(syntax-rules (:gen) (syntax-rules (:gen)
@ -58,9 +50,6 @@
(next (next
;; outer let bindings, bound outside the loop, unchanged during the loop ;; outer let bindings, bound outside the loop, unchanged during the loop
() ()
;; accumulators. These are the same as the bindings below, but values are
;; kept through subloops.
()
;; iterator, init, step ;; iterator, init, step
((cursor source succ)) ((cursor source succ))
;; tests to check whether the iterator is exhausted. ;; tests to check whether the iterator is exhausted.
@ -106,7 +95,6 @@
(in-lists ((elts pairs succ) (lol step null?)) next . rest)) (in-lists ((elts pairs succ) (lol step null?)) next . rest))
((in-lists ((elts pairs succ) (lol step done?)) next . rest) ((in-lists ((elts pairs succ) (lol step done?)) next . rest)
(next () (next ()
()
((pairs lol succ)) ((pairs lol succ))
((let lp ((ls pairs)) ; an in-lined ANY ((let lp ((ls pairs)) ; an in-lined ANY
(and (pair? ls) (if (done? (car ls)) #t (lp (cdr ls)))))) (and (pair? ls) (if (done? (car ls)) #t (lp (cdr ls))))))
@ -145,7 +133,6 @@
(%in-idx ge + s e r tmp ((var index) (seq from (e tmp))) next . rest)) (%in-idx ge + s e r tmp ((var index) (seq from (e tmp))) next . rest))
((%in-idx ge + s e r tmp ((var index) (seq from to)) next . rest) ((%in-idx ge + s e r tmp ((var index) (seq from to)) next . rest)
(next ((tmp seq) (end to)) (next ((tmp seq) (end to))
()
((index from (+ tmp index))) ((index from (+ tmp index)))
((ge index end)) ((ge index end))
((var (r tmp index))) ((var (r tmp index)))
@ -165,7 +152,6 @@
(in-port ((var p) (port read-char eof-object?)) next . rest)) (in-port ((var p) (port read-char eof-object?)) next . rest))
((in-port ((var p) (port reader eof?)) next . rest) ((in-port ((var p) (port reader eof?)) next . rest)
(next ((p port)) (next ((p port))
()
((var (reader p) (reader p))) ((var (reader p) (reader p)))
((eof? var)) ((eof? var))
() ()
@ -182,7 +168,6 @@
(in-file ((var p) (file reader eof-object?)) next . rest)) (in-file ((var p) (file reader eof-object?)) next . rest))
((in-file ((var p) (file reader eof?)) next . rest) ((in-file ((var p) (file reader eof?)) next . rest)
(next ((p (open-input-file file)) (r reader) (e? eof?)) (next ((p (open-input-file file)) (r reader) (e? eof?))
()
((var (r p) (r p))) ((var (r p) (r p)))
((e? var)) ((e? var))
() ()
@ -192,7 +177,6 @@
(syntax-rules () (syntax-rules ()
((_ ((var) (source)) next . rest) ((_ ((var) (source)) next . rest)
(next ((gen source)) (next ((gen source))
()
((var (gen) (gen))) ((var (gen) (gen)))
((eof-object? var)) ((eof-object? var))
() ()
@ -205,22 +189,21 @@
(up-from ((var) . args) next . rest)) (up-from ((var) . args) next . rest))
((up-from ((var) (start (to limit) (by step))) next . rest) ((up-from ((var) (start (to limit) (by step))) next . rest)
(next ((s start) (l limit) (e step)) (next ((s start) (l limit) (e step))
()
((var s (+ var e))) ((var s (+ var e)))
((>= var l)) ((>= var l))
() () . rest)) () () . rest))
((up-from ((var) (start (to limit))) next . rest) ((up-from ((var) (start (to limit))) next . rest)
(next ((s start) (l limit)) () ((var s (+ var 1))) (next ((s start) (l limit)) ((var s (+ var 1)))
((>= var l)) () () . rest)) ((>= var l)) () () . rest))
((up-from ((var) (start (by step))) next . rest) ((up-from ((var) (start (by step))) next . rest)
(next ((s start) (e step))() (next ((s start) (e step))
((var s (+ var e))) () () () . rest)) ((var s (+ var e))) () () () . rest))
((up-from ((var) (start)) next . rest) ((up-from ((var) (start)) next . rest)
(next ((s start)) () ((var s (+ var 1))) (next ((s start)) ((var s (+ var 1)))
() () () . rest)) () () () . rest))
;; Extra convenience, make it act like (in-range ...) from racket, but only for positive numbers. ;; Extra convenience, make it act like (in-range ...) from racket, but only for positive numbers.
((up-from ((var) (start limit step)) next . rest) ((up-from ((var) (start limit step)) next . rest)
(next ((s start) (l limit) (e step)) () ((var s (+ var e))) ((>= var l)) () () . rest)) (next ((s start) (l limit) (e step)) ((var s (+ var e))) ((>= var l)) () () . rest))
((up-from ((var) (start limit)) next . rest) ((up-from ((var) (start limit)) next . rest)
(up-from ((var) (start limit 1)) next . rest)))) (up-from ((var) (start limit 1)) next . rest))))
@ -230,21 +213,20 @@
(down-from ((var) . args) next . rest)) (down-from ((var) . args) next . rest))
((down-from ((var) (start (to limit) (by step))) next . rest) ((down-from ((var) (start (to limit) (by step))) next . rest)
(next ((s start) (l limit) (e step)) (next ((s start) (l limit) (e step))
()
((var (- s e) (- var e))) ((var (- s e) (- var e)))
((< var l)) ((< var l))
() () . rest)) () () . rest))
((down-from ((var) (start (to limit))) next . rest) ((down-from ((var) (start (to limit))) next . rest)
(next ((s start) (l limit)) () ((var (- s 1) (- var 1))) (next ((s start) (l limit)) ((var (- s 1) (- var 1)))
((< var l)) () () . rest)) ((< var l)) () () . rest))
((down-from ((var) (start (by step))) next . rest) ((down-from ((var) (start (by step))) next . rest)
(next ((s start) (e step)) () ((var (- s e) (- var e))) (next ((s start) (e step)) ((var (- s e) (- var e)))
() () () . rest)) () () () . rest))
((down-from ((var) (start)) next . rest) ((down-from ((var) (start)) next . rest)
(next ((s start)) () ((var (- s 1) (- var 1))) (next ((s start)) ((var (- s 1) (- var 1)))
() () () . rest)) () () () . rest))
((down-from ((var) (start limit step)) next . rest) ((down-from ((var) (start limit step)) next . rest)
(next ((s start) (l limit) (e step)) () ((var (- s e) (- var e))) ((< var l)) () () . rest)) (next ((s start) (l limit) (e step)) ((var (- s e) (- var e))) ((< var l)) () () . rest))
((down-from ((var) (start limit)) next . rest) ((down-from ((var) (start limit)) next . rest)
(down-from ((var) (start limit 1)) next . rest)))) (down-from ((var) (start limit 1)) next . rest))))
@ -253,7 +235,6 @@
(syntax-rules () (syntax-rules ()
((_ ((bindings) (expr)) n . rest) ((_ ((bindings) (expr)) n . rest)
(n (n
()
() ()
((cursor (hash-map->list cons expr) (cdr cursor))) ((cursor (hash-map->list cons expr) (cdr cursor)))
((not (pair? cursor))) ((not (pair? cursor)))
@ -273,7 +254,6 @@
((cursor init (if check (tmp-kons expr cursor) cursor))) ((cursor init (if check (tmp-kons expr cursor) cursor)))
() ()
() ()
()
((var (final cursor))) ((var (final cursor)))
. rest)) . rest))
((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest) ((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest)
@ -281,7 +261,6 @@
((cursor init (tmp-kons expr cursor))) ((cursor init (tmp-kons expr cursor)))
() ()
() ()
()
((var (final cursor))) ((var (final cursor)))
. rest)))) . rest))))
@ -290,7 +269,7 @@
((_ :acc ((var) (init update (if guard))) n . rest) ((_ :acc ((var) (init update (if guard))) n . rest)
(n () (n ()
((var init (if guard update var))) ((var init (if guard update var)))
() () () () ()
((var var)) ((var var))
. rest)) . rest))
((_ :acc ((var) (init update)) n . rest) ((_ :acc ((var) (init update)) n . rest)
@ -352,7 +331,6 @@
((dummy (if #f #f) (if guard (setter hash key value) (if #f #f)))) ((dummy (if #f #f) (if guard (setter hash key value) (if #f #f))))
() ()
() ()
()
((var hash)) ((var hash))
. rest))))))) . rest)))))))
@ -389,7 +367,6 @@
((index 0 (+ index 1)) (var (make-vector 32) (vector-set!? var index expr))) ((index 0 (+ index 1)) (var (make-vector 32) (vector-set!? var index expr)))
() ()
() ()
()
((var (vector-shrink? var index))) ((var (vector-shrink? var index)))
. rest)) . rest))
((_ :acc ((var index) (expr (:length len))) n . rest) ((_ :acc ((var index) (expr (:length len))) n . rest)
@ -404,7 +381,6 @@
((index 0 (begin (vector-set! var index expr) (+ index 1)))) ((index 0 (begin (vector-set! var index expr) (+ index 1))))
() ()
() ()
()
((var var)) ((var var))
o n l a v c r fi ff ul uw ((ub ... (= index len)) . ub-rest) uf o n l a v c r fi ff ul uw ((ub ... (= index len)) . ub-rest) uf
. rest)))) . rest))))
@ -428,7 +404,6 @@
(syntax-rules () (syntax-rules ()
((_ ((id) (source)) n . rest) ((_ ((id) (source)) n . rest)
(n ((gen (generator-cycle source))) (n ((gen (generator-cycle source)))
()
() ()
() ()
((id (gen))) ((id (gen)))
@ -444,16 +419,14 @@
(values res res) (values res res)
(begin (begin
(set! i (+ i 1)) (set! i (+ i 1))
(values index res))))))) (cons index res)))))))
;; Somewhat of a hack :)
(define-syntax in-indexed (define-syntax in-indexed
(syntax-rules () (syntax-rules ()
((_ ((i val) (source)) n . rest) ((_ ((binding) (source)) n . rest)
(n ((gen (generator-indexed source))) (n ((gen (generator-indexed source)))
() ((i (gen) (gen)))
((i 0 i))
((eof-object? i)) ((eof-object? i))
((i val (gen))) ((binding i))
() ()
. rest)))) . rest))))