impc:ti:coercion-run   scheme


Defined in:  https://github.com/digego/extempore/tree/v0.8.9/runtime/llvmti.xtm

Implementation

;; an optional compiler stage to support some basic type coercions
;; particular math coercions of forced types
(define impc:ti:coercion-run
  (lambda (ast forced-types)
    ;; (println 'ast: ast)
    (if (pair? ast)
        (cond ((member (car ast) '(< > * / = + - <>))
               (let ((a (assoc-strcmp (cadr ast) forced-types))
                     (b (assoc-strcmp (caddr ast) forced-types)))
                 (if (and (and a b)
                          (not (impc:ir:tuple? (cdr a)))
                          (not (impc:ir:vector? (cdr a)))
                          (<> (cdr a) (cdr b)))
                     (let ((ret (string->symbol (impc:ti:numeric-cast-operator (cdr a) (cdr b)))))
                       ;; (println '> (cdr a) (cdr b))
                       (if (> (cdr a) (cdr b))
                           `(,(car ast) (,ret ,(cadr ast)) ,(caddr ast))
                           `(,(car ast) ,(cadr ast) (,ret ,(caddr ast)))))
                     (if (and a (number? (caddr ast)))
                         (if (and (impc:ir:floating-point? (cdr a))
                                  (integer? (caddr ast)))
                             `(,(car ast) ,(cadr ast) ,(integer->real (caddr ast)))
                             ast)
                         (if (and b (number? (cadr ast)))
                             (if (and (impc:ir:floating-point? (cdr b))
                                      (integer? (cadr ast)))
                                 `(,(car ast) ,(integer->real (cadr ast)) ,(caddr ast))
                                 ast)
                             ast)))))
              (else (cons (impc:ti:coercion-run (car ast) forced-types)
                          (impc:ti:coercion-run (cdr ast) forced-types))))
        ast)))


Back to Index