#lang scheme/base
(require
 "list.ss"
 (lib "match.ss"))
(provide (all-defined-out))
(define-syntax tag?
  (syntax-rules ()
    ((_ tag)
     (match-lambda
      (('tag . r) #t)
      (other #f)))))
(define (substitute matches? fn expression)
  (let down ((e expression))
    (if (matches? e)
        (fn e)
        (if (list? e)
            (map down e) e))))
(define (substitute* matches? fn expression)
  (substitute matches?
              (splash fn)
              expression))
(define (substitute-body matches? fn expression)
  (substitute matches?
              (dip fn)
              expression))
(define (expand/done expand-once expr)
  (call/cc 
   (lambda (return)             (let down ((e expr))         (down (expand-once
              (lambda () (return e))
              e))))))
(define (flatten tree)
  (if (null? tree) tree
      (let ((f/l
             (lambda (cxr)
               ((if (list? (cxr tree))
                    flatten list) (cxr tree)))))
        (append
         (f/l car)
         (f/l cdr)))))