Made sure loop loops
Fix subloop :acc semantics. clarify code comments.
This commit is contained in:
parent
307240383a
commit
189f1d045d
1 changed files with 10 additions and 13 deletions
|
@ -48,19 +48,17 @@
|
||||||
|
|
||||||
(include "goof/iterators.scm")
|
(include "goof/iterators.scm")
|
||||||
|
|
||||||
|
;; This first step saves the original syntax.
|
||||||
(define-syntax loop
|
(define-syntax loop
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((loop . rest)
|
((loop . rest)
|
||||||
(%loop (loop . rest) . rest))))
|
(%loop (loop . rest) . rest))))
|
||||||
|
|
||||||
|
|
||||||
|
;; This second step adds a loop name and makes sure it loops
|
||||||
|
;; A loop form without name or clauses will run forever.
|
||||||
(define-syntax %loop
|
(define-syntax %loop
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
((%loop o () body ...)
|
|
||||||
(%loop o ((:for ensure-once (up-from 0 1))) body ...))
|
|
||||||
((%loop o name () body ...)
|
|
||||||
(%loop o name ((:for ensure-once (up-from 0 1))) body ...))
|
|
||||||
((%loop o (clauses ...) body ...)
|
((%loop o (clauses ...) body ...)
|
||||||
(cl o outer-loop
|
(cl o outer-loop
|
||||||
(()) (()) (()) (()) (()) () ((() ())) (())
|
(()) (()) (()) (()) (()) () ((() ())) (())
|
||||||
|
@ -71,8 +69,8 @@
|
||||||
clauses . body))))
|
clauses . body))))
|
||||||
|
|
||||||
|
|
||||||
;; This ensures that the first subloop has at least ONE for clause. If none is found
|
;; This is only here for simplified forms with an identity. If the loop has no :for-clause in the
|
||||||
;; we add a dummy one!
|
;; outermost loop, we add a dummy one so that the first part is executed once.
|
||||||
(define-syntax ensure-for-clause
|
(define-syntax ensure-for-clause
|
||||||
(syntax-rules (:for :acc :break :subloop :when :unless :final DONE)
|
(syntax-rules (:for :acc :break :subloop :when :unless :final DONE)
|
||||||
((_ DONE clauses () orig name . body)
|
((_ DONE clauses () orig name . body)
|
||||||
|
@ -216,7 +214,7 @@
|
||||||
checks
|
checks
|
||||||
((refs ... new-refs ...) . refs-rest)
|
((refs ... new-refs ...) . refs-rest)
|
||||||
(finals ... new-finals ...)
|
(finals ... new-finals ...)
|
||||||
ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))
|
ff ((cur-ub ... (:bind (accvar accupdate) ...) (:break new-checks) ... ) . ub-rest) clauses . body))
|
||||||
;; We have several subloops!
|
;; We have several subloops!
|
||||||
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
|
((_ (new-lets ...) ((accvar accinit accupdate) ...) (new-checks ...) (new-refs ...) (new-finals ...)
|
||||||
orig name
|
orig name
|
||||||
|
@ -235,7 +233,7 @@
|
||||||
checks
|
checks
|
||||||
((refs ... new-refs ...) . refs-rest)
|
((refs ... new-refs ...) . refs-rest)
|
||||||
(finals ... new-finals ...)
|
(finals ... new-finals ...)
|
||||||
ff ((cur-ub ... (:break new-checks) ... (:bind (accvar accupdate) ...)) . ub-rest) clauses . body))))
|
ff ((cur-ub ...(:bind (accvar accupdate) ...) (:break new-checks) ...) . ub-rest) clauses . body))))
|
||||||
|
|
||||||
;; Integrating for clauses is not as involved, since they only want to be introduced into the current
|
;; Integrating for clauses is not as involved, since they only want to be introduced into the current
|
||||||
;; 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
|
||||||
|
@ -263,11 +261,11 @@
|
||||||
((cl err ...)
|
((cl err ...)
|
||||||
(cl err ...))))
|
(cl err ...))))
|
||||||
|
|
||||||
|
;; 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 :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)
|
||||||
(user f n o rest . body))
|
(user f n o rest . body))
|
||||||
((_ f n o ((:bind pairs ...) . rest) . body)
|
((_ f n o ((:bind pairs ...) . rest) . body)
|
||||||
|
@ -287,7 +285,6 @@
|
||||||
(user f n o rest . body)))))
|
(user f n o rest . body)))))
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
;; If there are no subloops, we emit to the simple case
|
;; If there are no subloops, we emit to the simple case
|
||||||
(define-syntax emit
|
(define-syntax emit
|
||||||
(syntax-rules ()
|
(syntax-rules ()
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue