Implement for both llvm-14 and llvm-16 with opaque pointers.

.gitignore

@@ -3,4 +3,6 @@ _opam
 .merlin
 *.swp
 *.so
-*.o
+*.o
+*.exe
+*.out

Makefile

@@ -1,4 +1,23 @@
-.PHONY : build link all run
+.PHONY : build-14 link-14 all-14 run-14 build link all run
+
+# Check `README.md` for pre-requisite
+
+# These are for LLVM < 15 and OCaml < 5
+
+build-14 :
+	dune build bin/kaleidoscope_14.exe
+
+link-14 :
+	rm -f k_14.exe
+	ln -s _build/default/bin/kaleidoscope_14.exe k_14.exe
+
+run-14 :
+	LD_LIBRARY_PATH=_build/default/stubs ./k_14.exe
+
+demo-14:
+	dune exec bin/kaleidoscope_14.exe < example/mandel.ks
+
+# These are for LLVM >= 15 and OCaml >= 5
 
 build :
 	dune build bin/kaleidoscope.exe
@@ -7,14 +26,20 @@ link :
 	rm -f k.exe
 	ln -s _build/default/bin/kaleidoscope.exe k.exe
 
-all: build link
-
 run :
 	LD_LIBRARY_PATH=_build/default/stubs ./k.exe
 
+demo:
+	dune exec bin/kaleidoscope.exe < example/mandel.ks
+
+# Not covering yet
+
+test:
+	dune test lib
+
 ch8-main:
 	clang++ main.cpp output.o -o main
 
 ch9-clang:
-	LD_LIBRARY_PATH=_build/default/stubs ./k.exe < fib.ks 2>&1 | clang -x ir -
+	LD_LIBRARY_PATH=_build/default/stubs ./k_14.exe < example/fib.ks 2>&1 | clang -x ir -
 

README.md

@@ -1,9 +1,20 @@
 # llvm-ocaml-tutorial
 
