Fix scope error in CPS application

src/CPS.ml

@@ -51,9 +51,13 @@ let rec cps_term_inner (t: S.term) (cont: T.variable) (nameHint: string option)
         and fCont = freshBlockVar () in
         let xVal = freshVarHinted nameHint
         and fVal = freshVar () in
-        letCont fCont fVal (T.TailCall(T.vvar fVal, T.vvars [xVal; cont])) @@
-            letCont xCont xVal (cps_term_inner f fCont None) @@
+
+        letCont xCont xVal (
+            letCont fCont fVal
+                (T.TailCall(T.vvar fVal, T.vvars [xVal; cont])) @@
+            (cps_term_inner f fCont None)) @@
             cps_term_inner x xCont None
+
 | S.Print term ->
         let curCont = freshBlockVar ()
         and termVal = freshVar () in

src/Main.ml

@@ -5,6 +5,9 @@
 let debug =
   ref false
 
+let light_debug =
+    ref false
+
 let filenames =
   ref []
 
@@ -14,6 +17,7 @@ let record filename =
 let options =
   Arg.align [
     "--debug", Arg.Set debug, " Enable debugging output";
+    "--light-debug", Arg.Set light_debug, " Enable debugging output";
   ]
 
 let usage =
@@ -24,6 +28,8 @@ let () =
 
 let debug =
   !debug
+let light_debug =
+  !light_debug
 
 let filenames =
   List.rev !filenames
@@ -36,8 +42,8 @@ let print_delimiter () =
   Printf.eprintf "----------------------------------------";
   Printf.eprintf "----------------------------------------\n"
 
-let dump (phase : string) (show : 'term -> string) (t : 'term) =
-  if debug then begin
+let dump (phase : string) (show : 'term -> string) (light: bool) (t : 'term) =
+  if debug || (light_debug && light) then begin
     print_delimiter();
     Printf.eprintf "%s:\n\n%s\n\n%!" phase (show t)
   end;
@@ -82,17 +88,17 @@ let output (p : C.program) : unit =
 let process filename =
   filename
   |> read
-  |> dump "RawLambda" RawLambda.show_term
+  |> dump "RawLambda" RawLambda.show_term false
   |> Cook.cook_term
-  |> dump "Lambda" Lambda.show_term
+  |> dump "Lambda" Lambda.show_term false
   |> CPS.cps_term
-  |> dump "Tail" Tail.show_term
-  |> dump "PrettyTail" PrettyTail.show
+  |> dump "Tail" Tail.show_term false
+  |> dump "PrettyTail" PrettyTail.show true
   |> Defun.defun_term
-  |> dump "Top" Top.show_program
-  |> dump "PrettyTop" PrettyTop.show
+  |> dump "Top" Top.show_program false
+  |> dump "PrettyTop" PrettyTop.show true
   |> Finish.finish_program
-  |> dump "C" C.show_program
+  |> dump "C" C.show_program false
   |> output
 
 (* -------------------------------------------------------------------------- *)

src/prettify/PrettyTail.ml

@@ -23,4 +23,4 @@ and fmt_term fmt (t: S.term) = match t with
             fmt_var var fmt_block block fmt_term next
 
 let show term =
-    Format.asprintf "%a" fmt_term term
+    Format.asprintf "@[<v 0>%a@]" fmt_term term