#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
[(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? 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)
(define op (open-output-bytes))
(write (alternative-f) op)
(get-output-bytes op))])
(define op (open-output-bytes))
(write compiled-code op)
(get-output-bytes op)))
(define base-namespace
(lookup-language-namespace
'racket/base
`(file ,(path->string kernel-language-path)))
(make-base-namespace))
(define (get-compiled-code-from-path p)
(log-debug "get-compiled-code-from-path")
(with-handlers ([exn? (lambda (exn)
(log-debug "parsing from scratch")
(call-with-input-file* p
(lambda (ip)
(get-compiled-code-from-port ip))))])
(get-module-code p)))
(define (get-compiled-code-from-port ip)
(parameterize ([read-accept-reader #t]
[current-namespace base-namespace])
(define stx (read-syntax (object-name ip) ip))
(define expanded-stx (expand-out-images stx))
(compile expanded-stx)))