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

Clarified expansion

Browse source 
The expansion of (loop ...) without subloops is now the same as loop
with subloops.
This commit is contained in:
Linus 2021-03-11 14:35:07 +01:00
parent f90d83b6a0
commit 79b7c4eedd
1 changed files with 7 additions and 9 deletions
Download patch file Download diff file Expand all files Collapse all files

16
goof-impl.scm
View file

@ -118,7 +118,7 @@
clauses . body))))
;; Clauses 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
(syntax-rules (=> :for :acc :when :unless :break :final :let :let* :subloop)
((_ orig name l a v c r f ff ul uw ub uf () => expr . body)
@ -280,7 +280,7 @@
((_ () (stars ...) ((:let* id id* ... expr) clauses ...) . body)
(user-let () (stars ... (id id* ... expr)) (clauses ...) . body))))
;; If there is no subloops, we emit to the simple case
;; If there are no subloops, we emit to the simple case
(define-syntax emit
(syntax-rules ()
((_ orig name (one) . rest)
@ -300,10 +300,9 @@
(((ff-cur ...) (ff-above ...)))
((user-lets ...)) ((user-whens ...)) ((user-breaks ...)) uf
final-expr . body)
(let* (lets ...)
(define (final-fun final-binding ...)
final-expr)
(define (loopy-loop accvar ... var ...)
(let* ((final-fun (lambda (final-binding ...) final-expr))
lets ...)
(let loop ((accvar accinit) ... (var init) ...)
(if (or checks ...)
(begin
ff-cur ...
@ -314,15 +313,14 @@
(let-kw-form name
(final-fun final-value ...)
uf
(loopy-loop (accvar accstep) ... (var step) ...)
(loop (accvar accstep) ... (var step) ...)
(cond
((or user-breaks ...)
ff-above ... ff-cur ...
(final-fun final-value ...))
(else
(let () (if #f #f) . body))))
(loopy-loop accvar ... step ...) )))))
(loopy-loop accinit ... init ...)))))
(loop accvar ... step ...) )))))))))
;; Emit-many/first emits the outermost let loop and binds the final lambda.
(define-syntax emit-many/first