bjoli/goof-loop
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Simplified the iterator protocol.

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

20
goof.scm
View file

@ -209,11 +209,11 @@
(define-syntax cl-next/acc
(syntax-rules (:acc)
;; :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
((lets ...))
((accs ...))
((vars ...))
vars
((checks ...))
((refs ...))
(finals ...)
@ -221,17 +221,17 @@
(cl orig name
((lets ... new-lets ...))
((accs ... (accvar accinit accupdate) ...))
((vars ... new-vars ...))
vars
((checks ... new-checks ...))
((refs ... new-refs ...))
(finals ... new-finals ...)
ff ul uw ub uf clauses . body))
;; 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
(lets ... (outermost-lets ...))
((accs ...) ((oldacc oldinit oldupdate) ...))
((vars ...) . vars-rest)
vars
((checks ...) . checks-rest)
((refs ...) . refs-rest)
(finals ...)
@ -239,17 +239,17 @@
(cl orig name
(lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest)
vars
((checks ... new-checks ...) . checks-rest)
((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...)
ff ul uw ub uf clauses . body))
;; 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
(lets ... (outermost-lets ...))
((accs ...) ((oldacc oldinit oldupdate) ...) ... ((oldestacc oldestinit oldestupdate) ...))
((vars ...) . vars-rest)
vars
((checks ...) . checks-rest)
((refs ...) . refs-rest)
(finals ...)
@ -258,7 +258,7 @@
(lets ... (outermost-lets ... new-lets ...))
((accs ... (accvar accvar accupdate) ...) ((oldacc oldinit oldupdate) ... (accvar accvar accvar) ...) ...
((oldestacc oldestinit oldestupdate) ... (accvar accinit accvar) ...))
((vars ... new-vars ...) . vars-rest)
vars
((checks ... new-checks ...) . checks-rest)
((refs ... new-refs ...) . refs-rest)
(finals ... new-finals ...)
@ -268,7 +268,7 @@
;; loop. Any propagation of for finalizers (ff) is done by push-new-subloop
(define-syntax cl-next/for
(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
((lets ...) . lets-rest)
accs

59
goof/iterators.scm
View file

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