From 57071633901d74ccbc561d14eb47fc07cf93c8b8 Mon Sep 17 00:00:00 2001 From: Max Piskunov Date: Wed, 10 Mar 2021 19:18:21 -0600 Subject: [PATCH] $SetReplaceTypeGraph (#621) ## Changes * Adds a `$SetReplaceTypeGraph` constant. * The constant contains the nicely formatted type graph. ## Examples * Examples below do not work directly because they use fake types. To try them out, do something like ```wl AppendTo[$ContextPath, "SetReplace`PackageScope`"]; ``` and then evaluate the definitions (line 15 to 81) from `typeSystem.wlt`. * Now, check `$SetReplaceTypeGraph`: ```wl In[] := $SetReplaceTypeGraph ``` image --- Documentation/Images/$SetReplaceTypeGraph.png | Bin 0 -> 3855 bytes .../TypeSystem/$SetReplaceTypeGraph.md | 20 ++++ .../SymbolsAndFunctions/TypeSystem/README.md | 17 +++ .../SetReplaceMethodImplementation.md | 8 ++ .../TypeSystem/SetReplaceProperty.md | 7 ++ .../TypeSystem/SetReplaceType.md | 7 ++ Kernel/{A2$style.m => A0$style.m} | 31 ++++++ Kernel/A1$typeSystem.m | 97 ++++++++++++++---- Tests/typeSystem.wlt | 13 +++ 9 files changed, 182 insertions(+), 18 deletions(-) create mode 100644 Documentation/Images/$SetReplaceTypeGraph.png create mode 100644 Documentation/SymbolsAndFunctions/TypeSystem/$SetReplaceTypeGraph.md create mode 100644 Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceMethodImplementation.md create mode 100644 Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceProperty.md create mode 100644 Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceType.md rename Kernel/{A2$style.m => A0$style.m} (91%) diff --git a/Documentation/Images/$SetReplaceTypeGraph.png b/Documentation/Images/$SetReplaceTypeGraph.png new file mode 100644 index 0000000000000000000000000000000000000000..79a50b4030bfaf2c1211ad9cab3ed9e1ce1ac61f GIT binary patch literal 3855 zcmds4X;4#H7QTvYqpbxh5=D`qzT4yx?V6DB~2{!=LbOBfnQ(q2QVqwMF(5o#T8)xcZ9QV5!M2cUuot$d`7@`-tp{7HI}(wu<_UQEztf}McMr& z8UXE`3(qopw?D}sqXog*o8XSa5{PI#1{}v@&;-mGI5CuP7EU;efqUV?v3PU@+z}la z5`zxGz!7jFk!VQ#*=%?k7vXo~RvLt(zku`8@=#nP92FXY0SAo^8Y7JUj4(2R8y`fN znjnl!H)LiAp$dfCpZE$z>YnHuIOiUsc3-~RKKGVu&y`pfJFR>*#-n8nRipDDRe#*A z=1uk_)~H@)qlG?w&HI2^o;YZvXk*^k58Z7Qr-BQMC4BRQ)A_f%XGGSs0$Q`j57ACd z*Cj6-qN&kN+cRzeaG(6;XdnRBm;ewqg7fU<;F#AkFk%3J|7Sm0TRZ@`xBB1KUz`@K zi<}_qVkcFFYL+i^z_Wn&%e_({^CUt4)SD+)B=;=4Y#zk z#3mD>qoX4t_Fr|HQ7FBQe z%9%vGn3OaNXJ1uURaH@`RJmM!(>6ORJ3HiH0lq3xG1iV$y*+&dsT^x(;)L_lFB=Qx zwAx_f)Tp5+IjtqmdKM&EO5yJH=?mZHQSemRQ(L{m_TWBSMv*fp2Lk)=e!U|#O8h9j zw6v5;MN-&oc7QOM?`Mc4$>2>_XEG<5JZ!o5ckX+yI^iT&@KwESZEeyH&T;jJ4<9ZnWyG#0?A$o!RQ>s>M&5o$ltHW1URUPxWEN zPINCYgyqJ~D;0s{dDB$c$kUs%Gp{?O3b)b<@_SW;jmODyZ%4XYN=nMlAu>xYYUp_~ z+Xn{+e-vdCIfoDkok}l$zya;d$;nAt;v4&OqhhgmZZ6TRkcBcB##ebV(=^Qv9m=g6 z5{rXJbYe4h*LoS`#q+67C7-WcIX&LhDzM`D`1|^9*}U0)S6{h082<-bIX^RSTpi*+ z{X{U6*E&krm76X($t!V_7OGS#s1VN1&al;KU%(7gHL)Qf)zx8Ww0f?;!0KG}@4b)BlTjS)Xu1)cKax7j}a{%iH86pC7Bn-OSZ zFe`Jyhzs$swJYjN?cBOE7BI$+;*8p0#MP{n+ev}Ch?R9d$V(1%fl4W5WhDm%-QT+c z#Cm$wW;4P}bX>J!0zdcj_9nf1gX#6yw{M?RDt(tIFs-R5D=RB6H#RZRa*n~hX7G5t zFrHE_(yL77c7;bqM#k#dCNx{SR@}XNr4c(b(F3#UY`VD_QZ5c&wJ?P^VFnTT&vPa^ z^4z~?=^n{%7#4?mPr#PxA(MNRx4Oa&_wQFsO;rRMhYQuOIPQXI7RB%(W~Zw^qfjVP zMSPJva(=4SQ=_q7G8vdCPjiRLa+_U`<)&F(M;Y`%qr&6}!oIg=vDwM*=Vx&JHJf#G z5HVvYbuQt9gco08+;x{ zOPcP22ED%~ZnEKk5Q;334L)?HT9kH3wj~gGup>;cROe4AyrC+l%Fv35?__Y zpPrr;NUWPC{M-Hgp(ySWRLP!<`eA%2s{YJDXqm#JF|)$8`o(Ug8a5v4`jiG;%Xkx&g_+sQUMS+pU}p6M0B)2-K9zVtrY#>SK$9sH{O3wB?IhVLpf<{2F; [Type System](README.md) + +# $SetReplaceTypeGraph + +**`$SetReplaceTypeGraph`** gives the [`Graph`](https://reference.wolfram.com/language/ref/Graph.html) showing +[types]($SetReplaceTypes.md) and [properties]($SetReplaceProperties.md) defined in *SetReplace* (including internal +ones) and possible computation paths between them: + +```wl +In[] := $SetReplaceTypeGraph +``` + + + +It is a [`Graph`](https://reference.wolfram.com/language/ref/Graph.html) representation of a directed hypergraph with +types and properties as vertices and implementations of translations and properties as edges. + +All vertices have the form `kind[name]`, where `kind` can be either [`SetReplaceType`](SetReplaceType.md), +[`SetReplaceProperty`](SetReplaceProperty.md) or [`SetReplaceMethodImplementation`](SetReplaceMethodImplementation.md), +and `name` is either a type specification or a symbol. diff --git a/Documentation/SymbolsAndFunctions/TypeSystem/README.md b/Documentation/SymbolsAndFunctions/TypeSystem/README.md index eb080537b..4a8dc9176 100644 --- a/Documentation/SymbolsAndFunctions/TypeSystem/README.md +++ b/Documentation/SymbolsAndFunctions/TypeSystem/README.md @@ -23,3 +23,20 @@ convert an object to a different type manually for persistence or optimization, [`SetReplaceObjectQ`](SetReplaceObjectQ.md) can be used to find out if an expression is a *SetReplace* object, and [`SetReplaceObjectType`](SetReplaceObjectType.md) can be used to determine its type. + +## Helper Symbols and Functions + +* Enumeration: + * [`$SetReplaceTypes`]($SetReplaceTypes.md) + * [`$SetReplaceProperties`]($SetReplaceProperties.md) + * [`$SetReplaceTypeGraph`]($SetReplaceTypeGraph.md) — a graph showing translations/property implementation paths + * Vertex heads: [`SetReplaceType`](SetReplaceType.md), + [`SetReplaceProperty`](SetReplaceProperty.md), + [`SetReplaceMethodImplementation`](SetReplaceMethodImplementation.md) +* Introspection: + * [`SetReplaceObjectQ`](SetReplaceObjectQ.md) + * [`SetReplaceObjectType`](SetReplaceObjectType.md) +* Conversion: + * [`SetReplaceTypeConvert`](SetReplaceTypeConvert.md) — change an object from one type to another +* Types: + * [`Multihistory`](Multihistory.md) — a generic kind of types for computational systems diff --git a/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceMethodImplementation.md b/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceMethodImplementation.md new file mode 100644 index 000000000..9030ebbe3 --- /dev/null +++ b/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceMethodImplementation.md @@ -0,0 +1,8 @@ +###### [Symbols and Functions](/README.md#symbols-and-functions) > [Type System](README.md) + +# SetReplaceMethodImplementation + +**`SetReplaceMethodImplementation`** represents a (usually internal) implementation of either a translation or a +property. It has the implementation symbol as the only argument. + +It is used in vertex names of [`$SetReplaceTypeGraph`]($SetReplaceTypeGraph.md). diff --git a/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceProperty.md b/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceProperty.md new file mode 100644 index 000000000..97e7e0b53 --- /dev/null +++ b/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceProperty.md @@ -0,0 +1,7 @@ +###### [Symbols and Functions](/README.md#symbols-and-functions) > [Type System](README.md) + +# SetReplaceProperty + +**`SetReplaceProperty`** represents a *SetReplace* property. It has the property symbol as its single argument. + +It is used in vertex names of [`$SetReplaceTypeGraph`]($SetReplaceTypeGraph.md). diff --git a/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceType.md b/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceType.md new file mode 100644 index 000000000..b9f548cef --- /dev/null +++ b/Documentation/SymbolsAndFunctions/TypeSystem/SetReplaceType.md @@ -0,0 +1,7 @@ +###### [Symbols and Functions](/README.md#symbols-and-functions) > [Type System](README.md) + +# SetReplaceType + +**`SetReplaceType`** represents a *SetReplace* type. It has the type specification as its single argument. + +It is used in vertex names of [`$SetReplaceTypeGraph`]($SetReplaceTypeGraph.md). diff --git a/Kernel/A2$style.m b/Kernel/A0$style.m similarity index 91% rename from Kernel/A2$style.m rename to Kernel/A0$style.m index 4ecc2f4dc..460ed8013 100644 --- a/Kernel/A2$style.m +++ b/Kernel/A0$style.m @@ -12,6 +12,15 @@ PackageScope["$lightTheme"] +PackageScope["$typeVertexStyle"] +PackageScope["$typeVertexSize"] +PackageScope["$propertyVertexStyle"] +PackageScope["$propertyVertexSize"] +PackageScope["$methodImplementationVertexStyle"] +PackageScope["$methodImplementationVertexSize"] +PackageScope["$typeGraphEdgeStyle"] +PackageScope["$typeGraphLayout"] +PackageScope["$typeGraphBackground"] PackageScope["$evolutionObjectIcon"] PackageScope["$destroyedEdgeStyle"] PackageScope["$createdEdgeStyle"] @@ -81,6 +90,17 @@ ]; $styleNames = KeySort /@ KeySort @ <| + "TypeGraph" -> <| + "TypeVertexStyle" -> $typeVertexStyle, + "TypeVertexSize" -> $typeVertexSize, + "PropertyVertexStyle" -> $propertyVertexStyle, + "PropertyVertexSize" -> $propertyVertexSize, + "MethodImplementationVertexStyle" -> $methodImplementationVertexStyle, + "MethodImplementationVertexSize" -> $methodImplementationVertexSize, + "EdgeStyle" -> $typeGraphEdgeStyle, + "GraphLayout" -> $typeGraphLayout, + "Background" -> $typeGraphBackground + |>, "EvolutionObject" -> <|"Icon" -> $evolutionObjectIcon|>, "SpatialGraph" -> <| "DestroyedEdgeStyle" -> $destroyedEdgeStyle, @@ -213,6 +233,17 @@ $WolframPhysicsProjectPlotThemes = $SetReplacePlotThemes; style[$lightTheme] = <| + (* Type graph *) + $typeVertexStyle -> RGBColor[0.034, 0.30, 0.42], + $typeVertexSize -> Medium, + $propertyVertexStyle -> RGBColor[0.77, 0.83, 0.82], + $propertyVertexSize -> Medium, + $methodImplementationVertexStyle -> Black, + $methodImplementationVertexSize -> Small, + $typeGraphEdgeStyle -> GrayLevel[0.125], + $typeGraphLayout -> "SpringElectricalEmbedding", + $typeGraphBackground -> None, + (* Evolution object *) $evolutionObjectIcon -> $graphIcon, diff --git a/Kernel/A1$typeSystem.m b/Kernel/A1$typeSystem.m index db1f640c6..4cd0a2670 100644 --- a/Kernel/A1$typeSystem.m +++ b/Kernel/A1$typeSystem.m @@ -7,6 +7,11 @@ PackageExport["SetReplaceObjectQ"] PackageExport["$SetReplaceTypes"] PackageExport["$SetReplaceProperties"] +PackageExport["$SetReplaceTypeGraph"] + +PackageExport["SetReplaceType"] +PackageExport["SetReplaceProperty"] +PackageExport["SetReplaceMethodImplementation"] PackageScope["declareTypeTranslation"] PackageScope["declareRawProperty"] @@ -16,6 +21,20 @@ PackageScope["initializeTypeSystem"] +(* SetReplaceType and SetReplaceProperty should be public because they are returned by SetReplaceTypeGraph. *) + +SetUsage @ " +SetReplaceType[type$] represents a SetReplace type$. +"; + +SyntaxInformation[SetReplaceType] = {"ArgumentsPattern" -> {type_}}; + +SetUsage @ " +SetReplaceProperty[property$] represents a SetReplace property$. +"; + +SyntaxInformation[SetReplaceProperty] = {"ArgumentsPattern" -> {property_}}; + (* Object classes (like Multihistory) are expected to define their own objectType[...] implementation. This one is triggered if no other is found. *) @@ -57,14 +76,10 @@ (* Type translation functions can throw failure objects, in which case a message will be generated with a name corresponding to the Failure's type, and the keys passed to the message template. *) -SetUsage @ " -$SetReplaceTypes gives the list of all types defined in SetReplace. -"; - $translations = {}; declareTypeTranslation[function_, fromType_, toType_] := - AppendTo[$translations, {function, type[fromType], type[toType]}]; + AppendTo[$translations, {function, SetReplaceType[fromType], SetReplaceType[toType]}]; (* This function is called after all declarations to combine translations to a Graph to allow multi-step conversions. *) @@ -102,8 +117,9 @@ typeConvert[toType_][object_] := ModuleScope[ fromType = objectType[object]; - If[!VertexQ[$typeGraph, type[#]], throw[Failure["unconvertibleType", <|"type" -> #|>]]] & /@ {fromType, toType}; - path = FindShortestPath[$typeGraph, type[fromType], type[toType]]; + If[!VertexQ[$typeGraph, SetReplaceType[#]], throw[Failure["unconvertibleType", <|"type" -> #|>]]] & /@ + {fromType, toType}; + path = FindShortestPath[$typeGraph, SetReplaceType[fromType], SetReplaceType[toType]]; If[path === {} && toType =!= fromType, throw[Failure["noConversionPath", <|"from" -> fromType, "to" -> toType|>]]; ]; @@ -119,14 +135,10 @@ toProperty will need to be called as toProperty[args___][object_] or toProperty[object_, args___] where object can be of any type convertable to the implemented one. *) -SetUsage @ " -$SetReplaceProperties gives the list of all properties defined in SetReplace. -"; - $rawProperties = {}; declareRawProperty[implementationFunction_, fromType_, toProperty_Symbol] := - AppendTo[$rawProperties, {implementationFunction, type[fromType], property[toProperty]}]; + AppendTo[$rawProperties, {implementationFunction, SetReplaceType[fromType], SetReplaceProperty[toProperty]}]; (* This function is called after all declarations to combine implementations to a Graph to allow multi-step conversions and to define DownValues for all property symbols. *) @@ -136,7 +148,7 @@ $propertyEvaluationFunctions = AssociationThread[newEdges -> (First /@ $rawProperties)]; $typeGraph = EdgeAdd[$typeGraph, Keys[$propertyEvaluationFunctions]]; - defineDownValuesForProperty /@ First /@ VertexList[$typeGraph, _property]; + defineDownValuesForProperty /@ First /@ VertexList[$typeGraph, _SetReplaceProperty]; ]; (* declareCompositeProperty declares an implementation for a property that takes other properties as arguments. The @@ -166,9 +178,57 @@ freeFromInternalSymbolsQ[expr_] := NoneTrue[Context /@ Cases[expr, _Symbol, {0, Infinity}, Heads -> True], StringMatchQ[#, "SetReplace`" ~~ __] &]; -initializeConstants[] := +SetUsage @ " +$SetReplaceTypes gives the list of all types defined in SetReplace. +"; + +SetUsage @ " +$SetReplaceProperties gives the list of all properties defined in SetReplace. +"; + +initializeTypeAndPropertyLists[] := {$SetReplaceTypes, $SetReplaceProperties} = - Select[freeFromInternalSymbolsQ] /@ (Sort[First /@ VertexList[$typeGraph, #]] &) /@ {_type, _property}; + Sort @ Select[freeFromInternalSymbolsQ][First /@ VertexList[$typeGraph, #]] & /@ + {_SetReplaceType, _SetReplaceProperty}; + +SetUsage @ " +$SetReplaceTypeGraph gives the Graph of types and properties implemented in SetReplace. +"; + +SetUsage @ " +SetReplaceMethodImplementation[symbol$] represents an implementation of a SetReplace method, such as a translation or \ +property. +"; + +SyntaxInformation[SetReplaceMethodImplementation] = {"SetReplaceMethodImplementation" -> {symbol_}}; + +typeGraphVertexLabel[kind_, name_] := + If[!freeFromInternalSymbolsQ[name] || kind === SetReplaceMethodImplementation, Placed[#, Tooltip] &, Identity] @ + If[kind === SetReplaceProperty, ToString[#] <> "[\[Ellipsis]]" &, Identity] @ + name; + +insertImplementationVertex[inputEdge : DirectedEdge[from_, to_]] := ModuleScope[ + implementationSource = If[MatchQ[to, _SetReplaceProperty], $propertyEvaluationFunctions, $translationFunctions]; + {DirectedEdge[from, SetReplaceMethodImplementation[implementationSource[inputEdge]]], + DirectedEdge[SetReplaceMethodImplementation[implementationSource[inputEdge]], to]} +]; + +initializePublicTypeGraph[] := Module[{extendedGraphEdges}, + extendedGraphEdges = Catenate[insertImplementationVertex /@ EdgeList[$typeGraph]]; + $SetReplaceTypeGraph = Graph[ + DirectedEdge @@@ extendedGraphEdges, + VertexLabels -> kind_[name_] :> typeGraphVertexLabel[kind, name], + VertexStyle -> {_SetReplaceType -> style[$lightTheme][$typeVertexStyle], + _SetReplaceProperty -> style[$lightTheme][$propertyVertexStyle], + _SetReplaceMethodImplementation -> style[$lightTheme][$methodImplementationVertexStyle]}, + VertexSize -> {_SetReplaceType -> style[$lightTheme][$typeVertexSize], + _SetReplaceProperty -> style[$lightTheme][$propertyVertexSize], + _SetReplaceMethodImplementation -> style[$lightTheme][$methodImplementationVertexSize]}, + EdgeStyle -> style[$lightTheme][$typeGraphEdgeStyle], + GraphLayout -> style[$lightTheme][$typeGraphLayout], + Background -> style[$lightTheme][$typeGraphBackground], + PerformanceGoal -> "Quality"] +]; (* This function is called in init.m after all other files are loaded. *) @@ -176,7 +236,8 @@ initializeTypeSystemTranslations[]; initializeRawProperties[]; initializeCompositeProperties[]; - initializeConstants[]; + initializeTypeAndPropertyLists[]; + initializePublicTypeGraph[]; ); (* defineDownValuesForProperty defines both the operator form and the normal form for a property symbol. The DownValues @@ -232,8 +293,8 @@ case a property is used not as an operator form (in which case expected and actu propertyImplementation[publicProperty][args___][object_] := ModuleScope[ fromType = objectType[object]; - If[!VertexQ[$typeGraph, type[fromType]], throw[Failure["unknownType", <|"type" -> fromType|>]]]; - path = FindShortestPath[$typeGraph, type[fromType], property[publicProperty]]; + If[!VertexQ[$typeGraph, SetReplaceType[fromType]], throw[Failure["unknownType", <|"type" -> fromType|>]]]; + path = FindShortestPath[$typeGraph, SetReplaceType[fromType], SetReplaceProperty[publicProperty]]; If[path === {}, throw[Failure["noPropertyPath", <|"type" -> fromType, "property" -> publicProperty|>]]; ]; diff --git a/Tests/typeSystem.wlt b/Tests/typeSystem.wlt index c211ca63c..938b48e38 100644 --- a/Tests/typeSystem.wlt +++ b/Tests/typeSystem.wlt @@ -72,11 +72,13 @@ realDescription[][real_Real] := "I am a real " <> ToString[real] <> "."; realDescription[args__][_] := throwInvalidPropertyArgumentCount[0, Length[{args}]]; + Unprotect[$SetReplaceTypeGraph]; Unprotect[$SetReplaceProperties]; Unprotect[$SetReplaceTypes]; initializeTypeSystem[]; Protect[$SetReplaceTypes]; Protect[$SetReplaceProperties]; + Protect[$SetReplaceTypeGraph]; ), "tests" -> { (* Type and property lists *) @@ -85,6 +87,17 @@ VerificationTest[$SetReplaceTypes, Sort @ {"String", "Expression", "HalfInteger", "EvenInteger", "Real"}], VerificationTest[$SetReplaceProperties, Sort @ {description, multipliedHalf}], + VerificationTest[GraphQ @ $SetReplaceTypeGraph], + VerificationTest[ContainsOnly[Head /@ VertexList[$SetReplaceTypeGraph], + {SetReplaceType, SetReplaceProperty, SetReplaceMethodImplementation}]], + VerificationTest[ + Cases[ + EdgeList[$SetReplaceTypeGraph], + Except[ + DirectedEdge[_SetReplaceType | _SetReplaceProperty, _SetReplaceMethodImplementation] | + DirectedEdge[_SetReplaceMethodImplementation, _SetReplaceType | _SetReplaceProperty]]], + {}], + (* Type querying *) VerificationTest[SetReplaceObjectType[evenInteger[4]], "EvenInteger"], VerificationTest[SetReplaceObjectType[2.4], "Real"],