#lang scheme/base

;; POSTPROCESSING and OPTIMIZATION

;; This part is separate from target-compile.ss because the data
;; structure representation changed to a linked graph representing all
;; of the code, instead of the threaded immutable structure used in the compiler.


;; * inside the compiler, all data structures are functional. (labels
;;    are just abstract entities and not attached to any code)

;;  * in the postprocessor and assembler, labels contain:
;;       - code: which contains expressions that indirectly reference labels
;;       - next: the word immediately following, in case there's no terminating jump

(require
 "../target.ss"
 "../tools.ss"
 "../scat.ss"
 "../coma.ss"
 "../control.ss"
 scheme/pretty
 scheme/match)

(provide
 target-postprocess!
 target-postprocess
 macros->postprocess

 empty-ctrl->asm
 assert-empty-ctrl
 
 )

(define (empty-ctrl->asm state [name ""])
   (match state
          ((struct 2stack (ctor asm ctrl))
           (unless (null? ctrl)
             (error 'non-null-compilation-stack
                    "~a ~s" name ctrl))
           asm)))

(define (assert-empty-ctrl . a) (void (apply empty-ctrl->asm a)))


;; Turn a (set-of (list-of (list word code))) into a linked up
;; imperative data structure and perform postprocessing optimizations.

(define (target-postprocess! compiled-words)
  (define roots (link! compiled-words))
    
  (define (all: . fns)
    (let ((words (apply append (map target-chain->list roots))))
      (for-each (lambda (fn) (for-each fn words)) fns)))

  ;; Individual optimizations
  (all: target-post!)

  ;; No global optimizations yet
  
  roots)

;; Converts the (list-of (list-of (list word code))) to (list-of
;; word), with all graph structure linked in (code + chain)

(define (link! chains)
  (define link-chain!
    (match-lambda
     ((list w) w)
     ((list-rest w+ w ws)
      (set-target-word-next! w w+)
      (link-chain! (cons w ws)))))
  (define (link-code! word code)
    (set-target-word-code! word code)
    word)
  (map link-chain!
       (map (lambda (chain)
              (map* link-code! chain))
            chains)))


;; PER-WORD optimizations


;; Hook for target specific assembly postprocessing.  I.e. for PIC18
;; this translates the pseudo ops QW JW CW to real assembly code, and
;; performs SAVE elimination.

;; FIXME: the real question: why not postpone all optimisations till
;; later, and have the core language be simple?

(define target-postprocess
  (make-parameter
   (lambda (reverse-asm)
     reverse-asm)))

(define (target-post! word)
  (set-target-word-code! word
                         ((target-postprocess)
                          (target-word-code word))))


;; Lift a macro to a function that postprocesses a list of reversed
;; assembly code, by executing the macro after pushing the next
;; instruction to the assembly state. (Note that these macros are only
;; allowed to use the 2stack state.)
(define (macro->postprocessor macro)
  (lambda (reverse-asm)
    (let next ((a (reverse reverse-asm))
               (s (make-state:2stack '() '())))
      (let ((asm (empty-ctrl->asm s)))
        (if (null? a)
            asm
            (next (cdr a)
                  (macro
                      (make-state:2stack
                       (cons (car a) asm)
                       '() ;; empty ctrl
                       ))))))))

(define (do-macros->postprocess . macros)
  (lambda (asm)
    ((apply compose
            (map
             macro->postprocessor
             (reverse macros))) ;; use left -> right order
     asm)))
     
(define-sr (macros->postprocess namespace macro ...)
  (do-macros->postprocess
   (ns namespace macro) ...))




;; More optimizations:

;; * Serialize the code graph. Optimize jump sizes for words ending in
;;   'jw' (after dead code elimination), and eliminate jumps to the
;;   next word.

;; * jump chaining.