init: simplifier

ast.ml

@@ -70,16 +70,29 @@ module Syntax = struct
   type prog = def list
 end
 
-module IR = struct
-  type ident = string
+module type Parameters = sig
+  type value
+end
 
+module V1 = struct
   type value =
     | Void
     | Int of int
     | Bool of bool
+end
+
+module V2 = struct
+  type value =
+    | Void
+    | Int of int
+    | Bool of bool
+end
+
+module IR (P : Parameters) = struct
+  type ident = string
 
   type expr =
-    | Val of value
+    | Val of P.value
     | Var of ident
     | Call of ident * expr list
 
@@ -93,3 +106,6 @@ module IR = struct
   type def = Func of ident * ident list * block
   type prog = def list
 end
+
+module IR1 = IR (V1)
+module IR2 = IR (V2)

compiler.ml

@@ -1,6 +1,7 @@
-open Ast.IR
+open Ast.IR2
+open Ast.V2
 open Mips
-module Env = Map.Make (String)
+open Baselib
 
 type info =
   { asm : instr list
@@ -86,7 +87,7 @@ let rec compile_prog counter = function
     cd @ compile_prog new_counter r
 ;;
 
-let compile ir =
+let compile (ir, data) =
   let asm = compile_prog 0 ir in
-  { text = asm; data = [] }
+  { text = asm; data }
 ;;

main.ml

@@ -1,4 +1,5 @@
 open Errors
+open Simplifier
 
 let () =
   if Array.length Sys.argv != 2
@@ -13,7 +14,7 @@ let () =
     (* Test.debug_parser Stdlib.stderr parsed; *)
     let ast = Semantics.analyze parsed in
     (* Test.debug_semantics Stdlib.stderr ast; *)
-    let asm = Compiler.compile ast in
+    let asm = Compiler.compile (simplify ast) in
     Mips.emit Stdlib.stdout asm
   with
   | LexerError c ->

semantics.ml

@@ -1,5 +1,6 @@
 open Ast
-open Ast.IR
+open Ast.IR1
+open Ast.V1
 open Baselib
 open Errors
 

simplifier.ml

@@ -0,0 +1,44 @@
+open Ast
+
+let collect_constant_strings code =
+  let ccs_value = function
+    | V1.Void -> V2.Void, []
+    | V1.Bool b -> V2.Bool b, []
+    | V1.Int n -> V2.Int n, []
+  in
+  let rec ccs_expr = function
+    | IR1.Val v ->
+      let v2, cs = ccs_value v in
+      IR2.Val v2, cs
+    | IR1.Var v -> IR2.Var v, []
+    | IR1.Call (fn, args) ->
+      let a2 = List.map ccs_expr args in
+      IR2.Call (fn, List.map fst a2), List.flatten (List.map snd a2)
+  in
+  let ccs_instr = function
+    | IR1.Decl v -> IR2.Decl v, []
+    | IR1.Assign (lv, e) ->
+      let e2, cs = ccs_expr e in
+      IR2.Assign (lv, e2), cs
+    | IR1.Do e ->
+      let e2, cs = ccs_expr e in
+      IR2.Do e2, cs
+    | IR1.Return e ->
+      let e2, cs = ccs_expr e in
+      IR2.Do e2, cs
+  in
+  let rec ccs_block acc_b acc_cs = function
+    | i :: b ->
+      let i2, cs = ccs_instr i in
+      ccs_block (i2 :: acc_b) (cs @ acc_cs) b
+    | [] -> List.rev acc_b, acc_cs
+  in
+  let ccs_def (IR1.Func (name, args, body)) =
+    let body2, cs = ccs_block [] [] body in
+    IR2.Func (name, args, body2), cs
+  in
+  let code2 = List.map ccs_def code in
+  List.map fst code2, List.flatten (List.map snd code2)
+;;
+
+let simplify ir = collect_constant_strings ir