More parentheses
I have changed my mind about the clause forms. They should, with the exception of :subloop, be parethesised: :when test => (:when test).
This commit is contained in:
Linus
parent
a545c1cbd7
commit
7b3814c430
2 changed files with 53 additions and 36 deletions
|
|
@ -61,24 +61,41 @@
|
|||
((%loop o name () body ...)
|
||||
(%loop o name ((:for ensure-once (up-from 0 1))) body ...))
|
||||
((%loop o (clauses ...) body ...)
|
||||
(ensure-for-clause o
|
||||
loop-name (clauses ...)
|
||||
(ensure-for-clause #f () (clauses ...) o
|
||||
loop-name
|
||||
body ... (loop-name)))
|
||||
((%loop o name (clauses ...) . body)
|
||||
(ensure-for-clause o
|
||||
name
|
||||
(clauses ...)
|
||||
(ensure-for-clause #f () (clauses ...) o name
|
||||
. body))))
|
||||
|
||||
;; Should this check for more?
|
||||
;; This ensures that the first subloop has at least ONE for clause. If none is found
|
||||
;; we add a dummy one!
|
||||
(define-syntax ensure-for-clause
|
||||
(syntax-rules (:for :acc :break :subloop :when :unless :final :let :let*)
|
||||
((_ orig name ((:for for-rest ...) clauses ...) . body)
|
||||
(syntax-rules (:for :acc :break :subloop :when :unless :final DONE)
|
||||
((_ DONE clauses () orig name . body)
|
||||
(cl orig name
|
||||
(()) (()) (()) (()) (()) () ((() ())) (()) (()) (()) ()
|
||||
((:for for-rest ...) clauses ...) . body))
|
||||
((_ orig rest ...)
|
||||
(syntax-error "First clause must be a :for clause" orig))))
|
||||
clauses . body))
|
||||
|
||||
;; Ensure that a subloop gets run at least once
|
||||
((_ #f (clauses ...) () . rest)
|
||||
(ensure-for-clause DONE ((:for dummy (up-from 0 1)) clauses ...) () . rest))
|
||||
((_ #f (done ...) (:subloop . clauses) . rest)
|
||||
(ensure-for-clause DONE (done ... (:for dummy (up-from 0 1)) :subloop . clauses) () . rest))
|
||||
((_ #f (done ...) ((:when test) . clauses) . rest)
|
||||
(ensure-for-clause DONE (done ... (:for dummy (up-from 0 1)) (:when test) . clauses) () . rest))
|
||||
((_ #f (done ...) ((:unless test) . clauses) . rest)
|
||||
(ensure-for-clause DONE (done ... (:for dummy (up-from 0 1)) (:unless test) . clauses) () . rest))
|
||||
((_ #f (done ...) ((:break test) . clauses) . rest)
|
||||
(ensure-for-clause DONE (done ... (:for dummy (up-from 0 1)) (:break test) . clauses) () . rest))
|
||||
((_ #f (done ...) ((:final test) . clauses) . rest)
|
||||
(ensure-for-clause DONE (done ... (:for dummy (up-from 0 1)) (:final test) . clauses) () . rest))
|
||||
((_ _ (done ...) ((:for . stuff) . clauses) . rest)
|
||||
(ensure-for-clause DONE (done ... (:for . stuff) . clauses ) () . rest))
|
||||
|
||||
;; for the rest the clause type does not matter
|
||||
((_ ? (done ...) (clause . clauses) . rest)
|
||||
(ensure-for-clause ? (done ... clause) clauses . rest))))
|
||||
|
||||
|
||||
(define-syntax push-new-subloop
|
||||
|
|
@ -110,22 +127,22 @@
|
|||
(emit orig name l a v c r f ff ul uw ub uf (if #f #f) . body))
|
||||
|
||||
;; USER LETS
|
||||
((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) uw ub uf (:let (id id* ... expr) clauses ...) . body)
|
||||
((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) uw ub uf ((:let id id* ... expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub uf (clauses ...) . body))
|
||||
((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) uw ub uf (:let* (id id* ... expr) clauses ...) . body)
|
||||
((_ orig name l a v c r f ff ((cur-ul ...) . ul-rest) uw ub uf ((:let* id id* ... expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ((cur-ul ... (:let* id id* ... expr)) . ul-rest) uw ub uf (clauses ...) . body))
|
||||
;; user-whens
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf (:when test clauses ...) . body)
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf ((:when test) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ul ((cur-uw ... test) . uw-rest) ub uf (clauses ...) . body))
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf (:unless test clauses ...) . body)
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub uf ((:unless test) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ul ((cur-uw ... (not test)) . uw-rest) ub uf (clauses ...) . body))
|
||||
;; USER BREAKS
|
||||
;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards.
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ((cur-ub ...) . ub-rest) uf (:break expr clauses ...) . body)
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ((cur-ub ...) . ub-rest) uf ((:break expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ul ((cur-uw ... #t) . uw-rest) ((cur-ub ... expr) . ub-rest) uf (clauses ...) . body))
|
||||
;; user final
|
||||
;; This pushes a #t to the user when expression, thus forcing a subloop if a for-clause is found afterwards.
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub (cur-uf ...) (:final expr clauses ...) . body)
|
||||
((_ orig name l a v c r f ff ul ((cur-uw ...) . uw-rest) ub (cur-uf ...) ((:final expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ff ul ((cur-uw ... #t) . uw-rest) ub (cur-uf ... expr) (clauses ...) . body))
|
||||
|
||||
;; Explicit subloop. Shorthand for (:when #t)
|
||||
|
|
@ -454,20 +471,20 @@
|
|||
(%loop o n done-clauses . body))
|
||||
((_ o n (s ...) ((:for c-rest ...) clauses ...) . body)
|
||||
(forify* o n (s ... (:for c-rest ...)) (clauses ...) . body))
|
||||
((_ o n (s ...) (:when expr clauses ...) . body)
|
||||
(forify* o n (s ... :when expr) (clauses ...) . body))
|
||||
((_ o n (s ...) (:unless expr clauses ...) . body)
|
||||
(forify* o n (s ... :when expr) (clauses ...) . body))
|
||||
((_ o n (s ...) (:break expr clauses ...) . body)
|
||||
(forify* o n (s ... :break expr) (clauses ...) . body))
|
||||
((_ o n (s ...) (:final expr clauses ...) . body)
|
||||
(forify* o n (s ... :final expr) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:when expr) clauses ...) . body)
|
||||
(forify* o n (s ... (:when expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:unless expr) clauses ...) . body)
|
||||
(forify* o n (s ... (:when expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:break expr) clauses ...) . body)
|
||||
(forify* o n (s ... (:break expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:final expr) clauses ...) . body)
|
||||
(forify* o n (s ... (:final expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) (:subloop clauses ...) . body)
|
||||
(forify* o n (s ... :subloop) (clauses ...) . body))
|
||||
((_ o n (s ...) (:let (id id* ... expr) clauses ...) . body)
|
||||
(forify* o n (s ... :let (id id* ... expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) (:let* (id id* ... expr) clauses ...) . body)
|
||||
(forify* o n (s ... :let* (id id* ... expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:let id id* ... expr) clauses ...) . body)
|
||||
(forify* o n (s ... (:let id id* ... expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:let* id id* ... expr) clauses ...) . body)
|
||||
(forify* o n (s ... (:let* id id* ... expr)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((%acc c-rest ...) clauses ...) . body)
|
||||
(forify* o n (s ... (:acc c-rest ...)) (clauses ...) . body))
|
||||
((_ o n (s ...) ((:acc c-rest ...) clauses ...) . body)
|
||||
|
|
@ -508,7 +525,7 @@
|
|||
((n (clauses ...) body ...)
|
||||
(forify (n (clauses ...) body ...)
|
||||
loop/first
|
||||
() (clauses ... :final #t)
|
||||
() (clauses ... (:final #t))
|
||||
=> #f
|
||||
body ...))))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue