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

18
goof/goof-impl.scm
View file

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

21
goof/iterators.scm
View file

@ -30,7 +30,7 @@
;; in-stream ;; in-stream
(define-syntax in (define-syntax in
(syntax-rules () (syntax-rules (:for)
((in :for ((var) (init)) n . rest) ((in :for ((var) (init)) n . rest)
(n () ((var init var)) () () () . rest)) (n () ((var init var)) () () () . rest))
((in :for ((var) (init step)) n . rest) ((in :for ((var) (init step)) n . rest)
@ -393,18 +393,23 @@
((var (final cursor))) ((var (final cursor)))
. rest)))) . 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 (define-syntax folding
(syntax-rules (if :acc) (syntax-rules (:acc)
((_ :acc ((var) (init update (if guard))) n . rest) ((_ :acc ((var) (init update stop)) n orig name ((lets ...) . l-rest) . rest)
(n () (n ((folding-init init))
((var init (if guard update var))) ((var folding-init update))
() () (stop) ()
((var var)) ((var var))
orig name ((lets ... (var folding-init)) . l-rest)
. rest)) . rest))
((_ :acc ((var) (init update)) n . 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) ((_ :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 (define-syntax listing
(syntax-rules (:acc) (syntax-rules (:acc)