12345678910111213141516171819202122232425262728293031323334353637 |
- (define-module (trs utilities)
- #:use-module (ice-9 match)
- #:use-module (srfi srfi-11)
- #:export (step-body atomic? iterate qqify))
- (define (any/map f l)
- (if (null? l)
- (values #f '())
- (let-values (((p1 v1) (f (car l)))
- ((p2 v2) (any/map f (cdr l))))
- (values (or p1 p2)
- (cons v1 v2)))))
- (define (step-body step s)
- (let-values (((progress tail) (any/map step (cdr s))))
- (values progress (cons (car s) tail))))
- (define (iterate step s)
- (let-values (((progress s^) (step s)))
- (if progress
- (iterate step s^)
- s^)))
- (define (atomic? s)
- (or (symbol? s) (boolean? s) (number? s)))
- (define (qqify xs)
- (define (rec x)
- (cond ((symbol? x)
- (list 'unquote x))
- ((or (boolean? x)
- (number? x))
- x)
- (else
- `(,(car x) . ,(map rec (cdr x))))))
- (list 'quasiquote (rec xs)))
|