impc:ir:compiler:closure-ref   scheme


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

Implementation

(define impc:ir:compiler:closure-ref
  (lambda (ast types)
    ;; arg 1 must be a closure
    ;; arg 2 must be a string
    ;; arg 3 must be a string
    (let* ((os (make-string 0))
                                        ;(closure-str (impc:ir:compiler (cadr ast) types))
           (closure-str (if (and (symbol? (cadr ast))
                                 (impc:ti:closure-exists? (symbol->string (cadr ast))))
                            (impc:ir:compiler:closure-from-getter (symbol->string (cadr ast)))
                            (impc:ir:compiler (cadr ast) types)))
           (closure (impc:ir:gname))
           ;; (name-str (impc:ir:compiler (caddr ast) types))
           ;; (name (impc:ir:gname))
           (type-str (impc:ir:compiler (cadddr ast) types))
           (type (impc:ir:gname)))
      (emit "\n; closure ref \n" os)
      (emit closure-str os)
      ;; (emit name-str os)
      (emit type-str os)
      (emit (string-append (impc:ir:gname "tablePtr" (cadr closure)) " = getelementptr "
                           (impc:ir:pointer-- (cadr closure)) ", "
                           (cadr closure) " " (car closure) ", i32 0, i32 0\n") os)
      (emit (string-append (impc:ir:gname "tmp" "%clsvar**") " = bitcast i8** "
                           (car (impc:ir:gname 1)) " to %clsvar**\n") os)
      (emit (string-append (impc:ir:gname "table" "%clsvar*")
                           " = load %clsvar*, %clsvar** " (car (impc:ir:gname 1)) "\n") os)
      (emit (string-append (impc:ir:gname "ePtr" "i8**") " = getelementptr "
                           (impc:ir:pointer-- (cadr closure)) ", "
                           (cadr closure) " " (car closure) ", i32 0, i32 1\n") os)
      (define ePtr (impc:ir:gname))
      (emit (string-append (impc:ir:gname "e" "i8*")
                           " = load i8*, i8** " (car (impc:ir:gname "ePtr")) "\n") os)
      (define e (impc:ir:gname))
      (emit (string-append (impc:ir:gname "offset" "i32")
                           " = call i32 @get_address_offset(i64 "
                           (string-hash (caddr ast)) ", %clsvar* " (car (impc:ir:gname "table")) ")\n") os)
      (define offset (impc:ir:gname))
      (emit (string-append (impc:ir:gname "valPtr" "i8*") " = getelementptr "
                           (impc:ir:pointer-- (cadr e)) ", "
                           (cadr e) " " (car e) ", i32 " (car offset) "\n") os)
      (emit  (impc:ir:gname "val" "i8**") " = bitcast i8* " (car (impc:ir:gname 1)) " to i8**\n" os)
      (emit  (impc:ir:gname "val" "i8*") " = load i8*, i8** " (car (impc:ir:gname 1)) "\n" os)
      (emit (string-append (impc:ir:gname "val" (string-append (cadddr ast) "*")) " = bitcast i8* " (car (impc:ir:gname 1)) " to "
                           (string-append (cadddr ast) "*\n")) os)
      (emit  (impc:ir:gname "val" (cadddr ast)) " = load " (cadddr ast) ", " (cadddr ast) "* " (car (impc:ir:gname 1)) "\n" os)
      (impc:ir:strip-space os))))


Back to Index

Similar Entries