#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 (append* lsts)
(apply append lsts))
(define (flatten lst)
(append*
(map (lambda (x)
(if (list? x)
(flatten x)
(list x)))
lst)))