impc:ir:compiler:llvm_varargs   scheme


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

Implementation

(define impc:ir:compiler:llvm_varargs
  (lambda (ast types)
    (let ((args (map (lambda (a)
                       (cons (impc:ir:compiler a types)
                             (impc:ir:gname)))
                     (cdr ast)))
          (va (impc:ir:gname "val" "i32")))
      (cond ((equal? (car ast) 'printf)
             (if (<> (impc:ir:get-type-from-str (car (cdr (cdr (car args)))))
                     (impc:ir:pointer++ *impc:ir:si8*))
                 (impc:compiler:print-bad-type-error-with-ast
                  (impc:ir:get-type-from-str (car (cdr (cdr (car args)))))
                  "first argument must be a format string" ast)))
            ((member (car ast) '(fprintf fscanf))
             (if (<> (impc:ir:get-type-from-str (car (cdr (cdr (car args)))))
                     (impc:ir:pointer++ *impc:ir:si8*))
                 (impc:compiler:print-bad-type-error-with-ast
                  (impc:ir:get-type-from-str (car (cdr (cdr (car args)))))
                  "first argument must be stdc FILE*" ast))
             (if (<> (impc:ir:get-type-from-str (car (cdr (cdr (cadr args)))))
                     (impc:ir:pointer++ *impc:ir:si8*))
                 (impc:compiler:print-bad-type-error-with-ast
                  (impc:ir:get-type-from-str (car (cdr (cdr (cadr args)))))
                  "second argument must be a format string" ast)))
            ((member (car ast) '(sprintf sscanf))
             (if (<> (impc:ir:get-type-from-str (car (cdr (cdr (car args)))))
                     (impc:ir:pointer++ *impc:ir:si8*))
                 (impc:compiler:print-bad-type-error-with-ast
                  (impc:ir:get-type-from-str (car (cdr (cdr (car args)))))
                  "first argument must be allocated memory" ast))
             (if (<> (impc:ir:get-type-from-str (car (cdr (cdr (cadr args)))))
                     (impc:ir:pointer++ *impc:ir:si8*))
                 (impc:compiler:print-bad-type-error-with-ast
                  (impc:ir:get-type-from-str (car (cdr (cdr (cadr args)))))
                  "second argument must be a format string" ast)))
            (else (impc:compiler:print-bad-type-error "" "Bad VARARGS func!")))
      (if (equal? (car ast) 'printf)
          (string-append (apply string-append (map (lambda (a) (car a)) args))
                         "\n" va " = call i32 (i8*, ...) @printf("
                         (caddr (car args)) " " (cadr (car args))
                         (apply string-append (map (lambda (a)
                                                     (string-append ", "
                                                                    (caddr a)
                                                                    " " (cadr a)))
                                                   (cdr args)))
                         ")\n")
          (string-append (apply string-append (map (lambda (a) (car a)) args))
                         "\n" va " = call i32 (i8*,i8*, ...) @"
                         (symbol->string (car ast)) "("
                         (caddr (car args)) " " (cadr (car args)) ", "
                         (caddr (cadr args)) " " (cadr (cadr args))
                         (apply string-append (map (lambda (a)
                                                     (string-append ", "
                                                                    (caddr a)
                                                                    " " (cadr a)))
                                                   (cddr args)))
                         ")\n")))))


Back to Index

Similar Entries