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

fix folding, add :continue

Browse source 
Fix foldig to be an :acc version of in.

:continue will stop the subloop and start the next iteration of the
outer loop
This commit is contained in:
Linus Björnstam 2023-10-30 21:56:54 +01:00
parent 5668706b88
commit a47d6d992b
3 changed files with 31 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

10
goof.scm
View file

@ -47,7 +47,7 @@
loop/or
loop/list/parallel
:when :unless :break :final :bind :subloop :do :for :acc
:when :unless :break :continue :final :bind :subloop :do :for :acc
:initial
:length :fill
:to :by
@ -107,8 +107,8 @@
#'in-cycle
#'in-indexed
#'stop-before
#'stop-after
)))
#'stop-after)))
(define valid-acc-clauses (make-parameter (list #'folding
#'listing
#'listing-reverse
@ -119,8 +119,8 @@
#'hashing
#'hashving
#'hashqing
#'vectoring
)))
#'vectoring)))
(define (add-clause type form)
(cond ((eq? type 'for)

18
goof/goof-impl.scm
View file

@ -29,7 +29,7 @@
(define-aux-syntaxes
;; Auxiliary syntax for the loop clauses
:when :unless :break :final :bind :do :subloop :for :acc
:when :unless :break :final :continue :bind :do :subloop :for :acc
;; Auxiliary syntax for the iterators.
:gen
;; auxiliary syntax for some accumulators
@ -122,7 +122,7 @@
;; cl sorts all the clauses into subloops and positions everything where it should be.
(define-syntax cl
(syntax-rules (=> :for :acc :when :unless :break :final :do :bind :subloop)
(syntax-rules (=> :for :acc :when :unless :break :continue :final :do :bind :subloop)
((_ orig name l a v c r f ff user () => expr . body)
(emit orig name l a v c r f ff user expr . body))
((_ orig name l a v c r () ff user () . body)
@ -150,6 +150,10 @@
((_ orig name l a v c r f ff ((cur-user ...) . user-rest) ((:final expr) clauses ...) . body)
(final :acc ((fin) (expr)) cl-next/acc orig name l a v c r f ff ((cur-user ... (:break fin)) . user-rest) (clauses ...) . body))
;; USER continue
((_ orig name l a v c r f ff ((cur-co ...) . co-rest) ((:continue expr) clauses ...) . body)
(cl orig name l a v c r f ff ((cur-co ... (:continue expr)) . co-rest) (clauses ...) . body))
;; User do - sideffecting stuff.
((_ orig name l a v c r f ff ((cur-uw ...) . uw-rest) ((:do expr ...) clauses ...) . body)
(cl orig name l a v c r f ff ((cur-uw ... (:do expr ...)) . uw-rest) (clauses ...) . body))
@ -267,7 +271,7 @@
;; User is responsible for all non-acc/non-for clauses.
(define-syntax user
(syntax-rules (:when :bind :break :do :nop)
(syntax-rules (:when :bind :break :continue :do :nop)
((_ final-expr next outer () . body)
(begin . body))
((_ f n o (:nop . rest) . body)
@ -283,6 +287,10 @@
(cond
(expr final-expr ...)
(else (user (final-expr ...) n o rest . body))))
((_ f n outer ((:continue expr) . rest) . body)
(cond
(expr outer)
(else (user f n outer rest . body))))
((_ f n o ((:do expr ...) . rest) . body)
(begin
expr ...
@ -397,7 +405,7 @@
(ref-let (refs ...)
(user (ff-cur ... ff-above ... final)
(innermost-loop accstep ... step ...)
#f
outer
(us ...)
(let-kw-form name final () (innermost-loop (accvar accstep) ... (var step) ...)
. body)))))))
@ -425,7 +433,7 @@
(ref-let (refs ...)
(user (ff-cur ... ff-above ... final)
(intermediate-loop accstep ... step ...)
#f
outer
(us ...)
(emit-many/rest orig
name

21
goof/iterators.scm
View file

@ -30,7 +30,7 @@
;; in-stream
(define-syntax in
(syntax-rules ()
(syntax-rules (:for)
((in :for ((var) (init)) n . rest)
(n () ((var init var)) () () () . rest))
((in :for ((var) (init step)) n . rest)
@ -393,18 +393,23 @@
((var (final cursor)))
. rest))))
;; This looks wonky because it needs to reset var to the init value when the loop is re-entered
;; if it is a subloop. It does so by also binding var to folding-init in the outer binding of the current
;; loop. It has to do this because :acc clauses propagates all acc bindings to outside
;; the outermost loop.
(define-syntax folding
(syntax-rules (if :acc)
((_ :acc ((var) (init update (if guard))) n . rest)
(n ()
((var init (if guard update var)))
() ()
(syntax-rules (:acc)
((_ :acc ((var) (init update stop)) n orig name ((lets ...) . l-rest) . rest)
(n ((folding-init init))
((var folding-init update))
(stop) ()
((var var))
orig name ((lets ... (var folding-init)) . l-rest)
. rest))
((_ :acc ((var) (init update)) n . rest)
(folding :acc ((var) (init update (if #t))) n . rest))
(folding :acc ((var) (init update #f)) n . rest))
((_ :acc ((var) (init)) n . rest)
(folding :acc ((var) (init var (if #t))) n . rest))))
(folding :acc ((var) (init var #f)) n . rest))))
(define-syntax listing
(syntax-rules (:acc)