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

2
goof-impl.scm
View file

@ -155,7 +155,7 @@
;; For clause with a sequence creator. ;; 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) ((_ 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 ;; accumulator clause
((_ orig name l a v c r f ff ul uw ub uf ((:acc id ids ... (accumulator source ...)) clauses ...) . body) ((_ orig name l a v c r f ff ul uw ub uf ((:acc id ids ... (accumulator source ...)) clauses ...) . body)

134
goof/iterators.scm
View file

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