impc:ti:type-normalize   scheme


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

Implementation

;; this is here to normalize any recursive tuples
;; i.e. put them in their simplist "named" form
;; you can pass in a a complete list of types
;; at the end and have this normalize them
(define impc:ti:type-normalize
  (lambda (t)
    (cond ((atom? t) t)
          ((and (list? t)
                (not (null? t))
                (not (impc:ir:type? (car t)))
                (number? (car t))
                ;;(= *impc:ir:tuple* (modulo (car t) *impc:ir:pointer*)))
                (impc:ir:tuple? (car t)))
           ;; first check all sub tuples for possible normalization!
           (set! t (map (lambda (a) (impc:ti:type-normalize a)) t))
           (let ((named-types (cl:remove-if-not string? t)))
             (if (null? named-types)
                 t
                 (let ((res (map (lambda (k)
                                   ;; (println 'k: k)
                                   (let* ((split (regex:split k "%|(_poly_)"))
                                          (gen-type (if (impc:ti:get-generictype-candidate-types (cadr split))
                                                        (symbol->string (impc:ti:get-generictype-candidate-types (cadr split)))
                                                        ""))
                                          ;; (gen-type (symbol->string (impc:ti:get-generictype-candidate-types (cadr split))))
                                          (named-type (impc:ti:get-namedtype-type k))
                                          (domatch? (if (and (list? named-type)
                                                             (= (length named-type) (length t)))
                                                        #t #f))
                                          (match (if domatch?
                                                     (map (lambda (a b)
                                                            ;; (println 'aa a 'bb b)
                                                            (if (equal? a b) #t
                                                                (if (and (symbol? a)
                                                                         (regex:match? gen-type (symbol->string a)))
                                                                    #t
                                                                    #f)))
                                                          t ;; type coming in
                                                          named-type)
                                                     (list k))))
                                     (if (member #f match) #f k)))
                                 named-types)))
                   (set! res (cl:remove-if-not string? res))
                   (if (null? res)
                       (impc:ti:type-normalize (cdr t))
                       (if (car res)
                           (car res)
                           t))))))
          ((pair? t)
           (cons (impc:ti:type-normalize (car t))
                 (impc:ti:type-normalize (cdr t)))))))


Back to Index