impc:ti:handle-forced-types   scheme

Defined in:


(define impc:ti:handle-forced-types
  (lambda (t1 . args)
    (if (null? args) '()
        (let* ((forced-types (map (lambda (t)
                                    (map (lambda (tt)
                                           ;; (println 'tt: tt)
                                           (if (not (or (symbol? tt)
                                                        (list? tt)))
                                               (impc:compiler:print-bad-type-error t "bad fixed type")))
                                         (if (list? t) (cdr t) (list (cdr t))))
                                    (cons (car t) (impc:ir:convert-from-pretty-types (cdr t))))
               ;; (llllll (println 'ft forced-types))
               (forced-types-updated (apply append (list)
                                            (map (lambda (t)
                                                   ;; first off we might be introducing a new spec'd type here!
                                                   (if (string? (cdr t))
                                                      (impc:ti:spec-new-type? (cdr t)))
                                                   ;; on with the show!
                                                   (if (and (impc:ir:closure? (cdr t))
                                                            (not (null? (impc:ti:get-closure-arg-symbols (car t) t1))))
                                                       (if (<> (length (cdddr t))
                                                               (length (impc:ti:get-closure-arg-symbols (car t) t1)))
                                                           (impc:compiler:print-bad-type-error (cdr t) (car t))
                                                           (append (map (lambda (sym type)
                                                                          (cons sym type))
                                                                        (impc:ti:get-closure-arg-symbols (car t) t1)
                                                                        (cdddr t))
                                                                   (list t)))
                                                       (list t)))
               ;; (lllllllllllll (println 'typesupdated forced-types-updated))
               (checked-for-duplicates (let loop ((types forced-types-updated))
                                         (if (null? types) (cl:remove-duplicates forced-types-updated)
                                             (if (and (assoc-strcmp (caar types) (cdr types))
                                                      (not (equal? (cdr (assoc-strcmp (caar types) (cdr types)))
                                                                   (cdr (car types)))))
                                                  (cdar types)
                                                  (cdr (assoc-strcmp (caar types) (cdr types)))
                                                  (caar types))
                                                 (loop (cdr types))))))
               (fullyqualified (cl:remove-if-not (lambda (t) (impc:ir:type? (cdr t))) checked-for-duplicates)))
          ;; return fully qualified types

Back to Index