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 . 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 (define-syntax cl
(syntax-rules (=> :for :acc :when :unless :break :final :let :let* :subloop) (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) ((_ 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) ((_ () (stars ...) ((:let* id id* ... expr) clauses ...) . body)
(user-let () (stars ... (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 (define-syntax emit
(syntax-rules () (syntax-rules ()
((_ orig name (one) . rest) ((_ orig name (one) . rest)
@ -300,10 +300,9 @@
(((ff-cur ...) (ff-above ...))) (((ff-cur ...) (ff-above ...)))
((user-lets ...)) ((user-whens ...)) ((user-breaks ...)) uf ((user-lets ...)) ((user-whens ...)) ((user-breaks ...)) uf
final-expr . body) final-expr . body)
(let* (lets ...) (let* ((final-fun (lambda (final-binding ...) final-expr))
(define (final-fun final-binding ...) lets ...)
final-expr) (let loop ((accvar accinit) ... (var init) ...)
(define (loopy-loop accvar ... var ...)
(if (or checks ...) (if (or checks ...)
(begin (begin
ff-cur ... ff-cur ...
@ -314,15 +313,14 @@
(let-kw-form name (let-kw-form name
(final-fun final-value ...) (final-fun final-value ...)
uf uf
(loopy-loop (accvar accstep) ... (var step) ...) (loop (accvar accstep) ... (var step) ...)
(cond (cond
((or user-breaks ...) ((or user-breaks ...)
ff-above ... ff-cur ... ff-above ... ff-cur ...
(final-fun final-value ...)) (final-fun final-value ...))
(else (else
(let () (if #f #f) . body)))) (let () (if #f #f) . body))))
(loopy-loop accvar ... step ...) ))))) (loop accvar ... step ...) )))))))))
(loopy-loop accinit ... init ...)))))
;; Emit-many/first emits the outermost let loop and binds the final lambda. ;; Emit-many/first emits the outermost let loop and binds the final lambda.
(define-syntax emit-many/first (define-syntax emit-many/first