-The tutorial is tested up to OCaml 4.14.1 and LLVM 14.0.6.
+## Introduction
+
+The tutorial is Kaleidoscope on OCaml. It's not intended as a fully translation of [LLVM Kaleidoscope tutorial](https://llvm.org/docs/tutorial/MyFirstLanguageFrontend/index.html), but a demonstration of basic LLVM APIs in OCaml.
+
+The tutorial is tested with combinations of
+
+1. opam `llvm.16.0.6+nnp` and OCaml 5.1.0 (should be released soon).
+2. opam `llvm.14.0.6` and OCaml 4.14.1.
+
+In opam packages, `llvm.16.0.6+nnp` uses _Opaque Pointers_ and `llvm.14.0.6` uses _Typed pointers_. In official LLVM, _Opaque Pointers_ are enabled by default from LLVM 15 and _Typed pointers_ are not supported from LLVM 17. See [LLVM Opaque Pointers](https://llvm.org/docs/OpaquePointers.html) for details.
 
 ## Build
 
+Since the changes in LLVM is breakable but tiny in their APIs until now, for better or for worse, there is some duplicate code in the repo. Combination 1 uses `bin/kaleidoscope.ml` and `lib`. Combination 2 uses `bin/kaleidoscope.ml_14.ml` and `lib-14`. The rest are shared.
+
 ```console
 # Install the dependencies
 opam install base ctypes-foreign llvm menhir ppx_jane
@@ -15,21 +26,94 @@ dune build stubs/libbindings.so
 export LD_LIBRARY_PATH=_build/default/stubs
 ```
 
-## Run
+## Run (Hurry)
 
 ```console
+# with llvm 14.0.6
+dune exec bin/kaleidoscope_14.exe < example/mandel.kal
+```
+
+```console
+# with llvm 16.0.6+nnp or beyond
 dune exec bin/kaleidoscope.exe < example/mandel.kal
 ```
 
-## Test
+## Run (Step-wise)
+
+See `Makefile`.
 
 ```console
-dune test
+# with llvm 14.0.6
+make build-14
+make link-14
+make demo-14
+make run-14
 ```
 
+```console
+# with llvm 16.0.6+nnp or beyond
+make build
+make link
+make demo
+make run
+```
 ## Meta
 
+Currently, the difference between two version of code is tiny.
+
+The result of `diff bin/kaleidoscope.ml bin/kaleidoscope_14`
+```diff
+7c7
+<   Kaleidoscope_lib.Toplevel.main !dest
+---
+>   Kaleidoscope_lib_14.Toplevel.main !dest
+```
+
+The result of `diff lib lib-14-legacy`
+
+```diff
+diff '--color=auto' lib/codegen.ml lib-14-legacy/codegen.ml
+57c57
+<      | Some v -> Llvm.build_load double_type v name builder)
+---
+>      | Some v -> Llvm.build_load v name builder)
+96,99c96
+<        let fnty =
+<          Llvm.function_type double_type (Array.of_list [ double_type; double_type ])
+<        in
+<        Llvm.build_call fnty callee [| lhs_val; rhs_val |] "binop" builder)
+---
+>        Llvm.build_call callee [| lhs_val; rhs_val |] "binop" builder)
+112,114c109
+<     let arg_typs = Array.map args ~f:(Fn.const double_type) in
+<     let fnty = Llvm.function_type double_type arg_typs in
+<     Llvm.build_call fnty callee args "calltmp" builder
+---
+>     Llvm.build_call callee args "calltmp" builder
+211,212c206
+<     let cur_var = Llvm.build_load double_type alloca var_name builder in
+<     (* let cur_var = Llvm.build_load (Llvm.type_of alloca) alloca var_name builder in *)
+---
+>     let cur_var = Llvm.build_load alloca var_name builder in
+238,239c232
+<     let fnty = Llvm.function_type double_type (Array.of_list [ double_type ]) in
+<     Llvm.build_call fnty callee [| operand |] "unop" builder
+---
+>     Llvm.build_call callee [| operand |] "unop" builder
+diff '--color=auto' lib/dune lib-14-legacy/dune
+2c2
+<  (name kaleidoscope_lib)
+---
+>  (name kaleidoscope_lib_14)
+```
+
 Thank to @Kakadu's PR.
 
 The project is originally forked from https://github.com/adamrk/llvm-ocaml-tutorial.
 
+## Todo
+
+- [ ] Redo testing
+- [ ] Use vanilla library instead of `Base`
+- [ ] Update the missing part of the official Kaleidoscope tutorial
+- [ ] Rewrite the tutorial in OCaml

bin/dune

@@ -1,14 +1,27 @@
+(executable
+ (name kaleidoscope_14)
+ (modules kaleidoscope_14)
+ (libraries kaleidoscope_lib_14)
+ (link_deps
+  (file %{project_root}/stubs/libbindings.so))
+ (link_flags -cclib -Lstubs -cclib -lbindings))
+
+(cram
+ (deps
+  ./kaleidoscope_14.exe
+  %{project_root}/stubs/libbindings.so
+  %{project_root}/example/fib.ks))
+
 (executable
  (name kaleidoscope)
- (libraries base kaleidoscope_lib)
+ (modules kaleidoscope)
+ (libraries kaleidoscope_lib)
  (link_deps
   (file %{project_root}/stubs/libbindings.so))
- (link_flags -cclib -Lstubs -cclib -lbindings)
- (preprocess
-  (pps ppx_jane ppx_expect)))
+ (link_flags -cclib -Lstubs -cclib -lbindings))
 
 (cram
  (deps
   ./kaleidoscope.exe
   %{project_root}/stubs/libbindings.so
-  %{project_root}/fib.ks))
+  %{project_root}/example/fib.ks))

bin/kaleidoscope.ml

