Skip to content

Instantly share code, notes, and snippets.

@lshifr lshifr/Defines.m
Last active Mar 18, 2016

Embed
What would you like to do?
Static code analyzer for Mathematica code
ClearAll[shead];
SetAttributes[shead, HoldAllComplete];
shead[f_Symbol[___]] := HoldComplete[f];
shead[f_[___]] := shead[f];
shead[f_ /; AtomQ[Unevaluated[f]]] := Head[f];
(* TODO:This is a bit too simplisitc,since some pattern symbols might \
be localized by inner rules inside expr,and should not be \
counted.We might miss some extra dependencies this way *)
ClearAll[getPatternSymbols];
SetAttributes[getPatternSymbols, HoldAllComplete];
getPatternSymbols[expr_] :=
Cases[
Unevaluated[expr],
Verbatim[Pattern][ss_, _] :> HoldComplete[ss],
{0, \[Infinity]},
Heads -> True
];
ClearAll[getDeclaredSymbols];
SetAttributes[getDeclaredSymbols, HoldAllComplete];
getDeclaredSymbols[{decs___}] :=
Thread[Replace[HoldComplete[{decs}], HoldPattern[a_ = rhs_] :> a, {2}]];
getDeclaredSymbols[_] = {};
ClearAll[getDeclarationRHSides];
SetAttributes[getDeclarationRHSides, HoldAllComplete];
getDeclarationRHSides[{decs___}] :=
Cases[
Unevaluated[{decs}],
Verbatim[Set][_, rhs_] :> HoldComplete[rhs],
{1}
];
getDeclarationRHSides[_] := {};
ClearAll[extractSymbolsForUpValues];
SetAttributes[extractSymbolsForUpValues, HoldAllComplete];
extractSymbolsForUpValues[args___] :=
DeleteCases[
Cases[HoldComplete[args], s_Symbol :> HoldComplete[s], {-1}, Heads -> True],
HoldComplete[HoldComplete]
];
ClearAll[definesExt, filter, $defaultExcludes, defInfo];
$defaultExcludes = {HoldComplete[Condition]};
SetAttributes[filter, HoldAllComplete];
filter[sym_Symbol, excluded_] := filter[HoldComplete[sym], excluded];
filter[held_HoldComplete, excluded_] := Complement[{held}, excluded];
SetAttributes[definesExt, HoldAllComplete];
definesExt[Verbatim[Unevaluated][expr_], excluded_] :=
definesExt[expr, excluded];
definesExt[
Set[(prop : Alternatives[
Options,
Attributes,
DefaultValues,
OwnValues,
DownValues,
SubValues,
UpValues,
NValues,
FormatValues,
Messages
])[sym_Symbol], rhs_], excluded_] :=
Join[
{defInfo[filter[sym, excluded], prop]},
definesExt[rhs, excluded]
];
definesExt[Unset[sym_Symbol], excluded_] :=
List@defInfo[filter[sym, excluded], Unset];
definesExt[(h : (Clear | ClearAll | Remove))[syms__Symbol], excluded_] :=
List @ defInfo[Complement[Thread@HoldComplete[{syms}], excluded], h];
definesExt[Set[MessageName[sym_, _], rhs_], excluded_] :=
Join[
{defInfo[filter[sym, excluded], MessageName]},
definesExt[rhs, excluded]
];
definesExt[
(h : (Set | SetDelayed | UpSet | UpSetDelayed))[
Verbatim[Condition][lhs_, cond_], rhs_
],
excluded_
] :=
With[{excl = Join[excluded, getPatternSymbols[lhs]]},
Join[definesExt[h[lhs, rhs], excluded], definesExt[cond, excl]]
];
definesExt[
(h : (TagSet | TagSetDelayed))[
tag_Symbol, Verbatim[Condition][lhs_, cond_], rhs_
],
excluded_
] :=
With[{excl = Join[excluded, getPatternSymbols[lhs]]},
Join[
definesExt[h[tag, lhs, rhs], excluded],
definesExt[cond, excl],
{defInfo[filter[tag, excluded], h]}
]
];
definesExt[(h : (Set | SetDelayed))[lhs_Symbol, rhs_], excluded_] :=
With[{excl = Join[excluded, getPatternSymbols[lhs]]},
With[{exclFinal = If[h === Set, excluded, excl]},
Join[
{defInfo[filter[lhs, excluded], h]},
definesExt[rhs, exclFinal]
]]];
(*TODO:We need a more general parsing scheme for this type of patterns*)
definesExt[
(h : (Set | SetDelayed))[Verbatim[Pattern][name_Symbol, body_], rhs_],
excluded_
] :=
With[{excl = Join[excluded, {HoldComplete[name]}]},
definesExt[h[body, rhs], excl]
];
definesExt[
(h : (Set | SetDelayed))[(head : Verbatim[Pattern][name_Symbol, body_])[args___], rhs_],
excluded_
] :=
With[{excl = Join[excluded, {HoldComplete[name]}]},
definesExt[h[body[args], rhs], excl]
]
definesExt[(h : (Set | SetDelayed))[lhs_, rhs_], excluded_] :=
With[{excl = Join[excluded, getPatternSymbols[lhs]], head = shead[lhs]},
With[{exclFinal = If[h === Set, excluded, excl]},
Join[
definesExt[lhs, excl],
definesExt[rhs, exclFinal],
{defInfo[filter[head, excluded], h]}
]] /; MatchQ[head, _HoldComplete]];
definesExt[_SetDelayed | _Set, _] :=
Throw[$Failed, {definesExt, SetDelayed | Set}];
definesExt[(h : (UpSet | UpSetDelayed))[lhs : f_[args___], rhs_], excluded_] :=
With[{excl = Join[excluded, getPatternSymbols[lhs]]},
With[{exclFinal = If[h === UpSet, excluded, excl]},
Join[
definesExt[lhs, excl],
definesExt[rhs, exclFinal],
{defInfo[Complement[extractSymbolsForUpValues[args], excluded], h]}
]]];
definesExt[(h : (TagSet | TagSetDelayed))[tag_Symbol, lhs_, rhs_], excluded_] :=
With[{excl = Join[excluded, getPatternSymbols[lhs]]},
With[{exclFinal = If[h === TagSet, excluded, excl]},
Join[
definesExt[lhs, excl],
definesExt[rhs, exclFinal],
{defInfo[filter[tag, excluded], h]}
]]];
definesExt[SetOptions[sym_Symbol, rhs_], excluded_] :=
Join[
{defInfo[filter[sym, excluded], SetOptions]},
definesExt[rhs, excluded]
]
definesExt[SetAttributes[{syms___Symbol}, rhs_], excluded_] :=
Join[
List @ defInfo[
Map[
Function[s, filter[s, excluded], HoldAllComplete],
Unevaluated[{syms}]
], SetAttributes]
,
definesExt[rhs, excluded]
];
definesExt[SetAttributes[sym_Symbol, rhs_], excluded_] :=
Join[
{defInfo[filter[sym, excluded], SetAttributes]},
definesExt[rhs, excluded]
];
definesExt[Verbatim[Pattern][_, body_], excluded_] :=
definesExt[body, excluded];
definesExt[Verbatim[Condition][expr_, cond_], excluded_] :=
With[{excl = Join[excluded, getPatternSymbols[expr]]},
Join[
definesExt[expr, excl],
definesExt[cond, excl]
]]
definesExt[Verbatim[PatternTest][patt_Pattern, fun_], excluded_] :=
Join[
definesExt[patt, excluded],
definesExt[fun, excluded]
];
definesExt[Function[Null, body_, atts_], excluded_] :=
definesExt[body, excluded];
definesExt[body_ &, excluded_] := definesExt[body, excluded];
definesExt[Function[var_, body_], excluded_] :=
definesExt[Function[{var}, body], excluded];
definesExt[Function[{vars__}, body_], excluded_] :=
With[{excl = Join[excluded, Thread[HoldComplete[{vars}]]]},
definesExt[body, excl]
];
(* TODO:the Block case is not clear-cut,whether to include it *)
definesExt[(With | Module | Block)[decs_, body_], excluded_] :=
With[{rhsides = getDeclarationRHSides[decs]},
With[{joined = Join[excluded, getDeclaredSymbols[decs]]},
Join[
definesExt[body, joined],
definesExt[rhsides, excluded]
]]];
definesExt[f_[elems___], excluded_] :=
Join[
definesExt[Unevaluated[f], excluded],
Sequence @@ Map[
Function[arg, definesExt[arg, excluded], HoldAllComplete],
Unevaluated[{elems}]
]
];
definesExt[a_ /; AtomQ[Unevaluated[a]], _] := {};
definesExt[code_] :=
With[{excl = $defaultExcludes},
definesExt[code, excl]
];
definesExt[args___] := Throw[$Failed, {definesExt, Hold[args]}];
ClearAll[definesFull];
SetAttributes[definesFull, HoldAllComplete];
definesFull[expr_] :=
Composition[
Map[{First@First@#, Tally@#[[All, 2]]} &],
GatherBy[#, First] &,
Flatten[#, 1] &,
Composition[Thread, List] @@@ # &
] @ DeleteCases[definesExt[expr], defInfo[{}, _]];
@Kypaku

This comment has been minimized.

Copy link

commented Mar 18, 2016

Не получилось, или я что-то не так делаю.
definesExt@definesExt
{}

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.