#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)))))