diff --git a/src/ikarus.boot b/src/ikarus.boot index a9b5c2d..cd2570d 100644 Binary files a/src/ikarus.boot and b/src/ikarus.boot differ diff --git a/src/libcompile.ss b/src/libcompile.ss index b914b9d..2171f30 100644 --- a/src/libcompile.ss +++ b/src/libcompile.ss @@ -4916,7 +4916,8 @@ (primitive-set! 'assembler-output (make-parameter #f)) (primitive-set! 'compile (lambda (x) - (let ([code (compile-expr x)]) + (let ([code + (if (code? x) x (compile-expr x))]) (let ([proc ($code->closure code)]) (proc))))) diff --git a/src/libfasl.ss b/src/libfasl.ss index a4c5944..1745143 100644 --- a/src/libfasl.ss +++ b/src/libfasl.ss @@ -313,7 +313,7 @@ (let ([clos ($code->closure code)]) (put-mark clos-m clos) (set-code-reloc-vector! code (read)) - clos)] + code)] [else (set-code-reloc-vector! code (read)) code])))) @@ -321,7 +321,8 @@ (let ([c (read-char p)]) (case c [(#\x) - (read-code #f m)] + (let ([code (read-code #f m)]) + (if m (vector-ref marks m) ($code->closure code)))] [(#\<) (let ([cm (read-int p)]) (unless (fx< cm (vector-length marks)) @@ -333,7 +334,8 @@ [(#\>) (let ([cm (read-int p)]) (assert-eq? (read-char p) #\x) - (read-code cm m))] + (let ([code (read-code cm m)]) + (if m (vector-ref marks m) ($code->closure code))))] [else (error who "invalid code header ~s" c)]))) (define (read/mark m) (define (nom)