diff options
| -rw-r--r-- | csc/loop.csc | 63 |
1 files changed, 28 insertions, 35 deletions
diff --git a/csc/loop.csc b/csc/loop.csc index 69f9201..f07deae 100644 --- a/csc/loop.csc +++ b/csc/loop.csc @@ -35,7 +35,8 @@ ((loop loop-clauses* ...) (let ((list-acc '()) (number-acc 0) - (acc-last #f)) + (acc-last #f) + (first #t)) (letrec-syntax ((loop-aux (... (syntax-rules (= above across and append below by collect count do downfrom downto else end finally for from if in into maximize minimize on return sum then to unless until when while with) @@ -59,24 +60,20 @@ fin) clause* ...))) ((loop-aux "variable-clause-collector" ((body ...) fin) for x on l clause* ...) - (let* ((x l) - (next x)) + (let* ((x l)) (loop-aux "variable-clause-collector" - ((body ... (set! x next) + ((body ... (unless first + (set! x (cdr x))) (unless (pair? x) - (raise *loop-termination*)) - (set! next (cdr x))) + (raise *loop-termination*))) fin) clause* ...))) ((loop-aux "variable-clause-collector" ((body ...) fin) for x = init then subseq clause* ...) - (let ((first #t) - (init-value (lambda () init)) ; put the body of init outside the scope of x. + (let ((init-value (lambda () init)) ; put the body of init outside the scope of x. (x #f)) (loop-aux "variable-clause-collector" ((body ... (if first - (begin - (set! first #f) - (set! x (init-value))) + (set! x (init-value)) (set! x subseq))) fin) clause* ...))) @@ -100,49 +97,45 @@ ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start to last by inc clause* ...) (let* ((last* last) (inc* inc) - (x start) - (next x)) + (x start)) (loop-aux "variable-clause-collector" - ((body ... (set! x next) + ((body ... (unless first + (set! x (+ x inc*))) (unless (<= x last*) - (raise *loop-termination*)) - (set! next (+ x inc*))) + (raise *loop-termination*))) fin) clause* ...))) ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start downto last by inc clause* ...) (let* ((last* last) (inc* inc) - (x start) - (next x)) + (x start)) (loop-aux "variable-clause-collector" - ((body ... (set! x next) + ((body ... (unless first + (set! x (+ x inc*))) (unless (>= x last*) - (raise *loop-termination*)) - (set! next (+ x inc*))) + (raise *loop-termination*))) fin) clause* ...))) ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start below last by inc clause* ...) (let* ((last* last) (inc* inc) - (x start) - (next x)) + (x start)) (loop-aux "variable-clause-collector" - ((body ... (set! x next) + ((body ... (unless first + (set! x (+ x inc*))) (unless (< x last*) - (raise *loop-termination*)) - (set! next (+ x inc*))) + (raise *loop-termination*))) fin) clause* ...))) ((loop-aux "variable-clause-collector" ((body ...) fin) for x from start above last by inc clause* ...) (let* ((last* last) (inc* inc) - (x start) - (next x)) + (x start)) (loop-aux "variable-clause-collector" - ((body ... (set! x next) + ((body ... (unless first + (set! x (+ x inc))) (unless (> x last*) - (raise *loop-termination*)) - (set! next (+ x inc))) + (raise *loop-termination*))) fin) clause* ...))) ((loop-aux "variable-clause-collector" args for x clause* ...) @@ -193,11 +186,10 @@ (loop-aux "for-reordering" args for x from-clause to-clause 1 stepping clause* ...)) ((loop-aux "for-reordering" ((body ...) fin) for x start #f inc stepping clause* ...) (let* ((inc* inc) - (x start) - (next x)) + (x start)) (loop-aux "variable-clause-collector" - ((body ... (set! x next) - (set! next (+ x inc*))) + ((body ... (unless first + (set! x (+ x inc*)))) fin) clause* ...))) ; The word `to' is ambiguous as to which stepping, so replace to with downto if stepping is -1. @@ -244,6 +236,7 @@ (let loop-name () (guard (e ((loop-termination? e) fin ...)) body ... + (set! first #f) (loop-name)))) ((loop-aux "unconditional" continuation (compound ...) do (form1 form1* ...) (form2 form2* ...) clause* ...) (loop-aux "unconditional" continuation (compound ... (form1 form1* ...)) do (form2 form2* ...) clause* ...)) |