Merge pull request #15 from rhennigan/feature/more-rules

Feature/more rules
rhennigan · Oct 27, 2022 · 46ce2e9 · 46ce2e9
2 parents 814cc88 + 933dd7e
commit 46ce2e9
Show file tree

Hide file tree

Showing 16 changed files with 561 additions and 255 deletions.
diff --git a/Data/SimplifySymbols.wxf b/Data/SimplifySymbols.wxf
diff --git a/Documentation/English/ReferencePages/Symbols/$AllowedEvaluationPatterns.nb b/Documentation/English/ReferencePages/Symbols/$AllowedEvaluationPatterns.nb
@@ -281,6 +281,31 @@ Notebook[
       "PrimaryExamplesSection",
       CellID -> 530424701
      ],
+     Cell[
+      "Enable messaging for sandbox events:",
+      "ExampleText",
+      CellID -> 11588198
+     ],
+     Cell[
+      BoxData[
+       RowBox[
+        {
+         RowBox[
+          {
+           "On",
+           "[",
+           RowBox[{"EvaluateSafely", "::", "unsafe"}],
+           "]"
+          }
+         ],
+         ";"
+        }
+       ]
+      ],
+      "Input",
+      CellLabel -> "In[1]:=",
+      CellID -> 379994201
+     ],
      Cell[
       "By default, sandbox rules will prevent some evaluations that would otherwise give equivalent outputs::",
       "ExampleText",
@@ -305,7 +330,7 @@ Notebook[
        ]
       ],
       "Input",
-      CellLabel -> "In[1]:=",
+      CellLabel -> "In[2]:=",
       CellID -> 130182422
      ],
      Cell[
@@ -341,8 +366,8 @@ Notebook[
             "\"Sandboxed the following expressions: \\!\\(\\*RowBox[{\\\"HoldComplete\\\", \\\"[\\\", RowBox[{\\\"<<\\\", \\\"\\\\\\\"data.wl\\\\\\\"\\\"}], \\\"]\\\"}]\\)\"",
             2,
             3,
-            1,
-            34100295901694291473,
+            9,
+            34129244601778320131,
             "Local",
             "Wolfram`CodeEquivalenceUtilities`EvaluateSafely"
            },
@@ -352,13 +377,13 @@ Notebook[
          "Message",
          "MSG",
          CellLabel -> "During evaluation of In[3]:=",
-         CellID -> 748438447
+         CellID -> 364292292
         ],
         Cell[
          BoxData["False"],
          "Output",
          CellLabel -> "Out[3]=",
-         CellID -> 79013216
+         CellID -> 175534900
         ]
        },
        Open
@@ -1821,7 +1846,7 @@ Notebook[
    ],
   "NotebookUUID" -> "92ca80bf-5599-4a6a-afd7-aff73ec8f532"
  },
