impc:compiler:print-could-not-resolve-types   scheme


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

Implementation

(define impc:compiler:print-could-not-resolve-types
  (lambda (types ast . name)
    (if (and (not (null? types))
             (list? types)
             (= (length types) 1)
             (list? (car types)))
        (set! types (car types)))
    (if (and (not (null? types))
             (symbol? (car types)))
        (set! types (list types)))
    ;; (println 'types: types)
    ;; (println 'ast: ast)
    (print-with-colors 'black 'red #t (print "Could not resolve types!"))
    (if (not (null? name))
        (begin
          (print-with-colors 'red 'black #t (print "::"))
          (print-with-colors 'black 'red #t (print (car name)))))
    (print-with-colors 'default 'default #t (print "\n"))
    (for-each (lambda (t)
                ;; (println 't t (impc:ir:type? (cdr t)))
                (if (or (atom? t)
                        (and (not (null? (cdr t)))
                             (not (atom? (cdr t)))
                             (member (cadr t) '(213)))
                        (and (not (null? (cdr t)))
                             (impc:ir:type? (cdr t))))
                    'done
                    (let* ((ts (if (atom? (cdr t))
                                   (if (impc:ir:type? (cdr t))
                                       (list (cdr t))
                                       '())
                                   (map (lambda (x)
                                          (if (impc:ir:type? x) x
                                              #f))
                                        (cdr t))))
                           (tsr (cl:remove #f ts))
                           (expr1 (if (null? ast) '()
                                      (flatten (impc:compiler:print-could-not-resolve-types_find-expr (car t) ast))))
                           (expr2 (cl:remove #f expr1))
                           (expr1a (if (null? expr2) '() (vector-ref (car expr2) 0)))
                           (all-expr (cl:every (lambda (x) (symbol? x)) expr1a))
                           (expr (if all-expr (car expr1a) expr1a)))
                      ;; (println tsr ': expr)
                      ;; (println 'tsr tsr (car t))
                      (if (null? tsr)
                          (begin
                            (if (and (symbol? (car t))
                                     (or (regex:match? (symbol->string (car t)) "^_anon_lambda" )
                                         (regex:match? (symbol->string (car t)) "^!")))
                                'done
                                (begin
                                  (print-with-colors 'red 'black #t (print "unresolved: "))
                                  (if (null? expr)
                                      (print-with-colors 'red 'black #t (print (car t)))
                                      (print-with-colors 'red 'black #t (print expr)))
                                  (print-with-colors 'default 'default #t (print "\n")))))
                          (begin (print-with-colors 'red 'black #t (print "ambiguous: "))
                                 (if (null? expr)
                                     (print-with-colors 'red 'black #t (print (car t)))
                                     (print-with-colors 'red 'black #t (print expr)))
                                 (print-with-colors 'default 'default #t (print "\n"))
                                 (for-each (lambda (x n)
                                             (print (string-append "(" (number->string n) ") "))
                                             (print-with-colors 'default 'black #t (print (impc:ir:pretty-print-type x) "\n")))
                                           tsr
                                           (range 0 (length tsr))))))))
              types)
    (print-with-colors 'red 'default #t (print '------------------------))
    (print-with-colors *impc:compiler:pretty-print-type-color* 'default #f types)
    (println)
    (if (impc:aot:currently-compiling?)
        (quit 2)
        (throw ""))))


Back to Index

Similar Entries