(define impc:ti:first-transform
(lambda (ast inbody?)
;; (println 'ast: ast)
(if (null? ast) '()
(cond ((list? ast)
(cond ((or (and (symbol? (car ast))
(impc:ti:get-polyfunc-candidate-types (symbol->string (car ast))))
(impc:ti:genericfunc-exists? (car ast)))
(set! *unique-polynum* (+ 1 *unique-polynum*))
(cons (string->symbol (string-append (symbol->string (car ast))
"##" ;"$$$"
(number->string *unique-polynum*)))
(impc:ti:first-transform (cdr ast) inbody?)))
((and ;; exact poly match (with type)
(symbol? (car ast))
(regex:match? (symbol->string (car ast)) ":\\[")
;;(impc:ti:polyfunc-exists? (car (regex:type-split (symbol->string (car ast)) ":"))
(impc:ti:get-polyfunc-candidate (car (regex:type-split (symbol->string (car ast)) ":"))
(impc:ir:get-type-from-pretty-str
(cadr (regex:type-split (symbol->string (car ast)) ":")))))
(let ((p (regex:type-split (symbol->string (car ast)) ":")))
(cons
(impc:ti:get-polyfunc-candidate (car p)
(impc:ir:get-type-from-pretty-str (cadr p)))
(impc:ti:first-transform (cdr ast) inbody?))))
((and ;; generic match (with type)
(symbol? (car ast))
(regex:match? (symbol->string (car ast)) ":\\[")
(impc:ti:genericfunc-exists? (car (regex:type-split (symbol->string (car ast)) ":"))))
(let* ((p (regex:type-split (symbol->string (car ast)) ":"))
(ptrdepth (impc:ir:get-ptr-depth (cadr p))))
(impc:ti:specialize-genericfunc (car p) (cadr p))
(cons
(string->symbol (impc:ir:pointer++ (string-append (car p) "_poly_" (cname-encode (cadr p))) (- ptrdepth 1)))
(impc:ti:first-transform (cdr ast) inbody?))))
((and ;; non exact poly match with (with type)
(symbol? (car ast))
(regex:match? (symbol->string (car ast)) ":\\[")
(impc:ti:polyfunc-exists? (car (regex:type-split (symbol->string (car ast)) ":"))))
(let* ((p (regex:type-split (symbol->string (car ast)) ":"))
(t (if (impc:ti:typealias-exists? (cadr p))
(impc:ti:get-typealias-type (cadr p))
(cadr p)))
(cname (cname-encode (impc:ir:get-base-type t)))
(ptrdepth (impc:ir:get-ptr-depth t)))
(cons
(string->symbol (string-append (car p) "_adhoc_" cname))
(impc:ti:first-transform (cdr ast) inbody?))))
((eq? (car ast) 'letz)
(impc:ti:first-transform (impc:ti:letz ast) inbody?))
((eq? (car ast) 'memzone)
(impc:ti:first-transform (impc:ti:memzone ast) inbody?))
((eq? (car ast) 'beginz)
(impc:ti:first-transform (impc:ti:beginz ast) inbody?))
((eq? (car ast) 'zone_cleanup)
(impc:ti:first-transform (impc:ti:zone_cleanup ast) inbody?))
((eq? (car ast) '>=)
(impc:ti:first-transform (impc:ti:gteq ast) inbody?))
((eq? (car ast) '<=)
(impc:ti:first-transform (impc:ti:lteq ast) inbody?))
((eq? (car ast) 'and)
(impc:ti:first-transform (impc:ti:and (cdr ast)) inbody?))
;; ((eq? (car ast) 'random)
;; (impc:ti:first-transform (impc:ti:random (cdr ast)) inbody?))
((eq? (car ast) 'quote)
(impc:ti:first-transform (impc:ti:quote (cadr ast)) inbody?))
((eq? (car ast) 'list)
(impc:ti:first-transform (impc:ti:list (cdr ast)) inbody?))
((or (eq? (car ast) 'strln)
(eq? (car ast) 'strj))
(impc:ti:first-transform (impc:ti:format (cdr ast)) inbody?))
((eq? (car ast) 'sprintln)
(impc:ti:first-transform (impc:ti:sprintln (cdr ast)) inbody?))
((eq? (car ast) 'sprintout)
(impc:ti:first-transform (impc:ti:sprintln2 (cdr ast)) inbody?))
((eq? (car ast) 'println)
(impc:ti:first-transform (impc:ti:println (cdr ast)) inbody?))
((eq? (car ast) 'printout)
(impc:ti:first-transform (impc:ti:println2 (cdr ast)) inbody?))
((eq? (car ast) 'afill!)
(impc:ti:first-transform (impc:ti:afill! (cdr ast)) inbody?))
((eq? (car ast) 'pfill!)
(impc:ti:first-transform (impc:ti:pfill! (cdr ast)) inbody?))
((eq? (car ast) 'tfill!)
(impc:ti:first-transform (impc:ti:tfill! (cdr ast)) inbody?))
((eq? (car ast) 'vfill!)
(impc:ti:first-transform (impc:ti:vfill! (cdr ast)) inbody?))
((eq? (car ast) 'or)
(impc:ti:first-transform (impc:ti:or (cdr ast)) inbody?))
((eq? (car ast) 'free)
(list 'free (list 'bitcast (impc:ti:first-transform (cadr ast) inbody?)
'i8*)))
((member (car ast) '(vector_ref))
(impc:ti:first-transform `(let ((v1 (alloc)) (v2 (vector ,@(cdr ast)))) (pset! v1 0 v2) v1) inbody?))
((member (car ast) '(array_ref))
(impc:ti:first-transform `(let ((a1 (alloc)) (a2 (array ,@(cdr ast)))) (pset! a1 0 a2) a1) inbody?))
((member (car ast) '(tuple_ref))
(impc:ti:first-transform `(let ((t1 (alloc)) (t2 (tuple ,@(cdr ast)))) (pset! t1 0 t2) t1) inbody?))
((member (car ast) '(vector))
`(make-vector ,@(map (lambda (x) (impc:ti:first-transform x inbody?)) (cdr ast))))
((member (car ast) '(array))
`(make-array ,@(map (lambda (x) (impc:ti:first-transform x inbody?)) (cdr ast))))
((member (car ast) '(tuple))
`(make-tuple ,@(map (lambda (x) (impc:ti:first-transform x inbody?)) (cdr ast))))
((eq? (car ast) 'not)
(impc:ti:first-transform (impc:ti:not (cadr ast)) inbody?))
((member (car ast) '(callback schedule))
(impc:ti:first-transform (impc:ti:callback (impc:ti:first-transform (cdr ast) inbody?)) inbody?))
((and (member (car ast) *impc:mathbinaryaritylist*)
(<> (length ast) 3))
(impc:ti:first-transform (impc:ti:binary-arity ast inbody?) inbody?))
((member (car ast) '(bitwise-not ~))
(impc:ti:bitwise-not-to-eor ast inbody?))
((member (car ast) *impc:lambdaslist*)
(if inbody?
(impc:ti:lambda ast)
(cons (impc:ti:first-transform (car ast) inbody?)
(cons (impc:ti:first-transform (cadr ast) #t)
(list (cons 'begin (impc:ti:first-transform (cddr ast) #t)))))))
((eq? (car ast) 'cond)
(impc:ti:first-transform (impc:ti:cond (cdr ast)) inbody?))
((eq? (car ast) 'cset!)
(list 'closure-set!
(impc:ti:first-transform (cadr ast) inbody?)
(symbol->string (caddr ast))
(impc:ti:first-transform (cadddr ast) inbody?)
(if (not (null? (cddddr ast)))
(impc:ir:get-type-str (impc:ir:convert-from-pretty-types (car (cddddr ast)))))))
((eq? (car ast) 'cref)
(list 'closure-ref
(impc:ti:first-transform (cadr ast) inbody?)
(symbol->string (caddr ast))
(if (not (null? (cdddr ast)))
(impc:ir:get-type-str (impc:ir:convert-from-pretty-types (cadddr ast))))))
((eq? (car ast) 'refcheck)
(list 'closure-refcheck
(impc:ti:first-transform (cadr ast) inbody?)
(symbol->string (caddr ast))))
((member (car ast) '(cast convert))
(if (= (length ast) 2)
(impc:ti:first-transform (list (if (eq? (car ast) 'cast)
'bitcast
'bitconvert)
(cadr ast)) inbody?)
(let* ((p (regex:type-split (symbol->string (caddr ast)) ":"))
(ptrdepth (impc:ir:get-ptr-depth (caddr ast)))
(basetype (if (null? (cdr p)) #f (impc:ir:get-base-type (cadr p))))
(etype (if (null? (cdr p)) #f (cname-encode basetype))))
(impc:ti:first-transform
(list (if (eq? (car ast) 'cast)
'bitcast
'bitconvert)
(cadr ast)
(if etype
(string->symbol
(impc:ir:pointer++ (string-append "%" (car p) "_poly_" etype)
ptrdepth))
(string->symbol (car p))))
inbody?))))
((eq? (car ast) 'doloop) (impc:ti:doloop ast inbody?))
((eq? (car ast) 'dotimes) (impc:ti:dotimes ast inbody?))
((eq? (car ast) 'while) (impc:ti:while ast inbody?))
((member (car ast) *impc:letslist*)
(cons (impc:ti:first-transform (car ast) inbody?)
(cons (map (lambda (p)
(list (impc:ti:first-transform (car p) #f)
(impc:ti:first-transform (cadr p) #f))
)
(cadr ast))
(list (cons 'begin (impc:ti:first-transform (cddr ast) #t))))))
((and (symbol? (car ast))
(regex:match? (symbol->string (car ast)) ".*\\..*")
(not (regex:match? (symbol->string (car ast)) "\\.[0-9]*i$"))
;; this last case here to catch of '.' in
;; floating point numbers of type 1.000:float etc..
(not (number? (string->atom (car (regex:type-split (symbol->string (car ast)) ":"))))))
(if (regex:match? (symbol->string (car ast)) ".*\\..*:.*")
(let* ((subs (regex:split (symbol->string (car ast)) "\\."))
(a (string->symbol (car subs)))
(subs2 (regex:type-split (car (reverse subs)) ":"))
(b (string->symbol (car subs2)))
(c (string->symbol (cadr subs2))))
(cond ((and (= (length ast) 1) (= (length subs) 2)) ;; cref
(impc:ti:first-transform (list 'cref a b c) inbody?))
((= (length subs) 2) ;; cset
(impc:ti:first-transform (list 'cset! a b (cadr ast) c) inbody?))
((and (> (length subs) 2) (= (length ast) 2)) ;; multipart cset
(impc:ti:first-transform
(impc:ti:multicset
(append (map (lambda (x) (string->symbol x))
(append (reverse (cdr (reverse subs))) subs2))
(cdr ast)))
inbody?))
((and (> (length subs) 2) (= (length ast) 1)) ;; multipart cref
(impc:ti:first-transform
(impc:ti:multicref
(map (lambda (x) (string->symbol x))
(append (reverse (cdr (reverse subs))) subs2)))
inbody?))
(else ;; error!
(impc:compiler:print-compiler-error "Bad form!" ast))))
(let* ((subs (regex:split (symbol->string (car ast)) "\\."))
(a (string->symbol (car subs)))
(b (string->symbol (cadr subs))))
(if (= (length ast) 1)
(impc:ti:first-transform (list 'cref a b) inbody?)
(impc:ti:first-transform (list 'cset! a b (cadr ast)) inbody?)))))
((and (atom? (car ast))
(symbol? (car ast))
(impc:ti:xtmacro-exists? (symbol->string (car ast))))
(impc:ti:first-transform
(macro-expand (cons (string->symbol
(string-append "xtmacro_"
(symbol->string (car ast))))
(cdr ast)))
'inbody?))
(else
(cons ;(impc:ti:first-transform (car ast) inbody?)
(impc:ti:first-transform (car ast) #t)
;(impc:ti:first-transform (cdr ast) inbody?)))))
(impc:ti:first-transform (cdr ast) #t)))))
(else
;; (println 'atom: ast)
(cond ((rational? ast)
(impc:ti:first-transform `(Rat ,(rational->n ast) ,(rational->d ast)) inbody?))
((eq? ast #f) '(impc_false))
((eq? ast #t) '(impc_true))
((eq? ast '&) 'bitwise-and)
((eq? ast 'bor) 'bitwise-or) ; can't use a pipe
((eq? ast '^) 'bitwise-eor)
((eq? ast '<<) 'bitwise-shift-left)
((eq? ast '>>) 'bitwise-shift-right)
((eq? ast '~) 'bitwise-not)
((eq? ast 'else) '(impc_true))
((eq? ast 'null) '(impc_null))
((eq? ast 'now) 'llvm_now)
((eq? ast 'pset!) 'pointer-set!)
((eq? ast 'pref) 'pointer-ref)
((eq? ast 'pref-ptr) 'pointer-ref-ptr)
((eq? ast 'vset!) 'vector-set!)
((eq? ast 'vref) 'vector-ref)
((eq? ast 'vshuffle) 'vector-shuffle)
((eq? ast 'aset!) 'array-set!)
((eq? ast 'aref) 'array-ref)
((eq? ast 'aref-ptr) 'array-ref-ptr)
((eq? ast 'tset!) 'tuple-set!)
((eq? ast 'tref) 'tuple-ref)
((eq? ast 'tref-ptr) 'tuple-ref-ptr)
((eq? ast 'salloc) 'stack-alloc)
((eq? ast 'halloc) 'heap-alloc)
((eq? ast 'zalloc) 'zone-alloc)
((eq? ast 'alloc) 'zone-alloc)
;; ((eq? ast 'schedule) 'callback)
((eq? ast 'randomf) 'imp_randf)
((eq? ast 'void) '(void))
((and (symbol? ast)
(regex:match? (symbol->string ast) "^[+-]?[0-9]*\\.?[0-9]*[+-][0-9]*\\.?[0-9]*i$"))
(let ((p (regex:matched (symbol->string ast) "^([+-]?[0-9]*\\.?[0-9]*)([+-][0-9]*\\.?[0-9]*)i$")))
;;`(Cpxd ,(* 1.0 (string->number (cadr p))) ,(* 1.0 (string->number (caddr p))))))
(impc:ti:first-transform `(Cpxd ,(* 1.0 (string->number (cadr p))) ,(* 1.0 (string->number (caddr p)))) inbody?)))
((and (symbol? ast)
(regex:match? (symbol->string ast) ":\\$(\\[|<)"))
(let ((t (impc:ti:expand-generic-type ast)))
(if (impc:ti:closure-exists? (symbol->string t))
t
(let ((p (regex:type-split (symbol->string t) "_poly_")))
(impc:ti:specialize-genericfunc (car p) (cname-decode (cadr p)))
t))))
((and (symbol? ast)
(regex:match? (symbol->string ast) ":(f)|(i)|(f32)|(f64)|(float)|(double)|(i1)|(i8)|(i64)|(i32)|(i64)"))
(let ((p (regex:type-split (symbol->string ast) ":")))
(if (not (number? (string->atom (car p))))
ast
;; otherwise do a convert
(cond ((string=? (cadr p) "f")
(list 'bitconvert (string->atom (car p)) 'float))
((string=? (cadr p) "i")
(list 'bitconvert (string->atom (car p)) 'i32))
((string=? (cadr p) "f32")
(list 'bitconvert (string->atom (car p)) 'float))
((string=? (cadr p) "f64")
(list 'bitconvert (string->atom (car p)) 'double))
(else
(list 'bitconvert (string->atom (car p)) (string->symbol (cadr p))))))))
(else ast)))))))