#lang scheme/base

(require (only-in scheme/list empty? empty first rest)

(require (for-syntax (only-in scheme/base build-path)))

;; Bootstrap the javascript compiler.
;; * Ignores all provide/contracts
;; * Concatenates all the required modules into a single file
;; * Compiles the javascript compiler with the javascript compiler.

(define-runtime-path moby-runtime-path

(define-runtime-path runtime-manifest-path


;; The standalone compiler combines the sources of the regular compiler
;; and its dependent libraries.


(define-runtime-path permission-struct-path

(define-runtime-path syntax-path

(define-runtime-path effect-struct-path 

(define-runtime-path bootstrap-teachpack-module-path

(define-runtime-path jshashtable.js  "../../support/js/runtime/jshashtable.js")
(define-runtime-path types.js "../../support/js/runtime/types.js")
(define-runtime-path kernel.js "../../support/js/runtime/kernel.js")
(define-runtime-path read.js "../../support/js/runtime/read.js")

(define-runtime-path compressed-runtime.js "../../support/js/runtime/compressed-runtime.js")

;; write-compressed-runtime: -> void
;; Write out a runtime of all of the files in the MANIFEST, compressed by the YUI compressor.
;; Also writes a compressed version of the standalone compiler.
(define (write-compressed-runtime)

  (let* ([runtime-source (get-runtime-source)]
         [compressed-runtime-source (compress-and-optimize-source runtime-source)])
    (call-with-output-file compressed-runtime.js
      (lambda (op) (write-bytes compressed-runtime-source op))
      #:exists 'replace))
  (let* ([standalone-source (file->bytes standalone-compiler-path)]
         [compressed-standalone-source (compress-and-optimize-source standalone-source)])
    (call-with-output-file compressed-standalone-compiler-path
      (lambda (op) (write-bytes compressed-standalone-source op))
      #:exists 'replace))

;; compress-and-optimize-source: bytes -> bytes
;; Apply some process for compressing and optimizing the Javascript.
(define (compress-and-optimize-source bytes)
  (yui-compress bytes)
  ;; Switched away from google closure: the output of it is actually
  ;; crashing Rhino for some strange reason!
  #;(google-closure-compile bytes))

;; write-bootstrap-module: -> void
;; Writes out the bootstrap-teachpack module
(define (write-bootstrap-teachpack-module)
  (unless (directory-exists? (build-path moby-runtime-path "modules"))
    (make-directory (build-path moby-runtime-path "modules")))
  (call-with-output-file bootstrap-teachpack-module-path
    (lambda (op)
      (display "// This is bootstrap-teachpack.js\n" op)
      (display "// It's been automatically generated by\n" op)
      (display "// Pleaes don't hand-edit this file.\n" op)
      (display "if (typeof(plt) == 'undefined') { plt = {}; }\n" op)
      (display "if (typeof(plt.bootstrap) == 'undefined') { plt.bootstrap = {}; }\n" op)
      (display "(function() {\n" op)
      (display (compiled-program-main/expose
                (program->compiled-program/pinfo (read-program "modules/")
                                                 (get-base-pinfo 'moby)))
      (display "plt.bootstrap.start = start;\n" op)
      (display "}())\n" op))
    #:exists 'replace))

;; write-compiler: ->void
;; Writes out the javascript compiler and other files.
;; Generates: compiler.js, standalone-compiler.js, permission-struct.js
(define (write-compiler)
  (boot-compile-to-file "" compiler-path)
  #;(boot-compile-to-file "" syntax-path)
  (boot-compile-to-file "" permission-struct-path)
  (boot-compile-to-file "" effect-struct-path)
  (call-with-output-file standalone-compiler-path
    (lambda (op)
      (display "// This is the standalone compiler.\n" op)
      (display "// It's been automatically generated by\n" op)
      (display "// Please don't hand-edit this file.\n" op)
      (display "// compile: string -> (list string, (listof string))\n" op)
      (display "var compile = (function() {\n" op)
      (copy-path-to-port jshashtable.js op)
      (copy-path-to-port types.js op)
      (copy-path-to-port kernel.js op)
      (copy-path-to-port syntax-path op)
      (copy-path-to-port read.js op)

      (display (bootstrap-compile "") op)
      (display "
   function listToArray(aList) {
       var anArray = [];
       while (!aList.isEmpty()) {     
          aList =;
       return anArray;
   var aPinfo = get_dash_base_dash_pinfo(plt.types.Symbol.makeInstance('moby'));

   return function(s) {
       var exprs = plt.reader.readSchemeExpressions(s);
       var compiledProgram =
           program_dash__greaterthan_compiled_dash_program_slash_pinfo(exprs, aPinfo);

       var compiledSrc = compiled_dash_program_dash_main(compiledProgram);
       var permList = pinfo_dash_permissions(compiled_dash_program_dash_pinfo(compiledProgram));
       var perms = [];
       while (!permList.isEmpty()) {     
           permList =;
       return [compiledSrc, perms];
    #:exists 'replace))

;; boot-compile-to-file: path path -> void
;; Write out the bootstrap-compilation of a Scheme program to a Javascript program.
;; FIXME: we need to respect module boundaries, and we're not doing so right now.  Every
;; function definition is being exposed to toplevel, which is dangerous.
(define (boot-compile-to-file a-program-path an-output-path)
  (call-with-output-file an-output-path
    (lambda (op)
      (display "// This is automatically generated by\n" op)
      (display "// Please don't hand-edit this file.\n" op)
      (display (bootstrap-compile a-program-path)
    #:exists 'replace))

;; copy-path-to-port: path output-port -> void
(define (copy-path-to-port path outp)
  (call-with-input-file path
    (lambda (ip)
      (copy-port ip outp))))

;; bootstrap-compile: path -> string
(define (bootstrap-compile a-path)
   (program->compiled-program (get-big-program a-path))))

;; get-big-program: path -> program
(define (get-big-program a-path)
  (let* ([modules (find-transitive-required-modules a-path)]
         [big-program (apply append (map (lambda (p)
                                             (read-program p))))

;; find-transitive-required-modules: path -> (listof path)
(define (find-transitive-required-modules a-path)
   (let loop ([a-path a-path])
     (let ([new-paths 
            (get-require-paths (read-program a-path))])
         [(empty? new-paths)
          (list a-path)]
           (apply append
                  (map loop new-paths))
           (list a-path))])))))

;; read-program: path -> program
(define (read-program a-path)
  (call-with-input-file a-path
    (lambda (ip)
      (port-count-lines! ip)
      (check-special-lang-line! a-path (read-line ip)) ;; skip the first language-level line
      (let loop ()
        (let ([elt (read-syntax a-path ip)])
          [(eof-object? elt)
           (cons (syntax->stx elt) (loop))]))))))

;; make sure the line is a #lang s-exp "" line.
(define (check-special-lang-line! source a-line)
  (unless (or (regexp-match #rx"^#lang s-exp \"\"$" a-line)
              (regexp-match #rx"^#lang s-exp \"../../\"$" a-line))
    (error 'check-special-line! "~s needs to be written in language" source)))

;; get-require-paths: program -> (listof module-path)
;; Produces the module paths that are required in the program.
(define (get-require-paths a-program)
    [(empty? a-program)
    [(library-require? (first a-program))
     (append (map stx-e (rest (stx-e (first a-program))))
             (get-require-paths (rest a-program)))]
     (get-require-paths (rest a-program))]))

;; remove-provide/contracts: program -> program
(define (remove-provide/contracts a-program)
  (filter (lambda (top-level)
            (not (stx-begins-with? top-level 'provide/contract)))

;; remove-requires: program -> program
(define (remove-requires a-program)
  (filter (lambda (top-level)
            (not (stx-begins-with? top-level 'require)))

;; unique: (listof X) -> (listof X)
;; Produces a unique list of the elements, assuming elements can be
;; compared with equal? and are hashable.
(define (unique elts)
  (let ([ht (make-hash)])
    (let loop ([elts elts])
        [(empty? elts)
        [(hash-ref ht (first elts) #f)
         (loop (rest elts))]
         (hash-set! ht (first elts) #t)
         (cons (first elts)
               (loop (rest elts)))]))))

;; get-runtime-source: -> bytes
;; Returns the bytes of all the runtime files as a single chunk.
(define (get-runtime-source)
  (call-with-input-file runtime-manifest-path
    (lambda (ip)
      (apply bytes-append
             (for/list ([line (in-lines ip)])
               (let ([fip (open-input-file (build-path moby-runtime-path line))])
                 (bytes-append (file->bytes (build-path moby-runtime-path line))


 [write-compiler (-> any)]
 [write-compressed-runtime (-> any)])