impc:ti:tuple-set-check   scheme

(define impc:ti:tuple-set-check
  (lambda (ast vars kts request?)
    ;;(println 'tsetcheck ast vars kts request?)
    (if (<> (length ast) 4)
        (impc:compiler:print-bad-arity-error ast))
    ;; (caddr ast) must be an integer
    (if (not (integer? (caddr ast)))
        (impc:compiler:print-bad-type-error (caddr ast) "tuple-set! must use a literal integer index"))
    (let* (;; a should be a tuple of some kind
           (a (let ((res (impc:ti:type-check (cadr ast) vars kts #f)))
                (if (null? res) res
                    (if (and (string? (car res))
                             (char=? (string-ref (car res) 0) #\%))
                        (let ((t (impc:ti:get-namedtype-type (impc:ir:get-base-type (car res)))))
                          (dotimes (i (impc:ir:get-ptr-depth (car res))) (set! t (impc:ir:pointer++ t)))
                          (list t))
                        res))))
           ;; b should be 32bit fixed point type -- llvm structs only support 32bit indexes
           (b (impc:ti:type-check (caddr ast) vars kts (list *impc:ir:si32*)))
           (req? (if (and (not (null? a))
                          (list? a))
                     (if (impc:ir:tuple? (car a))
                         (if (> (+ 2 (caddr ast)) (length (car a)))
                             (impc:compiler:print-index-oob-error 'tuple ast)
                             (list-ref (car a) (+ 1 (caddr ast))))
                         #f)
                     #f))
                                        ;(llllll (println 'req: req?  'cara: (car a) 'z: (caddr ast) 'list-ref: (+ 1 (caddr ast))))
           ;; c should be an element of a tuple
           (c (impc:ti:type-check (cadddr ast) vars kts req?)))
      ;; (if (and (not (null? a))
      ;;          (list? a))
      ;;     (if (impc:ir:tuple? (car a))
      ;;         (list-ref (car a) (+ 1 (caddr ast)))
      ;;         #f)
      ;;     #f))))
      (if (and (not (null? a))
               (not (null? (car a)))
               (not (symbol? (car a))) ;; symbol may not have yet been defined!!
               (not (impc:ir:tuple? (car a))))
          (impc:compiler:print-bad-type-error (caddr ast) (string-append "invalid tuple-set-check type " (impc:ir:get-type-str (car a)))))
      ;; if (cadddr ast) is a symbol we should update
      ;; it's type with c but for polymorphic cases
      ;; we should ensure that we also do a type-unification
      (if (symbol? (cadddr ast))
          (let* ((types (if (assoc-strcmp (cadddr ast) vars)
                            (cdr (assoc-strcmp (cadddr ast) vars))
                            (impc:ti:type-check (cadddr ast) vars kts req?)))
                 (utype (impc:ti:type-unify (list c types) vars)))
                                        ;(println 'types: types 'utype: utype 'c: (list c types))
            (if (null? utype)
                (impc:ti:force-var (cadddr ast) vars kts (list c))
                (impc:ti:force-var (cadddr ast) vars kts (list utype)))))