A debug utility to print or extract intermediate data from a program

Question

Is there a way to print variables using their names, or to extract the corresponding information for later analysis ?

Answer 1

This version of ShowIt first shown by Leonid Shifrin is particularly useful, it can be used in conjunction with the function ReapTags[] defined below also.

It now uses the LetL[] function also from Leonid defined here (in order to avoid a nested With for printedExpr).

I've incorporated the answer of Szabolcs to the question Is it possible to Print expressions in reverse order?, the answer of Mr. Wizard to the question Delete contexts from a string representation of a symbol and the answer of rm -rf to How to Print to the Console.

• The Print output using $ShowIt = True allows to use it in the front end if you change its style to Input.
• $ReverseIt = True allows to Print the result of Print in a reverse order as asked in this question.
• The Message if you switch it on using On[Debug::ShowIt] prints a Mathematica message and would stop the code if you used a message breakpoint in Mathematica or Wolfram Workbench.

• $SowIt = True allows to store what would be printed with Print in a symbol.

  To see the list of keys defined in the debugSymbol containing the results extracted from a program you can use the function Keys.

• $ConsoleIt = True allows to output what would be output with Print but in the Messages console accessible in the menu Window > Messages.

• $GroupIt prints expressions in groups of two cells, for example x as title, and x=2; as expression.
• The System`* context of ShowIt and ShowItList allows to use them in the Private`* context of other packages without having to define the package in which these functions are defined (in BeginPackage[], see here for more info on the organisation of packages).
• ShowIt[] is not shown inside another ShowIt.
• You can define a tag when calling ShowIt, and restrict which tags let ShowIt output things using $ShowItTagPattern.
• You can use Debug`ShowIt in parallel kernels (as System`ShowIt is recognised as a Global` symbol in a parallel kernel).

All in all ShowIt and the functions around it show a lot of different aspects of advanced evaluation in Mathematica that could be interesting to a lot of people.

(*Auxiliary functions*)
SetAttributes[ExtractSymbolName, HoldAll];
ExtractSymbolName[expr_] :=
Module[{T,SR = StringReplace[#, a__ ~~ "$" ~~ DigitCharacter .. :> a] &}, 
    Defer[expr] 
        //. HoldPattern[System`ShowIt@x_] :> x
        /. s_Symbol :> T@MakeExpression@SR@SymbolName@Unevaluated@s 
        /. T@_@x___ :> x
];

insertBelowEvaluationCell[expr_]:=
(
    SelectionMove[EvaluationNotebook[],After,EvaluationCell];
    NotebookWrite[EvaluationNotebook[],Cell[BoxData@ToBoxes[expr],"Print"]]
);

$OldLine=-1;
SetAttributes[PrintToConsole,HoldFirst];
PrintToConsole[Defer[expr_],reversePrint_:False]:=PrintToConsole[expr,reversePrint];
PrintToConsole[expr_,reversePrint_:False]:=
 (
  If[$OldLine!=$Line,
        SelectionMove[MessagesNotebook[],After,Notebook];

        NotebookWrite[MessagesNotebook[],
            Cell[
                BoxData@ToBoxes@"","Print",
                CellLabel->"During evaluation of In["<>ToString[$Line-1]<>"]:=",
                ShowCellLabel->True
            ]
        ];
    ];

    If[$OldLine==$Line,
        If[reversePrint,
            SelectionMove[MessagesNotebook[],Previous,Cell];
            SelectionMove[MessagesNotebook[],Before,Cell];
            ,
            SelectionMove[MessagesNotebook[], After, Cell];
        ]
    ];

    NotebookWrite[MessagesNotebook[],
        Cell[
            BoxData@ToBoxes@Defer@expr,"Print"
        ]
    ];

    $OldLine=$Line;
);

SetAttributes[PrintGroupedCells, HoldAll]
 PrintGroupedCells[label_, expr_] :=
Module[{tag = ToString@Unique[]},
    CellPrint[
        CellGroup[
            {
                ExpressionCell[label, "Item", CellTags -> tag]
                ,
                ExpressionCell[expr, "Input", CellTags -> tag]
            }
        ]
    ];

    NotebookFind[EvaluationNotebook[], tag, All, CellTags];
    FrontEndExecute[FrontEndToken["CellGroup"]];
    FrontEndExecute[FrontEndToken["OpenCloseGroup"]];
    SelectionMove[EvaluationNotebook[], After, Cell];
];  

(*Main function*)  
System`$ShowIt = True;  

System`$SowIt = False;  
System`$ConsoleIt = False;
System`$ReverseIt = False;  
System`$GroupIt = False;  
Off[System`Debug::ShowIt];  
System`$ShowItTagPattern = None;

System`Debug::ShowIt = "`1`";
SetAttributes[System`ShowIt, HoldAll];
System`ShowIt[expr_,tag_:None]:=
LetL[{evaluatedExpr = expr,exprWithSymbolNamesCorrected = ExtractSymbolName@expr,printedExpr = Replace[Defer[CompoundExpression[exprWithSymbolNamesCorrected = evaluatedExpr,Null]],Defer[x_]:>x,{3}]},
    If[MatchQ[tag,System`$ShowItTagPattern],
       Message[Debug::ShowIt,printedExpr];

       If[TrueQ@System`$ShowIt,
       If[TrueQ@System`$ReverseIt,
               insertBelowEvaluationCell[printedExpr];
               ,
                 If[TrueQ@System`$GroupIt,
                   PrintGroupedCells[exprWithSymbolNamesCorrected,printedExpr]
                   ,
                   Print[printedExpr];
               ];
           ];
       ];

       If[TrueQ@System`$ConsoleIt,
      PrintToConsole[printedExpr,TrueQ@System`$ReverseIt];
       ];

       If[TrueQ@System`$SowIt,
           Sow[
               evaluatedExpr
               ,
               Function[deferedExpr, ToString@Unevaluated@deferedExpr, HoldFirst] @@ exprWithSymbolNamesCorrected
           ];
       ];
    ];

    evaluatedExpr
]; 

SetSharedFunction[System`ShowItList];
SetAttributes[System`ShowItList, {HoldAll,Listable}];
System`ShowItList[expr_,tag_:None] := System`ShowIt[expr];

SetAttributes[ReapTags,HoldFirst];
ReapTags[expr_]:=
   Module[{elements},
      Reap[Check[expr,"failed"],_,(elements[#1]=If[Length@#2==1,First@#2,#2])&];
      elements
   ];

SetSharedFunction[Debug`ShowIt];
SetAttributes[Debug`ShowIt,HoldFirst];
Debug`ShowIt[x_]:=ShowIt[x];

SetSharedFunction[Debug`ShowItList];
SetAttributes[Debug`ShowItList,HoldFirst];
Debug`ShowItList[x_]:=ShowItList[x];

Example

(*Uncomment the line below to test a tag*)
(*$ShowItTagPattern = "tag";*)
$ShowIt=True; $SowIt = True; $ReverseIt=False; $ConsoleIt = True; On[Debug::ShowIt];
debugResult = ReapTags[x={1,2};y=3;z=4;ShowIt@Mean@x;ShowIt[z,"tag"];ShowItList@{x,y};];
debugResult["Mean[x]"]
debugResult["x"]
debugResult["y"]
debugResult["z"]

The argument of ReapTags can be any expression including the call to a function which is hard to split into simple pieces thus using Reap[] and Sow[] as underlying functions is useful in such a case.