;;;; Cyclone Scheme
;;;; https://github.com/justinethier/cyclone
;;;;
;;;; Copyright (c) 2014-2016, Justin Ethier
;;;; All rights reserved.
;;;;
;;;; This module contains a front-end for the compiler itself.
;;;;
(import (scheme base)
        (scheme case-lambda)
        (scheme eval)
        (scheme file)
        (scheme lazy)
        (scheme read)
        (scheme time)
        (scheme write)
        (scheme cyclone ast)
        (scheme cyclone common)
        (scheme cyclone util)
        (scheme cyclone cgen)
        (scheme cyclone primitives)
        (scheme cyclone transforms)
        (scheme cyclone cps-optimizations)
        (scheme cyclone libraries)
        (srfi 18))

(define *fe:batch-compile* #t) ;; Batch compilation. TODO: default to false or true??
(define *optimization-level* 2) ;; Default level
(define *optimize:memoize-pure-functions* #f) ;; Memoize pure function
(define *optimize:beta-expand-threshold* #f) ;; BE threshold or #f to use default
(define *optimize:inline-unsafe* #f) ;; Inline primitives even if generated code may be unsafe
(define *cgen:track-call-history* #t)
(define *cgen:use-unsafe-prims* #f)

; Placeholder for future enhancement to show elapsed time by phase:
(define *start* (current-second))
;; FUTURE: make this a cmd line option
(define *report-elapsed* #f)
(define (report:elapsed label)
  (when *report-elapsed*
    (display "Elapsed is " (current-error-port))
    (display (- (current-second) *start*) (current-error-port))
    (display (string-append " at " label) (current-error-port))
    (newline (current-error-port))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Batch compilation section

;; Do we need to recompile given library?
(define (recompile? lib-dep append-dirs prepend-dirs)
  (let* ((sld-file (lib:import->filename lib-dep ".sld" append-dirs prepend-dirs))
         (includes (lib:read-includes lib-dep append-dirs prepend-dirs))
         (included-files
           (map
             (lambda (include)
               (lib:import->path lib-dep append-dirs prepend-dirs include))
             includes))
         (base (basename sld-file))
         (obj-file (string-append base ".o"))
         (sys-dir (Cyc-installation-dir 'sld)) )
    (and
      (not (in-subdir? sys-dir sld-file)) ;; Never try to recompile installed libraries
      (or
        (not (file-exists? obj-file)) ;; No obj file, must rebuild
        (any 
          (lambda (src-file)
            (> (file-mtime src-file)
               (file-mtime obj-file))) ;; obj file out of date
          (cons sld-file included-files))))))

;; Is "path" under given subdirectory "dir"?
(define (in-subdir? dir path)
  (and (>= (string-length path)
           (string-length dir))
       (equal? dir (substring path 0 (string-length dir)))))

(define-c file-mtime
  "(void *data, int argc, closure _, object k, object filename)"
  " make_double(box, 0.0);
    Cyc_check_str(data, filename);
    double_value(&box) = Cyc_file_last_modified_time(string_str(filename));
    return_closcall1(data, k, &box); ")

(define-c calling-program
  "(void *data, int argc, closure _, object k)"
  " make_utf8_string(data, s, _cyc_argv[0]);
    return_closcall1(data, k, &s); ")
;; END batch compilation
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; Code emission.
  
; c-compile-and-emit : (string -> A) exp -> void
(define (c-compile-and-emit input-program program:imports/code 
                            lib-deps change-lib-deps! src-file append-dirs prepend-dirs)
  (call/cc 
    (lambda (return)
      (define globals '())
      (define module-globals '()) ;; Globals defined by this module
      (define program? #t) ;; Are we building a program or a library?
      (define imports '())
      (define inlines '())
      (define imported-vars '())
      (define lib-name '())
      (define lib-exports '())
      (define lib-renamed-exports '())
      (define lib-pass-thru-exports '())
      (define c-headers '())
      (define rename-env (env:extend-environment '() '() '()))

      (emit *c-file-header-comment*) ; Guarantee placement at top of C file
    
      (report:elapsed "---------------- input program:")
      (trace:info "---------------- input program:")
      (trace:info input-program) 

      (cond
        ((library? (car input-program))
         (let ((includes (lib:includes (car input-program))))
           (set! program? #f)
           (set! lib-name (lib:name (car input-program)))
           (set! c-headers (lib:include-c-headers (car input-program)))
           (when (> *optimization-level* 0)
             (set! inlines (lib:inlines (car input-program))))
           (set! lib-exports
             (cons
               (lib:name->symbol lib-name)
               (lib:exports (car input-program))))
           (set! lib-pass-thru-exports lib-exports)
           (set! lib-renamed-exports 
             (lib:rename-exports (car input-program)))
           (set! imports (lib:imports (car input-program)))
           (set! input-program (lib:body (car input-program)))
           ;; Add any renamed exports to the begin section
           (set! input-program
                 (append
                   (map 
                     (lambda (r) 
                      `(define ,(caddr r) ,(cadr r)))
                     lib-renamed-exports)   
                   input-program))
           ;; Prepend any included files into the begin section
           (if (not (null? includes))
             (for-each
               (lambda (include)
                 (set! input-program 
                       (append (read-file ;(string-append 
                                            (lib:import->path lib-name append-dirs prepend-dirs include) 
                                            ;include)
                       ) 
                               input-program)))
               (reverse includes))))) ;; Append code in same order as the library's includes
        (else
          ;; Handle imports, if present
          (let ((reduction program:imports/code))
            (set! imports (car reduction))
            (set! input-program (cdr reduction)))

          ;;  Handle inline list, if present`
          (let ((lis (lib:inlines `(dummy dummy ,@input-program))))
            (cond
              ((not (null? lis))
               (when (> *optimization-level* 0)
                 (set! inlines lis))
               (set! input-program 
                     (filter 
                       (lambda (expr)
                         (not (tagged-list? 'inline expr)))
                       input-program)))))

          ;; Handle any C headers
          (let ((headers (lib:include-c-headers `(dummy dummy ,@input-program))))
            (cond
              ((not (null? headers))
               (set! c-headers headers)
               (set! input-program 
                     (filter 
                       (lambda (expr)
                         (not (tagged-list? 'include-c-header expr)))
                       input-program)))))
        ))

      (report:elapsed "inline candidates:")
      (trace:info "inline candidates:")
      (trace:info inlines)

      ;; Process library imports
      (report:elapsed "imports:")
      (trace:info "imports:")
      (trace:info imports)
      (set! imported-vars (lib:imports->idb imports append-dirs prepend-dirs (base-expander)))
      (report:elapsed "resolved imports:")
      (trace:info "resolved imports:")
      (trace:info imported-vars)
      (let ((meta (lib:resolve-meta imports append-dirs prepend-dirs)))
        (set! *defined-macros* (append meta *defined-macros*))
        (trace:info "resolved macros:")
        (trace:info meta))

      ;; TODO: how to handle stdlib when compiling a library??
      ;; either need to keep track of what was actually used,
      ;; or just assume all imports were used and include them
      ;; in final compiled program
      ;(set! input-program (add-libs input-program))
    
      ;; Load macros for expansion phase
      (let ((macros (filter 
                      (lambda (v) 
                        (Cyc-macro? (Cyc-get-cvar (cdr v))))
                      (Cyc-global-vars))))
        (set! *defined-macros*
              (append
                macros
                *defined-macros*)))
      (macro:load-env! *defined-macros* (create-environment '() '()))

      ;; Expand macros
      ;; In each case, the input is expanded in a way that ensures
      ;; defines from any top-level begins are spliced correctly.
      (set! input-program 
        (cond
          (program?
            (expand-lambda-body input-program (macro:get-env) rename-env))
          (else
            (let ((expanded (expand `(begin ,@input-program) 
                                    (macro:get-env)
                                    rename-env)))
              (cond
                ((and (pair? expanded)
                      (tagged-list? 'lambda (car expanded)))
                 (lambda->exp (car expanded)))
                ((tagged-list? 'define expanded)
                 (list expanded))
                ((boolean? expanded)
                 (list expanded))
                (else
                  (error `(Unhandled expansion ,expanded))))))))
      (report:elapsed "---------------- after macro expansion:")
      (trace:info "---------------- after macro expansion:")
      (trace:info input-program) 
      (set! input-program (macro:cleanup input-program rename-env))
      (report:elapsed "---------------- after macro expansion cleanup:")
      (trace:info "---------------- after macro expansion cleanup:")
      (trace:info input-program) 

      ;; If a program, check to see if any macros expanded into top-level imports
      (when program?
        (let ((program:imports/code (import-reduction input-program (base-expander))))
          (when (not (null? (car program:imports/code)))
            (trace:info "-------------- macro expanded into import expression(s):")
            (set! imports (append imports (car program:imports/code)))
            (trace:info "imports:")
            (trace:info imports)
            (set! imported-vars (lib:imports->idb imports append-dirs prepend-dirs (base-expander)))
            (report:elapsed "resolved imports:")
            (trace:info "resolved imports:")
            (trace:info imported-vars)
            (let ((meta (lib:resolve-meta imports append-dirs prepend-dirs)))
              (set! *defined-macros* (append meta *defined-macros*))
              (trace:info "resolved macros:")
              (trace:info meta))
            (set! input-program (cdr program:imports/code))
            ;(set! lib-deps (append lib-deps (lib:get-all-import-deps (car program:imports/code) append-dirs prepend-dirs)))
            (let ((changed #f)
                  (new-lib-deps (lib:get-all-import-deps (car program:imports/code) append-dirs prepend-dirs #f)))
              (for-each
                (lambda (dep)
                  (when (not (member dep lib-deps))
                    (set! changed #t)
                    (set! lib-deps (cons dep lib-deps))))
                new-lib-deps)
              (when changed
                ;; Library dependencies can change if additional import
                ;; expressions were encountered during macro expansion.
                ;; If so, update the list of dependencies now
                (set! ;; Use new deps
                  lib-deps 
                  (change-lib-deps! lib-deps)))) ;; Caller updates and returns new deps
            (trace:info lib-deps)
          )))
      ;; END additional top-level imports

      ;; Debug output for our dependencies
      (trace:info "---------------- Library dependencies")
      (trace:info lib-deps) 
      (trace:info "---------------- Library files")
      (trace:info (map 
                    (lambda (lib-dep)
                      (lib:import->filename lib-dep ".sld" append-dirs prepend-dirs))
                    lib-deps))
      ;; Build dependent libraries, if instructed
      (when *fe:batch-compile*
        (for-each 
          (lambda (lib-dep)
            (when (recompile? lib-dep append-dirs prepend-dirs)
              (let ((result (system (string-append 
                                      (calling-program) " " 
                                      (dirs->args "-A" append-dirs) " "
                                      (dirs->args "-I" prepend-dirs) " "
                                      (lib:import->filename lib-dep ".sld" append-dirs prepend-dirs)))))
                (when (> result 0)
                  (error "Unable to compile library" lib-dep)))))
          lib-deps))

      ;; Validate syntax of basic forms
      (validate-keyword-syntax input-program)

      ;; Separate global definitions from the rest of the top-level code
      (set! input-program 
          (isolate-globals input-program program? lib-name rename-env))

      ;; Optimize-out unused global variables
      ;; For now, do not do this if eval is used.
      ;; TODO: do not have to be so aggressive, unless (eval (read)) or such
      (if (not (has-global? input-program 'eval))
          (set! input-program 
            (filter-unused-variables input-program lib-exports)))

      (report:elapsed "---------------- after processing globals")
      (trace:info "---------------- after processing globals")
      (trace:info input-program) 

      ;; Identify global variables
      (set! module-globals (global-vars input-program))
      (set! globals (append (lib:idb:ids imported-vars) module-globals))

      ;; Register inlinable Scheme functions
      (for-each
        (lambda (e)
          (if (define-c-inline? e)
            (prim:add-udf! (define->var e) (define-c->inline-var e))))
            ;(write `(DEBUG add inline ,(define->var e) ,(define-c->inline-var e)))))
        input-program)

      ;; Inlines do not have to be non-CPS, they are really two separate things.
      ;; So keep track of all functions marked as inline because there are still
      ;; possibilities for optimization even if the function must call into its
      ;; continuation.
      (opt:add-inlinable-functions inlines) 

      ;; Trim down the export list to any exports that are just "pass throughs"
      ;; from imported libraries. That is, they are not actually defined in
      ;; the library being compiled
      (set! lib-pass-thru-exports
        (filter
          (lambda (e)
            (let ((module-global? (member e module-globals))
                  (imported-var? (assoc e imported-vars)))
              (cond
                ((eq? e 'call/cc) #f) ;; Special case
                ((and (not module-global?)
                      (not imported-var?)
                      (not (prim? e)))
                 (error "Identifier is exported but not defined" e))
                (else
                  ;; Pass throughs are not defined in this module,
                  ;; but by definition must be defined in an imported lib
                  (and (not module-global?) imported-var?)))))
          lib-pass-thru-exports))
      (report:elapsed "pass thru exports:")
      (trace:info "pass thru exports:")
      (trace:info lib-pass-thru-exports)
    
      ; Note alpha-conversion is overloaded to convert internal defines to 
      ; set!'s below, since all remaining phases operate on set!, not define.
      (set! globals (union globals '())) ;; Ensure list is sorted
      (set! input-program 
        (map
          (lambda (expr)
            (alpha-convert expr globals return))
          input-program))
      (report:elapsed "---------------- after alpha conversion:")
      (trace:info "---------------- after alpha conversion:")
      (trace:info input-program) 

      ;; EXPERIMENTAL CODE - Load functions in other modules that are
      ;; able to be inlined (in this context, from CPS).
      ;;
      ;; TODO: extend this initially by, for each import, invoking that module's inlinable_lambdas function
      ;;       behind an exception handler (in case the compiler does not have that module loaded).
      ;;
      ;;       Longer term, need to test if module is loaded (maybe do that in combo with exception handler above)
      ;;       and if not loaded, eval/import it and try again.
      ;;
      ;; assumes (scheme base) is available to compiler AND at runtime in the compiled module/program
      ;; TODO: probably not good enough since inlines are not in export list
      ;;
      ;; TODO: later on, in cgen, only add inlinables that correspond to exported functions
      
      (for-each
        (lambda (import)
          (with-handler
            (lambda (err)
              #f)
            (let* ((lib-name-str (lib:name->string (lib:list->import-set import)))
                   (inlinable-lambdas-fnc 
                    (string->symbol
                      (string-append "c_" lib-name-str "_inlinable_lambdas"))))
            (cond
              ((imported? import)
               (let ((lib-name (lib:import->library-name 
                                 (lib:list->import-set import)))
                     (vars/inlines
                       (filter
                        (lambda (v/i)
                          ;; Try to avoid name conflicts by not loading inlines
                          ;; that conflict with identifiers in this module.
                          ;; More of a band-aid than a true solution, though.
                          (not (member (car v/i) module-globals)))
                        (eval `( ,inlinable-lambdas-fnc )))))
                 ;(trace:info `(DEBUG ,import ,vars/inlines ,module-globals))
                 ;; Register inlines as user-defined primitives
                 (for-each
                   (lambda (v/i)
                     (let ((var (car v/i)) (inline (cdr v/i)))
                       (prim:add-udf! var inline)))
                   vars/inlines)
                 ;; Keep track of inline version of functions along with other imports
                 (set! imported-vars 
                   (append
                     imported-vars
                     (map
                       (lambda (v/i)
                         (cons (cdr v/i) lib-name))
                       vars/inlines)))))
              (else
                ;; TODO: try loading if not loaded (but need ex handler in case anything bad happens) #t ;(eval `(import ,import))
                ;;(%import import)
                ;; if this work is done, would need to consolidate inline reg code above
                #f)))))
        imports)
      ;; END

      ;; Convert some function calls to primitives, if possible
      (set! input-program 
        (map
          (lambda (expr)
            (prim-convert expr))
          input-program))
      (report:elapsed "---------------- after func->primitive conversion:")
      (trace:info "---------------- after func->primitive conversion:")
      (trace:info input-program) 

      ;; Identify native Scheme functions (from module being compiled) that can be inlined
      ;;
      ;; NOTE: There is a chicken-and-egg problem here that prevents this from 
      ;; automatically working 100%. Basically we need to know whether the inline logic will
      ;; work for a given candidate. The problem is, the only way to do that is to run the
      ;; code through CPS and by then we would have to go back and repeat many phases if a
      ;; candidate fails the inline tests. At least for now, an alternative is to require 
      ;; user code to specify (via inline) what functions the compiler should try inlining.
      ;; There is a small chance one of those inlines can pass these tests and still fail
      ;; the subsequent inline checks though, which causes an error in the C compiler.
      (define inlinable-scheme-fncs '())
      (let ((lib-init-fnc (lib:name->symbol lib-name))) ;; safe to ignore for programs
        (for-each
          (lambda (e)
            (when (and (define? e)
                       (member (define->var e) inlines) ;; Primary check, did use request inline
                       (not (equal? (define->var e) lib-init-fnc))
                       (inlinable-top-level-lambda? e)) ;; Failsafe, reject if basic checks fail
              (set! inlinable-scheme-fncs
                (cons (define->var e) inlinable-scheme-fncs))
              (set! module-globals
                (cons (define-c->inline-var e) module-globals))
              (prim:add-udf! (define->var e) (define-c->inline-var e))))
          input-program)
        (report:elapsed "---------------- results of inlinable-top-level-lambda analysis: ")
        (trace:info "---------------- results of inlinable-top-level-lambda analysis: ")
        (trace:info inlinable-scheme-fncs))
    
      (let ((cps (map 
                   (lambda (expr)
                     (cps-convert expr))
                   input-program)))
        (cond
         ((and library? (equal? lib-name '(scheme base)))
           (set! globals (append '(call/cc) globals))
           (set! module-globals (append '(call/cc) module-globals))
           (set! input-program 
             ;(cons
             ; ;; Experimental version of call-with-values,
             ; ;; seems OK in compiler but not in eval.
             ; '(define call-with-values
             ;   (lambda (k producer consumer)
             ;     (let ((x (producer)))
             ;       (if (and (pair? x) (equal? '(multiple values) (car x)))
             ;         (apply consumer (cdr x))
             ;         (consumer k x))))
             ;   ;  (producer 
             ;   ;    (lambda (result)
             ;   ;      (consumer k result))))
             ;   )
                    ;; multiple args requires more than just this.
                    ;; may want to look at:
                    ;; http://stackoverflow.com/questions/16674214/how-to-implement-call-with-values-to-match-the-values-example-in-r5rs
                    ;; (lambda vals
                    ;;   (apply k consumer vals)))))
             (cons
               ;; call/cc must be written in CPS form, so it is added here
               `(define call/cc
                 ,(ast:make-lambda 
                    '(k f) 
                    (list 
                      (list 'f 'k 
                            (ast:make-lambda '(_ result) 
                                             (list '(k result)))))))
                 ;(lambda (k f) (f k (lambda (_ result) (k result)))))
                cps)));)
         (else
           ;; No need for call/cc yet
           (set! input-program cps))))
      (report:elapsed "---------------- after CPS:")
      (trace:info "---------------- after CPS:")
      (trace:info (ast:ast->pp-sexp input-program))

      (define (inject-import lis)
        (let ((dep (lib:list->import-set lis)))
          (when (not (member dep lib-deps))
            (set! lib-deps (append lib-deps (list dep)))
            (change-lib-deps! lib-deps)))
      )

      (define (inject-globals! lis)
        ;; FUTURE: these lines are specifically for memoization optizations.
        ;;  if we need to make this more generic and have other globals
        ;;  injected, then this code will need to be relocated, maybe into
        ;;  an 'inject-memoization!' or such helper.
        (when (not (member 'Cyc-memoize globals))
          (set! globals (append globals '(Cyc-memoize)))
          (set! imported-vars (cons (lib:list->import-set '(Cyc-memoize srfi 69)) imported-vars))
        )

        (inject-import '(scheme cyclone common))
        (inject-import '(scheme base))
        (inject-import '(scheme char))
        (inject-import '(srfi 69))
        ;; END memoization-specific code

        (set! module-globals (append module-globals lis))
        (set! globals (append globals lis))
        (set! globals (union globals '())) ;; Ensure list is sorted
      )

      (define (flag-set? flag)
        (cond
          ((eq? flag 'memoize-pure-functions) 
           (and program? ;; Only for programs, because SRFI 69 becomes a new dep
                *optimize:memoize-pure-functions*))
          ((eq? flag 'track-call-history)
           *cgen:track-call-history*)
          ((eq? flag 'use-unsafe-prims)
           *cgen:use-unsafe-prims*)
          ((eq? flag 'inline-unsafe)
           *optimize:inline-unsafe*)
          ((eq? flag 'beta-expand-threshold)
           *optimize:beta-expand-threshold*)
          (else #f)))

      (when (> *optimization-level* 0)
        (set! input-program
          (optimize-cps input-program inject-globals! flag-set?))
        (report:elapsed "---------------- after cps optimizations (1):")
        (trace:info "---------------- after cps optimizations (1):")
        (trace:info (ast:ast->pp-sexp input-program))

        (set! input-program
          (optimize-cps input-program inject-globals! flag-set?))
        (report:elapsed "---------------- after cps optimizations (2):")
        (trace:info "---------------- after cps optimizations (2):")
        (trace:info (ast:ast->pp-sexp input-program))
        
        (set! input-program
          (optimize-cps input-program inject-globals! flag-set?))
        (report:elapsed "---------------- after cps optimizations (3):")
        (trace:info "---------------- after cps optimizations (3):")
        (trace:info (ast:ast->pp-sexp input-program))
      )
    
      (set! input-program (opt:local-var-reduction input-program))
      (report:elapsed "---------------- after local variable reduction")
      (trace:info "---------------- after local variable reduction")
      (trace:info (ast:ast->pp-sexp input-program))

      ;; Clean up lambda numbering after code elimination
      (set! input-program (opt:renumber-lambdas! input-program))
      (report:elapsed "---------------- after renumber lambdas")
      (trace:info "---------------- after renumber lambdas")
      (trace:info (ast:ast->pp-sexp input-program))

      (set! input-program
        (map
          (lambda (expr)
            (clear-mutables)
            (analyze-mutable-variables expr)
            (wrap-mutables expr globals))
          input-program))
      (report:elapsed "---------------- after wrap-mutables:")
      (trace:info "---------------- after wrap-mutables:")
      (trace:info (ast:ast->pp-sexp input-program))
    
      ;; Perform this analysis here since we need it later so it doesn't
      ;; make sense to execute it multiple times during CPS optimization
      (analyze:find-known-lambdas input-program)

      (set! input-program 
        (map
          (lambda (expr)
            (cond
             ((define? expr)
              ;; Global
              `(define ,(define->var expr)
                 ,@(car (ast:lambda-body (closure-convert (define->exp expr) globals *optimization-level*)))))
             ((define-c? expr)
              expr)
             (else
              (car (ast:lambda-body ;; Strip off superfluous lambda
                (closure-convert expr globals *optimization-level*))))))
          input-program))
      (report:elapsed "---------------- after closure-convert:")
      (trace:info "---------------- after closure-convert:")
      (trace:info (ast:ast->pp-sexp input-program))

      (report:elapsed "---------------- analysis db: ")
      (trace:info "---------------- analysis db: ")
      (trace:info (adb:get-db))
      
      (when (not *do-code-gen*)
        (trace:error "DEBUG, existing program")
        (exit 0))
    
      (trace:info "---------------- C headers: ")
      (trace:info c-headers)

      (trace:info "---------------- module globals: ")
      (trace:info module-globals)

      (report:elapsed "---------------- C code:")
      (trace:info "---------------- C code:")
      (mta:code-gen input-program 
                    program? 
                    lib-name 
                    lib-pass-thru-exports
                    imported-vars
                    module-globals
                    c-headers
                    lib-deps
                    src-file
                    flag-set?) 
      (return '())))) ;; No codes to return

;; Read top-level imports from a program and return a cons of:
;; - imports
;; - remaining program
(define (import-reduction expr expander)
  (let ((results
          (foldl
            (lambda (ex accum)
              (define (process e)
                (cond
                  ((tagged-list? 'import e)
                   (cons (cons (cdr e) (car accum)) (cdr accum)))
                  (else
                    (cons (car accum) (cons e (cdr accum))))))
              (cond
               ((tagged-list? 'cond-expand ex)
                (let ((ex* (expander ex))) ;(expand ex (macro:get-env) rename-env)))
                  ;(trace:info `(DEBUG ,ex* ,ex))
                  (if (tagged-list? 'import ex*)
                      (process ex*)
                      (process ex))))
               (else
                (process ex))))
            (cons '() '())
            expr)))
    (cons
      (apply append (reverse (car results)))
      (reverse (cdr results)))))

;; Return a function to expand any built-in macros
;; NOTE: since this uses a global macro env, it will be overridden later on when
;; macros are loaded from dependent libraries.
(define (base-expander)
  (let ((rename-env (env:extend-environment '() '() '()))
        (macros (filter 
                  (lambda (v) 
                    (Cyc-macro? (Cyc-get-cvar (cdr v))))
                  (Cyc-global-vars))))
    (macro:load-env! macros (create-environment '() '()))
    (lambda (ex) 
      (expand ex (macro:get-env) rename-env))))

;; TODO: longer-term, will be used to find where cyclone's data is installed
(define (get-data-path)
  ".")

(define (get-lib filename)
  (string-append (get-data-path) "/" filename))

(define (read-file filename)
  (call-with-input-file filename
    (lambda (port)
      (read-all/source port filename))))

;; Parse given expression and return data from any instances
;; of c-compiler-options
(define (program-c-compiler-opts! in-prog)
  (get-options! 'c-compiler-options in-prog))

(define (program-c-linker-opts! in-prog)
  (get-options! 'c-linker-options in-prog))

(define (get-options! opt in-prog)
  (foldl
    (lambda (expr acc)
      (cond
       ((tagged-list? opt expr)
        ;; Replace expression since it is only used in this initial 
        ;; pass, and would cause problems downstream
        (set-car! expr (string->symbol "quote"))
        (cons (cadr expr) acc))
       (else
         acc)))
    '()
    in-prog))

;; Compile and emit:
(define (run-compiler args append-dirs prepend-dirs change-cc-opts!)
  (let* ((in-file (car args))
         (expander (base-expander))
         (in-prog-raw (read-file in-file))
         (program? (not (library? (car in-prog-raw))))
         (in-prog
          (cond
            (program? 
              (Cyc-add-feature! 'program) ;; Load special feature
              ;; TODO: what about top-level cond-expands in the program?
              in-prog-raw)
            (else
              ;; Account for any cond-expand declarations in the library
              (list (lib:cond-expand in-file (car in-prog-raw) expander)))))
          ;; expand in-prog, if a library, using lib:cond-expand.
          ;; TODO: will also need to do below in lib:get-all-import-deps, after reading each library
         (program:imports/code (if program? (import-reduction in-prog expander) '()))
         (lib-deps 
           (if (and program?
                    (not (null? (car program:imports/code))))
             (lib:get-all-import-deps (car program:imports/code) append-dirs prepend-dirs expander)
            '()))
        ;; Read C compiler options
         (cc-opts
          (cond
            (program? 
              (let ((opts (program-c-compiler-opts! in-prog)))
                (when (not (null? opts))
                  (change-cc-opts! opts))
                (string-join ;; Check current program for options
                  opts
                  " ")))
            (else
              (string-join 
                (lib:c-compiler-options (car in-prog)) 
                " "))))
         ;; Read all linker options from dependent libs
         (c-linker-options
           (let ((lib-options (lib:get-all-c-linker-options lib-deps append-dirs prepend-dirs expander)))
             (if program?
                 (string-append ;; Also read from current program
                   (string-join (program-c-linker-opts! in-prog) " ")
                   " "
                   lib-options)
                 lib-options)))
         (exec-file (basename in-file))
         (src-file (string-append exec-file ".c"))
         (meta-file (string-append exec-file ".meta"))
         (get-comp-env 
           (lambda (sym str)
             (if (> (string-length str) 0)
                 str
                 (Cyc-compilation-environment sym)))) 
         (create-c-file 
           (lambda (program) 
             (with-output-to-file 
               src-file
               (lambda ()
                 (c-compile-and-emit 
                   program 
                   program:imports/code 
                   lib-deps 
                   (lambda (new-lib-deps)
                     ;; Deps changed so we need to
                     ;; resolve dependency tree again
                     (set! 
                       lib-deps
                       (lib:get-all-import-deps 
                         new-lib-deps
                         append-dirs 
                         prepend-dirs 
                         expander))
                     ;; Recompute linker options
                     (set! c-linker-options
                       (lib:get-all-c-linker-options 
                         lib-deps 
                         append-dirs 
                         prepend-dirs
                         expander))
                     ;; Return new deps
                     lib-deps)
                   in-file 
                   append-dirs 
                   prepend-dirs))))))
    (create-c-file in-prog)
    (cond
     (program?
      ;; Use .meta file to store information for C compiler phase
      (save-program-metadata meta-file lib-deps c-linker-options))
     (else
      ;; Emit .meta file
      (with-output-to-file
        meta-file
        (lambda ()
          (display ";; This file was automatically generated by the Cyclone Scheme compiler")
          (newline)
          (write (macro:get-defined-macros))))))))

(define (save-program-metadata filename lib-deps c-linker-options)
  (with-output-to-file
    filename
    (lambda ()
      (display ";; This file was automatically generated by the Cyclone Scheme compiler")
      (newline)
      (write `(lib-deps . ,lib-deps))
      (newline)
      (write `(c-linker-options . ,c-linker-options)))))

(define (load-program-metadata filename)
  (let ((data (call-with-input-file filename  read-all)))
    (delete-file filename)
    data))

(define (get-meta meta symbol default)
  (if (assoc symbol meta)
      (cdr (assoc symbol meta))
      default))

(define (run-external-compiler 
           args append-dirs prepend-dirs
           cc? cc-prog cc-exec cc-lib cc-so 
           cc-opts cc-prog-linker-opts cc-prog-linker-objs)
  (let* ((in-file (car args))
         (expander (base-expander))
         (in-prog-raw (read-file in-file))
         (program? (not (library? (car in-prog-raw))))
         (in-prog
          (cond
            (program? 
              (Cyc-add-feature! 'program) ;; Load special feature
              ;; TODO: what about top-level cond-expands in the program?
              in-prog-raw)
            (else
              ;; Account for any cond-expand declarations in the library
              (list (lib:cond-expand in-file (car in-prog-raw) expander)))))
         ;; Only read C compiler options from module being compiled
         (cc-opts*
          (cond
            (program? 
              (string-join ;; Check current program for options
                (program-c-compiler-opts! in-prog)
                " "))
            (else
              (string-join 
                (lib:c-compiler-options (car in-prog)) 
                " "))))
         (exec-file (basename in-file))
         (src-file (string-append exec-file ".c"))
         (meta-file (string-append exec-file ".meta"))
         (get-comp-env 
           (lambda (sym str)
             (if (> (string-length str) 0)
                 str
                 (Cyc-compilation-environment sym)))) 
        )
    ;; Compile the generated C file
    (cond
      (program?
        (letrec ((metadata (load-program-metadata meta-file))
                 (c-linker-options (get-meta metadata 'c-linker-options '()))
                 (lib-deps (get-meta metadata 'lib-deps '()))
                 (objs-str 
                  (string-append
                    cc-prog-linker-objs
                    (apply
                      string-append
                      (map
                        (lambda (i)
                          (string-append " " (lib:import->filename i ".o" append-dirs prepend-dirs) " "))
                        lib-deps))))
                 (comp-prog-cmd 
                   (string-append
                     (string-replace-all 
                       (string-replace-all 
                         (string-replace-all 
                           ;(Cyc-compilation-environment 'cc-prog) 
                           (get-comp-env 'cc-prog cc-prog)
                           "~src-file~" src-file)
                         "~cc-extra~" cc-opts)
                       "~exec-file~" exec-file)
                     " "
                     cc-opts*))
                 (comp-objs-cmd 
                  (string-append
                   (string-replace-all
                     (string-replace-all
                       (string-replace-all
                         (string-replace-all
                           ;(Cyc-compilation-environment 'cc-exec)
                           (get-comp-env 'cc-exec cc-exec)
                           "~exec-file~" exec-file)
                         "~ld-extra~" cc-prog-linker-opts)
                       "~obj-files~" objs-str)
                     "~exec-file~" exec-file)
                   " "
                   c-linker-options
                   )))
          ;(write `(DEBUG all imports ,lib-deps objs ,objs-str))
          ;(write `(DEBUG ,(lib:get-all-import-deps (cdar in-prog))))
          (cond
            (cc?
             (if (equal? 0 (system comp-prog-cmd))
               (system comp-objs-cmd)))
            (else
              (display comp-prog-cmd)
              (newline)
              (display comp-objs-cmd)
              (newline)))))
      (else
        ;; Compile library
        (let ((comp-lib-cmd
               (string-append
                (string-replace-all 
                  (string-replace-all 
                    (string-replace-all 
                      (get-comp-env 'cc-lib cc-lib)
                      "~src-file~" src-file)
                    "~cc-extra~" cc-opts)
                  "~exec-file~" exec-file)
                " "
                cc-opts*))
              (comp-so-cmd
               (string-append
                (string-replace-all 
                  (string-replace-all 
                    (get-comp-env 'cc-so cc-so)
                    "~src-file~" src-file)
                  "~exec-file~" exec-file)
                " "
                cc-opts
                " "
                cc-opts*))
              )
          (cond
            (cc?
              (system comp-lib-cmd)
              (system comp-so-cmd)
            )
            (else
              (display comp-lib-cmd)
              (newline)
              (display comp-so-cmd)
              (newline))))))))

;; Collect values for the given command line arguments and option.
;; Will return a list of values for the option.
;; For example:
;;  ("-a" "1" "2") ==> ("1")
;;  ("-a" "1" "-a" "2") ==> ("1" "2")
(define (collect-opt-values args opt)
  (cdr
    (foldl
      (lambda (arg accum)
        (cond
          ((equal? arg opt)
           (cons opt (cdr accum)))
          ((car accum) ;; we are at an opt value
           (cons #f (cons arg (cdr accum))))
          (else
           (cons #f (cdr accum)))))
      (list #f)
      args)))

;; Convert a list of directories to a string of arguments.
;; EG: (dirs->args "-I" '("dir-1" "dir-2")) =>
;;     " -I dir-1 -I dir-2 "
(define (dirs->args prefix dirs)
  (apply 
    string-append
    (map
      (lambda (dir)
        (string-append " " prefix " " dir " "))
      dirs)))

;; Handle command line arguments
(let* ((args (command-line-arguments))
       (non-opts 
        (if (null? args)
            '()
            (list (car (reverse args)))))
                ; (filter
                ;   (lambda (arg) 
                ;     (not (and (> (string-length arg) 1)
                ;               (equal? #\- (string-ref arg 0)))))
                ;   args))
       (compile? #t)
       (run-scm-compiler? (member "-run-scm-compiler" args))
       (no-compiler-subprocess (member "-no-compiler-subprocess" args))
       (cc-prog (apply string-append (collect-opt-values args "-CP")))
       (cc-exec (apply string-append (collect-opt-values args "-CE")))
       (cc-lib  (apply string-append (collect-opt-values args "-CL")))
       (cc-so   (apply string-append (collect-opt-values args "-CS")))
       (cc-opts (apply string-append (collect-opt-values args "-COPT")))
       (cc-linker-opts (apply string-append (collect-opt-values args "-CLNK")))
       (cc-linker-extra-objects (apply string-append (collect-opt-values args "-COBJ")))
       (opt-beta-expand-thresh (collect-opt-values args "-opt-be"))
       (append-dirs (collect-opt-values args "-A"))
       (prepend-dirs (collect-opt-values args "-I")))
  (if (member "-batch" args)
      (set! *fe:batch-compile* #t))
  (if (member "-no-batch" args)
      (set! *fe:batch-compile* #f))
  ;; Set optimization level(s)
  (if (member "-O0" args)
      (set! *optimization-level* 0))
  ;; Gather other optimization settings
  (when (pair? opt-beta-expand-thresh)
      (set! *optimize:beta-expand-threshold* 
            (string->number 
              (car opt-beta-expand-thresh))))
  (if (member "-opt-inline-unsafe" args)
      (set! *optimize:inline-unsafe* #t))
  (if (member "-memoization-optimizations" args)
      (set! *optimize:memoize-pure-functions* #t))
  (if (member "-no-memoization-optimizations" args)
      (set! *optimize:memoize-pure-functions* #f))
  (if (member "-use-unsafe-prims" args)
      (set! *cgen:use-unsafe-prims* #t))
  (if (member "-no-call-history" args)
      (set! *cgen:track-call-history* #f))
  ;; TODO: place more optimization reading here as necessary
  ;; End optimizations
  (if (member "-t" args)
      (set! *trace-level* 4)) ;; Show all trace output
  (if (member "-d" args)
     (set! compile? #f)) ;; Debug, do not run GCC
  (cond
    ((or (member "-h" args)
         (member "--help" args))
     (display "
Usage: cyclone [OPTIONS] FILENAME
Run the Cyclone Scheme compiler.

General options:

 -A directory    Append directory to the list of directories that are searched 
                 in order to locate imported libraries.
 -I directory    Prepend directory to the list of directories that are searched 
                 in order to locate imported libraries.
 -CP cc-commands Specify a custom command line for the C compiler to compile
                 a program module. See Makefile.config for an example of how
                 to construct such a command line.
 -CE cc-commands Specify a custom command line for the C compiler to compile
                 an executable.
 -CL cc-commands Specify a custom command line for the C compiler to compile
                 a library module.
 -CS cc-commands Specify a custom command line for the C compiler to compile
                 a shared object module.
 -COBJ objects   Specify additional object files to send to the compiler
                 when linking a program. For example, this may be used
                 to link an executable where some object files are generated
                 via a makefile instead of by Cyclone.
 -COPT options   Specify custom options to provide to the C compiler,
                 EG: \"-Imy-directory\".
 -CLNK option    Specify a custom command to provide as a linker option,
                 EG: \"-lcurl\".
 -d              Only generate intermediate C files, do not compile them
 -t              Show intermediate trace output in generated C files
 -h, --help      Display usage information
 -v              Display version information
 -vn             Display version number

Compilation options:

 -batch          Automatically compile local library dependencies 
                 (enabled by default).
 -no-batch       Compile as a single unit, do not attempt to compile local
                 library dependencies.

Optimization options:

 -Ox             Optimization level, higher means more optimizations will
                 be used. Set to 0 to disable optimizations.
 -memoization-optimizations     Memoize recursive calls to pure functions, 
                                where possible (enabled by default).
 -no-memoization-optimizations  Disable the above memoization optimization.

Unsafe options:

 -use-unsafe-prims    Emit unsafe primitives. These primitives are faster
                      but do not perform runtime type checking or bounds
                      checking.

Debug options:

 -no-call-history     Do not track call history in the compiled code. This 
                      allows for a faster runtime at the cost of having 
                      no call history in the event of an exception.
")
     (newline))
    ((member "-v" args)
     (display *version-banner*))
    ((member "--autogen" args)
     (autogen "autogen.out")
     (newline))
    ((member "-v" args)
     (display *version-banner*))
    ((member "-vn" args)
     (display (Cyc-version)))
    ((member "--autogen" args)
     (autogen "autogen.out"))
    ((or (< (length args) 1)
         (null? non-opts))
     (display "cyclone: no input file")
     (newline))
    (else
     (with-handler
      (lambda (err)
        ;; Top-level exception handler for the compiler.
        ;;
        ;; We set this up since call history is generally
        ;; pointless for users of the compiler, so we don't
        ;; want to display it.
        (parameterize ((current-output-port (current-error-port)))
          (cond
           ((and (string? (car err))
                 (equal? (substring (car err) 0 8)
                         "at line "))
            (display "Error "))
           (else
            (display "Error: ")))
          (display (car err))
          (display ": ")
          (newline)
          (for-each
            (lambda (obj)
              (write obj)
              (newline))
            (cdr err))
          (newline)
          (exit 1)))
      (cond
        (run-scm-compiler? 
          ;; Compile Scheme code into a C file
          (run-compiler non-opts append-dirs prepend-dirs
            (lambda (opts) 
              (set! cc-opts opts))))
        (else
          ;; Generate the C file
          (cond
           (no-compiler-subprocess
            ;; Special case, we can generate .C file within this process
            (run-compiler non-opts append-dirs prepend-dirs
              (lambda (opts) (set! cc-opts opts)))

            )
           (else
            ;; Normal path is to run another instance of cyclone to generate
            ;; the .C file. This lets us immediately free those resources once
            ;; the Scheme compilation is done.
            (when (not (zero? (system
                                (string-append 
                                  (calling-program) " -run-scm-compiler "
                                  (string-join args " ")))))
              (exit 1))))
          ;; Call the C compiler
          (run-external-compiler
            non-opts append-dirs prepend-dirs
            compile? cc-prog cc-exec cc-lib cc-so 
            cc-opts cc-linker-opts cc-linker-extra-objects)))
      ))))

