cleaning up toplevel

Author: adamrk

bin/kaleidoscope.ml

@@ -5,7 +5,7 @@ let () =
   Command.basic ~summary:"Parse and print kaleidoscope"
     [%map_open
       let file = flag "file" (optional file) ~doc:"FILE read input from file" in
-      fun () -> Kaleidoscope_lib.Toplevel.run_main (match file with
+      fun () -> Kaleidoscope_lib.Toplevel.main (match file with
     | None -> `Stdin
     | Some file -> `File file)]
   |> Command.run

lib/toplevel.ml

@@ -1,32 +1,13 @@
 open Core
 
-let setup_execution_engine () =
-  ( match Llvm_executionengine.initialize () with
-  | true -> ()
-  | false -> raise_s [%message "failed to initialize"] ) ;
-  Llvm_executionengine.create Codegen.the_module
-
-let setup_pass_manager () =
-  let the_fpm = Llvm.PassManager.create_function Codegen.the_module in
-  (* Promote allocas to registers. *)
-  Llvm_scalar_opts.add_memory_to_register_promotion the_fpm ;
-  (* Do simple "peephole" optimizations and bit-twiddling optzn. *)
-  Llvm_scalar_opts.add_instruction_combination the_fpm ;
-  (* reassociate expressions. *)
-  Llvm_scalar_opts.add_reassociation the_fpm ;
-  (* Eliminate Common SubExpressions. *)
-  Llvm_scalar_opts.add_gvn the_fpm ;
-  (* Simplify the control flow graph (deleting unreachable blocks, etc). *)
-  Llvm_scalar_opts.add_cfg_simplification the_fpm ;
-  Llvm.PassManager.initialize the_fpm |> ignore ;
-  the_fpm
-
-let new_incremental () = Parser.Incremental.toplevel Lexing.dummy_pos
-
-let run_main input =
+let run_main in_channel ~the_fpm ~the_execution_engine =
   let anonymous_func_count = ref 0 in
+  let supplier =
+    Parser.MenhirInterpreter.lexer_lexbuf_to_supplier Lexer.read
+      (Lexing.from_channel in_channel)
+  in
   let rec run_loop the_fpm the_execution_engine supplier =
-    let incremental = new_incremental () in
+    let incremental = Parser.Incremental.toplevel Lexing.dummy_pos in
     printf "\nready> " ;
     Out_channel.flush stdout ;
     ( try
@@ -39,7 +20,7 @@ let run_main input =
             Llvm_executionengine.add_module Codegen.the_module
               the_execution_engine ;
             anonymous_func_count := !anonymous_func_count + 1 ;
-            let tmp_name = sprintf "__anon_func_%d" !anonymous_func_count in
+            let tmp_name = sprintf "__toplevel%d" !anonymous_func_count in
             let tmp_func = Ast.set_func_name tmp_name func in
             let the_function = Codegen.codegen_func the_fpm tmp_func in
             Llvm.dump_value the_function ;
@@ -77,23 +58,36 @@ let run_main input =
     Out_channel.flush Out_channel.stdout ;
     run_loop the_fpm the_execution_engine supplier
   in
+  run_loop the_fpm the_execution_engine supplier
+
+let main input =
   (* Install standard binary operators.
    * 1 is the lowest precedence. *)
+  Hashtbl.add_exn Ast.binop_precedence ~key:'=' ~data:2 ;
   Hashtbl.add_exn Ast.binop_precedence ~key:'<' ~data:10 ;
   Hashtbl.add_exn Ast.binop_precedence ~key:'+' ~data:20 ;
   Hashtbl.add_exn Ast.binop_precedence ~key:'-' ~data:20 ;
   Hashtbl.add_exn Ast.binop_precedence ~key:'*' ~data:40 ;
-  Hashtbl.add_exn Ast.binop_precedence ~key:'=' ~data:2 ;
-  let f in_channel =
-    let supplier =
-      Parser.MenhirInterpreter.lexer_lexbuf_to_supplier Lexer.read
-        (Lexing.from_channel in_channel)
-    in
-    (* Create the JIT. *)
-    let the_execution_engine = setup_execution_engine () in
-    let the_fpm = setup_pass_manager () in
-    run_loop the_fpm the_execution_engine supplier
+  (* Create the JIT *)
+  let the_execution_engine =
+    ( match Llvm_executionengine.initialize () with
+    | true -> ()
+    | false -> raise_s [%message "failed to initialize"] ) ;
+    Llvm_executionengine.create Codegen.the_module
   in
+  let the_fpm = Llvm.PassManager.create_function Codegen.the_module in
+  (* Promote allocas to registers. *)
+  Llvm_scalar_opts.add_memory_to_register_promotion the_fpm ;
+  (* Do simple "peephole" optimizations and bit-twiddling optzn. *)
+  Llvm_scalar_opts.add_instruction_combination the_fpm ;
+  (* reassociate expressions. *)
+  Llvm_scalar_opts.add_reassociation the_fpm ;
+  (* Eliminate Common SubExpressions. *)
+  Llvm_scalar_opts.add_gvn the_fpm ;
+  (* Simplify the control flow graph (deleting unreachable blocks, etc). *)
+  Llvm_scalar_opts.add_cfg_simplification the_fpm ;
+  Llvm.PassManager.initialize the_fpm |> ignore ;
   match input with
-  | `Stdin -> f In_channel.stdin
-  | `File file -> In_channel.with_file file ~f
+  | `Stdin -> run_main ~the_execution_engine ~the_fpm In_channel.stdin
+  | `File file ->
+      In_channel.with_file file ~f:(run_main ~the_execution_engine ~the_fpm)

lib/toplevel.mli

@@ -1,3 +1,3 @@
 open! Core
 
-val run_main : [`Stdin | `File of string] -> unit
+val main : [`Stdin | `File of string] -> unit