impc:ti:type-unify   scheme


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

Implementation

;;
;; IF TYPE CANNOT BE UNIFIED SUCCESSFULLY THEN WE SHOULD RETURN NULL '()
;; i.e. if we have ((114 0 0) (14 0 0)) don't return this -> return '()
;;
(define impc:ti:type-unify
  (lambda (t vars)
    ;; (println 't: t 'vars: vars)
    (cond ((atom? t)
           (if (and (symbol? t)
                    #t
                    (or (impc:ti:get-generictype-candidate-types
                         (string->symbol
                          (impc:ir:get-base-type
                           (car (regex:split (car (regex:split (symbol->string t) "##")) "%")))))
                        (if (and (regex:match? (symbol->string t) "(:|{)")
                                 (impc:ti:get-generictype-candidate-types
                                  (string->symbol (car (impc:ti:split-namedtype t)))))
                            #t
                            #f)))
               (impc:ti:reify-generic-type t vars '())
               (if (and (symbol? t) (assoc-strcmp t vars))
                   (let ((r (impc:ti:type-unify (cdr (assoc-strcmp t vars)) vars)))
                     (if (null? r) t r)) ;; if r is NULL or false return t
                   t)))
          ((list? t)
           (cond ((impc:ti:complex-type? t)
                  (map (lambda (v) (impc:ti:type-unify v vars)) t))
                 ((= (length t) 1)
                  (impc:ti:type-unify (car t) vars))
                 (else
                  (let* ((ts (impc:ti:type-normalize
                              (map (lambda (v)
                                     (let ((vvv (impc:ti:type-unify v vars)))
                                       ;; (println 'vvv: vvv)
                                       (impc:ti:type-clean vvv)))
                                   t)))
                         (ts1 (cl:remove #f ts))
                         (ts2 (cl:remove-duplicates ts1))
                         (result ts2))
                    ;; (println 1 t 'unified: result)
                    (if (and (= (length result) 1)
                             (impc:ir:type? (car result)))
                        (car result) ;; return immediately if we have a result
                        (begin
                          ;; first check result to see if we have a valid named-type (i.e. "%string")
                          (if (and #f
                                   (= (length result) 2) ;; find all occurences of ((112 0 1) "%string--38293482")
                                   (cl:find-if string? result)
                                   (cl:find-if (lambda (k) (not (string? k))) result))
                              (set! result (list (cl:find-if string? result))))


Back to Index

Similar Entries