;; now with pretty print support
(define impc:ir:get-type-from-pretty-str-rec
(lambda (string-type . args)
;; (println 'ir:get-type-from-pretty-str-rec 'stype: 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-pretty-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 (regex:split (impc:ir:get-base-type string-type) "%")))
(base (impc:ir:get-base-type string-type)))
;; (println 'base: base 'ptr-depth: ptr-depth (string? base))
(if (< (string-length base) 1)
(impc:compiler:print-bad-type-error string-type "Illegal type"))
(cond ((string=? base "void") *impc:ir:void*)
((string=? base "notype") *impc:ir:notype*)
((string=? base "@") (+ -2 (* *impc:ir:pointer* ptr-depth)))
((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 "^\\[.*\\]$")
(cons (+ offset *impc:ir:pointer* *impc:ir:closure*) (apply impc:ir:get-type-from-pretty-closure string-type args)))
((regex:match? base "^\\{\\s?i8\\*,\\s?i8\\*.*")
(cons (+ offset *impc:ir:closure*) (impc:ir:get-closure-type-from-str string-type)))
((regex:match? base "^\\<[^{].*[^}]\\>$")
(cons (+ offset *impc:ir:tuple*) (apply impc:ir:get-type-from-pretty-tuple string-type args)))
((regex:match? base "^\\<?\\{.*\\}\\>?\\**")
(cons (+ offset *impc:ir:tuple*) (impc:ir:get-tuple-type-from-str string-type)))
((regex:match? base "^/.*/\\**")
(cons (+ offset *impc:ir:vector*) (apply impc:ir:get-type-from-pretty-vector string-type args)))
((regex:match? base "^\\|.*\\|\\**") ;; |3,double| is an array
(cons (+ offset *impc:ir:array*) (apply impc:ir:get-type-from-pretty-array string-type args)))
((regex:match? base "^[_A-Za-z0-9]*:")
;; (println "bingo: " base)
(let* ((p (regex:type-split base ":"))
(ags (impc:ir:get-pretty-tuple-arg-strings (cadr p)))
(ags2 (map (lambda (name) ;; check for aliases!
(let ((res (impc:ti:get-typealias-type name)))
(or res name)))
ags))
(anypolys (cl:find-if
(lambda (x) (not (equal? x #f)))
(map (lambda (k)
(if (equal? (impc:ir:get-base-type k) (car p)) ;; strip recursives
#f
(impc:ti:get-generictype-candidate-types (impc:ir:get-base-type k))))
ags2))))
;; (println 'prealias-p: p)
;; set p in case we have aliased types in args that need unaliasing!
(set! p (list (car p) (string-append "<" (string-join ags2 ",") ">")))