#lang scheme/base

(require (only-in scheme/list empty? empty first rest)
         scheme/runtime-path
         scheme/port
         scheme/file
         scheme/contract
         "stx.ss"
         "../stx-helpers.ss"
         "../compile-helpers.ss"
         "beginner-to-javascript.ss"
         "helpers.ss")

(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
  "../../support/js/runtime")

(define-runtime-path runtime-manifest-path
  "../../support/js/runtime/MANIFEST")


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


;; The standalone compiler combines the sources of the regular compiler
;; and its dependent libraries.
(define-runtime-path
  standalone-compiler-path
  "../../support/js/runtime/standalone-compiler.js")


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


(define-runtime-path permission-struct-path
  "../../support/js/runtime/permission-struct.js")

(define-runtime-path syntax-path
  "../../support/js/runtime/stx.js")

(define-runtime-path effect-struct-path 
  "../../support/js/runtime/effect-struct.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)
  (write-compiler)

  (let* ([runtime-source (get-runtime-source)]
         [compressed-runtime-source (yui-compress 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 (yui-compress standalone-source)])
    (call-with-output-file compressed-standalone-compiler-path
      (lambda (op) (write-bytes compressed-standalone-source op))
      #:exists 'replace))
  (void))



  

;; 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 "beginner-to-javascript.ss" compiler-path)
  #;(boot-compile-to-file "stx.ss" syntax-path)
  (boot-compile-to-file "permission.ss" permission-struct-path)
  (boot-compile-to-file "effect-struct.ss" 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 bootstrap-js-compiler.ss\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 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 "beginner-to-javascript.ss") op)
      
      (display "
   function listToArray(aList) {
       var anArray = [];
       while (!aList.isEmpty()) {     
          anArray.push(aList.first());
          aList = aList.rest();
       }
       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()) {     
           perms.push(
               permission_dash__greaterthan_string(permList.first()));
           permList = permList.rest();
       }
       return [compiledSrc, perms];
   }})();"
               op))
    #: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 bootstrap-js-compiler.ss\n" op)
      (display "// Please don't hand-edit this file.\n" op)
      (display (bootstrap-compile a-program-path)
             op))
    #: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)
  (compiled-program-main/expose
   (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)
                                           (remove-requires
                                            (remove-provide/contracts
                                             (read-program p))))
                                         modules))])
    big-program))
  



;; find-transitive-required-modules: path -> (listof path)
(define (find-transitive-required-modules a-path)
  (unique
   (let loop ([a-path a-path])
     (let ([new-paths 
            (get-require-paths (read-program a-path))])
       (cond
         [(empty? new-paths)
          (list a-path)]
         [else
          (append
           (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)])
        (cond
          [(eof-object? elt)
           empty]
          [else
           (cons (syntax->stx elt) (loop))]))))))


;; make sure the line is a #lang s-exp "lang.ss" line.
(define (check-special-lang-line! source a-line)
  #;(void)
  (unless (regexp-match #rx"^#lang s-exp \"lang.ss\"$" a-line)
    (error 'check-special-line! "~s needs to be written in lang.ss 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)
  (cond
    [(empty? a-program)
     empty]
    [(library-require? (first a-program))
     (append (map stx-e (rest (stx-e (first a-program))))
             (get-require-paths (rest a-program)))]
    [else
     (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)))
          a-program))


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


;; 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])
      (cond
        [(empty? elts)
         empty]
        [(hash-ref ht (first elts) #f)
         (loop (rest elts))]
        [else
         (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))
                               #"\n")))))))


(provide/contract
 [write-compiler (-> any)]
 [write-compressed-runtime (-> any)])