@@ -1,11 +1,8 @@
 let () =
   let dest = ref `Stdin in
   Arg.parse
-    [
-      ( "-file",
-        Arg.String (fun s -> dest := `File s),
-        " FILE read input from file" );
-    ]
+    [ "-file", Arg.String (fun s -> dest := `File s), " FILE read input from file" ]
     (fun _ -> failwith "Anonymous ones are not supported")
     "Parse and print kaleidoscope";
   Kaleidoscope_lib.Toplevel.main !dest
+;;

bin/kaleidoscope_14.ml

@@ -0,0 +1,8 @@
+let () =
+  let dest = ref `Stdin in
+  Arg.parse
+    [ "-file", Arg.String (fun s -> dest := `File s), " FILE read input from file" ]
+    (fun _ -> failwith "Anonymous ones are not supported")
+    "Parse and print kaleidoscope";
+  Kaleidoscope_lib_14.Toplevel.main !dest
+;;

lib/ast.ml → lang-ks/ast.ml

@@ -69,39 +69,37 @@ module Expr = struct
      * into a single term and then recurse until there is one term. *)
     let rec reduce first rest =
       match rest with
-      | (first_op, first_prec, _) :: tail -> (
-          let index =
-            (* search for the index of the operator with highest precedence *)
-            List.foldi tail ~init:(first_op, first_prec, 0)
-              ~f:(fun
-                   new_inx
-                   (highest_op, highest_prec, inx)
-                   (new_op, new_prec, _new_expr)
-                 ->
-                if Int.( > ) new_prec highest_prec then
-                  (new_op, new_prec, new_inx + 1)
-                else (highest_op, highest_prec, inx))
-            |> fun (_, _, index) -> index
-          in
-          match index with
-          (* if the first operator has precedence, combine [first] and [rest[0]]
-           * into new [first] and set [rest] to [tail rest]. *)
-          | 0 ->
-              let to_reduce = List.hd_exn rest in
-              let expr = Bin_list (first, [ to_reduce ]) in
-              reduce expr (List.tl_exn rest)
-          (* if it's index n > 0 then combine the terms at index [n] and [n-1]
-           * into the new [rest]. *)
-          | n ->
-              let to_reduce = List.nth_exn rest n in
-              let prev_op, prev_prec, prev_expr = List.nth_exn rest (n - 1) in
-              let new_expr =
-                (prev_op, prev_prec, Bin_list (prev_expr, [ to_reduce ]))
-              in
-              reduce first
-                (List.take rest (n - 1) @ (new_expr :: List.drop rest (n + 1))))
+      | (first_op, first_prec, _) :: tail ->
+        let index =
+          (* search for the index of the operator with highest precedence *)
+          List.foldi
+            tail
+            ~init:(first_op, first_prec, 0)
+            ~f:
+              (fun
+                new_inx (highest_op, highest_prec, inx) (new_op, new_prec, _new_expr) ->
+              if Int.( > ) new_prec highest_prec
+              then new_op, new_prec, new_inx + 1
+              else highest_op, highest_prec, inx)
+          |> fun (_, _, index) -> index
+        in
+        (match index with
+         (* if the first operator has precedence, combine [first] and [rest[0]]
+          * into new [first] and set [rest] to [tail rest]. *)
+         | 0 ->
+           let to_reduce = List.hd_exn rest in
+           let expr = Bin_list (first, [ to_reduce ]) in
+           reduce expr (List.tl_exn rest)
+         (* if it's index n > 0 then combine the terms at index [n] and [n-1]
+          * into the new [rest]. *)
+         | n ->
+           let to_reduce = List.nth_exn rest n in
+           let prev_op, prev_prec, prev_expr = List.nth_exn rest (n - 1) in
+           let new_expr = prev_op, prev_prec, Bin_list (prev_expr, [ to_reduce ]) in
+           reduce first (List.take rest (n - 1) @ (new_expr :: List.drop rest (n + 1))))
       (* once there's only one term left we're done *)
       | [] -> first
+    ;;
   end
 
   type t =
@@ -128,66 +126,65 @@ module Expr = struct
     | No_binop.Variable x -> Variable x
     | No_binop.Call (f, args) -> Call (f, List.map args ~f:of_no_binop)
     | No_binop.If (if_, then_, else_) ->
-        If (of_no_binop if_, of_no_binop then_, of_no_binop else_)
+      If (of_no_binop if_, of_no_binop then_, of_no_binop else_)
     | No_binop.For (id, start, end_, step, body) ->
-        For
-          ( id,
-            of_no_binop start,
-            of_no_binop end_,
-            Option.map step ~f:of_no_binop,
-            of_no_binop body )
+      For
+        ( id
+        , of_no_binop start
+        , of_no_binop end_
+        , Option.map step ~f:of_no_binop
+        , of_no_binop body )
     | No_binop.Unary (c, t) -> Unary (c, of_no_binop t)
     | No_binop.Var (vars, body) ->
-        Var
-          ( List.map vars ~f:(fun (name, expr) ->
-                (name, Option.map expr ~f:of_no_binop)),
-            of_no_binop body )
+      Var
+        ( List.map vars ~f:(fun (name, expr) -> name, Option.map expr ~f:of_no_binop)
+        , of_no_binop body )
     | No_binop.Bin_list (first, []) -> of_no_binop first
     | No_binop.Bin_list (first, [ (op, _prec, second) ]) ->
-        Binary (op, of_no_binop first, of_no_binop second)
-    | No_binop.Bin_list (first, rest) ->
-        of_no_binop (No_binop.reduce first rest)
+      Binary (op, of_no_binop first, of_no_binop second)
+    | No_binop.Bin_list (first, rest) -> of_no_binop (No_binop.reduce first rest)
+  ;;
 
   let%expect_test _ =
     let no_binop =
       No_binop.Bin_list
-        ( No_binop.Variable "x",
-          [ ('*', 40, No_binop.Variable "y"); ('+', 20, No_binop.Variable "z") ]
-        )
+        ( No_binop.Variable "x"
+        , [ '*', 40, No_binop.Variable "y"; '+', 20, No_binop.Variable "z" ] )
     in
-    Caml.Format.printf !"%{sexp: t}" (of_no_binop no_binop);
+    Stdlib.Format.printf !"%{sexp: t}" (of_no_binop no_binop);
     [%expect {| (Binary + (Binary * (Variable x) (Variable y)) (Variable z)) |}];
     let no_binop =
       No_binop.Bin_list
-        ( No_binop.Variable "x",
-          [
-            ('*', 40, No_binop.Variable "y");
-            ('+', 20, No_binop.Variable "z");
-            ('*', 40, No_binop.Variable "w");
+        ( No_binop.Variable "x"
+        , [ '*', 40, No_binop.Variable "y"
+          ; '+', 20, No_binop.Variable "z"
+          ; '*', 40, No_binop.Variable "w"
           ] )
     in
-    Caml.Format.printf !"%{sexp: t}" (of_no_binop no_binop);
+    Stdlib.Format.printf !"%{sexp: t}" (of_no_binop no_binop);
     [%expect
       {|
       (Binary + (Binary * (Variable x) (Variable y))
        (Binary * (Variable z) (Variable w)))
     |}]
+  ;;
 end
 
 (* func - This type represents a function definition itself. *)
 type func = Function of proto * Expr.t [@@deriving sexp]
 
 let func_of_no_binop_func (Expr.No_binop.Function (proto, body)) =
   Function (proto, Expr.of_no_binop body)
+;;
 
 let set_func_name name (Function (proto, body)) =
   let new_proto =
     match proto with
     | Prototype ((_name : string), args) -> Prototype (name, args)
-    | BinOpPrototype ((_name : string), args, prec) ->
-        BinOpPrototype (name, args, prec)
+    | BinOpPrototype ((_name : string), args, prec) -> BinOpPrototype (name, args, prec)
   in
   Function (new_proto, body)
+;;
 
 (* this holds the precedence for each binary operator that is defined. It can
  * be mutated if new binops are defined *)