impc:ir:get-type-from-str   scheme

(define impc:ir:get-type-from-str
  (lambda (string-type . args)
    ;; (println 'ir:get-type-from-str 'string-type: string-type 'args: args)
    (if (or (not (string? string-type))
            (string=? "" string-type))
        (impc:compiler:print-compiler-error (string-append "impc:ir:get-type-from-str must take a string, not " (sexpr->string string-type))))
    (let* ((ptr-depth (impc:ir:get-ptr-depth string-type))
           (offset (* ptr-depth *impc:ir:pointer*))
           ;;(expand-closures? (if (null? args) #f (car args)))
           (base (impc:ir:get-base-type string-type)))
      (if (= 92 (char->integer (string-ref base 0)))
          (string-set! base 0 (integer->char 48)))
      (cond ((string=? base "void") *impc:ir:void*)
            ((string=? base "notype") *impc:ir:notype*)
            ;; this here just for recursive named types from LLVM IR
            ((string=? base "@") -2)
            ((regex:match? base "^[0-9]*$")
             (- (* -1 ptr-depth *impc:ir:pointer*) (string->number base)))
            ((string=? base "closure") (+ *impc:ir:closure* offset))
            ((string=? base "tuple") (+ *impc:ir:tuple* offset))
            ((string=? base "array") (+ *impc:ir:array* offset))
            ((string=? base "vector") (+ *impc:ir:vector* offset))
                                        ;((regex:match? base "\\<\\{\\s?i8\\*,\\s?i8\\*.*")
            ((and (regex:match? base "^\\<.* x .*\\>\\**$")
                  (not (string-contains? base ",")))
             (cons (+ offset *impc:ir:vector*) (impc:ir:get-vector-type-from-str string-type)))
            ((regex:match? base "^\\{\\s?i8\\*,\\s?i8\\*.*\\)\\**}$")
             (cons (+ offset *impc:ir:closure*) (impc:ir:get-closure-type-from-str string-type)))
                                        ;((regex:match? base "\\<?\\{.*\\}\\>?\\**")
            ((regex:match? base "^\\<?\\{.*\\}\\>?\\**$")
             (cons (+ offset *impc:ir:tuple*) (impc:ir:get-tuple-type-from-str string-type)))
                                        ;((regex:match? base "\\[[^x]*x.*\\]\\**")
            ((regex:match? base "^\\[.*x.*\\]\\**$")
             (cons (+ offset *impc:ir:array*) (impc:ir:get-array-type-from-str string-type)))
            ((char=? (string-ref base 0) #\%)
             string-type)
             ;; (if (impc:ti:namedtype-exists? (substring base 1 (string-length base)))
             ;;     string-type
             ;;     (if (string-contains? string-type "_poly_")
             ;;         (if (impc:ti:spec-new-type? string-type)
             ;;             string-type
             ;;             (impc:compiler:print-bad-type-error string-type "Poly type not yet instantiated??"))
             ;;         (impc:compiler:print-bad-type-error string-type "Named Type Does not EXisT!"))))
            ((assoc-strcmp (string->symbol string-type) *impc:ti:generic-type-mappings*)
             (impc:ir:get-type-from-str (cdr (assoc-strcmp (string->symbol string-type) *impc:ti:generic-type-mappings*))))
            ;; ((regex:match? string-type "##") string-type)
            (else (let loop ((i -1))
                    (if (string=? base (impc:ir:get-type-str i string-type))
                        (+ i offset)
                        (if (< i *impc:ir:lowest-base-type*)
                            (loop (+ i 1))
                            (impc:compiler:print-bad-type-error string-type)))))))))