graph-rewriting-trs 0.1.3 → 0.1.4

raw patch · 9 files changed

+61/−77 lines, 9 filesdep ~GLUTdep ~OpenGLdep ~base

Dependency ranges changed: GLUT, OpenGL, base, filepath, graph-rewriting, graph-rewriting-gl, graph-rewriting-layout, uu-parsinglib

Files

• GL.hs +1/−6
• Graph.hs +1/−1
• Main.hs +3/−3
• Rules.hs +5/−11
• TermRewriting.hs +30/−39
• examples/add.trs +4/−0
• examples/mul.trs +5/−0
• examples/quot_min.trs +0/−6
• graph-rewriting-trs.cabal +12/−11

@@ -43,9 +43,4 @@  drawNode label = do 	GL.renderPrimitive GL.LineLoop (circle 1 1 20)-	drawString label--drawString label = GL.preservingMatrix $ do-	GL.translate $ vector2 (-0.3,-0.3)-	GL.scale 0.0065 0.0065 (0 ∷ GL.GLdouble)-	GL.renderString GL.MonoRoman label+	renderString label

@@ -30,7 +30,7 @@ compile ∷ Term → Rewrite Vertex Edge compile term = do 	e ← newEdge-	case term of+	_ ← case term of 		Var v → newNode Variable {inp = e, name = v} 		App f x → do 			ef ← compile f

@@ -25,7 +25,7 @@  instance Render (Wrapper Vertex) where render = render . wrappee -parseFiles ∷ (View Vertex n, View [Port] n) ⇒ Set FilePath → Set FilePath → IO [LabeledTree (Rule n)]+parseFiles ∷ (View Vertex n, View [Port] n) ⇒ Set FilePath → Set FilePath → IO [LabelledTree (Rule n)] parseFiles done todo = if Set.null todo 	then return [Branch "Beaurocratic" [Leaf "Erase" eraseRule, Leaf "Unshare" unshare]] 	else let f = Set.findMin todo in do@@ -34,7 +34,7 @@ 		let todo' = Set.union todo imports `Set.difference` done' 		liftM (branch:) (parseFiles done' todo') -parseFile ∷ (View Vertex n, View [Port] n) ⇒ FilePath → IO (Set FilePath, LabeledTree (Rule n))+parseFile ∷ (View Vertex n, View [Port] n) ⇒ FilePath → IO (Set FilePath, LabelledTree (Rule n)) parseFile f = do 	((imports,rules),parseErrors) ← liftM (parse ruleset) (readFile f) 	when (not $ null parseErrors) $ do@@ -74,4 +74,4 @@ 		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.modifyNode n $ adjust $ Position . sf (*0.9) . cgf (*0.01) . cf (\x → min (100/(x^2+0.1)) 10) . position

