Racketifying goof-loop
I have racketified goof loops. No :for or :acc needed, and :when, :unless, and :break are no longer parethesised. :acc blah (in ...) and :for blah (in ...) has been changed to (blah (folding ...)) and (blah (in ...))
This commit is contained in:
Linus
parent
716c26c7ce
commit
2c182da570
3 changed files with 101 additions and 113 deletions
87
goof.scm
87
goof.scm
|
|
@ -31,30 +31,22 @@
|
|||
;; foof-loop) by Alex Shinn. The name goof-loop is a play on that
|
||||
;; name, and the fact that I goofed in the chibi issue tracker when
|
||||
;; trying to understand the iterator protocol.
|
||||
;;
|
||||
;; It extends chibi loop in the following way:
|
||||
;; * adds support for binding variables in the loop clauses.
|
||||
;; * Adds :when, :unless, and :break clauses that controls when the loop
|
||||
;; body executes and when values are collected by accumulating for clauses.
|
||||
;; similar to how #:when, #:unless and #:break works in racket.
|
||||
;;
|
||||
;; It restricts chibi loops in the following ways:
|
||||
;; * with- and for-clauses are no longer visible in the final expression, for that you
|
||||
;; must use an accumulator clause.
|
||||
;; * Positional update is not supported. It seems error-prone once you start
|
||||
;; having a lot of loop variables, and because goof-loop does some re-ordering
|
||||
;; that foof loop does not. For example:
|
||||
;; (:for a (in 0 (+ a 1))) (:acc acc (in '() (cons a acc)))
|
||||
;; are actually reordered in a loop, because accumulators and for loops are separated
|
||||
;; due to having to propagate the accumulators through the loop.
|
||||
|
||||
|
||||
|
||||
(use-modules (helpers)
|
||||
(srfi srfi-71))
|
||||
|
||||
(define-aux-syntaxes
|
||||
;; Auxiliary syntax for the loop clauses
|
||||
:when :unless :break :final :let :let* :subloop
|
||||
;; Auxiliary syntax for the iterators.
|
||||
:gen)
|
||||
|
||||
|
||||
(include "iterators.scm")
|
||||
|
||||
(define-aux-syntaxes :for :when :unless :break :final :let :let* :acc :subloop)
|
||||
|
||||
|
||||
(define-syntax loop
|
||||
(syntax-rules ()
|
||||
|
|
@ -89,61 +81,43 @@
|
|||
|
||||
;; Clauses sorts all the clauses into subloops and positions everything where it should be.
|
||||
(define-syntax cl
|
||||
(syntax-rules (=> in :for :with :when :unless :break :final :let :acc)
|
||||
(syntax-rules (=> in :when :unless :break :final :let :let* :subloop)
|
||||
((_ orig name l a v c r f ul uw ub () => expr . body)
|
||||
(emit orig name l a v c r f ul uw ub expr . body))
|
||||
((_ orig name l a v c r f ul uw ub () . body)
|
||||
(emit orig name l a v c r f ul uw ub (if #f #f) . body))
|
||||
;; :for-clauses
|
||||
;; found a for clause when we have a :when or :unless clause. Push new subloop
|
||||
((_ orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((:for for-rest ...) clauses ...) . body)
|
||||
(push-new-subloop orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((:for for-rest ...) clauses ...) . body))
|
||||
|
||||
;; The four special :for var (in ...)-clauses where user specifies their own iteration
|
||||
((_ orig name l a v c r f ul ((uw uw* ...) uw-rest ...) ub ((:with args ...) clauses ...) . body)
|
||||
(push-new-subloop name l a v c r f ul ((uw uw* ...) uw-rest ...) ub ((:with args ...) clauses ...) . body))
|
||||
|
||||
((_ orig name l a ((v-cur ...) . v-rest) ((c-cur ...) . c-rest)
|
||||
r f ul uw ub ((:for var (in init step guard-expr)) clauses ...) . body)
|
||||
(cl orig name l a ((v-cur ... (var init step)) . v-rest) ((c-cur ... guard-expr) . c-rest)
|
||||
r f ul uw ub (clauses ...) . body))
|
||||
((_ orig name l a ((v-cur ...) . v-rest) c r f ul uw ub ((:for var (in init step)) clauses ...) . body)
|
||||
(cl orig name l a ((v-cur ... (var init step)) . v-rest) c r f ul uw ub (clauses ...) . body))
|
||||
((_ orig name l a ((v-cur ...) . v-rest) c r f ul uw ub ((:for var (in init)) clauses ...) . body)
|
||||
(cl orig name l a ((v-cur ... (var init var)) . v-rest) c r f ul uw ub (clauses ...) . body))
|
||||
;; For clause with a sequence creator.
|
||||
((_ orig name l a v c r f ul uw ub ((:for id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(iterator ((id ids ...) (source ...)) cl-next orig name l a v c r f ul uw ub (clauses ...) . body))
|
||||
|
||||
;; Accumulating clauses
|
||||
;; should I push a subloop on a when clause?
|
||||
;; Currently these have no stop or if-clauses. Maybe add?
|
||||
((_ orig name l a v c r f ul uw ub ((:acc var (in init update)) clauses ...) . body)
|
||||
(cl-next () ((var init update)) () () () ((var var)) orig name l a v c r f ul uw ub (clauses ...) . body))
|
||||
((_ orig name l a v c r f ul uw ub ((:acc var (in init)) clauses ...) . body)
|
||||
(cl-next () ((var init var)) () () () ((var var)) orig name l a v c r f ul uw ub (clauses ...) . body))
|
||||
;; Accumulator clause with a proper accumulator.
|
||||
((_ orig name l a v c r f ul uw ub ((:acc id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(iterator ((id ids ...) (source ...)) cl-next orig name l a v c r f ul uw ub (clauses ...) . body))
|
||||
|
||||
;; user-whens
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub ((:when test) clauses ...) . body)
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub (:when test clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... test) . uw-rest) ub (clauses ...) . body))
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub ((:unless test) clauses ...) . body)
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub (:unless test clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... (not test)) . uw-rest) ub (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 ul ((cur-uw ...) . uw-rest) ((cur-ub ...) . ub-rest) ((:break expr) clauses ...) . body)
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ((cur-ub ...) . ub-rest) (:break expr clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ((cur-ub ... expr) . ub-rest) (clauses ...) . body))
|
||||
;; USER LETS
|
||||
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub ((:let id id* ... expr) clauses ...) . body)
|
||||
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub (:let (id id* ... expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ((cur-ul ... (:let id id* ... expr)) . ul-rest) uw ub (clauses ...) . body))
|
||||
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub ((:let* id id* ... expr) clauses ...) . body)
|
||||
((_ orig name l a v c r f ((cur-ul ...) . ul-rest) uw ub (:let* (id id* ... expr) clauses ...) . body)
|
||||
(cl orig name l a v c r f ((cur-ul ... (:let* id id* ... expr)) . ul-rest) (clauses ...) . body))
|
||||
|
||||
;; Explicit subloop. Shorthand for (:when #t)
|
||||
((_ orig name l a v c r f ul ((cur-uw ...) . uw-rest) ub (:subloop clauses ...) . body)
|
||||
(cl orig name l a v c r f ul ((cur-uw ... #t) . uw-rest) ub (clauses ...) . body))
|
||||
|
||||
|
||||
|
||||
;; :for-clauses
|
||||
;; found a for clause when we have a :when or :unless clause. Push new subloop
|
||||
((_ orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((for-rest ...) clauses ...) . body)
|
||||
(push-new-subloop orig name l a v c r f ul ((uw uw* ...) . uw-rest) ub ((for-rest ...) clauses ...) . body))
|
||||
|
||||
;; For clause with a sequence creator.
|
||||
((_ orig name l a v c r f ul uw ub ((id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(iterator ((id ids ...) (source ...)) cl-next orig name l a v c r f ul uw ub (clauses ...) . body))
|
||||
|
||||
|
||||
|
||||
;; ERROR HANDLING?
|
||||
((_ orig name l a v c r f ul uw ub (clause . rest) . body)
|
||||
|
|
@ -208,9 +182,8 @@
|
|||
((checks ... new-checks ...) . checks-rest)
|
||||
((refs ... new-refs ...) . refs-rest)
|
||||
(finals ... new-finals ...)
|
||||
ul uw ub clauses . body))))
|
||||
|
||||
|
||||
ul uw ub clauses . body))
|
||||
))
|
||||
|
||||
(define-syntax user-let
|
||||
(syntax-rules (:let :let*)
|
||||
|
|
|
|||
|
|
@ -37,6 +37,15 @@
|
|||
;; hashqing
|
||||
;; hashving
|
||||
|
||||
(define-syntax in
|
||||
(syntax-rules ()
|
||||
((_ ((var) (init)) n . rest)
|
||||
(n () () ((var init var)) () () () . rest))
|
||||
((_ ((var) (init step)) n . rest)
|
||||
(n () () ((var init step)) () () () . rest))
|
||||
((_ ((var) (init step stop)) n . rest)
|
||||
(n () () ((var init step)) (stop) () () . rest))))
|
||||
|
||||
(define-syntax in-list
|
||||
(syntax-rules ()
|
||||
((_ ((var) source) next . rest)
|
||||
|
|
@ -150,24 +159,26 @@
|
|||
()
|
||||
. rest))))
|
||||
|
||||
;;> \macro{(for ch (in-file [input-port [reader [eof?]]]))}
|
||||
;; ;;> \macro{(for ch (in-file [input-port [reader [eof?]]]))}
|
||||
|
||||
;; (define-syntax in-file
|
||||
;; (syntax-rules ()
|
||||
;; ((in-file ((var) source) next . rest)
|
||||
;; (in-file ((var p) source) next . rest))
|
||||
;; ((in-file ((var p) (file)) next . rest)
|
||||
;; (in-file ((var p) (file read-char)) next . rest))
|
||||
;; ((in-file ((var p) (file reader)) next . rest)
|
||||
;; (in-file ((var p) (file reader eof-object?)) next . rest))
|
||||
;; ((in-file ((var p) (file reader eof?)) next . rest)
|
||||
;; (next ((p (open-input-file file)) (r reader) (e? eof?))
|
||||
;; ()
|
||||
;; ((var (r p) (r p)))
|
||||
;; ((e? var))
|
||||
;; ()
|
||||
;; ((dummy (clo
|
||||
;; se-input-port p)))
|
||||
;; . rest))))
|
||||
|
||||
(define-syntax in-file
|
||||
(syntax-rules ()
|
||||
((in-file ((var) source) next . rest)
|
||||
(in-file ((var p) source) next . rest))
|
||||
((in-file ((var p) (file)) next . rest)
|
||||
(in-file ((var p) (file read-char)) next . rest))
|
||||
((in-file ((var p) (file reader)) next . rest)
|
||||
(in-file ((var p) (file reader eof-object?)) next . rest))
|
||||
((in-file ((var p) (file reader eof?)) next . rest)
|
||||
(next ((p (open-input-file file)) (r reader) (e? eof?))
|
||||
()
|
||||
((var (r p) (r p)))
|
||||
((e? var))
|
||||
()
|
||||
((dummy (close-input-port p)))
|
||||
. rest))))
|
||||
|
||||
(define-syntax in-generator
|
||||
(syntax-rules ()
|
||||
|
|
@ -187,29 +198,15 @@
|
|||
((up-from (() . args) next . rest)
|
||||
(up-from ((var) . args) next . rest))
|
||||
((up-from ((var) (start (to limit) (by step))) next . rest)
|
||||
(next ((s start) (l limit) (e step))
|
||||
()
|
||||
((var s (+ var e)))
|
||||
((>= var l))
|
||||
()
|
||||
()
|
||||
. rest))
|
||||
(next ((s start) (l limit) (e step)) ()
|
||||
((var s (+ var e))) ((>= var l)) () () . rest))
|
||||
((up-from ((var) (start (to limit))) next . rest)
|
||||
(next ((s start) (l limit))
|
||||
()
|
||||
(next ((s start) (l limit))()
|
||||
((var s (+ var 1)))
|
||||
((>= var l))
|
||||
()
|
||||
()
|
||||
. rest))
|
||||
((>= var l)) () () . rest))
|
||||
((up-from ((var) (start (by step))) next . rest)
|
||||
(next ((s start) (e step))
|
||||
()
|
||||
((var s (+ var e)))
|
||||
()
|
||||
()
|
||||
()
|
||||
. rest))
|
||||
(next ((s start) (e step))()
|
||||
((var s (+ var e))) () () () . rest))
|
||||
((up-from ((var) (start)) next . rest)
|
||||
(next ((s start))
|
||||
()
|
||||
|
|
@ -218,7 +215,11 @@
|
|||
()
|
||||
()
|
||||
. rest))
|
||||
))
|
||||
;; Extra convenience, make it act like (in-range ...) from racket, but only for positive numbers.
|
||||
((up-from ((var) (start limit step)) next . rest)
|
||||
(next ((s start) (l limit) (e step)) () ((var s (+ var e))) ((>= var l)) () () . rest))
|
||||
((up-from ((var) (start limit)) next . rest)
|
||||
(up-from ((var) (start limit 1)) next . rest))))
|
||||
|
||||
;;> \macro{(for x (down-from [start] [(to limit)] [(by step)]))}
|
||||
|
||||
|
|
@ -283,6 +284,20 @@
|
|||
((var (final cursor)))
|
||||
. rest))))
|
||||
|
||||
(define-syntax folding
|
||||
(syntax-rules (if)
|
||||
((_ ((var) (init update (if guard))) n . rest)
|
||||
(n ()
|
||||
((var init (if guard update var)))
|
||||
() () ()
|
||||
((var var))
|
||||
. rest))
|
||||
((_ ((var) (init update)) n . rest)
|
||||
(folding ((var) (init update (if #t))) n . rest))
|
||||
((_ ((var) (init)) n . rest)
|
||||
(folding ((var) (init var (if #t))) n . rest))))
|
||||
|
||||
|
||||
;;> \macro{(for x [pair] (listing expr))}
|
||||
|
||||
(define-syntax listing
|
||||
|
|
|
|||
36
tests.scm
36
tests.scm
|
|
@ -1,25 +1,25 @@
|
|||
;; This is just a file with things that should be written as a test. Dump file.
|
||||
|
||||
(loop ((:for a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
|
||||
(:when #t)
|
||||
(:for b (in-list a))
|
||||
(:when #t)
|
||||
(:for c (in-list b))
|
||||
(:for acc (listing c)))
|
||||
(loop ((a (in-list '(((1) (2)) ((3) (4)) ((5) (6 7)))))
|
||||
:when #t
|
||||
(b (in-list a))
|
||||
:subloop
|
||||
(c (in-list b))
|
||||
(acc (listing c)))
|
||||
=> acc)
|
||||
|
||||
|
||||
(loop ((:for a (in-list '((1 2) (3 4) (5 6))))
|
||||
(:when #t)
|
||||
(:for b (in-list a))
|
||||
(:for acc (listing b)))
|
||||
=> acc)
|
||||
|
||||
(loop ((:for a (in-list '(1 2 3)))
|
||||
(:acc oa (summing a))
|
||||
(loop ((a (in-list '((1 2) (3 4) (5 6))))
|
||||
:subloop
|
||||
(:for b (up-from a (to (+ a 2))))
|
||||
(:acc ob (listing b)))
|
||||
=> (values oa ob))
|
||||
;; Should return 6 and (1 2 2 3 3 4
|
||||
(b (in-list a))
|
||||
(acc (listing b)))
|
||||
=> acc)
|
||||
|
||||
(loop ((a (in-list '(1 2 3)))
|
||||
(oa (summing a))
|
||||
:subloop
|
||||
(b (up-from a (to (+ a 2))))
|
||||
(ob (listing b)))
|
||||
=> (values oa ob))
|
||||
;; Should return 6 and (1 2 2 3 3 4)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue