101 lines
3.3 KiB
Racket
101 lines
3.3 KiB
Racket
#lang racket/base
|
|
(require racket/path
|
|
racket/runtime-path
|
|
syntax/modcode
|
|
"language-namespace.rkt"
|
|
"logger.rkt"
|
|
"expand-out-images.rkt")
|
|
|
|
(provide get-module-bytecode)
|
|
|
|
|
|
(define-runtime-path kernel-language-path
|
|
"lang/kernel.rkt")
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(define (get-module-bytecode x)
|
|
(log-debug "grabbing module bytecode for ~s" x)
|
|
|
|
(define-values (compiled-code alternative-f)
|
|
(cond
|
|
;; Assumed to be a path string
|
|
[(string? x)
|
|
(log-debug "assuming path string")
|
|
(values (get-compiled-code-from-path (normalize-path (build-path x)))
|
|
(lambda ()
|
|
(call-with-input-file* (normalize-path (build-path x))
|
|
get-compiled-code-from-port)
|
|
))]
|
|
|
|
[(path? x)
|
|
(values (get-compiled-code-from-path x)
|
|
(lambda ()
|
|
(call-with-input-file* x get-compiled-code-from-port)))]
|
|
|
|
;; Input port is assumed to contain the text of a module.
|
|
[(input-port? x)
|
|
(values (get-compiled-code-from-port x)
|
|
(lambda ()
|
|
(get-compiled-code-from-port x)))]
|
|
|
|
[else
|
|
(error 'get-module-bytecode)]))
|
|
|
|
(with-handlers ([exn? (lambda (exn)
|
|
;(printf "error? ~s\n" (exn-message exn))
|
|
(define op (open-output-bytes))
|
|
;(printf "trying alternative to get bytecode\n")
|
|
(define bytecode (alternative-f))
|
|
;(printf "got the bytecode\n")
|
|
(write bytecode op)
|
|
(get-output-bytes op))])
|
|
(define op (open-output-bytes))
|
|
(write compiled-code op)
|
|
(get-output-bytes op)))
|
|
|
|
|
|
|
|
|
|
(define base-namespace
|
|
(make-base-namespace))
|
|
;(lookup-language-namespace
|
|
;;'racket/base
|
|
;;`(file ,(path->string kernel-language-path)))
|
|
;(make-base-namespace)))
|
|
|
|
|
|
|
|
;; Tries to use get-module-code to grab at module bytecode. Sometimes
|
|
;; this fails because it appears get-module-code tries to write to
|
|
;; compiled/.
|
|
(define (get-compiled-code-from-path p)
|
|
(log-debug "get-compiled-code-from-path")
|
|
(with-handlers ([exn? (lambda (exn)
|
|
;; Failsafe: try to do it from scratch
|
|
(log-debug "parsing from scratch")
|
|
(call-with-input-file* p
|
|
(lambda (ip)
|
|
(get-compiled-code-from-port ip)))
|
|
)])
|
|
;; Note: we're trying to preserve the context, to avoid code expansion.
|
|
(parameterize ([compile-context-preservation-enabled #t])
|
|
(get-module-code p))))
|
|
|
|
|
|
;; get-compiled-code-from-port: input-port -> compiled-code
|
|
;; Compiles the source from scratch.
|
|
(define (get-compiled-code-from-port ip)
|
|
;(printf "get-compiled-code-from-port\n")
|
|
(parameterize ([read-accept-reader #t]
|
|
;; Note: we're trying to preserve the context, to avoid code expansion.
|
|
[compile-context-preservation-enabled #t]
|
|
[current-namespace base-namespace])
|
|
(define stx (read-syntax (object-name ip) ip))
|
|
;(printf "got stx; now expanding out the images\n")
|
|
(define expanded-stx (expand-out-images stx))
|
|
;(printf "now trying to compile the expanded syntax\n")
|
|
(compile expanded-stx))) |