impc:ir:compiler:vector-set   scheme


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

Implementation

(define impc:ir:compiler:vector-set
  (lambda (ast types)
    (let* ((os (make-string 0))
           (index-str (impc:ir:compiler (caddr ast) types *impc:ir:si32*)) ;; i32
           (idx (impc:ir:gname))
           (var-str (impc:ir:compiler (cadr ast) types))
           (var (impc:ir:gname))
           (ttype (impc:ir:get-type-from-str (cadr var)))
           (val-str (impc:ir:compiler (cadddr ast) types (caddr ttype)))
           (val (impc:ir:gname)))
      ;; type tests
      (if (not (impc:ir:vector? ttype))
          (impc:compiler:print-bad-type-error-with-ast ttype "invalid vector type" ast))
      (if (> (impc:ir:get-ptr-depth ttype) 1)
          (impc:compiler:print-bad-type-error-with-ast (cadr var) "pointer depth too great for vector-set!" ast))
      ;; type tests done
      (emit index-str os)
      (emit var-str os)
      (emit val-str os)
      (emit "; set vector\n" os)
      (if (impc:ir:pointer? ttype) ;; must be an array if we're not a pointer
          (emit (impc:ir:gname "vect" (impc:ir:get-type-str (impc:ir:pointer-- ttype))) " = load " (impc:ir:pointer-- (cadr var)) ", " (cadr var) " " (car var) "\n"
                (impc:ir:gname "vect2" (cadr (impc:ir:gname "vect"))) " = insertelement " (cadr (impc:ir:gname "vect")) " " (car (impc:ir:gname "vect"))
                ", " (cadr val) " " (car val) ", " (cadr idx) " " (car idx) "\n"
                "store " (cadr (impc:ir:gname "vect2")) " " (car (impc:ir:gname "vect2")) ", " (cadr var) " " (car var) "\n" os)
          (impc:compiler:print-bad-type-error-with-ast ttype "vset! needs to be a pointer to a vector" ast))
      (impc:ir:gname "voidmark" (impc:ir:get-type-str *impc:ir:void*))
      (impc:ir:strip-space os))))


Back to Index

Similar Entries