impc:ti:reverse-set-bangs-from-reified   scheme


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

Implementation

;; this attempts to update-var !bangs from reified types and also GTypes
;; i.e. if we have allready resolved xlist*##289 to %xlist--2812497382948
;; but we have failed to resolve !head##289
;; then we try to get back from %xlist--2812497382948 to set !head##289
(define impc:ti:reverse-set-bangs-from-reified
  (lambda (poly reified gnum vars)
    ;; (println 'reverse-bangs: poly 'gnum: gnum)
    ;; (println 'vars vars)
    ;; (println 'reified: reified)
    ;; (println 'pretty: (impc:ir:pretty-print-type reified))
    ;; (println 'okpretty)
    (if (and (not (list? poly))
             (or (not (symbol? poly))
                 (not (regex:match? (symbol->string poly) "(:|{)"))))
        'done ;; we can only check reified if poly IS a list (not a reference to a list!)
        (let* ((prettyreified (impc:ir:pretty-print-type reified))
               (sss (if (list? poly) "" (car (regex:type-split (symbol->string poly) "##"))))
               ;; (gpolytype (if (list? poly) poly (impc:ir:get-type-from-pretty-str sss)))
               (namedtype (impc:ir:get-type-from-str (impc:ti:get-named-type reified)))
               (gpolytype (if (list? poly) poly
                              (cons (car namedtype) (impc:ir:get-type-from-pretty-tuple
                                        (cadr (impc:ti:split-namedtype (impc:ti:maximize-generic-type sss))))))))
          ;; (println 'poly: poly 'gnum gnum)
          ;; (println 'reified: (impc:ti:get-named-type reified))
          ;; (println 'polyt: gpolytype)
          ;; (println 'named: namedtype)
          (if (<> (length gpolytype)
                  (length namedtype))
              ;; (impc:compiler:print-type-mismatch-error (list poly
              ;; gpolytype) (list reified namedtype)))
              '()
              (for-each (lambda (a b)
                          ;; (println 'a: a 'b: b)
                          (if (symbol? b)
                              (if (regex:match? (symbol->string b) "^!")
                                  (impc:ti:update-var
                                   (string->symbol (string-append (symbol->string b) "##" (number->string gnum)))
                                   vars '() a)))
                          (if (and (string? a)
                                   (not (string=? a reified)) ;; watch out for recursive!
                                   (string-contains? a "_poly_"))
                              (impc:ti:reverse-set-bangs-from-reified b a gnum vars)))
                        namedtype gpolytype))))))


Back to Index