impc:ti:generic-types-matchup?   scheme


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

Implementation

;; match two explicit generic types!
;; returns true for a match of false for a fail
(define impc:ti:generic-types-matchup?
  (lambda (aa bb vars)
    ;; (println 'trying 'to 'match 'generic 'type aa 'against 'generic 'type bb)
    (if (or (not (symbol? aa))
            (not (or (string? bb) (symbol? bb)))
            (not (string-contains? (symbol->string aa) ":")))
        #f
        (let* ((a (symbol->string aa))
               (b (if (symbol? bb) (symbol->string bb) bb))
               (p1a (regex:type-split a "##"))
               (p1b (regex:type-split b "##"))
               (p2a (regex:type-split (car p1a) ":"))
               (p2b (regex:type-split (car p1b) ":"))
               (t1a (if (not (null? (cdr p2a)))
                        (impc:ir:get-type-from-pretty-str (cadr p2a)) '()))
               (t1b (if (not (null? (cdr p2b)))
                        (impc:ir:get-type-from-pretty-str (cadr p2b)) '()))
               (au (if (and (assoc-strcmp aa vars)
                            (= (length (cdr (assoc-strcmp aa vars))) 1))
                       (car (cdr (assoc-strcmp aa vars)))))
               (bu (if (and (assoc-strcmp bb vars)
                            (= (length (cdr (assoc-strcmp bb vars))) 1))
                       (car (cdr (assoc-strcmp bb vars))))))
          (if (and (null? bu) (regex:match? (car p2b) "^%"))
              (set! bu (car p2b)))
          (if (string? au)
              (set! t1a (impc:ti:completely-unwrap-named-type au)))
          (if (string? bu)
              (set! t1b (impc:ti:completely-unwrap-named-type bu)))
          ;; (println 'which 'is 'to 'match:)
          ;; (println t1a)
          ;; (println 'against:)
          ;; (println t1b)
          ;; now try to match on t1a and t1b
          (let* ((res (impc:ti:descending-generic-type-match t1a t1b)))
            ;; this for printing only
            ;; (if (not res)
            ;;     (begin
            ;;       (println 'match-failed: t1a 'vs t1b)
            ;;       (println 'A: aa)
            ;;       (println 'B: bb)))
            res)))))


Back to Index