
;; Because Setup PLT is used to rebuild .zos, we may need to turn off
;; the use of compiled code or install cm before we do anything. This
;; startup stub parses the command line and either disables .zos or
;; installs cm for loading Setup PLT.

;; Note that this file is listed in "info.ss" so that it never gets a
;; .zo file. Do not `require' this module from anywhere, not even 
;; `for-label', otherwise it could get a .zo anyway.

(module main '#%kernel
  (#%require '#%min-stx
             ;; Need to make sure they're here:
             '#%builtin)

  (when (file-stream-port? (current-output-port))
    (file-stream-buffer-mode (current-output-port) 'line))

  (define-values (make-kernel-namespace)
    (lambda ()
      (let-values ([(ns) (make-empty-namespace)]
                   [(cns) (current-namespace)])
        (namespace-attach-module cns ''#%builtin ns)
        ns)))

  (define-values (short-name long-names raco?)
    ;; Load the name modulewithout using .zos, and in its own namespace to 
    ;;  avoid poluting the cm-managed namespace later
    (parameterize ([use-compiled-file-paths null]
                   [current-namespace (make-kernel-namespace)])
      ((dynamic-require 'setup/private/command-name 'get-names))))

  ;; Poor-man's processing of the command-line flags to drop strings
  ;; that will not be parsed as flags by "parse-cmdline.rkt". We don't
  ;; want to load "parse-cmdline.rkt" because it takes a long time with
  ;; bytecode files disabled, and we're not yet sure whether to trust
  ;; bytecode ifes that do exist.
  (define-values (filter-flags)
    (lambda (flags)
      (if (or (null? flags)
              (not (regexp-match? #rx"^-" (car flags)))
              (equal? "-l" (car flags)))
          null
          (if (equal? "-P" (car flags))
              (if ((length flags) . > . 5)
                  (filter-flags (list-tail flags 5))
                  null)
              (if (or (equal? "--mode" (car flags))
                      (equal? "--doc-pdf" (car flags)))
                  (if (pair? (cdr flags))
                      (filter-flags (cddr flags))
                      null)
                  (cons (car flags) (filter-flags (cdr flags))))))))

  (define-values (flags) (filter-flags (vector->list (current-command-line-arguments))))

  ;; Checks whether a flag is present:
  (define-values (on?)
    (lambda (flag-name)
      (member flag-name flags)))

  (define-values (print-bootstrapping)
    (lambda ()
      (fprintf (current-output-port) "~a: bootstrapping from source...\n" short-name)))

  (define-values (main-collects-relative->path)
    (let ([main-collects #f])
      (lambda (p)
        ;; At this point, it's safe to try to load 'setup/private/main-collects
        (unless main-collects
          (set! main-collects ((dynamic-require 'setup/private/main-collects 'find-main-collects))))
        (if (and (pair? p)
                 (eq? 'collects (car p)))
            (apply build-path main-collects
                   (map bytes->path (cdr p)))
            p))))

  (if (or (on? "--clean")
          (on? "-c")
	  (on? "--no-zo")
          (on? "-n"))
      ;; Don't use .zos, in case they're out of date, and don't load
      ;;  cm:
      (when (or (on? "--clean")
                (on? "-c"))
	(use-compiled-file-paths null)
	(print-bootstrapping))
  
      ;; Load the cm instance to be installed while loading Setup PLT.
      ;; This has to be dynamic, so we get a chance to turn off compiled
      ;;  file loading, and so it can be in a separate namespace.
      (let-values ([(mk trust-zos)
		    ;; Load cm.ss into its own namespace, so that cm compiles
		    ;;  itself and its required modules in the right order
		    ;;  (i.e., when some module requires cm or one of its
		    ;;  required modules)
		    ;; Since cm.ss pulls in quite a lot of code itself, we
		    ;;  would like to load using .zo files. But if we discover
		    ;;  any date mismatch in the loading process, abort and
		    ;;  try again without .zo files. If .zo files are newer
		    ;;  than .ss files but a required file is newer than its
		    ;;  requring file, we won't notice, but that
		    ;;  shouldn't happen for a reaonsbaly maintained
		    ;;  tree, and there's always --clean to turn this
		    ;;  off. If an .so file is used, we give up using
		    ;;  compiled files.
		    (let loop ([skip-zo? (null? (use-compiled-file-paths))])
		      (when skip-zo?
			(print-bootstrapping))
		      ((call/ec 
                        (lambda (escape)
			 ;; Create a new namespace, and also install load handlers
			 ;;  to check file dates, if necessary.
			 (parameterize ([current-namespace (make-kernel-namespace)]
					[use-compiled-file-paths 
					 (if skip-zo?
					     null
					     (use-compiled-file-paths))]
					[current-load 
					 (let ([orig-load (current-load)])
					   (if skip-zo?
					       orig-load
					       (lambda (path modname)
						 (if (regexp-match #rx#"[.]zo$" (path->bytes path))
						     ;; It's a .zo:
                                                     (begin0
                                                      (orig-load path modname)
                                                      ;; Force loading of all dependencies, which ensures
                                                      ;; a rebuild if a #lang reader changes. (Otherwise,
                                                      ;; the dependencies should be loaded already.)
                                                      ;; We do not currently support "external" dependencies
                                                      ;; (via cm-accomplice) during bootstrap.
                                                      (let ([deps (with-input-from-file 
                                                                      (bytes->path (regexp-replace #"[.]zo$" (path->bytes path) #".dep"))
                                                                    read)])
                                                        (for-each (lambda (dep)
                                                                    (unless (and (pair? dep)
                                                                                 (eq? (car dep) 'ext))
                                                                      (dynamic-require (main-collects-relative->path dep) #f)))
                                                                  (cddr deps))))
						     ;; Not a .zo! Don't use .zo files at all...
						     (escape (lambda ()
							       ;; Try again without .zo
							       (loop #t)))))))]
					[current-load-extension 
					 (if skip-zo?
					     (current-load-extension)
					     (lambda (path modname)
					       (escape (lambda ()
							 ;; Try again without .zo
							 (loop #t)))))])
		           ;; Other things could go wrong, such as a version mismatch.
		           ;; If something goes wrong, of course, give up on .zo files.
                           (parameterize ([uncaught-exception-handler
                                           (lambda (exn)
                                             (when (exn:break? exn) (exit 1))
                                             (if skip-zo?
                                                 (escape
                                                  (lambda () (raise exn)))
                                                 (escape
                                                  (lambda () (loop #t)))))])
			     ;; Here's the main dynamic load of "cm.ss":
			     (let ([mk
				    (dynamic-require 'compiler/cm
						     'make-compilation-manager-load/use-compiled-handler)]
				   [trust-zos
				    (dynamic-require 'compiler/cm 'trust-existing-zos)])
			       ;; Return the two extracted functions:
			       (lambda () (values mk trust-zos)))))))))])
	(when (on? "--trust-zos")
	  (trust-zos #t))
	(current-load/use-compiled (mk))))

  ;; This has to be dynamic, so we get a chance to turn off
  ;;  .zo use and turn on the compilation manager.
  (dynamic-require 'setup/setup-go #f))
