summary refs log tree commit diff
path: root/source/xi_lib/ir_utils.ml
diff options
context:
space:
mode:
Diffstat (limited to 'source/xi_lib/ir_utils.ml')
-rw-r--r--source/xi_lib/ir_utils.ml668
1 files changed, 668 insertions, 0 deletions
diff --git a/source/xi_lib/ir_utils.ml b/source/xi_lib/ir_utils.ml
new file mode 100644
index 0000000..48b59a1
--- /dev/null
+++ b/source/xi_lib/ir_utils.ml
@@ -0,0 +1,668 @@
+open Ir
+
+let remap_register_reg sb r = 
+  try
+    Hashtbl.find sb r
+  with Not_found ->
+    r
+
+let remap_register_expr sb = function
+  | E_Reg r -> E_Reg (remap_register_reg sb r)
+  | e -> e
+
+let remap_register_instr sb = function
+  | I_Add (r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Add (r0, r1, r2)
+
+  | I_Sub (r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Sub (r0, r1, r2)
+
+  | I_Div (r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Div (r0, r1, r2)
+
+  | I_Rem (r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Rem (r0, r1, r2)
+
+  | I_Mul(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Mul (r0, r1, r2)
+
+  | I_And(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_And(r0, r1, r2)
+
+  | I_Or(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Or(r0, r1, r2)
+
+  | I_Xor(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Xor(r0, r1, r2)
+
+  | I_LoadArray(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_LoadArray(r0, r1, r2)
+
+  | I_StoreArray(r0, r1, r2) ->
+    let r0 = remap_register_expr sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_StoreArray(r0, r1, r2)
+
+  | I_LoadMem(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_LoadMem(r0, r1, r2)
+
+  | I_StoreMem(r0, r1, r2) ->
+    let r0 = remap_register_expr sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_StoreMem(r0, r1, r2)
+
+  | I_Concat(r0, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Concat(r0, r1, r2)
+
+  | I_Neg(r0, r1) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    I_Neg(r0, r1)
+
+  | I_Not(r0, r1) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    I_Not(r0, r1)
+
+  | I_Move(r0, r1) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    I_Move(r0, r1)
+
+  | I_Length(r0, r1) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    I_Length(r0, r1)
+
+  | I_NewArray(r0, r1) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    I_NewArray(r0, r1)
+
+  | I_Set(r0, cond, r1, r2) ->
+    let r0 = remap_register_reg sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    let r2 = remap_register_expr sb r2 in
+    I_Set(r0, cond, r1, r2)
+
+  | I_LoadVar(r0, i) ->
+    let r0 = remap_register_reg sb r0 in
+    I_LoadVar(r0, i)
+
+  | I_StoreVar(i, r0) ->
+    let r0 = remap_register_expr sb r0 in
+    I_StoreVar(i, r0)
+
+  | I_LoadStack(r0, i) ->
+    let r0 = remap_register_reg sb r0 in
+    I_LoadStack(r0, i)
+
+  | I_StoreStack(i, r0) ->
+    let r0 = remap_register_expr sb r0 in
+    I_StoreStack(i, r0)
+
+  | I_StackAlloc i ->
+    I_StackAlloc i
+
+  | I_StackFree i ->
+    I_StackFree i
+
+  | I_Use rs ->
+    I_Use (List.map (remap_register_reg sb) rs)
+
+  | I_Def rs ->
+    I_Def (List.map (remap_register_reg sb) rs)
+
+  | I_Call (rs, procid, args, kills) ->
+    let rs = List.map (remap_register_reg sb) rs in
+    let args = List.map (remap_register_expr sb) args in
+    let kills = List.map (remap_register_reg sb) kills in
+    I_Call (rs, procid, args, kills)
+
+let subst_expr rmap = function
+  | (E_Reg r) as e ->
+    begin match RegMap.find_opt r rmap with
+    | None -> e
+    | Some e -> e
+    end
+  | e -> e
+
+let subst_expr_instr sb = function
+  | I_Add (r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Add (r0, r1, r2)
+
+  | I_Sub (r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Sub (r0, r1, r2)
+
+  | I_Div (r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Div (r0, r1, r2)
+
+  | I_Rem (r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Rem (r0, r1, r2)
+
+  | I_Mul(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Mul (r0, r1, r2)
+
+  | I_And(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_And(r0, r1, r2)
+
+  | I_Or(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Or(r0, r1, r2)
+
+  | I_Xor(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Xor(r0, r1, r2)
+
+  | I_LoadArray(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_LoadArray(r0, r1, r2)
+
+  | I_StoreArray(r0, r1, r2) ->
+    let r0 = subst_expr sb r0 in
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_StoreArray(r0, r1, r2)
+
+  | I_LoadMem(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_LoadMem(r0, r1, r2)
+
+  | I_StoreMem(r0, r1, r2) ->
+    let r0 = subst_expr sb r0 in
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_StoreMem(r0, r1, r2)
+
+  | I_Concat(r0, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Concat(r0, r1, r2)
+
+  | I_Neg(r0, r1) ->
+    let r1 = subst_expr sb r1 in
+    I_Neg(r0, r1)
+
+  | I_Not(r0, r1) ->
+    let r1 = subst_expr sb r1 in
+    I_Not(r0, r1)
+
+  | I_Move(r0, r1) ->
+    let r1 = subst_expr sb r1 in
+    I_Move(r0, r1)
+
+  | I_Length(r0, r1) ->
+    let r1 = subst_expr sb r1 in
+    I_Length(r0, r1)
+
+  | I_NewArray(r0, r1) ->
+    let r1 = subst_expr sb r1 in
+    I_NewArray(r0, r1)
+
+  | I_Set(r0, cond, r1, r2) ->
+    let r1 = subst_expr sb r1 in
+    let r2 = subst_expr sb r2 in
+    I_Set(r0, cond, r1, r2)
+
+  | I_LoadVar(r0, i) ->
+    I_LoadVar(r0, i)
+
+  | I_StoreVar(i, r0) ->
+    let r0 = subst_expr sb r0 in
+    I_StoreVar(i, r0)
+
+  | I_LoadStack(r0, i) ->
+    I_LoadStack(r0, i)
+
+  | I_StoreStack(i, r0) ->
+    let r0 = subst_expr sb r0 in
+    I_StoreStack(i, r0)
+
+  | I_StackAlloc i ->
+    I_StackAlloc i
+
+  | I_StackFree i ->
+    I_StackFree i
+
+  | I_Use rs ->
+    I_Use rs
+
+  | I_Def rs ->
+    I_Def rs
+
+  | I_Call (rs, procid, args, kills) ->
+    let args = List.map (subst_expr sb) args in
+    I_Call (rs, procid, args, kills)
+
+let remap_label_label sb l =
+  try
+    Hashtbl.find sb l
+  with Not_found ->
+    l
+
+let remap_label_terminator sb = function
+  | T_Jump l ->
+    T_Jump (remap_label_label sb l)
+
+  | T_Branch (cond, r0, r1, lt, lf) ->
+    T_Branch (cond, r0, r1, remap_label_label sb lt, remap_label_label sb lf)
+
+  | t ->
+    t
+
+let remap_register_terminator sb = function
+  | T_Return xs ->
+    let xs = List.map (remap_register_expr sb) xs in
+    T_Return xs
+
+  | T_Branch (cond, r0, r1, l1, l2) ->
+    let r0 = remap_register_expr sb r0 in
+    let r1 = remap_register_expr sb r1 in
+    T_Branch (cond, r0, r1, l1, l2)
+
+  | T_Jump l ->
+    T_Jump l
+
+let subst_expr_terminator sb = function
+  | T_Return xs ->
+    let xs = List.map (subst_expr sb) xs in
+    T_Return xs
+
+  | T_Branch (cond, r0, r1, l1, l2) ->
+    let r0 = subst_expr sb r0 in
+    let r1 = subst_expr sb r1 in
+    T_Branch (cond, r0, r1, l1, l2)
+
+  | T_Jump l ->
+    T_Jump l
+
+let defined_registers_instr = function
+  | I_Add (r0, _, _)
+  | I_Sub (r0, _, _)
+  | I_Div (r0, _, _)
+  | I_Mul (r0, _, _)
+  | I_And (r0, _, _)
+  | I_Or (r0, _, _)
+  | I_Xor (r0, _, _)
+  | I_LoadArray (r0, _, _)
+  | I_LoadMem (r0, _, _)
+  | I_Concat (r0, _, _)
+  | I_Not (r0, _)
+  | I_Move (r0, _)
+  | I_Length (r0, _)
+  | I_NewArray (r0, _)
+  | I_Neg (r0, _) 
+  | I_Set  (r0, _, _, _) 
+  | I_Rem (r0, _, _) 
+  | I_LoadStack (r0, _) 
+  | I_LoadVar (r0, _) ->
+    [r0]
+
+
+  | I_Call (outs, _, _, kills) ->
+    outs @ kills
+
+  | I_Use _
+  | I_StoreVar _ 
+  | I_StoreStack _
+  | I_StackAlloc _ 
+  | I_StackFree _
+  | I_StoreMem _ 
+  | I_StoreArray _ ->
+    []
+
+  | I_Def rs ->
+    rs
+
+let defined_registers_terminator _ = []
+
+let used_registers_instr = function
+  | I_Add (_, r0, r1)
+  | I_Sub (_, r0, r1)
+  | I_Div (_, r0, r1)
+  | I_Mul (_, r0, r1)
+  | I_And (_, r0, r1)
+  | I_Or (_, r0, r1)
+  | I_Xor (_, r0, r1)
+  | I_LoadArray (_, r0, r1)
+  | I_LoadMem (_, r0, r1)
+  | I_Concat (_, r0, r1)
+  | I_Set  (_, _, r0, r1)
+  | I_Rem (_, r0, r1) ->
+    List.flatten @@ List.map reglist_of_expr [r0;r1]
+
+  | I_Not (_, r0)
+  | I_Move (_, r0)
+  | I_Length (_, r0)
+  | I_NewArray (_, r0)
+  | I_StoreVar (_, r0) 
+  | I_StoreStack (_, r0) 
+  | I_Neg (_, r0)  ->
+    reglist_of_expr r0
+
+  | I_Call (_, _, args, _) ->
+    List.flatten @@ List.map reglist_of_expr args
+
+  | I_Def _ 
+  | I_StackAlloc _
+  | I_StackFree _
+  | I_LoadStack _
+  | I_LoadVar _ ->
+    []
+
+  | I_StoreArray (r0, r1, r2) 
+  | I_StoreMem (r0, r1, r2) ->
+    List.flatten @@ List.map reglist_of_expr [r0; r1; r2]
+
+  | I_Use rs ->
+    rs
+
+let used_registers_terminator = function
+  | T_Branch (_, r0, r1, _, _) ->
+    List.flatten @@ List.map reglist_of_expr [r0;r1]
+
+
+  | T_Return args ->
+    List.flatten @@ List.map reglist_of_expr args
+
+  | T_Jump _ ->
+    []
+
+let remap_registers_proc sb proc =
+  let cfg = (cfg_of_procedure proc) in 
+  let remap_block (l, body, terminator) =
+    let body = List.map (remap_register_instr sb) body in
+    let terminator = remap_register_terminator sb terminator in
+    (l, body, terminator)
+  in
+  let update_blocks (l, body, terminator) =
+    ControlFlowGraph.set_block2 cfg l body terminator
+  in
+
+  let blocks = ControlFlowGraph.blocklist2 cfg in
+  let blocks = List.map remap_block  blocks in
+  List.iter update_blocks blocks
+
+let string_of_expr = function
+  | E_Reg r -> string_of_reg r
+  | E_Int i -> Int32.to_string i
+
+let string_of_label = function
+  | Label i -> Format.sprintf "L%u" i
+
+let string_of_procid = function
+  | Procid l -> Format.sprintf "%s" l
+
+let string_of_reglist xs =
+  Format.sprintf "[%s]" (String.concat ", " @@ List.map string_of_reg xs)
+
+let string_of_labellist xs =
+  Format.sprintf "[%s]" (String.concat ", " @@ List.map string_of_label xs)
+
+let string_of_exprlist xs =
+  Format.sprintf "[%s]" (String.concat ", " @@ List.map string_of_expr xs)
+
+let string_of_expr_regmap k =
+  let f (k, v) = Format.sprintf "%s=%s" (string_of_reg k) (string_of_expr v) in 
+  String.concat "; " @@ List.of_seq @@ Seq.map f @@ RegMap.to_seq k
+let string_of_instr = function
+  | I_Add (r0, e0, e1) ->
+    Format.sprintf "add %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Sub (r0, e0, e1) ->
+    Format.sprintf "sub %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Div (r0, e0, e1) ->
+    Format.sprintf "div %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Rem (r0, e0, e1) ->
+    Format.sprintf "rem %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Mul (r0, e0, e1) ->
+    Format.sprintf "mul %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_And (r0, e0, e1) ->
+    Format.sprintf "and %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Or (r0, e0, e1) ->
+    Format.sprintf "or %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Xor (r0, e0, e1) ->
+    Format.sprintf "xor %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_LoadArray (r0, e0, e1) ->
+    Format.sprintf "loadarray %s, %s, %s // %s = %s[%s]"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_LoadMem (r0, e0, e1) ->
+    Format.sprintf "loadmem %s, %s, %s // %s = mem[%s + %s]"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_StoreArray (r0, e0, e1) ->
+    Format.sprintf "storearray %s, %s, %s // %s[%s] = %s"
+      (string_of_expr r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+      (string_of_expr r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_StoreMem (r0, e0, e1) ->
+    Format.sprintf "storemem %s, %s, %s // mem[%s + %s] = %s"
+      (string_of_expr r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+      (string_of_expr r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Concat (r0, e0, e1) ->
+    Format.sprintf "concat %s, %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+      (string_of_expr e1)
+  | I_Neg (r0, e0) ->
+    Format.sprintf "neg %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+  | I_Not (r0, e0) ->
+    Format.sprintf "not %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+  | I_Length (r0, e0) ->
+    Format.sprintf "length %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+  | I_Move (r0, e0) ->
+    Format.sprintf "move %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+  | I_NewArray (r0, e0) ->
+    Format.sprintf "newarray %s, %s"
+      (string_of_reg r0)
+      (string_of_expr e0)
+  | I_Call (rs, p, xs, kill) ->
+    Format.sprintf "call %s, %s, %s, kill %s"
+      (string_of_reglist rs)
+      (string_of_procid p)
+      (string_of_exprlist xs)
+      (string_of_reglist kill)
+  | I_Set (rr, cond, r0, r1) ->
+    Format.sprintf "set %s, %s, %s, %s"
+      (string_of_reg rr)
+      (string_of_cond cond)
+      (string_of_expr r0)
+      (string_of_expr r1)
+  | I_StoreVar (i0, e0) ->
+    Format.sprintf "storevar %s, %s"
+      (string_of_int i0)
+      (string_of_expr e0)
+  | I_LoadVar (r0, i0) ->
+    Format.sprintf "loadvar %s, %s"
+      (string_of_reg r0)
+      (string_of_int i0)
+  | I_StoreStack (i0, e0) ->
+    Format.sprintf "storestack %s, %s"
+      (string_of_int i0)
+      (string_of_expr e0)
+  | I_LoadStack (r0, i0) ->
+    Format.sprintf "loadstack %s, %s"
+      (string_of_reg r0)
+      (string_of_int i0)
+  | I_StackAlloc (i0) ->
+    Format.sprintf "stackalloc %s"
+      (Int32.to_string i0)
+  | I_StackFree (i0) ->
+    Format.sprintf "stackfree %s"
+      (Int32.to_string i0)
+  | I_Use rs ->
+    Format.sprintf "use %s" (string_of_reglist rs)
+  | I_Def rs ->
+    Format.sprintf "def %s" (string_of_reglist rs)
+
+let string_of_terminator = function
+  | T_Branch (cond, r0, r1, l1, l2) ->
+    Format.sprintf "branch %s, %s, %s, %s, %s"
+      (string_of_cond cond)
+      (string_of_expr r0)
+      (string_of_expr r1)
+      (string_of_label l1)
+      (string_of_label l2)
+  | T_Jump (l) ->
+    Format.sprintf "jump %s"
+      (string_of_label l)
+  | T_Return xs ->
+    Format.sprintf "return %s"
+      (string_of_exprlist xs)
+
+let indented_string_of_instr i = "    " ^ (string_of_instr i)
+let indented_string_of_terminator i = "    " ^ (string_of_terminator i)
+
+let string_of_block_body cfg label body =
+  String.concat "\n"
+    [ Format.sprintf "%s:" (string_of_label label) 
+    ; Format.sprintf "    cfg successors: %s"
+      (string_of_labellist @@ ControlFlowGraph.successors cfg label)
+    ; Format.sprintf "    cfg predecessors: %s"
+      (string_of_labellist @@ ControlFlowGraph.predecessors cfg label)
+    ; String.concat "\n" (List.map indented_string_of_instr body)
+    ]
+
+let string_of_block cfg k v =
+  let terminator = match ControlFlowGraph.terminator_safe cfg k with
+    | None -> "<<no terminator>>"
+    | Some t -> indented_string_of_terminator t
+  in
+  String.concat "\n"
+    [ string_of_block_body cfg k v 
+    ; terminator
+    ]
+
+let string_of_blockmap cfg =
+  let f xs (k, v) = string_of_block cfg k v :: xs in
+  let items = Seq.fold_left (fun xs x -> x::xs) [] (Hashtbl.to_seq @@ ControlFlowGraph.blockmap cfg) in
+  let items = List.sort compare items in
+  String.concat "\n" @@ List.rev @@ List.fold_left f  [] items
+
+let string_of_cfg cfg =
+  String.concat "\n"
+    [ Format.sprintf "    cfg entry point: %s" (string_of_label @@ ControlFlowGraph.entry_label cfg)
+
+    ; Format.sprintf "    cfg entry point successors: %s"
+      (string_of_labellist @@ ControlFlowGraph.successors cfg @@ ControlFlowGraph.entry_label cfg)
+
+    ; Format.sprintf "    cfg exit point: %s" (string_of_label @@ ControlFlowGraph.exit_label cfg)
+
+    ; Format.sprintf "    cfg exit point predecessors : %s"
+      (string_of_labellist @@ ControlFlowGraph.predecessors cfg @@ ControlFlowGraph.exit_label cfg)
+
+    ; string_of_blockmap cfg
+    ]
+
+let string_of_procedure (Procedure {procid; cfg; frame_size; formal_parameters; _}) =
+  String.concat "\n"
+    [ "////////////////////////////////////// "
+    ; Format.sprintf "procedure %s" (string_of_procid procid) 
+    ; Format.sprintf "    frame size: %u" frame_size
+    ; Format.sprintf "    formal parameters: %u" formal_parameters
+    ; string_of_cfg cfg
+    ]
+
+let string_of_module_definition xs =
+  String.concat "\n" @@ List.map string_of_procedure xs
+
+let string_of_program (Program {procedures; _}) =
+  String.concat "\n" @@ List.map string_of_procedure procedures
\ No newline at end of file