Refactored for-clauses to take :for for better error reporting
At least in the future
This commit is contained in:
parent
172d0aa180
commit
f6d7b01793
2 changed files with 71 additions and 71 deletions
|
@ -155,7 +155,7 @@
|
|||
|
||||
;; For clause with a sequence creator.
|
||||
((_ orig name l a v c r f ff ul uw ub uf ((:for id ids ... (iterator source ...)) clauses ...) . body)
|
||||
(valid-clause? iterator ((id ids ...) (source ...)) cl-next/for orig name l a v c r f ff ul uw ub uf (clauses ...) . body))
|
||||
(valid-clause? iterator :for ((id ids ...) (source ...)) cl-next/for orig name l a v c r f ff ul uw ub uf (clauses ...) . body))
|
||||
|
||||
;; accumulator clause
|
||||
((_ orig name l a v c r f ff ul uw ub uf ((:acc id ids ... (accumulator source ...)) clauses ...) . body)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue