impc:ir:compiler:math-intrinsics   scheme

(define impc:ir:compiler:math-intrinsics
  (let ((mls '(("double" . "f64") ("float" . "f32")
               ("<2 x double>" . "v2f64") ("<4 x float>" . "v4f32")
               ("<4 x double>" . "v4f64") ("<8 x float>" . "v8f32")
               ("<8 x double>" . "v8f64") ("<16 x float>" . "v16f32"))))
    (lambda (ast types . hint?)
      ;; (println 'math: ast types hint?)
      (let* ((args (- (length ast) 1))
             (astr (impc:ir:compiler (cadr ast) types (if (null? hint?) #f (car hint?))))
             (aval (impc:ir:gname))
             (bstr (if (member (car ast) '(pow powi fma))
                       (impc:ir:compiler (caddr ast) types (if (null? hint?) #f (car hint?)))
                       ""))
             (bval (if (< args 2) #f (impc:ir:gname)))
             (cstr (if (member (car ast) '(fma))
                       (impc:ir:compiler (cadddr ast) types (if (null? hint?) #f (car hint?)))
                       ""))
             (cval (if (< args 3) #f (impc:ir:gname)))
             (os (make-string 0)))
        ;; (println 'intrinsice ast aval bval cval)
        ;; sanity checks
        (if (not (or (impc:ir:number? (cadr aval))
                     (impc:ir:vector? (cadr aval))))
            (impc:compiler:print-bad-type-error (cadr aval) ast))
        (if (and bval
                 (not (or (and (impc:ir:number? (cadr aval))
                               (impc:ir:number? (cadr bval)))
                          (and (impc:ir:vector? (cadr aval))
                               (impc:ir:vector? (cadr bval))))))
            (impc:compiler:print-type-conflict-error (cadr aval)
                                                     (cadr bval)
                                                     ast))
        ;; equal types?
        (if bval
            (if (not (equal? (cadr aval) (cadr bval)))
                (if (or (number? (cadr ast))
                        (number? (caddr ast)))
                    (if (number? (cadr ast))
                        (begin
                          (set! astr (impc:ir:compiler `(bitconvert ,(cadr ast) ,(string->symbol (cadr bval))) types))
                          (set! aval (impc:ir:gname)))
                        (begin
                          (set! bstr (impc:ir:compiler `(bitconvert ,(caddr ast) ,(string->symbol (cadr aval))) types))
                          (set! bval (impc:ir:gname))))
                    (impc:compiler:print-type-conflict-error (cadr aval)
                                                             (cadr bval)
                                                             ast))))
        ;;(println 'bbbbbbb)
        (if (and cval (not (equal? (cadr aval) (cadr cval))))
            (impc:compiler:print-type-conflict-error (cadr aval)
                                                     (cadr cval)
                                                     ast))
        (emit astr os)
        (emit bstr os)
        (emit cstr os)
        (emit (string-append (impc:ir:gname "val" (cadr aval)) " = call "
                             (cadr aval) " @llvm." (symbol->string (car ast)) "." (cdr (assoc (cadr aval) mls))
                             "(" (cadr aval) " " (car aval)
                             (if bval (string-append ", " (cadr bval) " " (car bval)) "")
                             (if cval (string-append ", " (cadr cval) " " (car cval)) "")
                             ")\n")
              os)
        (impc:ir:strip-space os)))))