thunk
(lambda () #t))))
-;; (put 'call-with-output-file/atomic 'scheme-indent-function 1)
+;; emacs: (put 'call-with-output-file/atomic 'scheme-indent-function 1)
(define* (call-with-output-file/atomic filename proc #:optional reference)
(let* ((template (string-append filename ".XXXXXX"))
(tmp (mkstemp! template)))
(close-port tmp)
(rename-file template filename))
(lambda args
+ (close-port tmp)
(delete-file template)))))))
(define (ensure-language x)
file)
comp)))
-(define* (compile-and-load file #:key (from 'scheme) (to 'value)
+(define* (compile-and-load file #:key (from (current-language)) (to 'value)
(env (current-module)) (opts '())
(canonicalization 'relative))
(with-fluids ((%file-port-name-canonicalization canonicalization))
(let lp ((in (reverse (or (lookup-compilation-order from to)
(error "no way to compile" from "to" to))))
(lang to))
- (cond ((null? in)
- (error "don't know how to join expressions" from to))
+ (cond ((null? in) to)
((language-joiner lang) lang)
(else
(lp (cdr in) (caar in))))))
+(define (default-language-joiner lang)
+ (lambda (exps env)
+ (if (and (pair? exps) (null? (cdr exps)))
+ (car exps)
+ (error
+ "Multiple expressions read and compiled, but language has no joiner"
+ lang))))
+
+(define (read-and-parse lang port cenv)
+ (let ((exp ((language-reader lang) port cenv)))
+ (cond
+ ((eof-object? exp) exp)
+ ((language-parser lang) => (lambda (parse) (parse exp)))
+ (else exp))))
+
(define* (read-and-compile port #:key
(from (current-language))
(to 'objcode)
(let ((from (ensure-language from))
(to (ensure-language to)))
(let ((joint (find-language-joint from to)))
- (with-fluids ((*current-language* from))
+ (parameterize ((current-language from))
(let lp ((exps '()) (env #f) (cenv env))
- (let ((x ((language-reader (current-language)) port cenv)))
+ (let ((x (read-and-parse (current-language) port cenv)))
(cond
((eof-object? x)
(close-port port)
- (compile ((language-joiner joint) (reverse exps) env)
+ (compile ((or (language-joiner joint)
+ (default-language-joiner joint))
+ (reverse exps)
+ env)
#:from joint #:to to
;; env can be false if no expressions were read.
#:env (or env (default-environment joint))