emit-cpp-af-latest.rkt

#lang racket

(require "utils.rkt")
(require "slog-utils.rkt")
; (require print-debug/print-dbg)
(provide emit-cpp)
(define (emit-cpp proc_list filepath slog-flag ast-root desugarred_prog anf_prog alphatized_cps_prog)
  ; defining cpp header files
  ; replace the old cpp file, if exists
  (append-line filepath "#include<stdio.h>" 'replace)
  (append-line filepath "#include<string.h>")
  (append-line filepath "#include \"gmp_func.h\"")
  (append-line filepath (string-append "#include " "\"../../prelude.hpp\""))
  ; (append-line filepath "using namespace std;\n" )

  (define conflicting_c++_prims '#hash((abs . abs_brouhaha)
                                       (random . random_brouhaha)
                                       (remainder . remainder_brouhaha)
                                       (sqrt . sqrt_brouhaha)
                                       (for . for_brouhaha)
                                       ))

  (define proc-name-shadowed?
    (let loop ([env+ (hash)] [prog+ desugarred_prog])
      (match prog+
        [`((define (,name . ,_) ,_) ,_ ...)
         (loop
          (if (hash-has-key? env+ name)
              (hash-set env+ name `(shadowed ,@(cdr (hash-ref env+ name))))
              (hash-set env+ name `(not-shadowed dummyinfo)))
          (cdr prog+))]
        [`((define-prim ,f-name ,params ...) ,_ ...)
         (loop
          (if (hash-has-key? env+ f-name)
              (hash-set env+ f-name `(shadowed ,params))
              (hash-set env+ f-name `(not-shadowed-dp ,params)))
          (cdr prog+))]
        [`() env+])))

  (define find-global-constants
    (let loop ([env+ (hash)] [prog+ anf_prog])
      (match prog+
        [`((define (,name . ,param) ,body) ,rest ...)
         (loop (find-global-constants-helper body env+) rest)]
        [`((define-prim ,f-name ,params ...) ,_ ...)
         (loop env+ (cdr prog+))]
        [`() env+]
        )))

  ; (pretty-print anf_prog)
  ; (pretty-print find-global-constants)


  ; (define global-kont-set
  ;   (let loop ([item-set (set)] [prog+ alphatized_cps_prog])
  ;     (match prog+
  ;       [`((define (,ptr ,kont . ,param) ,body) ,rest ...)
  ;        (loop (set-add item-set kont) rest)]
  ;       [`((define (,ptr . ,param) ,body) ,rest ...)
  ;        (loop item-set rest)]
  ;       [`((define-prim ,ptr ,params ...) ,_ ...)
  ;        (loop item-set (cdr prog+))]
  ;       [`() item-set]
  ;       )))

  (define global-symbols-set
    (let loop ([item-set (set)] [prog+ alphatized_cps_prog])
      (match prog+
        ; [`((define (,ptr ,kont . ,param) ,body) ,rest ...)
        ;  (loop (set-add (set-add item-set ptr) kont) rest)]
        [`((define (,ptr . ,param) ,body) ,rest ...)
         (loop (set-add item-set ptr) rest)]
        [`((define-prim ,ptr ,params ...) ,_ ...)
         (loop (set-add item-set ptr) (cdr prog+))]
        [`() item-set]
        )))


  (append-line filepath "\n// declaring global constants at the top")
  (hash-map find-global-constants
            (lambda (key type)
              (cond
                [(equal? (car type) 'mpz)
                 (append-line filepath (format "mpz_t* ~a = (mpz_t *)(GC_MALLOC(sizeof(mpz_t)));" (cadr type)))]
                [(equal? (car type) 'mpf)
                 (append-line filepath (format "mpf_t* ~a = (mpf_t *)(GC_MALLOC(sizeof(mpf_t)));" (cadr type)))]
                [(equal? (car type) 'int)
                 (append-line filepath (format "void* ~a;" (cadr type)))]
                [(equal? (car type) 'float)
                 (append-line filepath (format "void* ~a;" (cadr type)))]
                [(or (equal? (car type) 'bool-true) (equal? (car type) 'bool-false))
                 (append-line filepath (format "void* ~a;" (cadr type)))]
                [else (error "Error occured find-global-constants!")]
                )
              ))
  (append-line filepath "\n")

  (define global-int-vars
    (foldl (lambda (idx acc)
             ;  (if (hash-has-key? find-global-constants idx)
             ;      acc
             ;      (hash-set acc idx (gensym 'int)))
             (hash-set acc idx (gensym 'int)))
           (hash)
           (range 1 6)))

  (append-line filepath "\n// declaring global integer variable")
  (hash-map global-int-vars
            (lambda (key val)
              ; (append-line filepath (format "void* ~a;" val))
              (append-line filepath (format "int ~a;" val))
              ))


  ; (append-line filepath "\n// declaring global konts at the top")
  ; (for ([item (set->list global-kont-set)])
  ;   (append-line filepath (format "void *const ~a = nullptr;" item)))
  ; (append-line filepath "\n")

  (append-line filepath "\n// declaring functions at the top")
  (define declare-top-level-funcs
    (let loop ([env+ (hash)] [prog+ proc_list])
      (match prog+

        [`((proc (,ptr ,env ,args ...) ,body) ,rest ...)
         (define args-str
           (foldl (lambda (arg acc) (string-append acc ", void* " (symbol->string arg)))
                  ; (string-append "long numArgs, " (string-append "void* " (symbol->string env)))
                  (string-append "void* " (symbol->string env))
                  args))

         ;  (if (string-prefix? (symbol->string ptr) "lam")
         ;      (append-line filepath (format "void ~a_fptr(); // ~a" (get-c-string ptr) ptr))
         ;      (append-line filepath (format "void ~a_fptr(~a); // ~a" (get-c-string ptr) args-str ptr)))

         (append-line filepath (format "void ~a_fptr(); // ~a" (get-c-string ptr) ptr))

         (when (not (string-prefix? (symbol->string ptr) "lam"))
           (define func_name (format "void ~a_spec(~a); // ~a" (get-c-string ptr) args-str ptr))
           (append-line filepath func_name))


         (if (hash-has-key? conflicting_c++_prims (get-c-string ptr))
             (append-line filepath
                          (format "void* ~a = encode_clo(alloc_clo(~a_fptr, ~a));\n"
                                  (hash-ref conflicting_c++_prims (get-c-string ptr))
                                  (get-c-string ptr)
                                  0))

             (append-line filepath
                          (format "void* ~a = encode_clo(alloc_clo(~a_fptr, ~a));\n"
                                  (get-c-string ptr)
                                  (get-c-string ptr)
                                  0)))

         ; (+ (length args) 1)) => +1, because we are including the env
         (loop (hash-set env+ ptr (+ (length args) 1)) (cdr prog+))
         ;  (if (string-prefix? (symbol->string ptr) "lam")
         ;      (loop (hash-set env+ ptr 0) (cdr prog+))
         ;      (loop (hash-set env+ ptr (+ (length args) 1)) (cdr prog+)))
         ]

        [`((proc (,ptr ,env . ,arg) ,body) ,rest ...)
         (define func_name (format "void ~a_fptr(); // ~a" (get-c-string ptr) ptr))
         (append-line filepath func_name)

         (append-line filepath
                      (if (hash-has-key? conflicting_c++_prims (get-c-string ptr))
                          (format "void* ~a = encode_clo(alloc_clo(~a_fptr, ~a));\n"
                                  (hash-ref conflicting_c++_prims (get-c-string ptr))
                                  (get-c-string ptr)
                                  0)
                          (format "void* ~a = encode_clo(alloc_clo(~a_fptr, ~a));\n"
                                  (get-c-string ptr)
                                  (get-c-string ptr)
                                  0)))

         (loop (hash-set env+ ptr 0) (cdr prog+))]

        [`((define-prim ,ptr ,params ...) ,_ ...)
         (define func_name (format "void ~a_fptr(); // ~a" (get-c-string ptr) ptr))
         (append-line filepath func_name)

         (append-line filepath
                      (if (hash-has-key? conflicting_c++_prims (get-c-string ptr))
                          (format "void* ~a = encode_clo(alloc_clo(~a_fptr, ~a));\n"
                                  (hash-ref conflicting_c++_prims (get-c-string ptr))
                                  (get-c-string ptr)
                                  0)
                          (format "void* ~a = encode_clo(alloc_clo(~a_fptr, ~a));\n"
                                  (get-c-string ptr)
                                  (get-c-string ptr)
                                  0)))

         (loop (hash-set env+ ptr 0) (cdr prog+))]
        [`() env+]
        )))

  ; (pretty-print declare-top-level-funcs)
  ; (pretty-print global-symbols-set)
  (append-line filepath "\n")





  ; (append-line filepath "\n// pre-decoding global symbols")
  ; (for ([item (set->list global-symbols-set)])
  ;   ;r = reinterpret_cast<void (*)(long, void*, void*, void*, void*)>((decode_clo(q_u45helper))[0]);
  ;   (define arg_size (hash-ref declare-top-level-funcs item))

  ;   (define args-str
  ;     (foldl (lambda (arg acc) (string-append acc ", " arg))
  ;            "long"
  ;            (map (λ (item) "void*") (range 0 arg_size))))

  ;   (append-line filepath
  ;                (if (hash-has-key? conflicting_c++_prims (get-c-string item))
  ;                    (format "auto decoded_~a = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);"
  ;                            (get-c-string item) (hash-ref conflicting_c++_prims (get-c-string item)))
  ;                    (format "auto decoded_~a = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);" (get-c-string item) (get-c-string item))))

  ;   ; (if (> arg_size 0)
  ;   ;     (append-line filepath
  ;   ;                  (if (hash-has-key? conflicting_c++_prims (get-c-string item))
  ;   ;                      (format "auto decoded_~a = reinterpret_cast<void (*)(~a)>((decode_clo(~a))[0]);"
  ;   ;                              (get-c-string item) (hash-ref conflicting_c++_prims (get-c-string item)))
  ;   ;                      (format "auto decoded_~a = reinterpret_cast<void (*)(~a)>((decode_clo(~a))[0]);" (get-c-string item) args-str (get-c-string item))))
  ;   ;     (append-line filepath
  ;   ;                  (if (hash-has-key? conflicting_c++_prims (get-c-string item))
  ;   ;                      (format "auto decoded_~a = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);"
  ;   ;                              (get-c-string item) (hash-ref conflicting_c++_prims (get-c-string item)))
  ;   ;                      (format "auto decoded_~a = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);" (get-c-string item) (get-c-string item)))))
  ;   )
  ; (append-line filepath "\n")


  (define (convert-proc-body proc_name proc_env proc_arg body)
    ; (match (p-dbg body)
    (match body
      [`(let ([,lhs (make-closure ,ptr ,args ...)]) ,letbody)
       (define arglength (length args))

       ; new-closure
       (append-line filepath "\n//creating new closure instance")

       ;  (define ptrName (gensym 'ptr))
       (define cloName (gensym 'clo))

       (append-line filepath (format "void** ~a = alloc_clo(~a_fptr, ~a);" cloName ptr arglength))

       (when (> (+ arglength 1) 1)
         (append-line filepath "\n//setting env list"))

       (for ([i (in-range 1 (+ arglength 1))] [item args])
         (if (hash-has-key? conflicting_c++_prims (get-c-string item))
             (append-line filepath (format "~a[~a] = ~a;" cloName i (hash-ref conflicting_c++_prims (get-c-string item))))
             (append-line filepath (format "~a[~a] = ~a;" cloName i (get-c-string item)))))

       (append-line filepath (format "void* ~a = encode_clo(~a);" (get-c-string lhs) cloName))

       ;  (when (> (+ arglength 1) 1) (append-line filepath "\n"))
       (append-line filepath "\n")

       (convert-proc-body proc_name proc_env proc_arg letbody)]

      [`(let ([,lhs (prim ,op ,args ...)]) ,letbody)
       (define line
         (format "void* const ~a = apply_prim_~a_~a(~a);"
                 (get-c-string lhs)
                 (get-c-string op)
                 (length args)
                 (string-join (map (λ (item) (format "~a" (get-c-string item))) args) ", ")))

       (append-line filepath line)

       (convert-proc-body proc_name proc_env proc_arg letbody)]

      [`(let ([,lhs (apply-prim ,op ,arg)]) ,letbody)
       (define line
         (format "void* ~a = apply_prim_~a(~a);"
                 (get-c-string lhs)
                 (get-c-string op)
                 (get-c-string arg)))

       (append-line filepath line)

       (convert-proc-body proc_name proc_env proc_arg letbody)]

      [`(let ([,lhs (env-ref ,env ,idx)]) ,letbody)
       ; (append-line filepath (format "void* ~a = (decode_clo(~a))[~a];" (get-c-string lhs) env idx))
       (append-line filepath (format "void* const ~a = decode_clo_array[~a];" (get-c-string lhs) idx))

       (convert-proc-body proc_name proc_env proc_arg letbody)]

      [`(let ([,lhs ,val]) ,letbody)
       ;  (match (p-dbg val)
       (match val
         [`(quote ,(? flonum? val))
          (match-define `(,type ,varname) (hash-ref find-global-constants val))

          (cond
            [(equal? type 'float)
             (append-line filepath (format "void* const ~a = ~a;" (get-c-string lhs) varname))]
            [(equal? type 'mpf)
             (append-line filepath (format "void* const ~a = encode_mpf(~a);" (get-c-string lhs) varname))]
            [else (error "Error occured in emit-cpp -> proc_body case: (let ([,lhs ,val]) ,letbody)")])

          (convert-proc-body proc_name proc_env proc_arg letbody)]

         [`(quote ,(? exact-integer? val))

          (match-define `(,type ,varname) (hash-ref find-global-constants val))

          (cond
            [(equal? type 'int)
             (append-line filepath (format "void* const ~a = ~a;" lhs varname))]
            [(equal? type 'mpz)
             (append-line filepath (format "void* const ~a = encode_mpz(~a);" (get-c-string lhs) varname))]
            [else (error "Error occured in emit-cpp -> proc_body case: (let ([,lhs ,val]) ,letbody)")])

          (convert-proc-body proc_name proc_env proc_arg letbody)]

         [`(quote ,(? boolean? val))

          (match-define `(,type ,varname) (hash-ref find-global-constants val))
          (cond
            [(equal? type 'bool-true)
             (append-line filepath (format "void* const ~a = ~a;" (get-c-string lhs) varname))]
            [(equal? type 'bool-false)
             (append-line filepath (format "void* const ~a = ~a;" (get-c-string lhs) varname))]
            [else (error "Error occured in emit-cpp -> proc_body case: (quote ,(? boolean? val)")])

          (convert-proc-body proc_name proc_env proc_arg letbody)
          ]

         [`(quote ,(? null? val))
          (append-line filepath (format "void* ~a = encode_null();" (get-c-string lhs)))
          (convert-proc-body proc_name proc_env proc_arg letbody)]

         [`(quote ,(? string? val))
          (append-line
           filepath
           (format "void* ~a = encode_str(new(GC) std::string(\"~a\"));" (get-c-string lhs) val))
          (convert-proc-body proc_name proc_env proc_arg letbody)]

         [`(quote ,(? symbol? val))
          (append-line
           filepath
           (format "void* ~a = encode_str(new(GC) std::string(\"~a\"));" (get-c-string lhs) (symbol->string val)))
          (convert-proc-body proc_name proc_env proc_arg letbody)]

         [(? symbol?) ; Not sure what this case does or supposed to do - SK
          ; (pretty-print (~a "cpb: " val))
          (append-line filepath
                       (format "void* ~a = encode_str(new string(\"~a\"));" (get-c-string lhs) val))
          (convert-proc-body proc_name proc_env proc_arg letbody)]

         [_ (raise (format "Unknown datatype! ~a" val))])]

      [`(if ,grd ,texp ,fexp)
       (append-line filepath "\n//if-clause")
       (define guard (gensym 'if_guard))

       ;  (append-line filepath (format "bool ~a = is_true(~a);" guard grd))
       (append-line filepath (format "if(is_true(~a))\n{" grd))
       (convert-proc-body proc_name proc_env proc_arg texp)
       (append-line filepath "}\nelse\n{")
       (convert-proc-body proc_name proc_env proc_arg fexp)
       (append-line filepath "}\n")]

      [`(clo-apply ,func ,args)
       (match-define `(,builtin-func ,res) (is-define-prim ast-root func))

       (cond
         [(and slog-flag res)
          ; (displayln (~a "func: " func "builtin-func: " builtin-func " res: " res))
          (append-line filepath "\n//clo-apply")

          (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string builtin-func)))
          (append-line filepath (format "arg_buffer[2] = ~a;" (get-c-string args)))
          (append-line filepath (format "arg_buffer[0] = reinterpret_cast<void*>(~a);" 2))

          (append-line filepath (format "~a_fptr();" (get-c-string builtin-func)))
          ; (append-line filepath "return nullptr;")
          ]
         [else
          (append-line filepath "\n//clo-apply")

          (match-define `(,is_define_prim ,is_callable ,arg_count)
            (callable-define-prim? proc-name-shadowed? func 0))

          ; (set! is_define_prim #f)
          ; (set! is_callable #f)
          ; (set! arg_count 0)
          ; (displayln func)
          ; (displayln is_define_prim)
          ; (displayln is_callable)
          ; (displayln arg_count)
          ; (displayln "---------")

          (cond
            ; one of the define-prim so call that without unpacking closure
            [is_define_prim
             (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string func)))
             (append-line filepath (format "arg_buffer[2] = ~a;" (get-c-string args)))
             ;  (append-line filepath (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars 2)))
             (append-line filepath (format "numArgs = ~a;" (hash-ref global-int-vars 2)))

             (append-line filepath (format "~a_fptr();" (get-c-string func)))
             ]
            [else
             (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string func)))
             (append-line filepath (format "arg_buffer[2] = ~a;" (get-c-string args)))
             ;  (append-line filepath (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars 2)))
             (append-line filepath (format "numArgs = ~a;" (hash-ref global-int-vars 2)))

             ;  (append-line filepath
             ;               (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);"
             ;                       (get-c-string func)))

             ;  (append-line filepath "\n// calling next procedure using a function pointer")
             ;  (append-line filepath "function_ptr();")

             (append-line filepath (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" (get-c-string func)))
             ])]
         )]

      [`(clo-app ,func ,args ...)

       ; builtin-func will hold, either the called builtin define-prim
       ; or the aliased builtin define-prim by the "func" at the call-site
       (match-define `(,builtin-func ,res1) (if slog-flag
                                                (is-define-prim ast-root func)
                                                `(,func #f)))
       (match-define `(,temp-func ,res2) (if slog-flag
                                             (check-define-prim-arg-count ast-root builtin-func (- (length args) 1))
                                             `(,func #f)))

       (cond
         ; builtin define-prim with a specific argument count
         ; builtin define-prim with a specific argument count
         [(and slog-flag res1 res2)
          (append-line filepath "\n//clo-app")
          (define args-str
            (foldl (lambda (arg acc) (string-append acc ", " (symbol->string arg)))
                   (symbol->string (cadr args))
                   (cddr args)))

          (append-line filepath (format "arg_buffer[2] = apply_prim_~a_~a(~a);" (get-c-string builtin-func) (- (length args) 1) args-str))
          (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string (car args))))


          (append-line filepath
                       (cond
                         ;  [(hash-has-key? find-global-constants 2) (format "numArgs = ~a;" (cadr (hash-ref find-global-constants 2)))]
                         ;  [(hash-has-key? global-int-vars 2) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars 2))]
                         [(hash-has-key? global-int-vars 2) (format "numArgs = ~a;" (hash-ref global-int-vars 2))]
                         [else (format "numArgs = 2;")]
                         ;  [else (format "arg_buffer[0] = reinterpret_cast<void*> (2);")]
                         )
                       )


          ; (append-line
          ;  filepath
          ;  (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);"
          ;          (get-c-string (car args))))

          ; (append-line filepath "\n// calling next procedure using a function pointer")
          ; (append-line filepath "function_ptr();")

          (append-line filepath (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" (get-c-string (car args))))
          ]

         ; not specific argument count, but still one of the builtin so calling that directly
         ; instead of unpacking the closure
         [(and slog-flag res1)
          (append-line filepath "\n//clo-app")

          (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string builtin-func)))

          (for ([i (in-range 1 (+ (length args) 1))] [item args])
            (append-line filepath (format "arg_buffer[~a] = ~a;" (+ i 1) (get-c-string item))))

          (append-line filepath
                       (cond
                         ;  [(hash-has-key? find-global-constants (+ (length args) 1))
                         ;   (format "numArgs = ~a;" (cadr (hash-ref find-global-constants (+ (length args) 1))))]
                         ;  [(hash-has-key? global-int-vars (+ (length args) 1)) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                         [(hash-has-key? global-int-vars (+ (length args) 1)) (format "numArgs = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                         ;  [else (format "arg_buffer[0] = reinterpret_cast<void*> (~a);" (+ (length args) 1))]
                         [else (format "numArgs = ~a;" (+ (length args) 1))]
                         )

                       )

          (if (hash-has-key? conflicting_c++_prims (get-c-string func))
              (append-line filepath (format "~a_fptr();" (hash-ref conflicting_c++_prims (get-c-string builtin-func))))
              (append-line filepath (format "~a_fptr();" (get-c-string builtin-func)))
              )

          ]
         [else
          (match-define `(,is_define_prim ,is_callable ,arg_count)
            (callable-define-prim? proc-name-shadowed? func (- (length args) 1)))

          ; (set! is_define_prim #f)
          ; (set! is_callable #f)
          ; (set! arg_count 0)
          ; (displayln func)
          ; (displayln (- (length args) 1))
          ; (displayln is_define_prim)
          ; (displayln is_callable)
          ; (displayln arg_count)
          ; (displayln "---------")

          ; (lambda (arg acc) 
          ;               (string-append
          ;                     (if (hash-has-key? arg_hash acc) 
          ;                         (hash-ref arg_hash acc)
          ;                         acc)
          ;                     ", " 
          ;                     (if (hash-has-key? arg_hash arg) 
          ;                       (hash-ref arg_hash (symbol->string arg))
          ;                       (symbol->string arg))))

          (define args-str
               (foldl (lambda (arg acc)
                        (string-append
                         (if (hash-has-key? arg_hash acc)
                             (hash-ref arg_hash acc)
                             acc)
                         ", "
                         (if (hash-has-key? arg_hash arg)
                             (hash-ref arg_hash (symbol->string arg))
                             (symbol->string arg))))

                      ; (symbol->string (cadr args))
                      (if (hash-has-key? arg_hash (cadr args))
                          (hash-ref arg_hash (cadr args))
                          (symbol->string (cadr args)))

                      (cddr args)))

          (cond
            [(and is_define_prim is_callable)
             (append-line filepath "\n//clo-app")

             (define args-str
               (foldl (lambda (arg acc) (string-append acc ", " (symbol->string arg)))
                      (symbol->string (cadr args))
                      (cddr args)))

             (append-line filepath (format "arg_buffer[2] = apply_prim_~a_~a(~a);" (get-c-string func) arg_count args-str))
             (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string (car args))))
             ;  (append-line filepath (format "arg_buffer[0] = reinterpret_cast<void*>(~a);" 2))

             (append-line filepath
                          (cond
                            ;  [(hash-has-key? find-global-constants 2) (format "numArgs = ~a;" (cadr (hash-ref find-global-constants 2)))]
                            ; [(hash-has-key? global-int-vars 2) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars 2))]
                            [(hash-has-key? global-int-vars 2) (format "numArgs = ~a;" (hash-ref global-int-vars 2))]
                            ; [else (format "arg_buffer[0] = reinterpret_cast<void*> (2);")]
                            [else (format "numArgs = 2;")]
                            ))


             (if (set-member? global-symbols-set (car args))
                 (begin
                   (append-line filepath (format "~a_fptr();" (get-c-string (car args)))))
                 (begin
                   ;  (append-line
                   ;   filepath
                   ;   (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);"
                   ;           (get-c-string (car args))))

                   ;  (append-line filepath "\n// calling next procedure using a function pointer")
                   ;  (append-line filepath "function_ptr();")

                   (append-line filepath (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" (get-c-string (car args))))
                   ))
             ]

            [is_define_prim
             (append-line filepath "\n//clo-app")

             (append-line filepath  (format "arg_buffer[1] = ~a;" (get-c-string func)))

             (for ([i (in-range 1 (+ (length args) 1))] [item args])
               (append-line filepath (format "arg_buffer[~a] = ~a;" (+ i 1) (get-c-string item))))

             ;  (append-line filepath (format "arg_buffer[0] = reinterpret_cast<void*>(~a);" (+ (length args) 1)))

             (append-line filepath
                          (cond
                            ;  [(hash-has-key? find-global-constants (+ (length args) 1))
                            ;   (format "numArgs = ~a;" (cadr (hash-ref find-global-constants (+ (length args) 1))))]
                            ; [(hash-has-key? global-int-vars (+ (length args) 1)) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                            [(hash-has-key? global-int-vars (+ (length args) 1)) (format "numArgs = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                            ; [else (format "arg_buffer[0] = reinterpret_cast<void*> (~a);" (+ (length args) 1))]
                            [else (format "numArgs = ~a;" (+ (length args) 1))]
                            ))

             (append-line filepath (format "~a_fptr();" (get-c-string func)))]
            [else
             (append-line filepath "\n//clo-app")



             (if (hash-has-key? declare-top-level-funcs func)
                 (if (= (hash-ref declare-top-level-funcs func) 0)
                     (begin
                       (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string func)))
                       (for ([i (in-range 1 (+ (length args) 1))] [item args])
                         (append-line filepath (format "arg_buffer[~a] = ~a;" (+ i 1) (get-c-string item))))

                       ;  (append-line filepath (format "arg_buffer[0] = reinterpret_cast<void*>(~a);" (+ (length args) 1)))
                       (append-line filepath
                                    (cond
                                      ; [(hash-has-key? find-global-constants (+ (length args) 1))
                                      ;  (format "numArgs = ~a;" (cadr (hash-ref find-global-constants (+ (length args) 1))))]
                                      ; [(hash-has-key? global-int-vars (+ (length args) 1)) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                                      [(hash-has-key? global-int-vars (+ (length args) 1)) (format "numArgs = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                                      ; [else (format "arg_buffer[0] = reinterpret_cast<void*> (~a);" (+ (length args) 1))]
                                      [else (format "numArgs = ~a;" (+ (length args) 1))]
                                      ))
                       (append-line filepath (format "~a_fptr();" (get-c-string func))) )

                     (append-line filepath
                                  (format "~a_spec(~a);" (get-c-string func)
                                          (foldl (lambda (arg acc) (string-append acc ", " (symbol->string arg)))
                                                 ;  (string-append (number->string (+ (length args) 1)) ", " (symbol->string (get-c-string func)) ", " (symbol->string (car args)))
                                                 (string-append (symbol->string (get-c-string func)) ", " (symbol->string (car args)))
                                                 (cdr args)))))
                 (begin
                   (append-line filepath (format "arg_buffer[1] = ~a;" (get-c-string func)))
                   (for ([i (in-range 1 (+ (length args) 1))] [item args])
                     (append-line filepath (format "arg_buffer[~a] = ~a;" (+ i 1) (get-c-string item))))

                   ;  (append-line filepath (format "arg_buffer[0] = reinterpret_cast<void*>(~a);" (+ (length args) 1)))
                   (append-line filepath
                                (cond
                                  ; [(hash-has-key? find-global-constants (+ (length args) 1))
                                  ;  (format "numArgs = ~a;" (cadr (hash-ref find-global-constants (+ (length args) 1))))]
                                  ; [(hash-has-key? global-int-vars (+ (length args) 1)) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                                  [(hash-has-key? global-int-vars (+ (length args) 1)) (format "numArgs = ~a;" (hash-ref global-int-vars (+ (length args) 1)))]
                                  [else (format "numArgs = ~a;" (+ (length args) 1))]
                                  ; [else (format "arg_buffer[0] = reinterpret_cast<void*> (~a);" (+ (length args) 1))]
                                  ))

                   ;  (append-line
                   ;   filepath
                   ;   (if (hash-has-key? conflicting_c++_prims (get-c-string func))
                   ;       (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);" (hash-ref conflicting_c++_prims (get-c-string func)))
                   ;       (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);" (get-c-string func))
                   ;       ))

                   ;  (append-line filepath "\n// calling next procedure using a function pointer")
                   ;  (append-line filepath "function_ptr();")

                   (append-line filepath
                                (if (hash-has-key? conflicting_c++_prims (get-c-string func))
                                    (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" (hash-ref conflicting_c++_prims (get-c-string func)))
                                    (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" (get-c-string func))))


                   ))
             ])

          ])]))

  (define (convert-procs proc)
    ; (pretty-print proc)
    (match proc
      [`(proc (,ptr ,env ,args ...) ,body)


       (append-line filepath (format "inline void ~a_fptr() // ~a -> generic version ~a" (get-c-string ptr) ptr "\n{"))

       ;  uncomment these two lines for debugging!
       ; (append-line filepath (format "std::cout<<\"In ~a_fptr: generic version\"<<std::endl;" (get-c-string ptr)))
       ;  (append-line filepath (format "print_arg_buffer();\n"))
       ;  (append-line filepath "call_counter++;")

       ;  (append-line filepath "//reading number of args")
       ;  (append-line filepath (format "int numArgs = reinterpret_cast<int>(arg_buffer[0]);"))
       ;  (append-line filepath (format "numArgs = reinterpret_cast<long>(arg_buffer[0]);"))
       (when (not (string-prefix? (symbol->string env) "_"))
         (append-line filepath "//reading env")
         (append-line filepath (format "void* const ~a = arg_buffer[1];" (get-c-string env))))

       ;  (append-line filepath "//reading env")
       ;  (append-line filepath (format "void* const ~a = arg_buffer[1];" (get-c-string env)))

       (append-line filepath "//reading env and args")
       (for ([i (in-range 2 (+ (length args) 2))] [item args])
         (append-line filepath (format "void* const ~a = arg_buffer[~a];" (get-c-string item) i)))

       (append-line filepath "//decoding closure array")
       (append-line filepath (format "void** decode_clo_array = nullptr;"))
       (when (string-prefix? (symbol->string env) "e")
         (append-line filepath (format "decode_clo_array = decode_clo(~a);" (get-c-string env))))

       (convert-proc-body (get-c-string ptr) (get-c-string env) args body)

       (append-line filepath "}\n")


       (when (not (string-prefix? (symbol->string ptr) "lam"))
         (define args-str
           (foldl (lambda (arg acc) (string-append acc ", void* " (symbol->string arg)))
                  ; (string-append "long numArgs, " (string-append "void* " (symbol->string env)))
                  (string-append "void* " (symbol->string env))
                  args))

         (append-line filepath (format "inline void ~a_spec(~a) // ~a ~a" (get-c-string ptr) args-str ptr "\n{"))


         ;  uncomment these two lines for debugging!
         ; (append-line filepath (format "std::cout<<\"In ~a_fptr\"<<std::endl;" (get-c-string ptr)))
         ;  (append-line filepath (format "print_arg_buffer();\n"))
         ;  (append-line filepath "call_counter++;")

         (if (hash-has-key? declare-top-level-funcs ptr)
             (begin
               (when (= (hash-ref declare-top-level-funcs ptr) 0)
                 ;  (append-line filepath "//reading number of args")
                 ;  (append-line filepath (format "int numArgs = reinterpret_cast<int>(arg_buffer[0]);"))
                 ;  (append-line filepath (format "numArgs = reinterpret_cast<long>(arg_buffer[0]);"))
                 (append-line filepath "//reading env")
                 (append-line filepath (format "void* const ~a = arg_buffer[1];" (get-c-string env)))

                 (append-line filepath "//reading env and args")
                 (for ([i (in-range 2 (+ (length args) 2))] [item args])
                   (append-line filepath (format "void* const ~a = arg_buffer[~a];" (get-c-string item) i))))
               )
             (begin
               ;  (append-line filepath "//reading number of args")
               ;  (append-line filepath (format "int numArgs = reinterpret_cast<int>(arg_buffer[0]);"))
               ;  (append-line filepath (format "numArgs = reinterpret_cast<long>(arg_buffer[0]);"))
               (append-line filepath "//reading env")
               (append-line filepath (format "void* const ~a = arg_buffer[1];" (get-c-string env)))

               (append-line filepath "//reading env and args")
               (for ([i (in-range 2 (+ (length args) 2))] [item args])
                 (append-line filepath (format "void* const ~a = arg_buffer[~a];" (get-c-string item) i)))
               )
             )

         (append-line filepath "//decoding closure array")
         (append-line filepath (format "void** decode_clo_array = nullptr;"))
         (when (string-prefix? (symbol->string env) "e")
           (append-line filepath (format "decode_clo_array = decode_clo(~a);" (get-c-string env))))

         (convert-proc-body (get-c-string ptr) (get-c-string env) args body)

         (append-line filepath "}\n"))
       ]

      [`(proc (,ptr ,env . ,arg) ,body)
       (define func_name (format "void ~a_fptr() // ~a ~a" (get-c-string ptr) ptr "\n{"))

       ; start of function definitions
       (append-line filepath func_name)

       ; uncomment these two lines for debugging!
       ; (append-line filepath (format "std::cout<<\"In ~a_fptr\"<<std::endl;" (get-c-string ptr)))
       ;  (append-line filepath (format "print_arg_buffer();\n"))
       ;  (append-line filepath "call_counter++;")

       ;  (append-line filepath "//reading number of args")
       ;  (append-line filepath (format "int numArgs = reinterpret_cast<int>(arg_buffer[0]);"))
       ;  (append-line filepath (format "numArgs = reinterpret_cast<long>(arg_buffer[0]);"))

       (append-line filepath "//reading env")
       (append-line filepath (format "void* const ~a = arg_buffer[1];" (get-c-string env)))

       (append-line filepath "//decoding closure array")
       (append-line filepath (format "void** decode_clo_array = nullptr;"))
       (when (string-prefix? (symbol->string env) "e")
         (append-line filepath (format "decode_clo_array = decode_clo(~a);" (get-c-string env))))

       (append-line filepath (format "void* ~a = nullptr;" arg))

       (append-line filepath (format "if(is_cons(arg_buffer[2]))\n{"))
       (append-line filepath "//(apply e0 e0) case")
       (append-line filepath (format "~a = arg_buffer[2];" arg))
       (append-line filepath "}\nelse\n{")

       (append-line filepath "//building cons cell")
       (append-line filepath (format "~a = encode_null();" arg))
       (append-line filepath (format "for(int i = numArgs; i >= 2; i--)\n{"))
       (append-line filepath (format "~a = prim_cons(arg_buffer[i], ~a);" arg arg))
       (append-line filepath (format "\n}\n"))

       (append-line filepath "}\n")

       (convert-proc-body (get-c-string ptr) (get-c-string env) arg body)
       (append-line filepath "}\n")
       ]

      [`(define-prim ,ptr ,args ...)
       (define k (gensym 'kont))
       (define x (gensym 'x))
       (define env (gensym '_env))
       (define arg 'lst)
       (define newarg (gensym arg))

       ;  (define make-generic-apply-prim-body
       ;    `(let ([,k (prim car ,arg)])
       ;       (let ([,newarg (prim cdr ,arg)])
       ;         (let ((,x (apply-prim ,ptr ,newarg)))
       ;           (clo-app ,k ,x)))))

       (define func_name (format "inline void ~a_fptr() // ~a ~a" (get-c-string ptr) ptr "\n{"))

       ; start of function definitions
       (append-line filepath func_name)

       ; uncomment these two lines for debugging!
       ; (append-line filepath (format "std::cout<<\"In ~a_fptr\"<<std::endl;" (get-c-string ptr)))
       ;  (append-line filepath (format "print_arg_buffer();\n"))
       ;  (append-line filepath "call_counter++;")

       ;  (append-line filepath "//reading number of args")
       ;  (append-line filepath "// This is the second type of the functions")
       ;  (append-line filepath (format "int numArgs = reinterpret_cast<int>(arg_buffer[0]);"))
       ;  (append-line filepath (format "numArgs = reinterpret_cast<long>(arg_buffer[0]);"))

       (append-line filepath "//reading env")
       (append-line filepath (format "void* const ~a = arg_buffer[1];" (get-c-string env)))

       (append-line filepath "//decoding closure array")
       (append-line filepath (format "void** decode_clo_array = nullptr;"))

       (append-line filepath (format "if(is_cons(arg_buffer[2]))\n{"))
       (append-line filepath "//(apply e0 e0) case")
       (append-line filepath (format "void* const ~a = arg_buffer[2];" arg))
       (append-line filepath (format "void* const ~a = prim_car(lst);" k))
       (append-line filepath (format "void* const ~a = prim_cdr(lst);" newarg))
       (append-line filepath (format "void* const ~a = apply_prim_~a(~a);" x (get-c-string ptr) newarg))

       (append-line filepath (format "arg_buffer[1] = ~a;" k))
       (append-line filepath (format "arg_buffer[2] = ~a;" x))

       (append-line filepath
                    (cond
                      ; [(hash-has-key? find-global-constants 2) (format "arg_buffer[0] = ~a;" (cadr (hash-ref find-global-constants 2)))]
                      ; [(hash-has-key? global-int-vars 2) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars 2))]
                      [(hash-has-key? global-int-vars 2) (format "numArgs = ~a;" (hash-ref global-int-vars 2))]
                      ; [else (format "arg_buffer[0] = reinterpret_cast<void*>(2);")]
                      [else (format "numArgs = 2;")]
                      ))

      ;  (append-line
      ;   filepath
      ;   (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);"  k))

      ;  (append-line filepath "\n// calling next procedure using a function pointer")
      ;  (append-line filepath "function_ptr();")

       (append-line filepath (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" k))


       (append-line filepath "}\nelse\n{")

       (append-line filepath (format "void* const ~a = arg_buffer[2];" k))
       (append-line filepath (format "void* const ~a = apply_prim_~a(arg_buffer);" x (get-c-string ptr)))

       (append-line filepath (format "arg_buffer[1] = ~a;" k))
       (append-line filepath (format "arg_buffer[2] = ~a;" x))

       ;  (append-line filepath (format "arg_buffer[0] = reinterpret_cast<void*>(~a);" 2))
       (append-line filepath
                    (cond
                      ; [(hash-has-key? find-global-constants 2) (format "arg_buffer[0] = ~a;" (cadr (hash-ref find-global-constants 2)))]
                      ; [(hash-has-key? global-int-vars 2) (format "arg_buffer[0] = ~a;" (hash-ref global-int-vars 2))]
                      [(hash-has-key? global-int-vars 2) (format "numArgs = ~a;" (hash-ref global-int-vars 2))]
                      ; [else (format "arg_buffer[0] = reinterpret_cast<void*>(2);")]
                      [else (format "numArgs = 2;")]
                      ))

      ;  (append-line
      ;   filepath
      ;   (format "auto function_ptr = reinterpret_cast<void (*)()>((decode_clo(~a))[0]);" k))

      ;  (append-line filepath "\n// calling next procedure using a function pointer")
      ;  (append-line filepath "function_ptr();")

       (append-line filepath (format "reinterpret_cast<void (*)()>((decode_clo(~a))[0])();" k))

       (append-line filepath "}\n")
       (append-line filepath "}\n")
       ]
      ) ;end of match
    ;end of function definitions.
    )

  (map convert-procs proc_list)

  ; writing the main function.
  (append-line filepath "int main(int argc, char **argv)\n{")


  (append-line filepath
               "mp_set_memory_functions(&allocate_function,
                            &reallocate_function,
                            &deallocate_function);")

  (append-line filepath "\n// initializing global constants in the main")
  (hash-map find-global-constants
            (lambda (key type)
              (cond
                [(equal? (car type) 'mpz)
                 (append-line filepath (format "mpz_init_set_str(*~a, \"~a\", 10);" (cadr type) key))]
                [(equal? (car type) 'mpf)
                 (append-line filepath (format "mpf_init_set_str(*~a, \"~a\", 10);" (cadr type) key))]
                [(equal? (car type) 'int)
                 (append-line filepath (format "~a = reinterpret_cast<void *>(encode_int(~a));" (cadr type) key))]
                [(equal? (car type) 'float)
                 (append-line filepath (format "~a = reinterpret_cast<void *>(encode_float(~a));" (cadr type) key))]
                [(equal? (car type) 'bool-true)
                 (append-line filepath (format "~a = encode_bool(true);" (cadr type)))]
                [(equal? (car type) 'bool-false)
                 (append-line filepath (format "~a = encode_bool(false);" (cadr type)))]
                [else (error "Error occured could not find value in -> find-global-constants!")]
                )
              ))

  (append-line filepath "\n")

  (append-line filepath "\n// initializing global integer vars")
  (hash-map global-int-vars
            (lambda (key val)
              ; (append-line filepath (format "~a = reinterpret_cast<void*>(encode_int(~a));" val key))
              ; (append-line filepath (format "~a = reinterpret_cast<void *>(~a);" val key))
              (append-line filepath (format "~a = ~a;" val key))
              ))

  (append-line filepath "\n//making a call to the brouhaha main function to kick off our C++ emission.")
  ; (append-line filepath "call_counter++;")
  (append-line filepath "void *fhalt_clo = encode_clo(alloc_clo(fhalt,0));")

  ; (append-line filepath "arg_buffer[0] = 0;")
  (append-line filepath "arg_buffer[2] = fhalt_clo;")

  (append-line filepath "\n// calling next procedure using a function pointer")
  (append-line filepath "brouhaha_main_spec(nullptr, fhalt_clo);")

  (append-line filepath "}\n")
  ;end of main function.
  'cpp-emission-done!)