;; currently only supports 64bit!
(define impc:ir:compiler:bitconvert
(lambda (ast types . hint?)
(if (and (null? (car hint?))
(null? (cddr ast)))
(impc:compiler:print-could-not-resolve-type-error ast "try forcing the conversion"))
(let* ((os (make-string 0))
(a (impc:ir:compiler (cadr ast) types))
(at (impc:ir:gname))
(type-str (if (null? (cddr ast))
(impc:ir:get-type-str (car hint?))
(impc:ir:get-type-str (impc:ir:convert-from-pretty-types (caddr ast))))))
(emit a os)
(let ((from (impc:ir:get-type-from-str (cadr at)))
(to (impc:ir:get-type-from-str type-str)))
;; (println 'convert: from '-> to)
(cond ((and (number? to) (= to *impc:ir:void*))
(impc:ir:gname "voidmark" (impc:ir:get-type-str *impc:ir:void*)))
((and (impc:ir:pointer? from) ;; must be pointer -> pointer
(impc:ir:pointer? to)) ;; do standard bitcast
(emit (string-append (impc:ir:gname "val" type-str)
" = bitcast " (cadr at) " " (car at) " to " type-str "\n") os))
((equal? from to) ;; if to and from are same type do standard bitcast
(emit (string-append (impc:ir:gname "val" type-str)
" = bitcast " (cadr at) " " (car at) " to " type-str "\n") os))
((impc:ir:pointer? from) ;; to must be value
;; first convert pointer to int
(emit (impc:ir:gname "val1" "i64") " = ptrtoint " (impc:ir:get-type-str from) " " (car at) " to i64\n" os)
;; now convert i64 into correct final type
(cond ((= to *impc:ir:fp64*) (emit (impc:ir:gname "val" type-str) " = sitofp i64 " (car (impc:ir:gname "val1")) " to double\n" os))
((= to *impc:ir:fp32*) (emit (impc:ir:gname "val" type-str) " = sitofp i64 " (car (impc:ir:gname "val1")) " to float\n" os))
((= to *impc:ir:si64*) (emit (impc:ir:gname "val" type-str) " = bitcast i64 " (car (impc:ir:gname "val1")) " to i64\n" os))
((= to *impc:ir:si32*) (emit (impc:ir:gname "val" type-str) " = trunc i64 " (car (impc:ir:gname "val1")) " to i32\n" os))
((= to *impc:ir:si16*) (emit (impc:ir:gname "val" type-str) " = trunc i64 " (car (impc:ir:gname "val1")) " to i16\n" os))
((= to *impc:ir:si8*) (emit (impc:ir:gname "val" type-str) " = trunc i64 " (car (impc:ir:gname "val1")) " to i8\n" os))
((= to *impc:ir:i1*) (emit (impc:ir:gname "val" type-str) " = trunc i64 " (car (impc:ir:gname "val1")) " to i1\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((impc:ir:pointer? to) ;; from must be a value
;; first convert from to i64
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val1" "i64") " = fptosi double " (car at) " to i64\n" os))
((= from *impc:ir:fp32*) (emit (impc:ir:gname "val1" "i64") " = fptosi float " (car at) " to i64\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val1" "i64") " = bitcast i64 " (car at) " to i64\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val1" "i64") " = sext i32 " (car at) " to i64\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val1" "i64") " = sext i16 " (car at) " to i64\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val1" "i64") " = sext i8 " (car at) " to i64\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val1" "i64") " = zext i1 " (car at) " to i64\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to)))
(emit (impc:ir:gname "val" type-str) " = inttoptr i64 " (car (impc:ir:gname "val1")) " to " type-str "\n" os))
((= to *impc:ir:fp64*)
(cond ((= from *impc:ir:fp32*) (emit (impc:ir:gname "val" "double") " = fpext float " (car at) " to double\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val" "double") " = sitofp i64 " (car at) " to double\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val" "double") " = sitofp i32 " (car at) " to double\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val" "double") " = sitofp i16 " (car at) " to double\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val" "double") " = sitofp i8 " (car at) " to double\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val" "double") " = uitofp i1 " (car at) " to double\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((= to *impc:ir:fp32*)
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val" "float") " = fptrunc double " (car at) " to float\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val" "float") " = sitofp i64 " (car at) " to float\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val" "float") " = sitofp i32 " (car at) " to float\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val" "float") " = sitofp i16 " (car at) " to float\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val" "float") " = sitofp i8 " (car at) " to float\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val" "float") " = uitofp i1 " (car at) " to float\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((= to *impc:ir:si64*)
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val" "i64") " = fptosi double " (car at) " to i64\n" os))
((= from *impc:ir:fp32*) (emit (impc:ir:gname "val" "i64") " = fptosi float " (car at) " to i64\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val" "i64") " = sext i32 " (car at) " to i64\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val" "i64") " = sext i16 " (car at) " to i64\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val" "i64") " = sext i8 " (car at) " to i64\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val" "i64") " = zext i1 " (car at) " to i64\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((= to *impc:ir:si32*)
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val" "i32") " = fptosi double " (car at) " to i32\n" os))
((= from *impc:ir:fp32*) (emit (impc:ir:gname "val" "i32") " = fptosi float " (car at) " to i32\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val" "i32") " = trunc i64 " (car at) " to i32\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val" "i32") " = sext i16 " (car at) " to i32\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val" "i32") " = sext i8 " (car at) " to i32\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val" "i32") " = zext i1 " (car at) " to i32\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((= to *impc:ir:si16*)
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val" "i16") " = fptosi double " (car at) " to i16\n" os))
((= from *impc:ir:fp32*) (emit (impc:ir:gname "val" "i16") " = fptosi float " (car at) " to i16\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val" "i16") " = trunc i64 " (car at) " to i16\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val" "i16") " = sext i32 " (car at) " to i16\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val" "i16") " = sext i8 " (car at) " to i16\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val" "i16") " = zext i1 " (car at) " to i16\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((= to *impc:ir:si8*)
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val" "i8") " = fptosi double " (car at) " to i8\n" os))
((= from *impc:ir:fp32*) (emit (impc:ir:gname "val" "i8") " = fptosi float " (car at) " to i8\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val" "i8") " = trunc i64 " (car at) " to i8\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val" "i8") " = trunc i32 " (car at) " to i8\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val" "i8") " = trunc i16 " (car at) " to i8\n" os))
((= from *impc:ir:i1*) (emit (impc:ir:gname "val" "i8") " = zext i1 " (car at) " to i8\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))
((= to *impc:ir:i1*)
(cond ((= from *impc:ir:fp64*) (emit (impc:ir:gname "val" "i1") " = fptoui double " (car at) " to i1\n" os))
((= from *impc:ir:fp32*) (emit (impc:ir:gname "val" "i1") " = fptoui float " (car at) " to i1\n" os))
((= from *impc:ir:si64*) (emit (impc:ir:gname "val" "i1") " = trunc i64 " (car at) " to i1\n" os))
((= from *impc:ir:si32*) (emit (impc:ir:gname "val" "i1") " = trunc i32 " (car at) " to i1\n" os))
((= from *impc:ir:si16*) (emit (impc:ir:gname "val" "i1") " = trunc i16 " (car at) " to i1\n" os))
((= from *impc:ir:si8*) (emit (impc:ir:gname "val" "i1") " = trunc i8 " (car at) " to i1\n" os))
(else (impc:compiler:print-unsupported-conversion-error from to))))))
(impc:ir:strip-space os))))