How to write a function-defining function which stores the function arguments in a stack?

Question

I have a function-defining function

SetAttributes[DefFn, HoldAll];

DefFn[f_[args___], body_] :=
 f[args] := body;

I am trying to modify this function to record the function name and the values of its arguments on a stack for error-reporting purposes. I have a function WithStackFrame which adds this information to a list, and I am inserting a call to this function into each definition:

DefFn[f_[args___], body_] :=
 f[args] := WithStackFrame[f,body];

This allows me to give a stack backtrace when reporting errors. This works. The problem comes when I try to store also the values of the function arguments. A naive

DefFn[f_[args___], body_] :=
 f[args] := WithStackFrame[{f,{args}},body];

does not work because args is actually the sequence of patterns. The closest I have got is

DefFn[f_[args___], body_] :=
 Module[{argValueExprs,x},
    argValueExprs = {args} /. x_Pattern :> x[[1]];
    f[args] := WithStackFrame[{f,argValueExprs},body]];

For the purpose of testing, you can use

WithStackFrame[sf_, expr_] := Print[sf];

However, running this gives

DefFn[f[x_], x^2];

f[3]  
(*
{f,{x}}
*)

when I really want {f,{3}}. For some reason, the x is not being evaluated in a scope in which the function arguments are visible.

Answer 1

You could name the patterns

DefFn[f_[args___], body_] := 
  f[s : PatternSequence[args]] := WithStackFrame[{f, {s}}, body];

Answer 2

You need a parser for the argument patterns. I wrote a simplistic one for this answer. I will reproduce it here to keep things self-contained:

splitHeldSequence[Hold[seq___], f_: Hold] := List @@ Map[f, Hold[seq]];

getFunArguments[Verbatim[HoldPattern][Verbatim[Condition][f_[args___], test_]]] := 
     getFunArguments[HoldPattern[f[args]]];

getFunArguments[Verbatim[HoldPattern][f_[args___]]] := 
     FunArguments[FName[f], FArgs @@ splitHeldSequence[Hold[args]]];

(*This is a simplistic "parser".It may miss some less trivial cases*)

getArgumentNames[args__FArgs] := 
   args //. {
     Verbatim[Pattern][tag_, ___] :> tag, 
     Verbatim[Condition][z_, _] :> z, 
     Verbatim[PatternTest][z_, _] :> z
   };

With this, your code might be:

ClearAll[DefFn];
SetAttributes[DefFn, HoldAll];
DefFn[f_[args___], body_] :=
  With[{funargs = getFunArguments[HoldPattern[f[args]]]},
     With[{fargs = Join @@ getArgumentNames[funargs[[2]]]},
        SetDelayed @@ Hold[f[args], WithStackFrame[{f, fargs}, body]]]];

Using it:

DefFn[f[x_], x^2];

?f
Global`f
f[x_]:=WithStackFrame[{f,Hold[x]},x^2]

and thus:

f[3]

(*
 ==> {f,Hold[3]}
*)

EDIT

Here is a somewhat more general and more robust argument parser:

ClearAll[parse];
SetAttributes[parse, HoldAll];
parse[(Condition | PatternTest | Optional)[arg_, _]] := parse[arg];
parse[(HoldPattern | Optional)[arg_]] := parse[arg];
parse[Verbatim[Pattern][sym_, _]] := Hold[sym];
parse[Verbatim[Repeated][p_, ___]] := parse[p];
parse[(Blank | BlankSequence | BlankNullSequence)[___]] := Hold["NotAPatternVar"];
parse[(Longest | Shortest)[arg_, ___]] := parse[arg];
parse[Verbatim[PatternSequence][args___]] := parse[args];
parse[a_ /; AtomQ[Unevaluated[a]]] := Hold["NotAPatternVar"];
parse[args___] := Join @@ Map[parse, Unevaluated /@ Unevaluated[{args}]];
parse[f_[args___]] := {Hold[f], parse[args]};

With its help, the function would be written as:

ClearAll[DefFn];
SetAttributes[DefFn, HoldAll];
DefFn[f_[args___], body_] :=
  With[{fargs = parse[f[args]]},
     SetDelayed @@ Hold[f[args], WithStackFrame[fargs, body]]];

Some examples to try:

ClearAll[f, ff];
DefFn[f[x_], x^2];
DefFn[
  ff[x_,PatternSequence[Shortest[y__], p__] /; {Length[{p}] < Length[{y}]},z_, (q_) ..] /; 
         x < z, 
  {x, y, p, z, q}]

Note that the trick SetDelayed@@Hold[lhs,rhs] is needed to fool the variable renaming mechanism of enclosing With. This is explained in more detail here.

Answer 3

I would do this:

DefFn[f_[args___], body_] := 
  lhs : f[args] := WithStackFrame[lhs, body];

Then make WithStackFrame HoldFirst and do de-structuring there. For example:

SetAttributes[WithStackFrame, HoldFirst]

WithStackFrame[f_[args___], expr_] := Print[{f, {args}}];

If for some reason this were unacceptable I would do:

DefFn[f_[args___], body_] := 
  lhs : f[args] := WithStackFrame[{f, List @@ Unevaluated[lhs]}, body];