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

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

  

;; 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 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)
      (check-special-lang-line! a-path (read-line ip)) ;; skip the first language-level line
      (stx-e
       (datum->stx 
        (let loop ([elt (read ip)])
          (cond
            [(eof-object? elt)
             empty]
            [else
             (cons elt (loop (read ip)))]))
        ;; FIXME: read the program and do the right thing with the lexer.
        (make-Loc 0 0 0 ""))))))


;; make sure the line is a #lang s-exp "lang.ss" line.
(define (check-special-lang-line! source a-line)
  (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)))]))))