61 lines
2.2 KiB
Scheme
61 lines
2.2 KiB
Scheme
#lang scheme/base
|
|
|
|
(require scheme/promise (for-syntax scheme/base))
|
|
(provide (all-from-out scheme/base scheme/promise))
|
|
|
|
(define (show x [p (current-output-port)])
|
|
(let show ([x x])
|
|
(cond [(or (void? x) (not x) (null? x)) (void)]
|
|
[(pair? x) (show (car x)) (show (cdr x))]
|
|
[(promise? x) (show (force x))]
|
|
[(keyword? x) (show (keyword->string x))]
|
|
[(and (procedure? x) (procedure-arity-includes? x 0)) (show (x))]
|
|
;; display won't work, since it calls us back
|
|
;; [else (display x p)]
|
|
;; things that are printed directly
|
|
[(bytes? x) (write-bytes x p)]
|
|
[(string? x) (write-string x p)]
|
|
[(char? x) (write-char x p)]
|
|
[(number? x) (write x p)]
|
|
;; generic fallback
|
|
[else (show (format "~a" x))])))
|
|
|
|
;; this is too much -- it also changes error messages
|
|
;; (global-port-print-handler show)
|
|
(port-display-handler (current-output-port) show)
|
|
|
|
;; the default prints a newline too, avoid that
|
|
(current-print display)
|
|
|
|
;; make it possible to use this language through a repl
|
|
;; --> won't work: need an `inside' reader that reads a single expression
|
|
;; (require (prefix-in * "text/lang/reader.ss"))
|
|
;; (current-prompt-read
|
|
;; (lambda () (parameterize ([read-accept-reader #t]) (*read-syntax))))
|
|
|
|
;; Utilities
|
|
|
|
(require (prefix-in at: "reader.ss"))
|
|
(provide at:read-inside at:read-syntax-inside)
|
|
|
|
(provide include)
|
|
(define-syntax (include stx)
|
|
(syntax-case stx ()
|
|
[(_ filename)
|
|
(let* ([source (syntax-source stx)]
|
|
[dir (or (and source
|
|
(let-values ([(base file dir?) (split-path source)])
|
|
(and (path? base) base)))
|
|
(current-load-relative-directory)
|
|
(current-directory))])
|
|
(with-syntax ([ns (if source
|
|
#`(module->namespace #,source)
|
|
#'(current-namespace))]
|
|
[dir dir])
|
|
#'(let ([contents
|
|
(with-input-from-file (path->complete-path filename dir)
|
|
at:read-syntax-inside)])
|
|
(parameterize ([current-namespace ns])
|
|
(for ([expr (syntax->list contents)])
|
|
(show (eval expr)))))))]))
|