;; BF C Code Emitter
;; Jon Simons (simonsj at ccs dot neu dot edu)
;; August, 2007
;; -------------------------------------------------------------------------
;; This module emits ANSI-compatible C code for the BF IR.
;;
;;   Memory is represented with a char[].  "The pointer" is just a char*.
;;   No bounds checking is done for memory dereferencing.
;;
;;   ANSI functions getchar and putchar (via stdio.h) are used for IN and
;;   OUT emitting.
;;
;;   This module emits code which is completely oblivious to any integer
;;   wrapping issues.
;; -------------------------------------------------------------------------
(module bf-emit-c mzscheme
  
  (provide emit)
  
  ;; For AST structs
  (require "../bf-ast-to-ir.scm")
  ;; Emit Utils
  (require "bf-emit-util.scm")
  
  (require scheme/list)
  
  ;; emit : (list of EXPRs) -> string
  (define (emit AST)
    (string-append (emit-prologue)
                   (emit-program AST)
                   (emit-epilogue)))
  
  ;; emit-prologue : -> string
  (define (emit-prologue)
    (string-append "#include <stdio.h>\n"
                   "int main(int argc, char **argv)\n"
                   "{\n"
                   "  char mem[30000] = { 0 };\n"
                   "  char *p = mem;\n"))
  
  ;; emit-epilogue : -> string
  (define (emit-epilogue)
    (string-append "  return 0;~%"
                   "}~%"))
  
  ;; emit-program : (list of EXPRs) -> string
  (define (emit-program AST)
    (apply string-append (emit-exprs AST #f 2 ())))
  
  ;; Emits a list of strings which correspond to the given
  ;; list of EXPRs, using the given indentation level.
  ;;
  ;; The argument "mult-mode" should be #f for normal emitting,
  ;; or for MUL emitting, a MULTEMP.
  ;;
  ;; emit-exprs : (list of EXPRs) (#f or MULTEMP) number (list of strings)
  ;;              -> (list of strings)
  (define (emit-exprs lst mult-mode indent acc)
    
    ;; Here emit and emit+ are helpers for padding and formatting
    ;; strings to be emitted
    (let ((emit  (case-lambda
                   (()   (error "emitting nothing?"))
                   ((x)  (pad x indent))
                   (args (pad (apply format args) indent))))
          (emit+ (case-lambda
                   (()   (error "emitting nothing?"))
                   ((x)  (pad x (+ 2 indent)))
                   (args (pad (apply format args) (+ 2 indent))))))
      (if (null? lst)
          (reverse acc)
          (let* ((e   (car lst))
                 (ptr (EXPR-ptr e))
                 (N   (EXPR-N   e))
                 (str (case (EXPR-type e)
                        ((inc)  (emit "p[~v] += ~v~a;~%"
                                      ptr
                                      N
                                      (mult-string mult-mode)))
                        ((dec)  (emit "p[~v] -= ~v~a;~%"
                                      ptr
                                      N
                                      (mult-string mult-mode)))
                        ((lt)   (emit "p -= ~v;~%" N))
                        ((rt)   (emit "p += ~v;~%" N))
                        ((out)  (emit "putchar(p[~v]);~%" ptr))
                        ((in)   (emit "p[~v] = getchar();~%" ptr))
                        ((loop) (string-append
                                 (emit "while (p[~v]) {~%" ptr)
                                 (apply string-append
                                        (emit-exprs (EXPR-exprs e)
                                                    #f
                                                    (+ 2 indent)
                                                    ()))
                                 (emit "}~%")))
                        ((mul) (let ((mul-tmp (gen-MULTEMP ptr)))
                                 (string-append
                                  (emit "{~%")
                                  (emit+ (MULTEMP-init mul-tmp))
                                  (emit+ "if (~a != 0) {~%"
                                         (MULTEMP-val mul-tmp))
                                  (apply string-append
                                         (emit-exprs (EXPR-exprs e)
                                                     mul-tmp
                                                     (+ 4 indent)
                                                     ()))
                                  (emit+ "}~%")
                                  (emit "}~%"))))
                        ((zero) (emit "p[~v] = 0;~%" ptr))
                        (else  (error "unknown token, can't emit")))))
            (emit-exprs (cdr lst) mult-mode indent (cons str acc))))))
  ;; MULTEMP Stuff -----------------------------------------------------------
  
  ;; Used for declaring and referencing temp variables in the target language.
  ;;
  ;; make-MULTEMP : string string -> MULTEMP
  (define-struct MULTEMP (init val))
  
  ;; Used for generating MULTEMPs; see gen-MULTEMP.
  ;;
  ;; gen-wrap: (nothing) -> (number -> MULTEMP)
  (define (gen-wrap)
    (let ((tmp-num (box 0)))
      (lambda (ptr)
        (begin
          (set-box! tmp-num (+ 1 (unbox tmp-num)))
          (make-MULTEMP (format "char mulTmp_~v = p[~v];~%"
                                (unbox tmp-num)
                                ptr)
                        (format "mulTmp_~v" (unbox tmp-num)))))))
  
  ;; Generates a multiplication string for the given MULTEMP
  ;;
  ;; mult-string : MULTEMP -> string
  (define (mult-string multmp)
    (if multmp
        (string-append " * " (MULTEMP-val multmp))
        ""))
  
  ;; Generates a MULTEMP using the given pointer location.
  ;;
  ;; gen-MULTEMP : number -> MULTEMP
  (define gen-MULTEMP (gen-wrap))
  
  )