/ llvm / attribute.scm
attribute.scm
 1  (define-module (llvm attribute)
 2    #:use-module ((rnrs base) #:select (assert))
 3  
 4    #:use-module (system foreign)
 5    #:use-module (oop goops)
 6    #:use-module (llvm types)
 7    #:use-module (llvm type)
 8    #:use-module (llvm context)
 9    #:use-module (llvm raw)
10    #:export (create-string-attribute
11              create-enum-attribute))
12  
13  (define* (create-string-attribute k v #:key (context (current-llvm-context)))
14    (wrap-llvm-attribute
15     (LLVMCreateStringAttribute
16      (unwrap-llvm-context context)
17      (string->pointer k) (string-length k)
18      (string->pointer v) (string-length v))))
19  
20  (define-public (add-attribute-at-index! function index attribute)
21    (LLVMAddAttributeAtIndex (unwrap-llvm-function function)
22                             index
23                             (unwrap-llvm-attribute attribute)))
24  (define-public (add-target-dependent-attribute! function A V)
25    (LLVMAddTargetDependentFunctionAttr
26     (unwrap-llvm-function function)
27     (string->pointer A)
28     (string->pointer V)))
29  
30  (define-public (enum-attribute-kind-for-name name)
31    (LLVMGetEnumAttributeKindForName (string->pointer name)
32                                     (string-length name)))
33  
34  (define-inlinable (ensure-string s)
35    (if (string? s)
36        s
37        (symbol->string s)))
38  
39  (define* (create-enum-attribute
40            kind-id #:optional (val 0)
41            #:key (context (current-llvm-context)))
42    (let ((kind (if (number? kind-id)
43                    kind-id
44                    (enum-attribute-kind-for-name
45                     (ensure-string kind-id)))))
46      (assert (not (zero? kind)))
47      (wrap-llvm-attribute
48       (LLVMCreateEnumAttribute
49        (unwrap-llvm-context context)
50        kind
51        val))))