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

Refactored for-clauses to take :for for better error reporting

Browse source 
At least in the future
This commit is contained in:
Linus 2021-03-16 19:30:08 +01:00
parent 172d0aa180
commit f6d7b01793
2 changed files with 71 additions and 71 deletions
Download patch file Download diff file Expand all files Collapse all files

140
goof/iterators.scm
View file

@ -31,22 +31,22 @@
(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))))
((in :for ((var) (init)) n . rest)
(n () ((var init var)) () () () . rest))
((in :for ((var) (init step)) n . rest)
(n () ((var init step)) () () () . rest))
((in :for ((var) (init step stop)) n . rest)
(n () ((var init step)) (stop) () () . rest))))
(define-syntax in-list
(syntax-rules (:gen)
((_ ((var) source) next . rest)
(in-list ((var cursor) source) next . rest))
((_ ((var cursor) source) next . rest)
(in-list ((var cursor succ) source) next . rest))
((_ ((var cursor succ) (source)) next . rest)
(in-list ((var cursor succ) (source cdr)) next . rest))
((_ ((var cursor succ) (source step)) next . rest)
(syntax-rules (:for)
((in-list:for ((var) source) next . rest)
(in-list :for ((var cursor) source) next . rest))
((in-list:for ((var cursor) source) next . rest)
(in-list :for ((var cursor succ) source) next . rest))
((in-list:for ((var cursor succ) (source)) next . rest)
(in-list :for ((var cursor succ) (source cdr)) next . rest))
((in-list:for ((var cursor succ) (source step)) next . rest)
(next
;; outer let bindings, bound outside the loop, unchanged during the loop
()
@ -63,9 +63,9 @@
. rest))
;; Generator-clauses
((_ lst)
((in-listlst)
(gen-list lst))
((_ :gen (var) (expr step))
((in-list(var) (expr step))
(gen-list lst step))))
(define gen-list
@ -82,18 +82,18 @@
(define-syntax in-lists
(syntax-rules ()
((in-lists ((elts) lol) next . rest)
(in-lists ((elts pairs) lol) next . rest))
((in-lists ((elts pairs) lol) next . rest)
(in-lists ((elts pairs succ) lol) next . rest))
((in-lists ((elts pairs succ) (lol)) next . rest)
(in-lists ((elts pairs succ) (lol cdr)) next . rest))
((in-lists ((elts pairs succ) (lol)) next . rest)
(in-lists ((elts pairs succ) (lol cdr)) next . rest))
((in-lists ((elts pairs succ) (lol step)) next . rest)
(in-lists ((elts pairs succ) (lol step null?)) next . rest))
((in-lists ((elts pairs succ) (lol step done?)) next . rest)
(syntax-rules (:for)
((in-lists :for ((elts) lol) next . rest)
(in-lists :for ((elts pairs) lol) next . rest))
((in-lists :for ((elts pairs) lol) next . rest)
(in-lists :for ((elts pairs succ) lol) next . rest))
((in-lists :for ((elts pairs succ) (lol)) next . rest)
(in-lists :for ((elts pairs succ) (lol cdr)) next . rest))
((in-lists :for ((elts pairs succ) (lol)) next . rest)
(in-lists :for ((elts pairs succ) (lol cdr)) next . rest))
((in-lists :for ((elts pairs succ) (lol step)) next . rest)
(in-lists :for ((elts pairs succ) (lol step null?)) next . rest))
((in-lists :for ((elts pairs succ) (lol step done?)) next . rest)
(next ()
((pairs lol succ))
((let lp ((ls pairs)) ; an in-lined ANY
@ -125,18 +125,18 @@
(begin
(define-syntax in-type
(syntax-rules ()
((in-type seq next . rest)
((in-type :for seq next . rest)
(%in-idx >= (lambda (x i) (+ i 1)) (lambda (x) 0) length ref tmp seq next . rest))
((_ coll)
((in-type coll)
(in-indexed-generator coll length ref))))
(define-syntax in-type-reverse
(syntax-rules ()
((in-type-reverse seq next . rest)
((in-type-reverse :for seq next . rest)
(%in-idx <
(lambda (x i) (- i 1))
(lambda (x) (- (length x) 1))
(lambda (x) 0) ref tmp seq next . rest))
((_ coll)
((in-type coll)
(in-indexed-generator-reverse coll length ref))))))))
(define (in-indexed-generator coll len ref)
@ -181,15 +181,15 @@
(define-syntax in-port
(syntax-rules ()
((in-port ((var) source) next . rest)
(in-port ((var p) source) next . rest))
((in-port ((var p) ()) next . rest)
(in-port ((var p) ((current-input-port))) next . rest))
((in-port ((var p) (port)) next . rest)
(in-port ((var p) (port read-char)) next . rest))
((in-port ((var p) (port read-char)) next . rest)
(in-port ((var p) (port read-char eof-object?)) next . rest))
((in-port ((var p) (port reader eof?)) next . rest)
((in-port :for ((var) source) next . rest)
(in-port :for ((var p) source) next . rest))
((in-port :for ((var p) ()) next . rest)
(in-port :for ((var p) ((current-input-port))) next . rest))
((in-port :for ((var p) (port)) next . rest)
(in-port :for ((var p) (port read-char)) next . rest))
((in-port :for ((var p) (port read-char)) next . rest)
(in-port :for ((var p) (port read-char eof-object?)) next . rest))
((in-port :for ((var p) (port reader eof?)) next . rest)
(next ((p port))
((var (reader p) (reader p)))
((eof? var))
@ -213,13 +213,13 @@
(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)
((in-file :for ((var) source) next . rest)
(in-file :for ((var p) source) next . rest))
((in-file :for ((var p) (file)) next . rest)
(in-file :for ((var p) (file read-char)) next . rest))
((in-file :for ((var p) (file reader)) next . rest)
(in-file :for ((var p) (file reader eof-object?)) next . rest))
((in-file :for ((var p) (file reader eof?)) next . rest)
(next ((p (open-input-file file)) (r reader) (e? eof?))
((var (r p) (r p)))
((e? var))
@ -244,7 +244,7 @@
(define-syntax in-generator
(syntax-rules ()
((_ ((var) (source)) next . rest)
((_ :for ((var) (source)) next . rest)
(next ((gen source))
((var (gen) (gen)))
((eof-object? var))
@ -259,55 +259,55 @@
(define-syntax up-from
(syntax-rules (to by)
((up-from (() . args) next . rest)
(up-from ((var) . args) next . rest))
((up-from ((var) (start (to limit) (by step))) next . rest)
((up-from :for (() . args) next . rest)
(up-from :for ((var) . args) next . rest))
((up-from :for ((var) (start (to limit) (by step))) next . rest)
(next ((s start) (l limit) (e step))
((var s (+ var e)))
((>= var l))
() () . rest))
((up-from ((var) (start (to limit))) next . rest)
((up-from :for ((var) (start (to limit))) next . rest)
(next ((s start) (l limit)) ((var s (+ var 1)))
((>= var l)) () () . rest))
((up-from ((var) (start (by step))) next . rest)
((up-from :for ((var) (start (by step))) next . rest)
(next ((s start) (e step))
((var s (+ var e))) () () () . rest))
((up-from ((var) (start)) next . rest)
((up-from :for ((var) (start)) next . 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)
((up-from :for ((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))))
((up-from :for ((var) (start limit)) next . rest)
(up-from :for ((var) (start limit 1)) next . rest))))
(define-syntax down-from
(syntax-rules (to by)
((down-from (() . args) next . rest)
(down-from ((var) . args) next . rest))
((down-from ((var) (start (to limit) (by step))) next . rest)
((down-from :for (() . args) next . rest)
(down-from :for ((var) . args) next . rest))
((down-from :for ((var) (start (to limit) (by step))) next . rest)
(next ((s start) (l limit) (e step))
((var (- s e) (- var e)))
((< var l))
() () . rest))
((down-from ((var) (start (to limit))) next . rest)
((down-from :for ((var) (start (to limit))) next . rest)
(next ((s start) (l limit)) ((var (- s 1) (- var 1)))
((< var l)) () () . rest))
((down-from ((var) (start (by step))) next . rest)
((down-from :for ((var) (start (by step))) next . rest)
(next ((s start) (e step)) ((var (- s e) (- var e)))
() () () . rest))
((down-from ((var) (start)) next . rest)
((down-from :for ((var) (start)) next . rest)
(next ((s start)) ((var (- s 1) (- var 1)))
() () () . rest))
((down-from ((var) (start limit step)) next . rest)
((down-from :for ((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))))
((down-from :for ((var) (start limit)) next . rest)
(down-from :for ((var) (start limit 1)) next . rest))))
(define-syntax in-hash
(syntax-rules ()
((_ ((bindings) (expr)) n . rest)
((in-hash :for ((bindings) (expr)) n . rest)
(n
()
((cursor (hash-map->list cons expr) (cdr cursor)))
@ -315,8 +315,8 @@
((bindings (car cursor)))
()
. rest))
((_ hash-expr)
(in-list (hash-map->list cons hash-expr)))))
((in-hash hash-expr)
(in-list :for (hash-map->list cons hash-expr)))))
(define-syntax accumulating