diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-24 19:44:50 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2019-04-24 19:44:50 +0200 |
commit | 2fca0d0511dcc5514d97b5cf559df1f38afad56c (patch) | |
tree | 8fb59e89e561e7dae95340fc6a730ae18c3b3856 | |
parent | Add {mod,set}/r! (diff) | |
download | calp-2fca0d0511dcc5514d97b5cf559df1f38afad56c.tar.gz calp-2fca0d0511dcc5514d97b5cf559df1f38afad56c.tar.xz |
Add let-lazy.
Diffstat (limited to '')
-rw-r--r-- | module/util.scm | 25 |
1 files changed, 24 insertions, 1 deletions
diff --git a/module/util.scm b/module/util.scm index 9a816cee..9673288d 100644 --- a/module/util.scm +++ b/module/util.scm @@ -8,7 +8,9 @@ mod! sort* sort*! mod/r! set/r! find-min - catch-multiple) + catch-multiple + quote? + tree-map let-lazy) #:replace (let* set! define-syntax) ) @@ -335,4 +337,25 @@ (else (values (reverse done) rem))))) +(define* (tree-map proc tree #:key (descend (const #t))) + (cond ((not (list? tree)) (proc tree)) + ((null? tree) '()) + ((list? (car tree)) + (cons (if (descend (car tree)) + (tree-map proc (car tree) #:descend descend) + (car tree)) + (tree-map proc (cdr tree) #:descend descend))) + (else (cons (proc (car tree)) + (tree-map proc (cdr tree) #:descend descend))))) + +(define (quote? form) + (and (not (null? form)) + (eq? 'quote (car form)))) + +(define-macro (let-lazy bindings . body) + (let ((keys (map car bindings))) + `(let ,(map (lambda (b) `(,(car b) (delay ,@(cdr b)))) + bindings) + ,@(tree-map (lambda (t) (if (memv t keys) `(force ,t) t)) + body #:descend (negate quote?))))) |