impc:ir:genericfunc-type-setup   scheme


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

Implementation

(define impc:ir:genericfunc-type-setup
  (lambda (type)
    ;; (println 'type: type)
    (if (null? type)
        '()
        (map (lambda (x)
               ;; (println 'x x)
               (cond ((string? x)
                      (let ((depth (impc:ir:get-ptr-depth x)))
                        ;; (println 'depth_a: x depth)
                        (if (string-contains? x "_poly_")
                            (apply string-append (cadr (regex:matched x "%(.*)_poly_.*")) (make-list depth "*"))
                            (apply string-append (cadr (regex:matched x "%([^-*]*)")) (make-list depth "*")))))
                     ((and (symbol? x)
                           (regex:match? (symbol->string x) "(:|{)")) ;; this is my last change here!!
                      (let ((depth (impc:ir:get-ptr-depth x)))
                        ;; (println 'depth_b: x depth)
                        (apply string-append (car (impc:ti:split-namedtype x)) (make-list depth "*"))))
                     ((impc:ir:closure? x)
                      (let* ((depth (+ -1 (impc:ir:get-ptr-depth x)))
                             (res (apply
                                   string-append "[" (impc:ir:genericfunc-stringify-generic-arg-strings (cdr x)) "]"
                                   (make-list depth "*"))))
                        res))
                     ((impc:ir:tuple? x)
                      (let* ((depth (+ 0 (impc:ir:get-ptr-depth x)))
                             (res (apply
                                   string-append "<" (impc:ir:genericfunc-stringify-generic-arg-strings (cdr x)) ">"
                                   (make-list depth "*"))))
                        res))
                     ((impc:ir:array? x)
                      (if (impc:ir:type? x)
                          (impc:ir:pretty-print-type x)
                          (if (and (list? (caddr x))
                                   (impc:ir:type? (car (caddr x))))
                              (impc:ir:pretty-print-type (list (car x) (cadr x) (car (caddr x))))
                              (impc:compiler:print-compiler-error "Bad array for gen type" x))))
                     ((impc:ir:vector? x)
                      (if (impc:ir:type? x)
                          (impc:ir:pretty-print-type x)
                          (if (and (list? (caddr x))
                                   (impc:ir:type? (car (caddr x))))
                              (impc:ir:pretty-print-type (list (car x) (cadr x) (car (caddr x))))
                              (impc:compiler:print-compiler-error "Bad vector for gen type" x))))
                     ((and (number? x)
                           (= x *impc:ir:notype*))
                      "notype")
                     ((impc:ir:type? x)
                      (impc:ir:pretty-print-type x))
                     ((and (list? x) ;; if we have mulitple VALID type
                           ;; options then just choose the first valid
                           ;; type
                           (member #t (map (lambda (xx) (impc:ir:type? xx)) x)))
                      (impc:ir:pretty-print-type (car (cl:remove-if-not (lambda (xx) (impc:ir:type? xx)) x))))
                     (else "_")))
             (if (and (number? (car type))
                      (impc:ir:closure? type))
                 (cddr type)
                 type)))))


Back to Index