Add more stops in interpreter (stopping just at the point of each internal function call)

Also turning off an annoying printf I left in.

2 files changed, 17 insertions, 7 deletions

diff --git a/src/lem_interp/interp.lem b/src/lem_interp/interp.lem
index 0490fca4..888d17a7 100644
--- a/src/lem_interp/interp.lem
+++ b/src/lem_interp/interp.lem
@@ -1045,10 +1045,14 @@ and interp_main mode t_level l_env l_mem (E_aux exp (l,annot)) =
 	    | Nothing -> 
               (Error l (String.stringAppend "No matching pattern for function " name ),l_mem,l_env)
 	    | Just(env,exp) -> 
-              resolve_outcome (interp_main mode t_level env emem exp)
+	      resolve_outcome (if mode.eager_eval 
+		               then (interp_main mode t_level env emem exp)
+		               else (debug_out exp t_level emem env))  
 	                      (fun ret lm le -> (Value ret Tag_empty, l_mem,l_env))
                               (fun a -> update_stack a 
-				(fun stack -> (Hole_frame (id_of_string "0") (E_aux (E_id (Id_aux (Id "0") l)) (l,annot)) t_level l_env l_mem stack)))
+				(fun stack -> (Hole_frame (id_of_string "0") 
+						          (E_aux (E_id (Id_aux (Id "0") l)) (l,annot))
+							  t_level l_env l_mem stack)))
              end)
           | Nothing -> (Error l (String.stringAppend "Internal error: function with empty tag unfound " name),lm,le) end)
 	| Tag_spec ->  
@@ -1058,7 +1062,9 @@ and interp_main mode t_level l_env l_mem (E_aux exp (l,annot)) =
 	    | Nothing -> 
               (Error l (String.stringAppend "No matching pattern for function " name ),l_mem,l_env)
 	    | Just(env,exp) -> 
-              resolve_outcome (interp_main mode t_level env emem exp)
+              resolve_outcome (if mode.eager_eval 
+		               then (interp_main mode t_level env emem exp)
+                               else (debug_out exp t_level emem env))
 	                      (fun ret lm le -> (Value ret Tag_empty, l_mem,l_env))
                               (fun a -> update_stack a 
 				(fun stack -> (Hole_frame (id_of_string "0") (E_aux (E_id (Id_aux (Id "0") l)) (l,annot)) t_level l_env l_mem stack)))
@@ -1098,7 +1104,9 @@ and interp_main mode t_level l_env l_mem (E_aux exp (l,annot)) =
 				               (match find_funcl funcls (V_tuple [lv;rv]) with 
 				               | Nothing -> (Error l (String.stringAppend "No matching pattern for function " name),lm,l_env)
 				               | Just(env,exp) ->
-				                 resolve_outcome (interp_main mode t_level env emem exp)
+				                 resolve_outcome (if mode.eager_eval
+						                  then (interp_main mode t_level env emem exp)
+						                  else (debug_out exp t_level emem env)) 
 				                   (fun ret lm le -> (Value ret Tag_empty,l_mem,l_env))
                                                    (fun a -> update_stack a 
 						     (fun stack -> (Hole_frame (Id_aux (Id "0") l)
@@ -1111,7 +1119,9 @@ and interp_main mode t_level l_env l_mem (E_aux exp (l,annot)) =
 				               (match find_funcl funcls (V_tuple [lv;rv]) with 
 				               | Nothing -> (Error l (String.stringAppend "No matching pattern for function " name),lm,l_env)
 				               | Just(env,exp) ->
-				                 resolve_outcome (interp_main mode t_level env emem exp)
+				                 resolve_outcome (if mode.eager_eval 
+						   then (interp_main mode t_level env emem exp)
+						   else (debug_out exp t_level emem env))
 				                   (fun ret lm le -> (Value ret Tag_empty,l_mem,l_env))
                                                    (fun a -> update_stack a 
 						     (fun stack -> (Hole_frame (Id_aux (Id "0") l)
diff --git a/src/type_internal.ml b/src/type_internal.ml
index 8423ecf5..00522798 100644
--- a/src/type_internal.ml
+++ b/src/type_internal.ml
@@ -1394,7 +1394,7 @@ let rec type_coerce_internal co d_env is_explicit t1 cs1 e t2 cs2 =
 and type_coerce co d_env is_explicit t1 e t2 = type_coerce_internal co d_env is_explicit t1 [] e t2 [];;
 
 let rec conforms_to_t spec actual =
-  let _ = Printf.printf "conforms_to_t called with %s, %s\n" (t_to_string spec) (t_to_string actual) in
+  (*let _ = Printf.printf "conforms_to_t called with %s, %s\n" (t_to_string spec) (t_to_string actual) in*)
   match spec.t,actual.t with
     | Tuvar _,_ -> true
     | Ttup ss, Ttup acs -> (List.length ss = List.length acs) && List.for_all2 conforms_to_t ss acs
@@ -1418,7 +1418,7 @@ and conforms_to_ta spec actual =
     | TA_eft  s, TA_eft  a -> conforms_to_e s a
     | _ -> false
 and conforms_to_n spec actual =
-  let _ = Printf.printf "conforms_to_n called with %s, %s\n" (n_to_string spec) (n_to_string actual) in
+(*  let _ = Printf.printf "conforms_to_n called with %s, %s\n" (n_to_string spec) (n_to_string actual) in*)
   match spec.nexp,actual.nexp with
     | Nuvar _,_ -> true
     | Nconst si,Nconst ai -> eq_big_int si ai