Add printing of whole call stack

2 files changed, 22 insertions, 3 deletions

diff --git a/src/lem_interp/printing_functions.ml b/src/lem_interp/printing_functions.ml
index d54b7155..6fd91793 100644
--- a/src/lem_interp/printing_functions.ml
+++ b/src/lem_interp/printing_functions.ml
@@ -151,8 +151,6 @@ let bit_lifteds_to_string (bls: bit_lifted list) (show_length_and_start:bool) (s
               "0x"^s
   else
     simple_bit_lifteds_to_string bls show_length_and_start starto
-
-
   
 
 let register_value_to_string rv = 
@@ -439,6 +437,22 @@ let instruction_state_to_string (IState(stack, _)) =
 let top_instruction_state_to_string (IState(stack,_)) = 
   let (exp,(env,_)) = top_frame_exp_state stack in exp_to_string env exp
 
+let instruction_stack_to_string (IState(stack,_)) =
+  let rec stack_to_string = function
+      Interp.Top -> ""
+    | Interp.Hole_frame(_,e,_,env,mem,Interp.Top)
+    | Interp.Thunk_frame(e,_,env,mem,Interp.Top) ->
+      exp_to_string env e
+    | Interp.Hole_frame(_,e,_,env,mem,s) 
+    | Interp.Thunk_frame(e,_,env,mem,s) ->
+      (exp_to_string env e) ^ "\n----------------------------------------------------------\n" ^
+      (stack_to_string s)
+  in
+  match stack with
+  | Interp.Hole_frame(_,(E_aux (E_id (Id_aux (Id "0",_)), _)),_,_,_,s) ->
+    stack_to_string s
+  | _ -> stack_to_string stack
+    
 let rec option_map f xs = 
   match xs with 
   | [] -> [] 
@@ -478,6 +492,9 @@ let instruction_to_string (name, parms, base_effects) =
 
 let print_backtrace_compact printer (IState(stack,_)) =
   List.iter (fun (e,(env,mem)) -> print_exp printer env e) (compact_stack stack)
+
+let print_stack printer is = printer (instruction_stack_to_string is)
+
 let print_continuation printer (IState(stack,_)) = 
   let (e,(env,mem)) = top_frame_exp_state stack in print_exp printer env e
 let print_instruction printer instr = printer (instruction_to_string instr)
diff --git a/src/lem_interp/printing_functions.mli b/src/lem_interp/printing_functions.mli
index 2ce2c016..dbd48b36 100644
--- a/src/lem_interp/printing_functions.mli
+++ b/src/lem_interp/printing_functions.mli
@@ -45,6 +45,8 @@ val top_frame_exp_state : interpreter_state -> (tannot exp * (Interp.lenv*Interp
 val format_events : event list -> string
 (*format a portion of the instruction state for easy viewing *)
 val instruction_state_to_string : instruction_state -> string
+(*format a the cull instruction call stack*)
+val instruction_stack_to_string : instruction_state -> string
 (*format just the top of the call stack*)
 val top_instruction_state_to_string : instruction_state -> string
 val local_variables_to_string : instruction_state -> string
@@ -57,7 +59,7 @@ val print_exp : (string-> unit) -> Interp.lenv -> tannot exp -> unit
 val print_backtrace_compact : (string -> unit) -> instruction_state -> unit
 val print_continuation : (string -> unit) -> instruction_state -> unit
 val print_instruction : (string -> unit) -> instruction -> unit
-
+val print_stack : (string -> unit) -> instruction_state -> unit
 
 val register_value_to_string : register_value -> string
 val memory_value_to_string : end_flag -> memory_value -> string