Safer Code

Stephan Leibbrandt

Symbols and Numbers GbR

Motivation

Engineers need robust and reliable building blocks to create simulations. This is difficult in Mathematica, because variables in Mathematica are not bound to a type.

var=3
var=Function[x,(x^2)]

Mathematica has no type checking and sometimes logical errors are detected quite late. In the first example, Mathematica pulls the emergency brake. The exact source of the problem is not directly obvious from the output. Expected results are an integer and a list of two, not four real numbers.

values=Range[10];
fac[n_Integer]:=n*fac[n-1];
fac[0.]=1;
CALCULATION:=values[[fac[3]]]+fac[3]
CALCULATION

trig[v1_]:=Flatten[Table[Block[{s,c},
s=Sin[v1[[i]]];c=Cos[v1];
(s^2)+(c^2)
],{i,Length[v1]}]]
CALCULATION2:=trig[{20.Degree,10.Degree}]
CALCULATION2

Introducing a print statement in the functions would help to track down the problems, but a more general approach is better. Many programming languages restrict variables and functions to data types that must be specified, for example C:

int fac (int no) {
	if(no==0) return 1; else return no*fac(no-1);
}

This function represents a black box module:

Graphics[{
{Arrow[{{-1,2},{-0.2,2}}]},
{EdgeForm[Thick],LightGray,Rectangle[{0,0},{6,4}]},
{Text[Style["Precondition","Subsection"],{0.2,3},{-1,0}],Text[Style["no is an integer","Text"],{5.8,3},{1,0}]},
{Text[Style["«Body»","Subsection"],{3,2},{0,0}]},
{Text[Style["Postcondition","Subsection"],{0.2,1},{-1,0}],Text[Style["return value is an integer","Text"],{5.8,1},{1,0}]},
{Text[Style["Black Box","Section"],{3,4},{0,-1}]},
{Arrow[{{6.2,2},{7,2}}]}
},Frame->False,ImageSize->600,AspectRatio->1/4]

The main purpose of the conditions are:

({{Precondition, asserts that unkown code can be called}})

({{Postcondition, proper result allows usage in own code}})

Since all Mathematica expressions share the same structure, all possible black boxes follow the structure head[arguments], for example (the first two will be shown here):

({{Set, a = {1.6, 8.0, -3.2}, {c, d} := {5, 7}, a[[2]] = -6.1, Set[a, List[1.6, 8.0, -3.2]]}})

({{Thread, {2,3} + {4,5}, Thread[{_Real, _Integer} -> {"R", "I"}], Plus[List[2,3], List[4,5]]}})

({{Scope, Block[[$RecursionLimit = 20}, ...], Module[{var}, var],  }})

({{Flow, If[cond, ...], While[True, ...],  }})

Here are a few examples for pre- and postconditions:

({{Data Types, real, integer,matrix of reals,character}})

({{Values, even,odd,positive}})

({{Combinations, v1>v2, v1.v2==0}})

({{Unrelated, today is Thursday}})

Every task can be structured by means of such black boxes without knowing details. This supports

Structured Programming

Abstract Data Types

Paradigm of Divide and Conquer

The implementation presented here has two characteristics and is composed of two parts:

({{Proof of Principle, contains all relevant ideas}})

({{Overhead, condition checks only if requested}})

({{Sentinel, what to check}})

({{RunChecked, request evaluation of checks}})

In order to implement such black boxes, we look at some debugging techniques.

Debug

There are some functions to get information on a running calculation.

