#lang racket/base
(require racket/path

(provide get-module-bytecode)

(define-runtime-path kernel-language-path

(define (get-module-bytecode x)
  (log-debug "grabbing module bytecode for ~s" x)

  (define-values (compiled-code alternative-f)
      ;; 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))
      [(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)))]
       (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
   `(file ,(path->string kernel-language-path)))

;; 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)))
    (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)
  (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)))