Commits

Jacques-Pascal Deplaix committed d3dd0bb

Simulate types using GADT instead of polymorphic variants (2/2)

  • Participants
  • Parent commits 3350538

Comments (0)

Files changed (5)

File examples/hello.ml

     (LLVM.new_declaration
        (LLVM_types.Int 32)
        "puts"
-       [| (*LLVM_types.Pointer (LLVM_types.Int 8)*) |]
+       [| LLVM_types.Pointer (LLVM_types.Int 8) |]
       ~link_type:(Some `External)
     );
   LLVM.print_context_module
       (LLVM_types.Int 32)
       "main"
       [||]
-      [LLVM.Ret (LLVM_types.Int 32 (*Some (Big_int.big_int_of_int 0)*))]
+      [LLVM.Ret (LLVM_types.Int 32, 0, string_of_int)]
     )
   | Returned
 
 type 'a instr =
-  | Ret of 'a LLVM_types.t
+  | Ret of 'a LLVM_types.value
 
-type 'a context_module =
+type ('a, 'b, 'c) context_module =
   | Global of
     (string * thread_local option *
     address * link_type option * bool *
     'a LLVM_types.t * string option * int option)
   | Declaration of
-    ('a LLVM_types.t * string * 'a LLVM_types.t array *
+    ('a LLVM_types.t * string * 'b LLVM_types.t array *
     [`External | `Dllimport | `Extern_weak ] option)
   | Definition of
-    (('a LLVM_types.t * string * 'a LLVM_types.t array) * 'a instr list)
+    (('a LLVM_types.t * string * 'b LLVM_types.t array) * 'c instr list)
 
 let string_of_link_type = function
   | `Private                -> "private"
   | `Dllexport              -> "dllexport"
 
 let string_of_instr = function
-  | Ret a                   -> "\tret " ^ (LLVM_types.to_string a)
+  | Ret a                   -> "\tret " ^ (LLVM_types.value_to_string a)
 
 let string_of_address = function
   | Addrspace i             -> "addr(" ^ (string_of_int i) ^ ")"

File src/LLVM.mli

   | Returned
 
 type 'a instr =
-  | Ret of 'a LLVM_types.t
+  | Ret of 'a LLVM_types.value
 
-type 'a context_module =
+type ('a, 'b, 'c) context_module =
   | Global of
     (string * thread_local option *
     address * link_type option * bool *
     'a LLVM_types.t * string option * int option)
   | Declaration of
-    ('a LLVM_types.t * string * 'a LLVM_types.t array *
+    ('a LLVM_types.t * string * 'b LLVM_types.t array *
     [`External | `Dllimport | `Extern_weak ] option)
   | Definition of
-    (('a LLVM_types.t * string * 'a LLVM_types.t array) * 'a instr list)
+    (('a LLVM_types.t * string * 'b LLVM_types.t array) * 'c instr list)
 
 (*
  *  Global:
   ?constant: bool ->
   ?section: string option ->
   ?alignment: int option ->
-  string -> 'a LLVM_types.t -> 'a context_module
+  string -> 'a LLVM_types.t -> ('a, 'b, 'c) context_module
 
 val new_declaration:
   ?link_type: [< `External | `Dllimport | `Extern_weak ] option ->
-  'a LLVM_types.t -> string -> 'a LLVM_types.t array -> 'a context_module
+  'a LLVM_types.t -> string -> 'b LLVM_types.t array -> ('a, 'b, 'c) context_module
 
 val new_definition:
-  'a LLVM_types.t -> string -> 'a LLVM_types.t array -> 'a instr list -> 'a context_module
+  'a LLVM_types.t -> string -> 'b LLVM_types.t array -> 'c instr list -> ('a, 'b, 'c) context_module
 
-val print_context_module: 'a context_module -> unit
+val print_context_module: ('a, 'b, 'c)  context_module -> unit

File src/LLVM_types.ml

   | Pointer : 'a t -> 'a t t
   | FunctionPointer : 'a f -> 'a f t
 
-type 'a value = 'a t * 'a
+type 'a value = 'a t * 'a * ('a -> string)
 
 let rec to_string : type a. a t -> string = fun data ->
   let rec aux : type a. string -> a f -> string = fun acc -> function
         "[" ^ string_of_int i ^ " x " ^ to_string t ^ "]"
     | Pointer t -> to_string t ^ "*"
     | FunctionPointer f -> aux "" f
+
+let value_to_string (t, x, f) = to_string t ^ f x

File src/LLVM_types.mli

   | Pointer : 'a t -> 'a t t
   | FunctionPointer : 'a f -> 'a f t
 
-type 'a value = 'a t * 'a
+type 'a value = 'a t * 'a * ('a -> string)
 
 val to_string : 'a t -> string
+val value_to_string : 'a value -> string