Commits

camlspotter committed 9fc2873

compilation fun begins

  • Participants
  • Parent commits b06d459

Comments (0)

Files changed (2)

 
   module L = Llvm
 
+  module Env = struct
+    type t = (string * L.llvalue) list
+  end
+
   let context = L.global_context ()
   let the_module = L.create_module context "my cool jit"
   let builder = L.builder context
-  let named_values : (string, L.llvalue) Hashtbl.t = Hashtbl.create 17
   let i32_type = L.i32_type context
 
-  let rec codegen_expr : Lang.t -> L.llvalue = fun t -> match t.desc with
-      | Int n -> L.const_int i32_type n
-      | _ -> assert false
+  let rec codegen_expr : Env.t -> Lang.t -> L.llvalue = fun env t -> match t.desc with
+    | Int n -> L.const_int i32_type n
+    | LIdent v -> 
+	begin
+	  try List.assoc v env
+	  with Not_found -> failwithf "Variable %s is not found" v
+	end
+    | App [{ desc = LIdent "add" }; e1; e2] ->
+        let lv1 = codegen_expr env e1 in
+	let lv2 = codegen_expr env e2 in
+	L.build_add lv1 lv2 "added" builder
+    | App [{ desc = LIdent "lt" }; e1; e2] ->
+        let lv1 = codegen_expr env e1 in
+	let lv2 = codegen_expr env e2 in
+	L.build_icmp L.Icmp.Slt lv1 lv2 "lted" builder
+    | App ({ desc = LIdent f } :: es) ->
+        (* Look up the name in the module table. *)
+	let lf =
+          match L.lookup_function f the_module with
+          | Some lf -> lf
+          | None -> failwithf "function %s is not found in the module" f
+	in
+	let params = L.params lf in
 
-  let codegen_proto (name, args) : L.llvalue =
+        (* If argument mismatch error. *)
+	let arity = Array.length params in
+	let num_es = List.length es in
+	if arity = num_es then () 
+	else failwithf "function %s has arity %d but applied with %d args" f arity num_es;
+	let les = Array.of_list (List.map (codegen_expr env) es) in
+	L.build_call lf les "called" builder
+    | _ -> 
+        Format.eprintf "Compile error: %a@." Lang.format t;
+        assert false
+
+  let codegen_proto env (name, args) : L.llvalue * Env.t =
     (* Make the function type: double(double,double) etc. *)
     let ints = Array.make (Array.length args) i32_type in
     let f_type = L.function_type i32_type ints in (* int -> ... -> int *)
-    let f =
-      match L.lookup_function name the_module with
+    let f = match L.lookup_function name the_module with
       | None -> L.declare_function name f_type the_module
 	
       (* If 'f' conflicted, there was already something named 'name'. If it
     in
   
     (* Set names for all arguments. *)
+    let env = ref env in
     Array.iteri (fun i a ->
       let n = args.(i) in
       L.set_value_name n a;
-      Hashtbl.add named_values n a;
+      env := (n, a) :: !env
     ) (L.params f);
-    f
+    f, !env
 
-  let codegen_func (proto, body) : L.llvalue =
-    Hashtbl.clear named_values;
-    let the_function = codegen_proto proto in
+  let codegen_func env (proto, body) : L.llvalue =
+    let the_function, env = codegen_proto env proto in
         
     (* Create a new basic block to start insertion into. *)
     let bb = L.append_block context "entry" the_function in
     L.position_at_end bb builder;
         
     try
-      let ret_val = codegen_expr body in
+      let ret_val = codegen_expr env body in
         
       (* Finish off the function. *)
       let _ = L.build_ret ret_val builder in
       L.delete_function the_function;
       raise e
 
+  let codegen_top_lang env lang = match lang.desc with
+    | (Int _ | Char _ | String _ | LIdent _ | Unit | App _ ) ->
+	(* Evaluate a top-level expression into an anonymous function. *)
+        L.dump_value (codegen_func env (("" (* "" means anonymous *), [||]), lang));
+        env
+    | Define (v, { desc = Lambda (args, lang) }) -> 
+        L.dump_value (codegen_func env ((v, Array.of_list args), lang));
+        env
+    | Define (v, lang) -> 
+        let lv = codegen_expr env lang in
+	(v, lv) :: env
+    | _ -> assert false
+
   let iter (str_lang : Parser.StrLang.t) = 
+    let env = ref [] in
     Parser.StrLang.iter (fun lang -> 
-      (* Evaluate a top-level expression into an anonymous function. *)
-      let e = ("" (* "" means anonymous *), [||]), lang in
-      L.dump_value (codegen_func e);
-    ) str_lang;
-    (* Print out all the generated code. *)
-    L.dump_module the_module
+      env := codegen_top_lang !env lang;
+    ) str_lang
 
   module Test = struct
     let test () = 
-      let str = Lexer.stream (Sbuffer.from_string "42 24") in
+      let str = Lexer.stream (Sbuffer.from_string 
+"
+42 
+(define x 30) 
+(add 12 x)
+(define double (lambda (x) (add x x)))
+(define triple (lambda (x) (add x (add x x))))
+(double 5)
+") in
       let stream = Parser.stream_lang str in
-      iter stream
+      iter stream;
+      (* Print out all the generated code. *)
+      L.dump_module the_module
   end
 end
         (list sep f) xs
 end
 
-
+let failwithf fmt = Printf.kprintf failwith fmt