Added KernelTunnels

Author: b3m2a1

InterfaceObjects.m

@@ -1,6 +1,6 @@
 (* ::Package:: *)
 
-
+(* Autogenerated Package *)
 
 (* ::Section:: *)
 (*Interfaces*)
@@ -39,6 +39,8 @@
   "Alias for defining object methods";
 InterfaceAttribute::usage=
   "Alias for defining object attributes";
+InterfaceOverride::usage=
+  "Alias for defining object UpValues";
 
 
 Begin["`Private`"];
@@ -314,12 +316,13 @@
     "Constructor"->Automatic,
     "MutationHandler"->Automatic,
     "MutationFunctions"->None,
+    "Protect"->False,
     "AccessorFunctions"->Automatic,
     "NormalFunction"->Automatic,
     "Formatted"->True,
     "Icon"->None,
     "DefaultMethods"->{
-      Keys, SetProperty, PropertyValue,
+      Association, Keys, Values, SetProperty, PropertyValue,
       RemoveProperty, PropertyList
       },
     "DefaultAttributes"->{
@@ -416,6 +419,7 @@
       ];
     iRegisterDefaultInterfaceMethods[head, OptionValue["DefaultMethods"]];
     iRegisterDefaultInterfaceAttributes[head, OptionValue["DefaultAttributes"]];
+    If[OptionValue["Protect"], Protect[head]];
     head
     ];
 
@@ -601,6 +605,7 @@
       },
     InterfaceConstructor[head]=constructor;
     (* Constructor DownValue on the object *)
+    Unprotect[head];
     head//ClearAll;
     head~SetAttributes~HoldAllComplete;
     head[args___]?checkInvalid:=
@@ -623,6 +628,102 @@
 
 
 
+$noArgMutations=
+  Alternatives@@
+    {Unset, Increment, Decrement};
+
+
+$oneArgMutations=
+  Alternatives@@
+    {
+        Set, SetDelayed,
+        AddTo, SubtractFrom, TimesBy, DivideBy,
+        AppendTo, PrependTo,
+        AssociateTo, KeyDropFrom
+        };
+
+
+iRegisterInterfaceMutationHandler[
+  head_,
+  func_,
+  dispatcher_
+  ]:=
+  With[
+    {
+      oQ=InterfaceValidator[head],
+      symQ=Unique[symbolQ],
+      oA=$oneArgMutations,
+      nA=$noArgMutations,
+      d=
+        If[!AssociationQ@dispatcher, 
+          <|"Keys"->dispatcher|>,
+          dispatcher
+          ]
+      },
+    symQ~SetAttributes~{Temporary, HoldFirst};
+    symQ[sym_]:=
+      MatchQ[OwnValues[sym], {_:>_head?oQ}];
+    func // ClearAll;
+    func~SetAttributes~HoldAllComplete;
+    If[KeyExistsQ[d, "Self"],
+      With[{subdispatch=dispatcher["Self"]},
+        func[
+          (h: oA)[obj_Symbol?symQ, val_]
+          ] :=
+          With[{res=subdispatch[h][obj, val]},
+            (obj=res)/;Head[res]===head
+            ];
+        func[
+          (h : nA)[obj_Symbol?symQ]
+          ] :=
+          With[{res=subdispatch[h][obj]},
+            (obj=res)/;Head[res]===head
+            ];
+        ];
+      ];
+    If[KeyExistsQ[d, "Keys"],
+      With[{subdispatch=dispatcher["Keys"]},
+        func[
+          (h: oA)[obj_Symbol?symQ[attr__], val_]
+          ] :=
+          With[{res=subdispatch[h][obj, {attr}, val]},
+            (obj=res)/;Head[res]===head
+            ];
+        func[
+          (h : nA)[obj_Symbol?symQ[attr__]]
+          ] :=
+          With[{res=subdispatch[h][obj, {attr}]},
+            (obj=res)/;Head[res]===head
+            ];
+        ]
+      ];
+    If[KeyExistsQ[d, "Parts"],
+      With[{subdispatch=dispatcher["Parts"]},
+        func[
+          (h: oA)[obj_Symbol?symQ[[part__]], val_]
+          ] :=
+          With[{res=subdispatch[h][obj, {part}, val]},
+            (obj=res)/;Head[res]===head
+            ];
+        func[
+          (h : nA)[obj_Symbol?symQ[[part__]]]
+          ] :=
+          With[{res=subdispatch[h][obj, {part}]},
+            (obj=res)/;Head[res]===head
+            ];
+        ]
+      ];
+    (* fallthrough to get normal behavior back *)
+    func[___] := Language`MutationFallthrough;
+    Language`SetMutationHandler[head, func];
+    ]
+
+
+(* ::Subsubsection::Closed:: *)
+(*iRegisterInterfaceMutationHandler*)
+
+
+
 $noArgMutations=
   Alternatives@@
     {Unset, Increment, Decrement};
