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

Undid racketification, because not diffrentiating between :for and :acc means that errors become very strange and unhelpful.

Browse source 
Added simple forms, like loop/list that accumulates bodies into a list.

Add :final that works like in racket:
(loop/list ((:for a (in-list '(1 2 3))) :final (= a 2)) (display a))
=> (1 2)
This commit is contained in:
Linus 2020-11-22 21:47:48 +01:00
parent 80464ebe48
commit 1a826f86e2
2 changed files with 154 additions and 115 deletions
Download patch file Download diff file Expand all files Collapse all files

115
iterators.scm
View file

@ -214,23 +214,20 @@
((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))()
((var s (+ var 1)))
(next ((s start) (l limit)) () ((var s (+ var 1)))
((>= var l)) () () . rest))
((up-from ((var) (start (by step))) next . rest)
(next ((s start) (e step))()
((var s (+ var e))) () () () . rest))
((up-from ((var) (start)) next . rest)
(next ((s start))
()
((var s (+ var 1)))
()
()
()
. rest))
(next ((s start)) () ((var s (+ var 1)))
() () () . 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))
@ -248,42 +245,28 @@
()
((var (- s e) (- var e)))
((< var l))
()
()
. rest))
() () . rest))
((down-from ((var) (start (to limit))) next . rest)
(next ((s start) (l limit))
()
((var (- s 1) (- var 1)))
((< var l))
()
()
. rest))
(next ((s start) (l limit)) () ((var (- s 1) (- var 1)))
((< var l)) () () . rest))
((down-from ((var) (start (by step))) next . rest)
(next ((s start) (e step))
()
((var (- s e) (- var e)))
()
()
()
. rest))
(next ((s start) (e step)) () ((var (- s e) (- var e)))
() () () . rest))
((down-from ((var) (start)) next . rest)
(next ((s start))
()
((var (- s 1) (- var 1)))
()
()
()
. rest))
))
(next ((s start)) () ((var (- s 1) (- var 1)))
() () () . rest))
((down-from ((var) (start limit step)) next . rest)
(next ((s start) (l limit) (e step)) () ((var (- s e) (- var e))) ((< var l)) () () . rest))
((down-from ((var) (start limit)) next . rest)
(down-from ((var) (start limit 1)) next . rest))))
(define-syntax accumulating
(syntax-rules (initial if)
((accumulating (kons final init) ((var) . x) next . rest)
(accumulating (kons final init) ((var cursor) . x) next . rest))
((accumulating (kons final init) ((var cursor) ((initial i) . x)) n . rest)
(accumulating (kons final i) ((var cursor) x) n . rest))
((accumulating (kons final init) ((var cursor) (expr (if check))) n . rest)
(syntax-rules (initial if :acc)
((accumulating :acc (kons final init) ((var) . x) next . rest)
(accumulating :acc (kons final init) ((var cursor) . x) next . rest))
((accumulating :acc (kons final init) ((var cursor) ((initial i) . x)) n . rest)
(accumulating :acc (kons final i) ((var cursor) x) n . rest))
((accumulating :acc (kons final init) ((var cursor) (expr (if check))) n . rest)
(n ((tmp-kons kons))
((cursor init (if check (tmp-kons expr cursor) cursor)))
()
@ -291,7 +274,7 @@
()
((var (final cursor)))
. rest))
((accumulating (kons final init) ((var cursor) (expr)) n . rest)
((accumulating :acc (kons final init) ((var cursor) (expr)) n . rest)
(n ((tmp-kons kons))
((cursor init (tmp-kons expr cursor)))
()
@ -301,32 +284,32 @@
. rest))))
(define-syntax folding
(syntax-rules (if)
((_ ((var) (init update (if guard))) n . rest)
(syntax-rules (if :acc)
((_ :acc ((var) (init update (if guard))) n . rest)
(n ()
((var init (if guard update var)))
() () ()
((var var))
. rest))
((_ ((var) (init update)) n . rest)
((_ :acc ((var) (init update)) n . rest)
(folding ((var) (init update (if #t))) n . rest))
((_ ((var) (init)) n . rest)
((_ :acc ((var) (init)) n . rest)
(folding ((var) (init var (if #t))) n . rest))))
;;> \macro{(for x [pair] (listing expr))}
(define-syntax listing
(syntax-rules ()
((listing args next . rest)
(accumulating (cons reverse '()) args next . rest))))
(syntax-rules (:acc)
((listing :acc args next . rest)
(accumulating :acc (cons reverse '()) args next . rest))))
;;> \macro{(for x [pair] (listing-reverse expr))}
(define-syntax listing-reverse
(syntax-rules ()
((listing-reverse args next . rest)
(accumulating (cons (lambda (x) x) '()) args next . rest))))
(syntax-rules (:acc)
((listing-reverse :acc args next . rest)
(accumulating :acc (cons (lambda (x) x) '()) args next . rest))))
(define (append-reverse rev tail)
(if (null? rev) tail (append-reverse (cdr rev) (cons (car rev) tail))))
@ -334,29 +317,29 @@
;;> \macro{(for x [pair] (appending expr))}
(define-syntax appending
(syntax-rules ()
((appending args next . rest)
(accumulating (append-reverse reverse '()) args next . rest))))
(syntax-rules (:acc)
((appending :acc args next . rest)
(accumulating :acc (append-reverse reverse '()) args next . rest))))
;;> \macro{(for x [pair] (appending-reverse expr))}
(define-syntax appending-reverse
(syntax-rules ()
((appending-reverse args next . rest)
(accumulating (append-reverse (lambda (x) x) '()) args next . rest))))
(syntax-rules (:acc)
((appending-reverse :acc args next . rest)
(accumulating :acc (append-reverse (lambda (x) x) '()) args next . rest))))
;;> \macro{(for x (summing expr))}
(define-syntax summing
(syntax-rules ()
((summing args next . rest)
(accumulating (+ (lambda (x) x) 0) args next . rest))))
(syntax-rules (:acc)
((summing :acc args next . rest)
(accumulating :acc (+ (lambda (x) x) 0) args next . rest))))
;;> \macro{(for x (multiplying expr))}
(define-syntax multiplying
(syntax-rules ()
((multiplying args next . rest)
(syntax-rules (:acc)
((multiplying :acc args next . rest)
(accumulating (* (lambda (x) x) 1) args next . rest))))
@ -380,10 +363,10 @@
((_ ((id) (source)) n . rest)
(n ((gen (generator-cycle source)))
()
((id (gen) (gen)))
((eof-object? id))
()
()
((id (gen)))
()
. rest))))