Select[Names["Trace*"],ToExpression[#,InputForm,StringCount[#::usage,"\"[\""]>0&]&]

Applying one of these functions to the failed calculations shows the problem of negative numbers in fac, but gives no hint that trig is erroneous.

Block[{$RecursionLimit=20},
Trace[CALCULATION,_fac]
]

Trace[CALCULATION2,_trig]

It is better to react on the problem at the point it occurs. The first approach are Assert statements inside the code block to implement a postcondition, here the result of fac must be positive. The precondition is phrased in the argument pattern. The additional code causes a slight change in the result.

ClearAll[fac]
fac[n_Integer?NonNegative]:=With[{result=n*fac[n-1]},
Assert[result>0,n];
result
];
fac[0.]=1;
On[Assert]
CALCULATION
Off[Assert]

This is too much output. Defining an exiting $AssertFunction reduces the amount of output.

On[Assert]
Catch[Block[{$AssertFunction = Throw[{##}]&},CALCULATION]]
Off[Assert]

Analogously, the postcondition for trig is that a single number and not a list is generated.

trig[v1_]:=Flatten[Table[Block[{s,c,r},
s=Sin[v1[[i]]];c=Cos[v1];
r=(s^2)+(c^2);
With[{tag={s,c}},Assert[Head[r]===Real,tag]];
r
],{i,Length[v1]}]]
On[Assert]
CALCULATION2
Off[Assert]

Always paying attention to place Assert calls is tedious and error prone, for example forgetting an If- branch. A better approach is an automatism, here realized in the short package shown below. Assert can be used in parallel, where appropriate. In the first step, we define, what to check. AddSentinel takes five arguments:

({{Set|Thread, kind of check}})

({{Before|After, check with respect to evaluation }})

({{pattern, what to check, for example _fac}})

({{check, ({{return: list of failures (arbitrary)}, {arguments: the observed pattern, the expression before (Before and After) and after evaluation (After)}})}})

({{actions, expressions to evaluate in case of a nonempty failure list (optional, here Abort[])}})

AddSentinel[Set,After,fac[_],Select[DownValues[fac],!FreeQ[#,_Real]&]&,Abort[]]

In the final step, we clear definitions from fac and place the code to be tested inside RunChecked. The problematic case is identified.

ClearAll[fac]
RunChecked[fac[n_Integer]:=n*fac[n-1]]
RunChecked[fac[0.]=1]

Further Examples

Because threading is already defined, a sentinel is predefined below. The optional argument of RunChecked controls the size of the stack information printed.

RunChecked[Fold[Plus,{2,3},List/@Range[10]]]

RunChecked[Fold[Plus,{2,3},List/@Range[10]],2]

Embedded assignments are caught.

RunChecked[ClearAll[fac];{fac[n_Integer],fac[0.]}:={n*fac[n-1],1}]

The clean up function DropSentinel takes the patterns to drop from observation, introduced by a call of AddSentinel.

DropSentinel[fac[_]];

Now the patterns are restricted to domains and we continue the calculation.

AddSentinel[Set,After,int[],Replace[#1,_Integer->{}]&]
AddSentinel[Set,After,real[],Replace[#1,_Real->{}]&]
RunChecked[Evaluate[Through[{int,real}[]]]={2.7,8}]
RunChecked[int[]=7]

Outside RunChecked, no checks are executed and there is no overhead.

int[]=7.

The trig function from above can be checked unmodified.

AddSentinel[Set,After,c,Replace[c,_Real->{}]&,Abort[]]
RunChecked[CALCULATION2]
DropSentinel[c];

Value based restrictions only afford another sentinel.

DropSentinel[int[],real[]];
AddSentinel[Set,After,int[]|real[],{If[int[]<8,{},Row[{"int[]=",int[]}]],If[real[]<10,{},Row[{"real[]=",real[]}]]} &]
RunChecked[real[]=8;real[]=10;int[]=8]

Due to the way RunChecked is defined, an access is not checked, but only assignments and threading.

RunChecked[real[]]

All active sentinels are easily listed and dropped.

Sentinel[Pattern]

DropSentinel@@Sentinel[Pattern]

With a naming convention, general purpose checks are easily phrased. The list check[] prevents repeated postcondition checks.

check[pattern_,HoldForm[{lhs_,rest___} = {rhs_,rhsRest___}],{eval_,evalRest___}]:={check[pattern,HoldForm[lhs= rhs],eval],check[pattern,HoldForm[{rest} = {rhsRest}],{evalRest}]};check[pattern_,before:HoldForm[lhs_Symbol = rhs_],eval_]/;!MemberQ[check[],before]:=Block[
{name=ToString[HoldForm[lhs]],type,depth,res},
{type, depth}=StringSplit[name,{"R"->Real,"I"->Integer,d:NumberString:>ToExpression[d]}]/.{{__,t_Symbol,""...,d_Integer}:>{t,d},{__}:>{None,-1}};
res=And[
Length[Dimensions[eval]]==ToExpression[depth],
And@@Flatten[Map[Head[#]===type&,{eval},{-1}]]
];
If[!res,check[]=Union[check[],{before}];before,{}]/;type=!=None&&NonNegative[depth]
];
check[___]:={};
AddSentinel[Set,After,_,check]
check[]={};RunChecked[Map[({valR0,val,valI1}={#,#,#})&,{0,0.0,{2}}],1]
DropSentinel[_];

Sentinels

We now look at the implementation.

Define check functions (AddSentinel)

Call TraceScan with appropriate patterns (RunChecked)

Since we will handle code not known in advance, the defined functions should hold their arguments.

SetAttributes[{Sentinel, AddSentinel, DropSentinel}, HoldAll];

A list of patterns will limit the checks.

Sentinel[Pattern] = Alternatives[];

The reporting is simpler phrased with a few auxiliary definitions.

Sentinel[Stack] := If[$StackLength==0, "", Row[{If[$StackLength==1, " Call: ", " Stack:\n"], TableForm[
	Take[#,-Min[$StackLength,Length[#]]]&[
		DeleteCases[ReplacePart[#, Extract[#, {-1, 1, 1}, HoldForm], -1], 
			HoldForm[_TraceScan|_StackComplete|(_StackInhibit&)[__]|Block[{$StackLength=_},_]]]
	]]}]&[Stack[_]]]
Sentinel::failed = "Check for pattern `1` failed: `2`.`3`";
AppendTo[$ContextPath, "Sentinel`"];

We are ready to define a function to add patterns to be observed.

AddSentinel[kind_Symbol, when:Before|After, pattern_, check_, actions___] := Quiet[With[{p = DisplayForm[ToBoxes[HoldForm[pattern]][[1]]]},
	Sentinel[kind, when, pattern, before_, after___] := Block[
		{failed, wasOn = Head[General::stop]=!=$Off, $MessagePrePrint = Identity},
		failed = Flatten[{check[pattern, before, after]}];
		If[failed=!={}, 
			Off[General::stop];
			Message[Sentinel::failed, p, failed, Sentinel[Stack]];
			If[wasOn, On[General::stop]];
			actions
		]
	];
	Sentinel[Pattern] = Union[Sentinel[Pattern], Alternatives[HoldPattern[pattern]]]];,
	{RuleDelayed::rhs}
];

Here is the corresponding function to drop patterns from the observation.

DropSentinel[pattern_, patterns__]:= (DropSentinel[pattern]; DropSentinel[patterns]);
DropSentinel[Verbatim[HoldPattern][pattern_]] := DropSentinel[pattern];
DropSentinel[pattern_] := Quiet[
		DownValues[Sentinel] = DeleteCases[DownValues[Sentinel], 
			HoldPattern[Verbatim[HoldPattern][Sentinel[_,_,Verbatim[pattern],__]]]:>_];
		Sentinel[Pattern] = DeleteCases[Sentinel[Pattern], HoldPattern[Verbatim[HoldPattern][Verbatim[pattern]]]],
	{RuleDelayed::rhs}
];
DropSentinel[] := Null;

It is useful to reject wrong calls.

Scan[Function[fun,
	fun[args___] := Throw[Row[{"Undefined call ",HoldForm[fun[args]],". Allowed are: ",
		HoldForm @@@ First/@DownValues[fun]}]]
],{AddSentinel, DropSentinel}]

Automatic Checks

The function that triggers the condition checks uses TraceScan.

Block[{$RecursionLimit=20},
TraceScan[
Hold,
CALCULATION,
_fac,
If[#2==0,Throw[Row[{#1," yields ",#2}]]]&
]
]

TraceScan[
Hold,
CALCULATION2,
_Set,
If[Head[#2]=!=Real,Throw[Row[{#1," yields ",#2}]]]&
]

Since we will handle code not known in advance, the defined functions should hold their arguments.

SetAttributes[RunChecked, HoldAll];

Two kind of sources of problems serve as examples: assignments and combinations of tensors. We start with assignments. The delayed Condition prevents possible pattern renaming.

RunChecked[Set] := Condition @@ Hold[HoldPattern[
		(Set | SetDelayed | TagSet | TagSetDelayed | UpSet | UpSetDelayed | 
		AddTo | SubtractFrom | TimesBy | DivideBy | AppendTo | PrependTo)[___, lhs_, rhs_] | 
		(Increment | PreIncrement | Decrement | PreDecrement)[lhs_]
	], Not[FreeQ[Hold[lhs], Sentinel[Pattern]]]];

Threading only relies on form and can be formulated in a general way.

RunChecked[Thread] := Condition @@ Hold[f_Symbol[___], MemberQ[Attributes[f], Listable]];
ThreadSentinel[pattern_, t:HoldForm[_[before:h_[___]..]], after___] := 
	Quiet[Check[Thread[Hold[before]/.HoldPattern[h]:>Hold,Hold];{}, {t}, Thread::tdlen]];
ThreadSentinel[___] := {};
AddSentinel[Thread, Before, Evaluate[RunChecked[Thread]], ThreadSentinel, Abort[]]

The main function to observe evaluations uses TraceScan.

RunChecked[] = Set | Thread;
RunChecked[expr:Except[_Symbol]|(sym_Symbol/;Context[sym]=!="System`"), stackLength_Integer:1] := 
Block[{$StackLength = stackLength}, StackComplete[TraceScan[
	StackInhibit[Extract[#1, Position[#1, Sentinel[Pattern]], 
		Function[pattern, Scan[Function[tag, Sentinel[tag, Before, pattern, #1]], RunChecked[]], HoldAll]]] &,
	expr,
	Evaluate[RunChecked /@ RunChecked[]],
	StackInhibit[Extract[#1, Position[#1, Sentinel[Pattern]], 
		Function[pattern, Scan[Function[tag, Sentinel[tag, After, pattern, #1, #2]], RunChecked[]], HoldAll]]] &,
	TraceAbove -> All,
	TraceForward -> All,
	TraceInternal -> True
]]];

It is useful to reject wrong calls.

Scan[Function[fun,
	fun[args___] := Throw[Row[{"Undefined call ",HoldForm[fun[args]],". Allowed are: ",
		HoldForm @@@ First/@DownValues[fun]}]]
],{RunChecked}]

Code Structure

Understanding the structure of own code helps to avoid bugs. TreeForm gives the structure of an expression, but is formatted too big for bigger structures. The alternative presented here uses a function that includes additional information in an expression.

SetAttributes[Structure, HoldAllComplete];
Structure[expr_] := With[{no = ++$ModuleNumber}, 
	Selected[no] = {};
	Fold[Function[
		{sub,pos},
		ReplacePart[sub, pos -> Extract[sub, pos, Function[part, Structure[part,no,pos], HoldAllComplete]]],
		HoldAllComplete
	], HoldForm[expr], Sort[Position[HoldForm[expr],_,{2,∞}], Length[#1]>Length[#2]&]]
]

Special formatting makes the information easily available.

operatorCharacters[range__] := Select[FromCharacterCode/@Range[range], Length[Quiet[Symbol["$`$"<>#]]]>0&];
operators = Alternatives @@ Join[Select[
	Flatten[Outer @@@ Map[Prepend[#,StringJoin]&, Table[operatorCharacters[(2^5)+1,(2^7)-1],{i,2,3},{i}]]],
	MatchQ[Quiet[ToExpression["Hold["<>#<>"]"]],Hold[_Symbol[(2)..]]]& /@ Or[#<>"2","2"<>#,#<>"2"<>#,"2"<>#<>"2"]&
], operatorCharacters[(2^16)-1]];
Remove["$`$*"];
MakeBoxes[Structure[head_,no_,pos_,rest___][args__],format_] := Block[{boxes, mark, color},
	boxes = MakeBoxes[head[args],format];
	mark = Which[boxes[[1,2]]==="[", {{1,1},{1,2},{1,-1}}, Head[boxes]===RowBox, Position[boxes,operators,{2}], True, {}];
	color = Dynamic[If[MatchQ[Selected[no],ReplacePart[pos,-1->__]],Hue[Length[pos]/Length[Selected[no]]],None]];
	MapAt[StyleBox[#, Background->color]&, boxes, mark]
];
MakeBoxes[Structure[arg_,no_,pos_,rest___],format_] := Block[{boxes},
	boxes = MakeBoxes[EventHandler[arg, {
		"MouseEntered" :> (Selected[no]=pos),
		"MouseExited" :> (Selected[no]={}),
		PassEventsUp->False
	}],format];
	MapAt[StyleBox[#, Background->Dynamic[If[Selected[no]==pos,Gray,None]]]&, boxes, 1]
]

The output interactively highlights the structure while hovering with the mouse.

Structure[Block[{a},Module[{a},2+(a^2)]]]

Structure[Evaluate[DownValues[Structure]]]