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

Fix a bug where simple loops did not bind let bindings correctly

Browse source 
add check whether a loop clause exists to avoid the ultra-shit errors that happen if you
accidentally write (up-form ...)
This commit is contained in:
Linus 2021-02-09 22:02:40 +01:00
parent d48ed19e43
commit a545c1cbd7
2 changed files with 87 additions and 8 deletions
Download patch file Download diff file Expand all files Collapse all files

12
goof-impl.scm
View file

@ -138,11 +138,11 @@
;; 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)
(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 ((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)
(accumulator :acc ((id ids ...) (source ...)) cl-next/acc orig name l a v c r f ff ul uw ub uf (clauses ...) . body))
(valid-clause? accumulator :acc ((id ids ...) (source ...)) cl-next/acc orig name l a v c r f ff ul uw ub uf (clauses ...) . body))
;; ERROR HANDLING?
((_ orig name l a v c r f ff ul uw ub uf (clause . rest) . body)
@ -464,10 +464,10 @@
(forify* o n (s ... :final expr) (clauses ...) . body))
((_ o n (s ...) (:subloop clauses ...) . body)
(forify* o n (s ... :subloop) (clauses ...) . body))
((_ o n (s ...) ((:let id id* ... expr) clauses ...) . body)
(forify* o n (s ... (:let id id* ... expr)) (clauses ...) . body))
((_ o n (s ...) ((:let* id id* ... expr) clauses ...) . body)
(forify* o n (s ... (:let* id id* ... expr)) (clauses ...) . body))
((_ o n (s ...) (:let (id id* ... expr) clauses ...) . body)
(forify* o n (s ... :let (id id* ... expr)) (clauses ...) . body))
((_ o n (s ...) (:let* (id id* ... expr) clauses ...) . body)
(forify* o n (s ... :let* (id id* ... expr)) (clauses ...) . body))
((_ o n (s ...) ((%acc c-rest ...) clauses ...) . body)
(forify* o n (s ... (:acc c-rest ...)) (clauses ...) . body))
((_ o n (s ...) ((:acc c-rest ...) clauses ...) . body)

83
goof.scm
View file

@ -32,10 +32,10 @@
(define-module (goof)
#:use-module (goof helpers)
#:use-module (goof ref-let)
#:use-module ((srfi srfi-1) #:select (circular-list))
#:use-module (rnrs io simple)
#:use-module ((srfi srfi-1) #:select (circular-list find))
#:use-module ((srfi srfi-43) #:select (vector-copy vector-copy!))
#:use-module (srfi srfi-71)
#:use-module (rnrs io simple)
#:use-module (ice-9 futures)
#:export (loop
@ -75,13 +75,92 @@
hashing
vectoring
;; generator clauses
in-cycle
in-indexed
;; Syntax for adding clauses
register-loop-clause
))
;; This contains the portable parts of goof-loop.
(include "goof-impl.scm")
;; This part is only for an auxilary macro that checks whether the :for or :acc clause is
;; actually defined. The reason I use parameters here is because guile modules are immutable by
;; default and I had to wrap it in something. Paremeters are available in the default environment
;; boxer are not.
(define valid-for-clauses (make-parameter (list #'in #'in-list #'in-lists
#'in-vector #'in-reverse-vector
#'in-string #'in-reverse-string
#'in-hash
#'in-port
#'in-file
#'in-generator
#'up-from
#'down-from
;; generator clauses
#'in-cycle
#'in-indexed
)))
(define valid-acc-clauses (make-parameter (list #'folding
#'listing
#'listing-reverse
#'appending
#'appending-reverse
#'summing
#'multiplying
#'hashing
#'hashving
#'hashqing
#'vectoring
)))
(define (add-clause type form)
(cond ((eq? type 'for)
(valid-for-clauses (cons form (valid-for-clauses))))
((eq? type 'acc)
(valid-acc-clauses (cons form (valid-acc-clauses))))
(else
(error "The argument type should be either 'acc or 'for"))))
(define-syntax register-loop-clause
(syntax-rules ()
((_ type form)
(eval-when (expand load eval)
(add-clause type form)))))
;; Syntax (valid-clause? form rest ...) validates that it's first form is an already registered iterator
;; or accumulator. In guile we can do this by offloading all hard book-keeping to the hygienic
;; macro system. We simple store the syntax object of the iterator/accumulator and use
;; free-identifier=? to see if whatever iterator/accumulator used is actually defined.
(define-syntax valid-clause?
(lambda (stx)
(define (clause-defined? type binding)
(define searchee
(cond ((eq? 'for type) (valid-for-clauses))
((eq? 'acc type) (valid-acc-clauses))))
(define (pred x) (free-identifier=? x binding))
(find pred searchee))
(syntax-case stx (:acc)
((_ accumulator :acc one two original-syntax . rest)
(if (clause-defined? 'acc #'accumulator)
#'(accumulator :acc one two original-syntax . rest)
(syntax-violation (syntax->datum #'accumulator)
"Unknown accumulator in loop: "
#'original-syntax
#'accumulator)))
((_ iterator one two original-syntax . rest)
(if (clause-defined? 'for #'iterator)
#'(iterator one two original-syntax . rest)
(syntax-violation (syntax->datum #'iterator)
"Unknown iterator in loop: "
#'original-syntax
#'iterator))))))
;; Helper procedures for let-kw-form
(define (syntax= s1 s2)
(equal? (syntax->datum s1) (syntax->datum s2)))