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:
parent
7311da2ec2
commit
93aa5aa439
2 changed files with 26 additions and 53 deletions
20
goof.scm
20
goof.scm
|
@ -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
|
||||||
|
|
|
@ -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))))
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue