;;; This is the top-level phase structure of the compiler.
 
 ;;; Compilation phase support
 
 (define *phase* '#f)
 (define *abort-phase* '#f)         ; abort when this phase completes
 (define *abort-compilation*
   (lambda ()
     (error "No error continuation defined here!")))
 
 (define *module-asts* '())   ; a global only for debugging purposes
 
 ;;; Later add the printing and timing stuff here
 
 (define-local-syntax (phase-body phase-name body printer)
   `(dynamic-let ((*phase*       ',phase-name))
      (when (memq ',phase-name (dynamic *printers*))
        (format '#t "~%Phase ~a:~%" ',phase-name)
        (force-output))
      (let* ((phase-start-time (get-run-time))
 	    (result ,body)
 	    (current-time  (get-run-time)))
        (when (eq? (dynamic *abort-phase*) ',phase-name)
 	 (abort-compilation))
        ,@(if (eq? printer '#f)
 	     '()
 	     `((when (memq ',phase-name (dynamic *printers*))
 		 (funcall ,printer result)
 		 (force-output))))
        (when (memq 'phase-time *printers*)
 	 (let ((elapsed-time (- current-time phase-start-time)))
 	   (format '#t "~&~A complete: ~A seconds~%"
 		   ',phase-name elapsed-time)
 	   (force-output)))
        result)))
 
 
 
 ;;; Returns 2 values: module ast's and lisp code.
 
 (define (compile-haskell-files files)
   (dynamic-let ((*abort-phase*                '#f))
      (let ((all-mods       (haskell-parse-files files))
 	   (interface-mods '())
 	   (regular-mods   '()))
        (dolist (m all-mods)
 	 (if (eq? (module-type m) 'interface)
 	     (push m interface-mods)
 	     (push m regular-mods)))
        (dynamic-let ((*unit*  (module-name (car all-mods))))
 	 (values
 	   all-mods
 	   `(begin
 	      ,(if interface-mods
 		   (compile-interface-modules (nreverse interface-mods))
 		   '#f)
 	      ,(if regular-mods
 		   (compile-modules (nreverse regular-mods))
 		   '#f))
 	   )))))
 
 
 
 (define (compile-modules mods)
   (dynamic-let ((*context*                    '#f)
 		(*recoverable-error-handler*  '#f)
 		(*abort-phase*                '#f)
 		(*unique-name-counter*        1)
 		(*suffix-table*               (make-table)))
   	  (haskell-import-export mods '#f)
 	  (haskell-process-type-declarations mods)
 	  (haskell-scope mods)
 	  (let ((big-let (haskell-dependency-analysis mods)))
 	    (cond ((not (void? big-let))
 		   (haskell-type-check big-let mods)
 		   (setf big-let (haskell-cfn big-let))
 		   (setf big-let (haskell-dependency-reanalysis big-let))
 		   (setf big-let (haskell-ast-to-flic big-let))
 		   (setf big-let (haskell-optimize big-let))
 		   (setf big-let (haskell-strictness big-let))
 		   (haskell-codegen big-let mods))
 		  (else
 		   ''#f)
 		  ))))
 
 
 (define (modules->lisp-code modules)
   (dynamic-let ((*unit* (module-name (car modules))))
     (compile-modules modules)))
 
 
 (predefine (notify-error))  ; in command-interface/command-utils.scm
 
 (define (abort-compilation)
   (notify-error)
   (funcall (dynamic *abort-compilation*)))
 
 (define (halt-compilation)
   (setf (dynamic *abort-phase*) (dynamic *phase*)))
 
 
 ;;; Here are the actual phase bodies
 
 (predefine (parse-files files))
 
 (define (haskell-parse-files filenames)
   (phase-body parse
     (let ((mods (parse-files filenames)))
       mods)
     #f))
 
 (predefine (import-export modules))  ; in import-export/import-export.scm
 (predefine (import-export/interface modules))
 
 (define (haskell-import-export modules interface?)
   (phase-body import
     (if interface?
 	(import-export/interface modules)
 	(import-export modules))
     #f))
 
 
 (predefine (process-type-declarations modules)) 
     ; in tdecl/type-declaration-analysis.scm
 
 (define (haskell-process-type-declarations modules)
   (phase-body type-decl
     (begin
       (process-type-declarations modules))
     #f))
 
 
 (predefine (scope-modules x))  ; in prec/scope.scm
 (predefine (print-full-module x . maybe-stream)) ; in the printers
 
 (define (haskell-scope modules)
   (phase-body scope
     (scope-modules modules)
     (lambda (result)
       (declare (ignore result))
       (dolist (m modules) (print-full-module m)))
     ))
 
 
 (predefine (do-dependency-analysis x))  ; in depend/dependency-analysis.scm
 
 (define (haskell-dependency-analysis modules)
   (phase-body depend
     (do-dependency-analysis modules)
     (function pprint*)))
 
 
 (predefine (do-haskell-type-check big-let mods))
 
 (define (haskell-type-check big-let modules)
   (phase-body type
     (do-haskell-type-check big-let modules)
     #f))
 
 (predefine (cfn-ast x))  ; in cfn/main.scm
 
 (define (haskell-cfn big-let)
   (phase-body cfn
     (cfn-ast big-let)
     (function pprint*)))
 
 
 (predefine (analyze-dependency-top x))  ; in depend/dependency-analysis.scm
 
 (define (haskell-dependency-reanalysis big-let)
   (phase-body depend2
     (begin
       (analyze-dependency-top big-let)
       big-let)
     (function pprint*)))
 
 
 (predefine (ast-to-flic x))		; in flic/ast-to-flic.scm
 
 (define (haskell-ast-to-flic big-let)
   (phase-body flic
     (ast-to-flic big-let)
     (function pprint*)))
 
 
 (predefine (optimize-top x))  ; in backend/optimize.scm
 
 (define (haskell-optimize big-let)
   (phase-body optimize
     (optimize-top big-let)
     (function pprint*)))
 
 (predefine (strictness-analysis-top x)) ; in backend/strictness.scm
 (predefine (strictness-analysis-printer x))
 
 (define (haskell-strictness big-let)
   (phase-body strictness
     (strictness-analysis-top big-let)
     (function strictness-analysis-printer)))
 
 
 (predefine (codegen-top x))  ; in backend/codegen.scm
 (predefine (codegen-exported-types x)) ; "
 (predefine (codegen-prim-entries x))  ; ditto
 
 (define (haskell-codegen big-let mods)
   (phase-body codegen
     `(begin
        ,(codegen-exported-types mods)
        ,(codegen-top big-let))
     #f))
 
 	       
 ;;; This is for interface modules.
 
 (predefine (haskell-codegen/interface mods))
 
 (define (compile-interface-modules mods)
  (dynamic-let ((*context*                    '#f)
 	       (*recoverable-error-handler*  '#f)
 	       (*abort-phase*                '#f))
      (haskell-import-export mods '#t)
      (haskell-process-type-declarations mods)
      (haskell-scope mods)
      (haskell-codegen/interface mods)))