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

More parentheses

Browse source 
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 2021-02-18 21:19:12 +01:00
parent a545c1cbd7
commit 7b3814c430
2 changed files with 53 additions and 36 deletions
Download patch file Download diff file Expand all files Collapse all files

12
README.md
View file

@ -18,7 +18,7 @@ Compared to foof-loop, some things are added. Apart from minor syntactic changes
```
(define lst '((1 2) dud (3 4) (5 6)))
(loop ((:for a (in-list lst))
:when (pair? a)
(:when (pair? a))
(:for b (in-list a))
(:acc acc (summing b)))
=> acc)
@ -111,12 +111,12 @@ I also provide simplified forms for many common operations. Omitting :for is all
a)
;; => 24
(loop/first ((a (in-list '(a b c 3 4 d))) :when (integer? a))
(loop/first ((a (in-list '(a b c 3 4 d))) (:when (integer? a)))
(display a)
a)
;; => displays 3 and returns 3.
(loop/last ((a (in-list '(a b c d e f))) :break (eq? a 'e))
(loop/last ((a (in-list '(a b c d e f))) (:break (eq? a 'e)))
a)
;; => 'd
@ -194,7 +194,7 @@ Speed is good. Despite the rather involved expansion above, due to dead-code eli
```
> ,opt (loop ((:for a (in-list '(1 2 3 4)))
:when (even? a)
(:when (even? a))
(:acc acc (listing a)))
=> acc)
$1 = (let loopy-loop ((cursor-1 '()) (cursor '(1 2 3 4)))
@ -207,13 +207,13 @@ $1 = (let loopy-loop ((cursor-1 '()) (cursor '(1 2 3 4)))
;; loop/list, being less general, produces faster code that can be more easily unroled and optimized.
> ,opt (loop/list ((a (in-list '(1 2 3 4)))
:when (even? a))
(:when (even? a)))
a)
$2 = (list 2 4)
;; Removing the opportunity to completely remove the loop
> ,opt (loop/list ((a (in-list (read)))
:when (even? a))
(:when (even? a)))
a)
$5 = (let loopy-loop ((cursor (read)))

77
goof-impl.scm
View file

@ -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 ...))))