term-rewrite-system/chez-trs/utilities.scm

;(define-module (trs utilities)
;  #:use-module (ice-9 match)
;  #:use-module (srfi srfi-11)
;  #:export (step-body atomic? iterate qqify))

(library (utilities)
(export step-body atomic? iterate qqify)
(import (chezscheme))

(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 syntax-car
  (lambda (ls)
    (syntax-case ls ()
      ((x . y) #'x))))

(define syntax-cdr
  (lambda (ls)
    (syntax-case ls ()
      ((x . y) #'y))))

(define (qqify xs)
  (define (rec x)
    (let ((x^ (syntax->datum x)))
      (cond ((symbol? x^)
	     (list #'unquote x))
	    ((or (boolean? x^)
		 (number? x^))
	     x)
	    (else
	     `(,(syntax-car x) . ,(map rec (syntax->list (syntax-cdr x))))))))
  (list #'quasiquote (rec xs)))

)