impc:ir:get-type-str   scheme

(define impc:ir:get-type-str
  (lambda (type . args)
    ;; (println 'ir:get-type-str 'type: type 'args: args)
    (if (null? args) (set! args (list type)))
    (if (or (string? type)
            (symbol? type))
        (if (symbol? type) (symbol->string type) type)
        (cond ((list? type) ;; must be a complex type
               (cond ((impc:ir:closure? (car type))
                      (string-append "{i8*, i8*, " (impc:ir:make-function-str (cdr type) #t) "*}"
                                     (make-string (impc:ir:get-ptr-depth (car type)) #\*)))
                     ((impc:ir:tuple? (car type))
                      (string-append "{" (string-join (map (lambda (x) (apply impc:ir:get-type-str x args)) (cdr type)) ",") "}"
                                     (make-string (impc:ir:get-ptr-depth (car type)) #\*)))
                     ((impc:ir:array? (car type))
                      (string-append "[" (number->string (cadr type)) " x " (apply impc:ir:get-type-str (caddr type) args) "]"
                                     (make-string (impc:ir:get-ptr-depth (car type)) #\*)))
                     ((impc:ir:vector? (car type))
                      (string-append "<" (number->string (cadr type)) " x " (apply impc:ir:get-type-str (caddr type) args) ">"
                                     (make-string (impc:ir:get-ptr-depth (car type)) #\*)))
                     (else (impc:compiler:print-bad-type-error type "bad complex type"))))
              ((= type *impc:ir:void*) "void")
              ((= type *impc:ir:notype*) "notype")
              ((< type 0) ;; this here for recursive llvm ir type defs only!
               (let ((base (* -1 (modulo type (* -1 *impc:ir:pointer*))))
                     (ptr-depth (real->integer (floor (/ type (* -1 *impc:ir:pointer*))))))
                 (string-append "\\" (number->string base) (make-string ptr-depth #\*))))
              (else (let ((base (modulo type *impc:ir:pointer*))
                          (ptr-depth (real->integer (floor (/ type *impc:ir:pointer*)))))
                      (string-append (cond ((= base *impc:ir:fp64*) "double")
                                           ((= base *impc:ir:fp32*) "float")
                                           ((member base (list *impc:ir:si64* *impc:ir:ui64*)) "i64")
                                           ((member base (list *impc:ir:si32* *impc:ir:ui32*)) "i32")
                                           ((member base (list *impc:ir:si16* *impc:ir:ui16*)) "i16")
                                           ((member base (list *impc:ir:si8* *impc:ir:ui8* *impc:ir:char*)) "i8")
                                           ((= base *impc:ir:i1*) "i1")
                                           ((string? (car args))
                                            (string-append "%" (car args)))
                                           (else (impc:compiler:print-bad-type-error (if (null? args) type (car args)))))
                                     (make-string ptr-depth #\*))))))))