;; bind-val takes an optional argument, the meaning of which depends
;; on the type of the val, and also an optional docstring
(define-macro (bind-val symbol type . args)
(let* ((string-literal? (and (equal? 'i8* type)
(not (null? args))
(string? (car args))))
(value (if string-literal?
(car args)
(if (not (or (null? args) (string? (car args))))
(car args)
#f)))
(docstring (if (or (null? args)
(not (string? (car (reverse args))))
(and string-literal? (= (length args) 1)))
""
(car (reverse args))))
(t (impc:ir:get-type-from-pretty-str (atom->string type)))
(oldt (impc:ti:get-globalvar-type (symbol->string symbol))))
;; this next line looks superflous but isn't!
;; 't' maybe a %blah_poly_Hldkfjs* etc. that is not
;; yet "constructed". calling get-type-from-pretty-str
;; will construct it if it doesn't yet exist
(if (string? t) (impc:ir:get-type-from-pretty-str t))
(cond (oldt
`(impc:compiler:print-already-bound-error ',symbol ,(impc:ir:pretty-print-type (impc:ir:pointer-- oldt))))
;; string literal
(string-literal?
`(begin
(llvm:compile-ir (string-append "@" ,(symbol->string symbol)
" = dllexport global i8* zeroinitializer"))
;; we should really take the globalvar out of the cache
;; if the previous steps failed
(impc:ti:register-new-globalvar ,(symbol->string symbol) ',t ,docstring)
(impc:aot:insert-globalvar-binding-details *impc:aot:current-lib-name*
,(symbol->string symbol)
,(symbol->string type)
,docstring)
(impc:aot:do-or-emit
(call-as-xtlang (set! ,symbol ,value) void))
(impc:compiler:print-binding-details-to-log "SetValue:"
,(symbol->string symbol)
,(impc:ir:pretty-print-type t))))
;; non-pointer values
((and (or (impc:ir:number? t)
(impc:ir:boolean? t)
(not (impc:ir:pointer? t))))
`(begin
(llvm:compile-ir (string-append "@" ,(symbol->string symbol)
" = dllexport global "
,(impc:ir:get-type-str t) " "
,(if (number? value)
;; can we serialise the value straight into the
;; IR? (e.g. i32/i64/float/double)
(if (equal? t *impc:ir:fp32*)
(llvm:convert-float (atom->string value))
(atom->string value))
;; otherwise use zeroinitializer and we'll just use a
;; set! inside a call-as-xtlang a bit further down
"zeroinitializer")))
(impc:ti:register-new-globalvar ,(symbol->string symbol) ',t ,docstring)
(impc:aot:insert-globalvar-binding-details *impc:aot:current-lib-name*
,(symbol->string symbol)
,(symbol->string type)
,docstring)
;; set value for non int/float literals
,(if (and value (not (number? value)))
`(impc:aot:do-or-emit
(call-as-xtlang (set! ,symbol (convert ,value ,type)) void)))
;; we should really take the globalvar out of the
;; cache if any of the previous steps failed
(impc:compiler:print-binding-details-to-log "SetValue:"
,(symbol->string symbol)
,(impc:ir:pretty-print-type t))))
;; pointer
((impc:ir:pointer? t)
(if (or (not value) (integer? value))
`(begin
(llvm:compile-ir (string-append "@" ,(symbol->string symbol)
" = dllexport global "
,(impc:ir:get-type-str t)
" zeroinitializer"))
(impc:ti:register-new-globalvar ,(symbol->string symbol) ',t ,docstring)
(impc:aot:insert-globalvar-binding-details *impc:aot:current-lib-name*
,(symbol->string symbol)
,(symbol->string type)
,docstring)
(impc:aot:do-or-emit
(call-as-xtlang (set! ,symbol (cast (malloc ,(* (or value 1)
(if (impc:ir:number? t)
(impc:ir:get-type-size t)
(/ (sys:pointer-size) 8))))
,type))
void))
;; we should really take the globalvar out of the cache
;; if the previous steps failed
(impc:compiler:print-binding-details-to-log "SetValue:"
,(symbol->string symbol)
,(impc:ir:pretty-print-type t)))
(if (list? value)
`(begin
(llvm:compile-ir (string-append "@" ,(symbol->string symbol)
" = dllexport global "
,(impc:ir:get-type-str t)
"zeroinitializer"))
(impc:ti:register-new-globalvar ,(symbol->string symbol) ',t ,docstring)
(impc:aot:insert-globalvar-binding-details *impc:aot:current-lib-name*
,(symbol->string symbol)
,(symbol->string type)
,docstring)
(impc:aot:do-or-emit
(call-as-xtlang (set! ,symbol ,value) void))
;; we should really take the globalvar out of the cache
;; if the previous steps failed
(impc:compiler:print-binding-details-to-log "SetValue:"
,(symbol->string symbol)
,(impc:ir:pretty-print-type t)))
`(impc:compiler:print-compiler-error "when binding global pointers, third argument should be size of buffer to allocate or a valid xtlang sexpr"))))
;; tuple/array/vector
((or (impc:ir:tuple? t) (impc:ir:array? t) (impc:ir:vector? t))
`(begin
(llvm:compile-ir
(string-append
"@" ,(symbol->string symbol)
" = dllexport global "
,(impc:ir:get-type-str t) " zeroinitializer"))
(impc:ti:register-new-globalvar ,(symbol->string symbol) ',t ,docstring)
(impc:aot:insert-globalvar-binding-details *impc:aot:current-lib-name*
,(symbol->string symbol)
,(symbol->string type)
,docstring)
;; we should really take the globalvar out of the cache
;; if the previous steps failed
(impc:compiler:print-binding-details-to-log "SetValue:"
,(symbol->string symbol)
,(impc:ir:pretty-print-type t))))
(else (impc:compiler:print-missing-identifier-error type 'type)))))