impc:ti:tuple-ref-check   scheme

(define impc:ti:tuple-ref-check
  (lambda (ast vars kts request?)
    ;; (println 'ref-check ast request?) ;kts vars)
    ;; (caddr ast) must be an integer
    (if (not (integer? (caddr ast)))
        (impc:compiler:print-bad-type-error (caddr ast) "tuple-ref must use a literal integer index"))
    (let* (; a should be a tuple of some kind!
           (a (impc:ti:type-check (cadr ast) vars kts #f)) ;(if (and (impc:ir:type? request?)
                                        ;	(impc:ir:tuple? request?))
                                        ;  request?
                                        ; #f))) ;request?))
           ;; b should be fixed point -- llvm structs only support 32bit indexes
           (b (impc:ti:type-check (caddr ast) vars kts (list *impc:ir:si32*)))
           (idx (eval (caddr ast))))
      (if (and (not (null? a)) (or (atom? a) (impc:ir:type? a))) (set! a (list a)))
      ;; unify a?
      (if (not (null? a)) (set! a (impc:ti:type-unify (car a) vars)))
      (if (and (not (null? a)) (or (atom? a) (impc:ir:type? a))) (set! a (list a)))
      ;; is 'a' still generic? (i.e. not resolved to a named type yet?)
      (if (and (not (null? a))
               (symbol? (car a)))
          (let* ((p1 (regex:split (symbol->string (car a)) "##"))
                 ;; (lllll (println 'ppp1: p1))
                 (p2 (regex:type-split (car p1) ":"))
                 ;; (llllllll (println 'ppp2: p2))
                 (args (map (lambda (x)
                              (if (regex:match? x "^\\!")
                                  (string->symbol (string-append x "##" (cadr p1)))
                                  (impc:ir:get-type-from-pretty-str x)))
                            (if (null? (cdr p2))
                                '()
                                (impc:ir:get-pretty-tuple-arg-strings (cadr p2))))))
            (set! a (list (list (cons 114 args))))))
      ;; we MUST expand named types!
      (if (and (not (null? a))
               (not (number? (car a))))
          (set! a (impc:ti:try-to-resolve-named-types (car a) vars)))
      (if (and (not (null? a))
               (or (atom? a)
                   (number? (car a))
                   (impc:ir:type? a)))
          (set! a (list a)))
      (if (and (not (null? a))
               (list? a)
               (impc:ir:tuple? (car a)))
          (begin (if (>= (caddr ast)
                         (- (length (car a)) 1))
                     (impc:compiler:print-index-oob-error 'tuple ast))
                 (let ((res (list-ref (car a) (+ 1 idx))))
                   (if (not (impc:ir:type? res))
                       (if (and (assoc-strcmp res vars) request?)
                           (if (null? (cdr (assoc-strcmp res vars)))
                               (begin
                                 ;; (println 'updateres: res '-> request?)
                                 (impc:ti:update-var res vars kts request?)
                                 (set! res request?))
                               (set! res '()))
                           (set! res '())))
                   ;; (println 'trefres: res)
                   res))
          '()))))