impc:ti:nativef-generics-final-tests   scheme

Defined in:


;; first for generic functions we do a gnum test
;; basically the gnum test looks to see if all of the types
;; in the gftype are of the same gnum as the generic function
;; if they aren't of the same gnum (i.e. if they are NEW links)
;; then we might be able to do additonal reverse lookups on the
;; OLD gnum vars by looking into NEW gnum vars
;; for example:
;; if ORIGINAL type (gpoly-type) = (211 !head##110 xlist*##110)
;; and NEW type         (gftype) = (211 !head##110 xlist*##109)
;; then we might be able to match !head##110 against !head##109
(define impc:ti:nativef-generics-final-tests
  (lambda (ast gpoly-type gftype gnum vars kts)
    ;; (println 'nativef-generics-final-tests)
    ;; do a final check of all !bang types in original gpoly-type to see
    ;; if we can improve them with any reified types we may have
    (for-each (lambda (k)
                (if (symbol? k)
                    (if (assoc-strcmp k vars) ;;(not (null? (assoc-strcmp k vars)))
                        (let ((v (cdr (assoc-strcmp k vars))))
                          (if (string? v)
                              (impc:ti:reverse-set-bangs-from-reified k v gnum vars)
                              (if (and (list? v)
                                       (= (length v) 1)
                                       (string? (car v)))
                                  (impc:ti:reverse-set-bangs-from-reified k (car v) gnum vars)))))))
              (cdr gpoly-type))
    ;; attempt to reify any gtype symbols that don't currenty have type values (i.e. not var entry)
    (for-each (lambda (a)
                (if (and (symbol? a)
                         (string-contains? (symbol->string a) "##")
                         (not (assoc-strcmp a vars)))
                    ;; (null? (cdr (assoc-strcmp a vars))))
                    ;; should call this impc:ti:symbol-tryto-reify-generic-type
                    (let ((res (impc:ti:reify-generic-type a vars '())))
                      (if (not (equal? res a))
                          (begin ;; (println 'genupdate: a '-> res)
                            (impc:ti:update-var a vars kts res))))))
              (cdr gftype))

Back to Index