(module text-ui mzscheme (require (lib "match.ss") (lib "pretty.ss") (lib "etc.ss") "front-end.ss") (define count (opt-lambda (s x [cutoff +inf.0]) (match s [($ semantics language relation _ value?) (let loop ([n cutoff] [term (type-check s x)] [count 1]) (if (or (zero? n) (value? term)) count (loop (sub1 n) (next relation term) (add1 count))))]))) (define trace (opt-lambda (s x [cutoff +inf.0]) (match s [($ semantics language relation _ value?) (let ([term (type-check s x)]) (let loop ([n cutoff] [term term] [trace (list term)]) (if (or (zero? n) (value? term)) (reverse trace) (let ([result (next relation term)]) (loop (sub1 n) result (cons result trace))))))]))) (define pretty (opt-lambda (s x [cutoff +inf.0]) (match s [($ semantics language relation _ value?) (parameterize ([pretty-print-columns 80]) (let ([term (type-check s x)]) (pretty-print term) (let loop ([n cutoff] [term term]) (unless (or (zero? n) (value? term)) (let ([term (next relation term)]) (printf "---->\n") (pretty-print term) (loop (sub1 n) term))))))]))) (provide count trace pretty))