Commits

camlspotter committed 4c553d8

cleaning up

Comments (0)

Files changed (11)

 .*\.cm[a-z]+$
 .*~$
-\.(sp[io]t|annot|o|cm[a-z]+|orig|omc|lock)$
+\.(sp[io]t|annot|o|cm[a-z]+|orig|omc|lock|opt|run)$
 \.omakedb$
 .*\.a
 llvm-ocamlfind/META$
+examples/double$
+examples/double_phantom$
 
 printer: printer.ml
     ocamlfind ocamlc -linkpkg -package spotlib -o printer printer.ml
+
+Subdirs()
       Module.PassManager.run_function_if_opt f;
       Analysis.assert_valid_function f;
       Format.eprintf "Now running %s@." name;
-      ignore (Module.ExecutionEngine.run_function f [||]);
+      ignore (Module.ExecutionEngine.run_function f P.c0);
       Format.eprintf "Done running %s@." name;
 end
   end
 
   val func : string -> 'a typ -> ('b, (string * Llvm.lltype)) Phantom.ts
-    -> (('b -> 'a) pointer v (* self *)
-        -> 'b vs -> 'a v m) -> ('b -> 'a) pointer v m
+    -> (('b -> 'a) pointer v (* self *) -> 'b vs -> 'a v m) 
+    -> ('b -> 'a) pointer v m
   (** [func name return_type arg_types f] defines a function of a name [name] whose type is
       [arg_types] -> [return_type]. Its function body is defined by [f].
       Self is for recursion.

examples/OMakefile

+OCAMLINCLUDES += ..
+OCAML_BYTE_LINK_FLAGS += llvm_phantom.cmo
+OCAML_NATIVE_LINK_FLAGS += llvm_phantom.cmx
+OCAMLDEPFLAGS += -I .. 
+
+MyOCamlProgram(double, double)
+MyOCamlProgram(double_phantom, double_phantom)

examples/double.ml

+(* This code is written in the vanilla LLVM OCaml binding.
+   See double_phantom.ml for the phantomed version.
+   Comments are in Japanese, UTF-8.
+*)
+
+open Llvm
+
+module E = Llvm_executionengine
+  (* Llvm_executionengine って一々書いてられないから E って名前をつけます *)
+
+let _ = E.initialize_native_target ()
+  (* これをしないと JIT が有効にならず、ただのインタープリタになっちゃって遅くなるよ *)
+
+let context = global_context ()
+  (* このコンテクストってのをいろんなものが要求します。面倒だね *)
+
+let module_ = create_module context "mymodule"
+  (* モジュールを作りましょう *)
+
+let builder = builder context
+  (* ビルダを作りましょう。 build_hogehoge 引数 builder すると、
+     hogehoge という命令を builder が指している所に作ってくれる。
+     カーソルみたいなものです。 *)
+
+let i32_t = i32_type context
+  (* 32bit 整数の型。何度も i32_type context って書くの面倒だから定義しとこう *)
+
+(* 準備終わり! double 関数を定義していきましょう!! *)
+
+let double_type = function_type i32_t [| i32_t |]
+  (* double 関数の型。 i32_t を一つ受け取って i32_t を返す *)
+
+let double = declare_function "double" double_type module_
+  (* "double" という関数が double_type を持つと宣言します。 *)
+
+let bb = append_block context "entry" double
+  (* double 関数に "entry" という名前の basic block を付け加えます。 *)
+
+let () = position_at_end bb builder
+  (* ビルダを bb を指すようにして、 build_hogehoge が double 関数のコードを生成するようにします *)
+
+let param = match params double with
+  | [| param |] -> param
+  | _ -> assert false
+      (* double 関数の引数を指す llvalue を得ます。一引数だから、一つしか帰ってこないはず *)
+
+let () = set_value_name "param" param
+  (* 引数に名前はつけなくてもいいけど、せっかくだから俺は "param" って名前をえらぶぜぇ *)
+
+let doubled = build_mul param (const_int i32_t 2) "doubled" builder
+  (* param を 2 倍するコードを生成します。結果を利用するには doubled を使う *)
+
+let () = ignore (build_ret doubled builder)
+  (* doubled を関数の戻り値にするよ *)
+
+(* double 関数は定義できた!! *)
+
+let () = dump_value double
+  (* 念のため、 double をダンプしてみる。コードがプリントアウトされるよ。それとなく二倍してるっぽいでしょ? *)
+
+let () = Llvm_analysis.assert_valid_function double
+  (* 折角だから、 LLVM 様に俺のコードが正しいか聞いてみるぜぇ!
+     というか、お願いですから必ず聞いてください。ここで聞かないと後で後悔します。
+     もしここでエラーが出るといろいろ言われます。はじめは意味がわかりませんが、めげてはいけません。
+     チェックをせずに後で文句を言われた場合、もっとわけがわからなくなります。 *)
+
+(* double 関数はチェックできたよ! さあ、 LLVM 様にコンパイルしてもらおう! *)
+
+let engine = E.ExecutionEngine.create module_
+  (* LLVM engine を作るよ! *)
+
+let res = E.ExecutionEngine.run_function double [| E.GenericValue.of_int i32_t 21 |] engine
+  (* Engine に double 関数をコンパイルして、その上 21 を適用して結果をもらいます *)
+
+let res_int = E.GenericValue.as_int res
+  (* 結果を OCaml の整数に変換するよ *)
+
+let () = Printf.eprintf "double(21)=%d\n" res_int
+  (* ちゃんと 42 になっていますかぁ? *)

examples/double_phantom.ml

+open Llvm
+open Llvm_phantom
+
+module P = Spotlib.Spot.Phantom
+open P.Open
+
+let context = Llvm.global_context () 
+
+include Wrap.Create(struct let context = context end)
+open Type
+open Value
+
+module M = CreateModule(struct
+  let name = "mymodule"
+  let opt = true
+end)
+open M.Monad.Open
+ 
+let double = M.Monad.run (M.func "double" i32 (P.c1 (P.combine "param" i32)) (fun 
+  _self (* for recursion (not used here) *) 
+  vs (* parameters *) -> 
+    let param = P.d1 vs in
+    M.mul param (Const.i32_of_int 2)))
+
+let () = Value.dump double
+let () = Value.Analysis.assert_valid_function double
+
+let res = M.ExecutionEngine.run_function double (P.c1 (Genvalue.of_int i32 21))
+let res_int = Genvalue.as_int res
+
+let () = Printf.eprintf "double(21)=%d\n" res_int
   
   let engine = E.ExecutionEngine.create module_
   module ExecutionEngine = struct
-    let run_function (lv : ('a -> 'b) pointer v) args = 
-      E.ExecutionEngine.run_function !<lv args engine
+    let run_function (lv : ('args -> 'b) pointer v) (args : 'args Genvalue.vs) : 'b Genvalue.v = 
+      P.unsafe ^$ E.ExecutionEngine.run_function !<lv (P.List.to_array args) engine
   end
   
   let fpm = Llvm.PassManager.create_function module_
 
   module ExecutionEngine : sig
     (* CR: can be more type safe *)
-    val run_function : ('args -> 'ret) pointer v -> GenericValue.t array -> GenericValue.t
+    val run_function : ('args -> 'ret) pointer v -> 'args Genvalue.vs -> 'ret Genvalue.v
   end
 
   module Function : sig
 open Spotlib.Spot
 
-module Create(A : sig end) = struct
+(* We require [initialize_native_target] to make the engine real JIT.
+   Otherwise it fails to create a JIT and fall back to an interpreter,
+   which fails to find external symbols
+*)
+let _ = Llvm_executionengine.initialize_native_target ()
 
-  module Engine = Llvm_executionengine
+module Create(A : sig 
+  val context : Llvm.llcontext
+end) = struct
 
-  (* We require [initialize_native_target] to make the engine real JIT.
-     Otherwise it fails to create a JIT and fall back to an interpreter,
-     which fails to find external symbols
-  *)
-  let _ = Engine.initialize_native_target ()
-    
-  let context = Llvm.global_context ()
+  include A
 
   module Value = Value_ctxt.Make(struct let context = context end)
   module Type = struct
-module Create(A : sig end) : Wrap_intf.S
+module Create(A : sig 
+  val context : Llvm.llcontext
+end) : Wrap_intf.S