packages feed

graph-rewriting-ski 0.5.7 → 0.6.1

raw patch · 7 files changed

+104/−82 lines, 7 filesdep ~basedep ~graph-rewritingdep ~graph-rewriting-gl

Dependency ranges changed: base, graph-rewriting, graph-rewriting-gl, graph-rewriting-layout

Files

Direct/Graph.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances #-} module Direct.Graph where  import Data.View@@ -48,7 +49,7 @@ compile ∷ Term.Expr → Rewrite SKI Edge compile term = do 	e ← newEdge-	case term of+	_ ← case term of 		Term.A f x → do 			ef ← compile f 			ex ← compile x
Direct/Main.hs view
@@ -33,7 +33,7 @@ 		sf ← springForce 1.5 n 		rot ← angularMomentum n 		return (cgf, cf, sf, rot)-	Unsafe.adjustNode (Position . sf (*0.9) . cgf (*0.01) . cf (\x → min (100/(x^2+0.1)) 10) . position) n+	Unsafe.adjustNode n $ Position . sf (*0.9) . cgf (*0.01) . cf (\x → min (100/(x^2+0.1)) 10) . position 	-- Unsafe.adjustNode (rot (*0.9)) n  ruleTree = Branch "All"
Direct/Rules.hs view
@@ -1,82 +1,87 @@+{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-} module Direct.Rules where  import Prelude.Unicode+import Data.Monoid.Unicode import Direct.Graph import GraphRewriting+import Control.Applicative   -- <chunk: rules> ruleS ∷ (View [Port] n, View SKI n) ⇒ Rule n  ruleS = do 	S {inp = si} ← node-	Applicator {inp = i1, out1 = o1, out2 = f} ← nodeAt si+	Applicator {inp = i1, out1 = o1, out2 = f} ← nodeWith si 	require (si ≡ o1)-	Applicator {inp = i2, out1 = o2, out2 = g} ← nodeAt i1+	Applicator {inp = i2, out1 = o2, out2 = g} ← nodeWith i1 	require (i1 ≡ o2)-	Applicator {inp = i3, out1 = o3, out2 = x} ← nodeAt i2+	Applicator {inp = i3, out1 = o3, out2 = x} ← nodeWith i2 	require (i2 ≡ o3)-	replace4 $ \l r lr rr →-		[Node $ Applicator {inp = i3, out1 = l, out2 = r},-		 Node $ Applicator {inp = l, out1 = f, out2 = lr},-		 Node $ Applicator {inp = r, out1 = g, out2 = rr},-		 Node $ Duplicator {inp1 = lr, inp2 = rr, out = x}]+	replace $ do+		(l,r,lr,rr) ← (,,,) <$> byEdge <*> byEdge <*> byEdge <*> byEdge+		byNode Applicator {inp = i3, out1 = l, out2 = r}+		byNode Applicator {inp = l, out1 = f, out2 = lr}+		byNode Applicator {inp = r, out1 = g, out2 = rr}+		byNode Duplicator {inp1 = lr, inp2 = rr, out = x}  -- <chunk: ruleK> ruleK ∷ (View [Port] n, View SKI n) ⇒ Rule n  ruleK = do 	K {inp = si} ← node-	Applicator {inp = i1, out1 = o1, out2 = x} ← nodeAt si+	Applicator {inp = i1, out1 = o1, out2 = x} ← nodeWith si 	require (si ≡ o1)-	Applicator {inp = i2, out1 = o2, out2 = y} ← nodeAt i1+	Applicator {inp = i2, out1 = o2, out2 = y} ← nodeWith i1 	require (i1 ≡ o2)-	replace0 [Wire x i2, Node $ Eraser {inp = y}]+	replace $ byWire x i2 ⊕ byNode Eraser {inp = y} -- </chunk: ruleK>  ruleI ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleI = do 	I {inp = iI} ← node-	Applicator {inp = iA, out2 = o2} ← nodeAt iI-	require (iI ≡ iA)+	Applicator {inp = iA, out1 = o1, out2 = o2} ← nodeWith iI+	require (iI ≡ o1) 	rewire [[iA,o2]]  combinatorAt ∷ (View [Port] n, View SKI n) ⇒ Edge → Pattern n SKI combinatorAt e = anyOf [s,k,i] where-	s = do {s@S {} ← nodeAt e; return s}-	k = do {k@K {} ← nodeAt e; return k}-	i = do {i@I  {} ← nodeAt e; return i}+	s = do {s@S {} ← nodeWith e; return s}+	k = do {k@K {} ← nodeWith e; return k}+	i = do {i@I  {} ← nodeWith e; return i}  duplicateCombinator  ∷ (View [Port] n, View SKI n) ⇒ Rule n duplicateCombinator = do 	Duplicator {inp1 = i1, inp2 = i2, out = o} ← node 	c ← combinatorAt o-	replace0 [Node $ c {inp = i1}, Node $ c {inp = i2}]+	replace $ byNode c {inp = i1} ⊕ byNode c {inp = i2}  duplicateApp ∷ (View [Port] n, View SKI n) ⇒ Rule n  duplicateApp = do 	Duplicator {inp1 = i1, inp2 = i2, out = o} ← node-	Applicator {inp = i, out1 = o1, out2 = o2} ← nodeAt o-	replace4 $ \l lr rl r →-		[Node $ Applicator {inp = i1, out1 = l, out2 = lr},-		 Node $ Applicator {inp = i2, out1 = rl, out2 = r},-		 Node $ Duplicator {inp1 = l, inp2 = rl, out = o1},-		 Node $ Duplicator {inp1 = lr, inp2 = r, out = o2}]+	Applicator {inp = i, out1 = o1, out2 = o2} ← nodeWith o+	replace $ do+		(l,lr,rl,r) ← (,,,) <$> byEdge <*> byEdge <*> byEdge <*> byEdge+		byNode Applicator {inp = i1, out1 = l, out2 = lr}+		byNode Applicator {inp = i2, out1 = rl, out2 = r}+		byNode Duplicator {inp1 = l, inp2 = rl, out = o1}+		byNode Duplicator {inp1 = lr, inp2 = r, out = o2}  eraseCombinator ∷ (View [Port] n, View SKI n) ⇒ Rule n  eraseCombinator = do 	Eraser {inp = i} ← node-	combinatorAt i+	_ ← combinatorAt i 	erase  eraseApp ∷ (View [Port] n, View SKI n) ⇒ Rule n  eraseApp = do 	Eraser {inp = i} ← node-	Applicator {out1 = o1, out2 = o2} ← nodeAt i-	replace0 [Node $ Eraser {inp = o1}, Node $ Eraser {inp = o2}]+	Applicator {out1 = o1, out2 = o2} ← nodeWith i+	replace $ byNode Eraser {inp = o1} ⊕ byNode Eraser {inp = o2}  eliminate ∷ (View [Port] n, View SKI n) ⇒ Rule n eliminate = do 	Eraser {inp = iE} ← node-	Duplicator {out = oD, inp1 = i1, inp2 = i2} ← neighbour =<< previous+	Duplicator {out = oD, inp1 = i1, inp2 = i2} ← nodeWith iE 	require (iE ≡ i1 ∨ iE ≡ i2) 	if iE ≡ i1 		then rewire [[oD,i2]]
INet/Graph.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE UnicodeSyntax, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, UndecidableInstances #-} -- To understand how to use the graph-rewriting library this module is a good point to start reading. Some fundamentals are covered in the documentation of the "GraphRewriting" module. module INet.Graph where @@ -8,6 +9,7 @@ import GraphRewriting.Pattern.InteractionNet -- This module specifies the term representation of an SKI expression (abstract syntax tree)  import qualified Common.Term as Term+import Control.Monad (void)   -- The signature of the graph is determined by the node type we provide. For each node constructor we define as record fields a fixed collection of ports. Here we name ports attached at the top of the nodes input ports and nodes at the bottom output ports.@@ -56,19 +58,19 @@ 		S2 {} → ski {inp = i, out1 = o1, out2 = o2} where [i,o1,o2] = ports  -- Since we want to make use of interaction net reductions (using the 'activePair' pattern) we need to specify the principal port for each node type in the form of an index into the port list above.-instance INet SKI where-	principalPort ski = case ski of-		R {out = o}                        → 0-		A {inp = i, out1 = o1, out2 = o2}  → 1-		I {inp = i}                        → 0-		E {inp = i}                        → 0-		D {inp1 = i1, inp2 = i2, out = o}  → 2-		V {inp = i}                        → 0-		K0 {inp = i}                       → 0-		K1 {inp = i, out = o}              → 0-		S0 {inp = i}                       → 0-		S1 {inp = i, out = o}              → 0-		S2 {inp = i, out1 = o1, out2 = o2} → 0+instance View SKI n ⇒ INet n where+	principalPort n = case inspect n of+		R {out = o}                        → o+		A {inp = i, out1 = o1, out2 = o2}  → o1+		I {inp = i}                        → i+		E {inp = i}                        → i+		D {inp1 = i1, inp2 = i2, out = o}  → o+		V {inp = i}                        → i+		K0 {inp = i}                       → i+		K1 {inp = i, out = o}              → i+		S0 {inp = i}                       → i+		S1 {inp = i, out = o}              → i+		S2 {inp = i, out1 = o1, out2 = o2} → i  -- In "Term" a little SKI term parser is given. The code below implements a small compiler that translates the abstract syntax tree into a graph. Here you can see how primitive graph transformation functions like 'newNode' and 'newEdge' can be used to build a graph inside the 'GraphRewriting.Graph.Rewrite' monad. Also it shows how an edge can be attached to a node's port, simply by assigning it to the corresponding record field. fromTerm ∷ Term.Expr → Graph SKI@@ -79,7 +81,7 @@ compile ∷ Term.Expr → Rewrite SKI Edge compile term = do 	e ← newEdge-	case term of+	void $ case term of 		Term.A f x → do 			ef ← compile f 			ex ← compile x
INet/Main.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE UnicodeSyntax, FlexibleInstances #-} -- Given the graph signature in INet/Graph.hs, the rewrite rules in INet/Rules.hs and the layouting information and rendering code in INet/GL.hs we can tie it together to obtain an interactive, graphical application to see our rewriting system in action. module Main where @@ -44,7 +45,7 @@ 		rot ← angularMomentum n    -- this tries to rotate nodes such that the angular forces exercised by the edges upon the nodes are minimised. 		return (cgf, cf, sf, rot) 	-- combine all the forces specifying for each of them a function that maps the distance the force bridges to a strength.-	Unsafe.adjustNode (Position . sf (*0.9) . cgf (*0.01) . cf (\x → min (100/(x^2+0.1)) 10) . position) n+	Unsafe.adjustNode n $ Position . sf (*0.9) . cgf (*0.01) . cf (\x → min (100/(x^2+0.1)) 10) . position 	-- We do not rotate our nodes here, since an SKI combinator graph can nicely be drawn top-down. Uncomment, if you like. 	-- Unsafe.adjustNode (rot (*0.9)) n
INet/Rules.hs view
@@ -1,7 +1,10 @@+{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-} -- Now we are going to specify rewriting rules that implement the SKI combinator reductions. Refer to the module decumentation of GraphRewriting.Pattern and GraphRewriting.Rule for more detailed information about the functions used here. module INet.Rules where  import Prelude.Unicode+import Data.Monoid.Unicode+import Control.Applicative import INet.Graph import GraphRewriting import GraphRewriting.Pattern.InteractionNet -- This gives us the 'activePair' pattern.@@ -17,37 +20,38 @@ ruleK0 ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleK0 = do 	K0 {} :-: A  {inp = iA, out2 = o2} ← activePair-	replace0 [Node $ K1 {inp = iA, out = o2}]+	replace $ byNode K1 {inp = iA, out = o2}  -- The 'replace*' functions can be used replace the matched nodes by a combination of new nodes and rewirings, hence the constructors 'Wire' and 'Node'. ruleK1 ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleK1 = do 	K1 {out = oK} :-: A {inp = iA, out2 = o2A} ← activePair-	replace0 [Wire iA oK, Node $ E {inp = o2A}]+	replace $ byWire iA oK ⊕ byNode E {inp = o2A}  ruleS0 ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleS0 = do 	S0 {} :-: A {inp = iA, out2 = o2A} ← activePair-	replace0 [Node $ S1 {inp = iA, out = o2A}]+	replace $ byNode S1 {inp = iA, out = o2A}  ruleS1 ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleS1 = do 	S1 {out = oS} :-: A {inp = iA, out2 = o2A} ← activePair-	replace0 [Node $ S2 {inp = iA, out1 = oS, out2 = o2A}]+	replace $ byNode S2 {inp = iA, out1 = oS, out2 = o2A}  -- If we need new edges for the right-hand side of the rewrite rule you can use 'replaceN' with N > 0. ruleS2 ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleS2 = do 	S2 {inp = iS, out1 = oS1, out2 = o2S} :-: a@A {out1 = o1A, out2 = o2A} ← activePair-	replace3 $ \i1D iB i2D →-		[Node $ A {inp = iS, out1 = oS1, out2 = i1D},-		 Node $ a {out2 = iB},-		 Node $ D {inp1 = i1D, inp2 = i2D, out = o2A},-		 Node $ A {inp = iB, out1 = o2S, out2 = i2D}]+	replace $ do+		(i1D,iB,i2D) ← (,,) <$> byEdge <*> byEdge <*> byEdge+		byNode A {inp = iS, out1 = oS1, out2 = i1D}+		byNode a {out2 = iB}+		byNode D {inp1 = i1D, inp2 = i2D, out = o2A}+		byNode A {inp = iB, out1 = o2S, out2 = i2D}  -- This is an abstraction to match any active pair that involves a node with arity 0. arity0 ∷ (View [Port] n, View SKI n) ⇒ Pattern n (Pair SKI)-arity0 = anyOf [i,k,s] where+arity0 = i <|> k <|> s where 	i = do {pair@(n :-: I  {}) ← activePair; return pair} 	k = do {pair@(n :-: K0 {}) ← activePair; return pair} 	s = do {pair@(n :-: S0 {}) ← activePair; return pair}@@ -66,40 +70,42 @@ ruleE1 ∷ (View [Port] n, View SKI n) ⇒ Rule n  ruleE1 = do 	E {} :-: n ← arity1-	replace0 [Node $ E {inp = out n}]+	replace $ byNode E {inp = out n} 	 ruleE2 ∷ (View [Port] n, View SKI n) ⇒ Rule n  ruleE2 = do 	E {inp = iE} :-: S2 {inp = iS, out1 = o1, out2 = o2} ← activePair-	replace0 [Node $ E {inp = o1}, Node E {inp = o2}]+	replace $ byNode E {inp = o1} ⊕ byNode E {inp = o2}  ruleD0  ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleD0 = do 	D {inp1 = iD1, inp2 = iD2, out = oD} :-: n ← arity0-	replace0 [Node $ n {inp = iD1}, Node $ n {inp = iD2}]+	replace $ byNode n {inp = iD1} ⊕ byNode n {inp = iD2}  ruleD1  ∷ (View [Port] n, View SKI n) ⇒ Rule n ruleD1 = do 	D {inp1 = iD1, inp2 = iD2, out = oD} :-: n ← arity1-	replace2 $ \iD1' iD2' →-		[Node $ n {inp = iD1, out = iD1'},-		 Node $ n {inp = iD2, out = iD2'},-		 Node $ D {inp1 = iD1', inp2 = iD2', out = out n}]+	replace $ do+		(iD1',iD2') ← (,) <$> byEdge <*> byEdge+		byNode n {inp = iD1, out = iD1'}+		byNode n {inp = iD2, out = iD2'}+		byNode D {inp1 = iD1', inp2 = iD2', out = out n} 	 ruleD2 ∷ (View [Port] n, View SKI n) ⇒ Rule n  ruleD2 = do 	D {inp1 = iD1, inp2 = iD2, out = oD} :-: S2 {inp = iS, out1 = o1, out2 = o2} ← activePair-	replace4 $ \l1 l2 x1 x2 →-		[Node $ S2 {inp = iD1, out1 = l1, out2 = x1},-		 Node $ S2 {inp = iD2, out1 = x2, out2 = l2},-		 Node $ D {inp1 = l1, inp2 = x2, out = o1},-		 Node $ D {inp1 = x1, inp2 = l2, out = o2}]+	replace $ do+		(l1,l2,x1,x2) ← (,,,) <$> byEdge <*> byEdge <*> byEdge <*> byEdge+		byNode S2 {inp = iD1, out1 = l1, out2 = x1}+		byNode S2 {inp = iD2, out1 = x2, out2 = l2}+		byNode D {inp1 = l1, inp2 = x2, out = o1}+		byNode D {inp1 = x1, inp2 = l2, out = o2}  -- Here is the only rule that is not an interaction-net reduction, hence it does not rely on the 'activePair' pattern. First we match on an eraser node anywhere in the graph. Next we require a duplicator node that is connected to the eraser. Therefore we use the 'previous' pattern that returns a reference to the previously matched node and feed it to the 'neighbour' function that matches on nodes connected to the referenced node. eliminate ∷ (View [Port] n, View SKI n) ⇒ Rule n eliminate = do 	E {inp = iE} ← node-	D {out = oD, inp1 = i1, inp2 = i2} ← neighbour =<< previous+	D {out = oD, inp1 = i1, inp2 = i2} ← nodeWith iE 	require (iE ≡ i1 ∨ iE ≡ i2) 	if iE ≡ i1 		then rewire [[oD,i2]]
graph-rewriting-ski.cabal view
@@ -1,5 +1,5 @@ Name:           graph-rewriting-ski-Version:        0.5.7+Version:        0.6.1 Copyright:      (c) 2010, Jan Rochel License:        BSD3 License-File:   LICENSE@@ -10,37 +10,44 @@ Build-Type:     Simple Synopsis:       Two implementations of the SKI combinators as interactive graph rewrite systems Description:    This package serves as an example for how to use the graph-rewriting, graph-rewriting-layout, and graph-rewriting-gl packages to create a graph rewriting system with an interactive, graphical front-end. The SKI combinator calculus is implemented once as an interaction net with combinators that accumulate their arguments, and once in a more direct manner. The sources (of the interaction net implementation) are well documented and serve as a tutorial for implementing your own rewrite system. Start reading in INet/Graph.hs. To run the program run either the "ski-inet" or the "ski-direct" with one of the files from the "examples" directory as an argument. For usage of the GUI see "GraphRewriting.GL.UI".-Category:       Graphs, Application+Category:       Compilers/Interpreters, Application Cabal-Version:  >= 1.6 Data-Files:     examples/*.ski examples/combinator_birds/*.ski -Library-  Build-Depends:-    base >= 4 && < 4.5,-    base-unicode-symbols >= 0.2 && < 0.3,-    graph-rewriting >= 0.4.4 && < 0.6,-    graph-rewriting-layout >= 0.4.2 && < 0.5,-    graph-rewriting-gl >= 0.6.5 && < 0.7,-    parsec >= 2.1 && < 2.2,-    GLUT >= 2.2 && < 2.3,-    OpenGL >= 2.4 && < 2.5- Executable ski-inet   Main-Is:        INet/Main.hs-  GHC-Options:    -fno-warn-duplicate-exports+  GHC-Options:    -fno-warn-duplicate-exports -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-unrecognised-pragmas   Other-Modules:  Common.GL INet.GL INet.Graph INet.Rules Common.Term   Extensions:     UnicodeSyntax     FlexibleInstances     FlexibleContexts     MultiParamTypeClasses+  Build-Depends:+    base >= 4.3 && < 4.6,+    base-unicode-symbols >= 0.2 && < 0.3,+    graph-rewriting >= 0.7 && < 0.8,+    graph-rewriting-layout >= 0.5 && < 0.6,+    graph-rewriting-gl >= 0.6.9 && < 0.8,+    parsec >= 2.1 && < 2.2,+    GLUT >= 2.2 && < 2.3,+    OpenGL >= 2.4 && < 2.5  Executable ski-direct   Main-Is:        Direct/Main.hs-  GHC-Options:    -fno-warn-duplicate-exports+  GHC-Options:    -fno-warn-duplicate-exports -fwarn-unused-binds -fwarn-unused-imports -fwarn-unused-do-bind -fwarn-wrong-do-bind -fwarn-unrecognised-pragmas   Other-Modules:  Common.GL Direct.GL Direct.Graph Direct.Rules Common.Term   Extensions:     UnicodeSyntax     FlexibleInstances     FlexibleContexts     MultiParamTypeClasses+  Build-Depends:+    base >= 4.3 && < 4.5,+    base-unicode-symbols >= 0.2 && < 0.3,+    graph-rewriting >= 0.7 && < 0.8,+    graph-rewriting-layout >= 0.5 && < 0.6,+    graph-rewriting-gl >= 0.6.9 && < 0.8,+    parsec >= 2.1 && < 2.2,+    GLUT >= 2.2 && < 2.3,+    OpenGL >= 2.4 && < 2.5