- FrontEndVersion -> "13.1 for Microsoft Windows (64-bit) (June 16, 2022)",
+ FrontEndVersion -> "13.2 for Microsoft Windows (64-bit) (October 20, 2022)",
  StyleDefinitions ->
   FrontEnd`FileName[
    {"Wolfram"},

diff --git a/Kernel/CanonicalForms/Rules.wl b/Kernel/CanonicalForms/Rules.wl
@@ -1037,11 +1037,26 @@ extraRules = HoldComplete[
 
 
 syntaxRules = HoldComplete[
+    ApplyTo[ x_, f_ ] :> (x = f @ x),
+    AddTo[ a_, b_ ] :> (a = a + b),
+    SubtractFrom[ a_, b_ ] :> (a = a - b),
+    TimesBy[ a_, b_ ] :> (a = a * b),
+    DivideBy[ a_, b_ ] :> (a = a / b),
+    PreIncrement[ x_ ] :> (x = x + 1),
+    PreDecrement[ x_ ] :> (x = x - 1),
+    AppendTo[ a_, b_ ] :> (a = Append[ a, b ]),
+    PrependTo[ a_, b_ ] :> (a = Prepend[ a, b ]),
+
+    Construct[ f_, x___ ] :> f @ x,
+    OperatorApplied[ f_ ][ x_ ][ y_ ] :> f[ y, x ],
+    ReverseApplied[ f_ ][ a___ ] :> With[ { r = Reverse @ TempHold @ a }, f @ r /; True ],
+    Operate[ p_, f_[ x_, y_ ] ] :> p[ f ][ x, y ],
+
     Composition[ fs__, f_? NonHoldingQ ][ a___ ] :> Composition[ fs ][ f @ a ],
     Composition[ f_ ][ a___ ] :> f @ a,
     a_[ b___, c_Composition, d___ ] :> a[ b, c[ # ] &, d ]
     ,
-    RightComposition[ a___ ] :> WithHolding[ { reversed = Reverse @ TempHold @ a }, Composition @ reversed ]
+    RightComposition[ a___ ] :> With[ { r = Reverse @ TempHold @ a }, Composition @ r /; True ]
     ,
     Identity[ e_ ] :> e
     ,
@@ -1095,9 +1110,54 @@ syntaxRules = HoldComplete[
         Replace[ a, b, c, d ],
 
     ReplaceAll[ a_, b_ ] :>
-        Replace[ a, b, { 0, DirectedInfinity[ 1 ] }, Heads -> True ]
+        Replace[ a, b, { 0, DirectedInfinity[ 1 ] }, Heads -> True ],
+
+    System`MapApply[ f_, expr_ ] :>
+        Apply[ f, expr, { 1 } ]
+];
+
+
+$$forwardOps = HoldPattern @ Alternatives[
+    Apply,
+    Map,
+    System`MapApply
 ];
 
+$$reverseOps = HoldPattern @ Alternatives[
+    Replace,
+    Select,
+    Append,
+    Prepend,
+    ReplacePart,
+    SelectFirst,
+    FirstCase,
+    Cases,
+    DeleteCases,
+    Position,
+    Extract,
+    Delete,
+    AnyTrue,
+    AllTrue,
+    NoneTrue,
+    SortBy,
+    MaximalBy,
+    MinimalBy,
+    DeleteDuplicatesBy,
+    CurryApplied
+];
+
+$$reverseOps2 = HoldPattern @ Alternatives[
+    Insert
+];
+
+operatorFormRules = Inline[ { $$forwardOps, $$reverseOps }, HoldComplete[
+    (h:$$forwardOps)[ a_ ][ b_ ] :> h[ a, b ],
+    (h:$$reverseOps)[ a_ ][ b_ ] :> h[ b, a ],
+    (h:$$reverseOps2)[ a_, b_ ][ c_ ] :> h[ c, a, b ]
+] ];
+
+
+
 $booleanFunctions1 = HoldPattern @ Alternatives[
     AcyclicGraphQ, AlgebraicIntegerQ, AlgebraicUnitQ, \
     AntihermitianMatrixQ, AntisymmetricMatrixQ, ArrayQ, AssociationQ, \
@@ -1686,6 +1746,7 @@ rules = {
     eiwlRules,
     extraRules,
     syntaxRules,
+    operatorFormRules,
     arithmeticRules,
     booleanFunctionRules,
     graphicsRules,

diff --git a/Kernel/CodeEquivalenceUtilities.wl b/Kernel/CodeEquivalenceUtilities.wl
@@ -39,4 +39,6 @@ Quiet[
     General::shdw
 ];
 
+Off[ Wolfram`CodeEquivalenceUtilities`EvaluateSafely::unsafe ];
+
 EndPackage[ ];
diff --git a/Kernel/Config.wl b/Kernel/Config.wl
@@ -56,7 +56,7 @@ $RasterPatterns = HoldPattern @ Alternatives[
 (* ::Section::Closed:: *)
 (*Argument patterns*)
 
-$$hold := Hold | HoldForm | HoldComplete;
+$$hold := Hold | HoldForm | HoldComplete | HoldPattern | $holdWrapper;
 
 (* ::**********************************************************************:: *)
 (* ::Section::Closed:: *)