Commits

Jacques-Pascal Deplaix  committed a38f93c Merge

Merge branch 'master' of bitbucket.org:dinosaure/tyllvm into type-system

  • Participants
  • Parent commits 13d687b, 2ddcfc8

Comments (0)

Files changed (3)

-type link_type =
-  | Private
-  | Linker_private
-  | Linker_private_weak
-  | Internal
-  | Available_externally
-  | Linkonce
-  | Weak
-  | Common
-  | Appending
-  | Extern_weak
-  | Linkonce_odr
-  | Weak_odr
-  | Linkonce_odr_auto_hide
-  | External
-  | Dllimport
-  | Dllexport
+type link_type = [
+  | `Private
+  | `Linker_private
+  | `Linker_private_weak
+  | `Internal
+  | `Available_externally
+  | `Linkonce
+  | `Weak
+  | `Common
+  | `Appending
+  | `Extern_weak
+  | `Linkonce_odr
+  | `Weak_odr
+  | `Linkonce_odr_auto_hide
+  | `External
+  | `Dllimport
+  | `Dllexport
+  ]
 
 type data_type =
   | Int of int
     address * link_type option * bool *
     data_type * string option * int option)
   | Declaration of
-    (data_type * string * data_type array)
+    (data_type * string * data_type array *
+    [`External | `Dllimport | `Extern_weak ] option)
 
 
 let string_of_link_type = function
-  | Private                 -> "private"
-  | Linker_private          -> "linker_private"
-  | Linker_private_weak     -> "linker_private_weak"
-  | Internal                -> "internal"
-  | Available_externally    -> "available_externally"
-  | Linkonce                -> "linkonce"
-  | Weak                    -> "weak"
-  | Common                  -> "common"
-  | Appending               -> "appending"
-  | Extern_weak             -> "extern_weak"
-  | Linkonce_odr            -> "linkonce_odr"
-  | Weak_odr                -> "weak_odr"
-  | Linkonce_odr_auto_hide  -> "linkonce_odr_auto_hide"
-  | External                -> "external"
-  | Dllimport               -> "dllimport"
-  | Dllexport               -> "dllexport"
+  | `Private                 -> "private"
+  | `Linker_private          -> "linker_private"
+  | `Linker_private_weak     -> "linker_private_weak"
+  | `Internal                -> "internal"
+  | `Available_externally    -> "available_externally"
+  | `Linkonce                -> "linkonce"
+  | `Weak                    -> "weak"
+  | `Common                  -> "common"
+  | `Appending               -> "appending"
+  | `Extern_weak             -> "extern_weak"
+  | `Linkonce_odr            -> "linkonce_odr"
+  | `Weak_odr                -> "weak_odr"
+  | `Linkonce_odr_auto_hide  -> "linkonce_odr_auto_hide"
+  | `External                -> "external"
+  | `Dllimport               -> "dllimport"
+  | `Dllexport               -> "dllexport"
 
 let rec string_of_data_type ?f:(name = "") data =
   let rec aux acc arr = function
   ^ string_constant ^ string_data_type ^ string_section ^ string_align
 
 let string_of_declaration
-  (type_return, id, type_arguments) =
+  (type_return, id, type_arguments, link_type) =
   let rec aux acc arr = function
     | 0 -> acc
     | n -> aux (acc ^ ", " ^ (string_of_data_type arr.(n))) arr (n - 1)
     aux (if Array.length type_arguments > 0
       then (string_of_data_type type_arguments.(0))
       else "") type_arguments (Array.length type_arguments - 1)
+  in let string_link_type = match link_type with
+    | None                  -> ""
+    | Some a                -> " " ^ (string_of_link_type a)
   in "declare " ^ string_type_return ^ " @" ^ id
-  ^ "(" ^ string_type_arguments ^ ")"
+  ^ "(" ^ string_type_arguments ^ ")" ^ string_link_type
 
 let print_global a = print_string (string_of_global a)
 
 let print_declaration a = print_string (string_of_declaration a)
 
 let new_declaration
-  type_return id type_arguments =
-  Declaration (type_return, id, type_arguments)
+  ?(link_type=None) type_return id type_arguments =
+  Declaration (type_return, id, type_arguments,
+    (link_type :> [ `External | `Dllimport | `Extern_weak] option))
 
 let print_context_module e =
   let aux = function
-type link_type =
-  | Private
-  | Linker_private
-  | Linker_private_weak
-  | Internal
-  | Available_externally (* only allowed on definitions, not declarations*)
-  | Linkonce
-  | Weak
-  | Common
-  | Appending
-  | Extern_weak
-  | Linkonce_odr
-  | Weak_odr
-  | Linkonce_odr_auto_hide
-  | External
-  | Dllimport
-  | Dllexport
+type link_type = [
+  | `Private
+  | `Linker_private
+  | `Linker_private_weak
+  | `Internal
+  | `Available_externally (* only allowed on definitions, not declarations *)
+  | `Linkonce
+  | `Weak
+  | `Common
+  | `Appending
+  | `Extern_weak
+  | `Linkonce_odr
+  | `Weak_odr
+  | `Linkonce_odr_auto_hide
+  | `External
+  | `Dllimport
+  | `Dllexport
+  ]
 
 type data_type =
   | Int of int
     address * link_type option * bool *
     data_type * string option * int option)
   | Declaration of
-    (data_type * string * data_type array)
+    (data_type * string * data_type array *
+    [`External | `Dllimport | `Extern_weak ] option)
 
 (*
  *  Global:
   string -> data_type -> context_module
 
 val new_declaration:
+  ?link_type: [< `External | `Dllimport | `Extern_weak ] option ->
   data_type -> string -> data_type array -> context_module
 
 val print_context_module: context_module -> unit
 let () =
   LLVM.print_context_module
     (LLVM.new_global
-      ~link_type:(Some LLVM.Internal)
+      ~link_type:(Some `Internal)
       ~constant:true
       "msg" (LLVM.Array (13, LLVM.Int 8)));
   LLVM.print_context_module
     (LLVM.new_declaration
-      (LLVM.Int 32) "puts" [| LLVM.Pointer (LLVM.Int 8); LLVM.Int 32 |])
+      (LLVM.Int 32) "puts" [| LLVM.Pointer (LLVM.Int 8); LLVM.Int 32 |]
+      ~link_type: (Some `External))