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

;; 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.


;; 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 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 "" 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 types.js op)
      (copy-path-to-port kernel.js 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)
      (check-special-lang-line! a-path (read-line ip)) ;; skip the first language-level line
        (let loop ([elt (read ip)])
            [(eof-object? elt)
             (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 "" line.
(define (check-special-lang-line! source a-line)
  (unless (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)))]))))