@@ -1,14 +1,9 @@-{-# LANGUAGE UnicodeSyntax, FlexibleContexts #-}+{-# LANGUAGE UnicodeSyntax, FlexibleContexts, ScopedTypeVariables #-} module Rules where  import Prelude.Unicode import Graph import GraphRewriting-import GraphRewriting.Graph.Read-import GraphRewriting.Graph.Write-import GraphRewriting.Graph.Write.Unsafe as Unsafe-import Control.Monad (liftM, replicateM)-import Data.Maybe (catMaybes)   unshare ∷ (View [Port] n, View Vertex n) ⇒ Rule n@@ -16,18 +11,17 @@ 	e ← edge 	c ← liftReader $ edgeCardinality e 	require (c > 2)-	v ← nodeAt e+	v ← nodeWith e 	require (e ≡ inp v) 	rewrite $ \[n] → do 		es ← deleteEdge e 		v' ← inspectNode n-		mapM (copyNode n) [v {inp = i} | i ← es, i ≢ inp v']+		mapM_ (copyNode n) [v {inp = i} | i ← es, i ≢ inp v'] 		deleteNode n  eraseRule ∷ (View [Port] n, View Vertex n) ⇒ Rule n eraseRule = do 	e ← edge-	c ← liftReader $ edgeCardinality e-	require (c ≡ 1)-	nodeAt e ∷ View Vertex n ⇒ Pattern n Vertex+	requireM $ liftReader $ dangling e+	_ ∷ [Port] ← nodeWith e 	erase

@@ -3,11 +3,8 @@  import Prelude.Unicode import GraphRewriting-import GraphRewriting.Pattern-import GraphRewriting.Graph.Read-import GraphRewriting.Graph.Write import Data.Char (isLower)-import Control.Monad+import Control.Applicative import Data.Map (Map) import qualified Data.Map as Map import Term@@ -18,42 +15,36 @@  buildRule ∷ (View Vertex n, View [Port] n) ⇒ Term → Term → Rule n buildRule lhs rhs = do-	(inc, varMap) ← buildLHS lhs-	buildRHS varMap rhs inc--buildLHS ∷ (View Vertex n, View [Port] n) ⇒ Term → Pattern n (Edge, VarMap)-buildLHS term = do-	e ← edge-	varMap ← build term e-	return (e, varMap)-	where build term inc = case term of-		Var v | isLower v → return $ Map.singleton v inc-		Var v | otherwise → do-			c ← liftReader (edgeCardinality inc)-			require (c ≡ 2)-			Variable {name = n} ← nodeAt inc-			require (n ≡ v)-			return Map.empty-		App f x → do-			c ← liftReader (edgeCardinality inc)-			require (c ≡ 2)-			Applicator {inp = i, out1 = o1, out2 = o2} ← nodeAt inc-			require (i ≡ inc)-			liftM2 (Map.unionWithKey nonLinear) (build f o1) (build x o2)-			where nonLinear v = error $ "Left-hand side is not linear as " ⧺ [v] ⧺ " occurs twice"--buildRHS ∷ (View Vertex n, View [Port] n) ⇒ VarMap → Term → Edge → Rule n-buildRHS bindings term inc = replace (reqEdges term) (build term inc) where+	root ← edge+	varMap ← buildLHS root lhs+	buildRHS root varMap rhs -	reqEdges (App f x) = 2 + reqEdges f + reqEdges x-	reqEdges (Var v) = 0+buildLHS ∷ (View Vertex n, View [Port] n) ⇒ Edge → Term → Pattern n VarMap+buildLHS root term = case term of+	Var v | isLower v → return $ Map.singleton v root+	Var v | otherwise → do+		c ← liftReader (edgeCardinality root)+		require (c ≡ 2)+		Variable {name = n} ← nodeWith root+		require (n ≡ v)+		return Map.empty+	App f x → do+		c ← liftReader (edgeCardinality root)+		require (c ≡ 2)+		Applicator {inp = i, out1 = o1, out2 = o2} ← nodeWith root+		require (i ≡ root)+		Map.unionWithKey nonLinear <$> buildLHS o1 f <*> buildLHS o2 x+		where nonLinear v = error $ "Left-hand side is not linear as " ⧺ [v] ⧺ " occurs twice" -	build (App f x) inc (fEdge:xEdge:edges) = let (fEdges,xEdges) = splitAt (reqEdges f) edges-		in Node Applicator {inp = inc, out1 = fEdge, out2 = xEdge} : build f fEdge fEdges ⧺ build x xEdge xEdges+buildRHS ∷ (View Vertex n, View [Port] n) ⇒ Edge → VarMap → Term → Rule n+buildRHS root bindings term = replace $ build term root where -	build (Var v) inc [] = singleton $ if isLower v-		then maybe freeVar (Wire inc) (Map.lookup v bindings)-		else Node Variable {inp = inc, name = v}-		where freeVar = error $ [v] ⧺ " occurs free on the right-hand side"+	build (App f x) inc = do+		(xEdge,fEdge) ← (,) <$> byEdge <*> byEdge+		byNode Applicator {inp = inc, out1 = fEdge, out2 = xEdge}+		build f fEdge >> build x xEdge >> return () -	singleton x = [x]+	build (Var v) inc = if isLower v+		then maybe freeVar (byWire inc) (Map.lookup v bindings)+		else byNode Variable {inp = inc, name = v}+		where freeVar = error $ v : " occurs free on the right-hand side"

@@ -0,0 +1,4 @@+import peano.trs++A0x    → x+A(Sx)y → S(Axy)

@@ -0,0 +1,5 @@+import peano.trs+import add.trs++M0x       → 0+M(Sy)x    → A(Myx)x

@@ -1,6 +0,0 @@-import peano.trs--Mx0       → x-M(Sx)(Sy) → Mxy-Q0(Sy)    → 0-Q(Sx)(Sy) → S(Q(Mxy)(Sy))

@@ -1,5 +1,5 @@ Name:           graph-rewriting-trs-Version:        0.1.3+Version:        0.1.4 Copyright:      (c) 2011, Jan Rochel License:        BSD3 License-File:   LICENSE@@ -8,7 +8,7 @@ Homepage:       http://rochel.info/#graph-rewriting Stability:      beta Build-Type:     Simple-Synopsis:       Evaluate a first-order term rewrite system interactively using graph reduction+Synopsis:       Evaluate a first-order applicative term rewrite system interactively using graph reduction Description:    Given a set of term rewriting rules and an initial term with this tool you can interactively evaluate the corresponding term graph. The employed rule set has to be defined in one or more files. In the examples-directory a few rewriting systems are already supplied. To see how it works invoke the with the SKI-combinator rules and an initial term as arguments: @trs examples/ski.trs "SK(S(KIS)K)I"@. On how to interact with the application see the "GraphRewriting.GL.UI" module of the graph-rewriting-gl package. Category:       Graphs, Application Cabal-Version:  >= 1.6@@ -17,16 +17,16 @@ Executable trs   Main-Is:        Main.hs   Build-Depends:-    base >= 4 && < 4.5,+    base >= 4 && < 4.6,     base-unicode-symbols >= 0.2 && < 0.3,-    graph-rewriting >= 0.5.2 && < 0.6,-    graph-rewriting-layout >= 0.4.1 && < 0.5,-    graph-rewriting-gl >= 0.6 && < 0.7,-    uu-parsinglib >= 2.7 && < 2.8,+    graph-rewriting >= 0.7.1 && < 0.8,+    graph-rewriting-layout >= 0.5.1 && < 0.6,+    graph-rewriting-gl >= 0.6.9 && < 0.8,+    uu-parsinglib >= 2.7 && < 2.9,     containers >= 0.4 && < 0.5,-    GLUT >= 2.2 && < 2.3,-    OpenGL >= 2.4 && < 2.5,-    filepath >= 1.1 && < 1.3,+    GLUT >= 2.2 && < 2.5,+    OpenGL >= 2.4 && < 2.9,+    filepath >= 1.1 && < 1.4,     directory >= 1.0 && < 1.2   Extensions:     UnicodeSyntax@@ -34,5 +34,6 @@     FlexibleContexts     MultiParamTypeClasses     Rank2Types-  GHC-Options:    -fno-warn-duplicate-exports+    ScopedTypeVariables+  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:  GL Graph Rules Term TermRewriting