@@ -731,8 +832,10 @@
     {
       mn=methodName,
       valid=InterfaceValidator[head],
-      meths=InterfaceMethods[head]
+      meths=InterfaceMethods[head],
+      attrs=Attributes[head]
       },
+    If[MemberQ[attrs, Protected], Unprotect[head]];
     InterfaceMethods[head]=
       If[meths===Null,
         <|mn->True|>,
@@ -742,6 +845,7 @@
       def;
     head/:lhs?valid[mn][args]:=
       def;
+    If[MemberQ[attrs, Protected], Protect[head]];
     ];
 
 
@@ -779,15 +883,18 @@
     {
       mn=methodName,
       valid=InterfaceValidator[head],
-      meths=InterfaceAttributes[head]
+      meths=InterfaceAttributes[head],
+      attrs=Attributes[head]
       },
+    If[MemberQ[attrs, Protected], Unprotect[head]];
     InterfaceAttributes[head]=
       If[meths===Null,
         <|mn->True|>,
         Append[meths, mn->True]
         ]; 
     head/:lhs?valid[mn]:=
       def;
+    If[MemberQ[attrs, Protected], Protect[head]];
     ];
 
 
@@ -802,6 +909,70 @@
 Protect[InterfaceAttribute]
 
 
+(* ::Subsubsection::Closed:: *)
+(*iRegisterInterfaceOverride*)
+
+
+
+iRegisterInterfaceOverride~SetAttributes~HoldRest;
+iRegisterInterfaceOverride[
+  head_,
+  upval_,
+  {lh___},
+  main_,
+  {rh___},
+  def_
+  ]:=
+  With[
+    {
+      mn=upval,
+      valid=InterfaceValidator[head],
+      attrs=Attributes[head]
+      },
+    If[MemberQ[attrs, Protected], Unprotect[head]];
+    head/:upval[lh, main?valid, rh]:=
+      def;
+    If[MemberQ[attrs, Protected], Protect[head]];
+    ];
+
+
+Unprotect[InterfaceOverride];
+InterfaceOverride/:
+  (
+    InterfaceOverride[head_][
+      upval_[args___]
+      ]:=def_
+    ):=
+    Module[
+      {
+        pivot,
+        argList
+        },
+      argList=Thread[HoldComplete[{args}]];
+      pivot=
+        SelectFirst[Range[Length[argList]], !FreeQ[argList[[#]], head]&,
+         Length[argList]+1];
+      argList=
+        Map[
+          Thread[#, HoldComplete]&, 
+          {
+            Take[argList, UpTo[pivot-1]], 
+            argList[[{pivot}]],
+            Drop[argList, UpTo[pivot]]
+            }
+          ];
+      Replace[argList,
+        {
+          HoldComplete[{lh___}]|{lh___}, 
+          HoldComplete[{main_}], 
+          HoldComplete[{rh___}]|{rh___}
+          }:>
+          iRegisterInterfaceOverride[head, upval, {lh}, main, {rh}, def]
+        ]
+      ];
+Protect[InterfaceOverride]
+
+
 (* ::Subsubsection::Closed:: *)
 (*iRegisterInterfaceAccessor*)
 
@@ -815,9 +986,13 @@
       },
     If[KeyExistsQ[ea, "Keys"],
       With[{lookup=dispatcher["Keys"]},
-        obj_head?valid[attr_String?(!KeyExistsQ[InterfaceMethods[head], #]&)]:=
+        obj_head?valid[attr_String?(
+          !KeyExistsQ[
+            Join[InterfaceMethods[head], InterfaceAttributes[head]], 
+            #
+            ]&)]:=
           With[{res=lookup[obj, attr]}, res/;Head[res]=!=lookup];
-        obj_head?valid[attr:Except[_String|_String[]]]:=
+        obj_head?valid[attr:Except[_String|_String[___]]]:=
           With[{res=lookup[obj, attr]}, res/;Head[res]=!=lookup];
         obj_head?valid[attr1_, attrs__]:=
           With[{res=lookup[obj, attr1, attrs]}, res/;Head[res]=!=lookup];
@@ -934,6 +1109,16 @@
 
 
 
+(* ::Subsubsubsection::Closed:: *)
+(*Association*)
+
+
+
+registerDefaultMethod[head_, validator_, Association]:=
+  head/:HoldPattern@Association[head[a_]?validator]:=
+    Association[a];
+
+
 (* ::Subsubsubsection::Closed:: *)
 (*Keys*)
 
@@ -944,6 +1129,16 @@
     Keys[a];
 
 
+(* ::Subsubsubsection::Closed:: *)
+(*Values*)
+
+
+
+registerDefaultMethod[head_, validator_, Values]:=
+  head/:HoldPattern@Values[head[a_]?validator]:=
+    Values[a];
+
+
 (* ::Subsubsubsection::Closed:: *)
 (*ReplacePart*)