diff --git a/GL.hs b/GL.hs --- a/GL.hs +++ b/GL.hs @@ -14,13 +14,9 @@ Root {} → [sd s] where n = Vector2 0 1 - w = Vector2 (-1) 0 - e = Vector2 1 0 s = Vector2 0 (-1) sw = Vector2 (-1) (-1) se = Vector2 1 (-1) - nw = Vector2 (-1) 1 - ne = Vector2 1 1 instance Render Vertex where render = renderNode diff --git a/Main.hs b/Main.hs --- a/Main.hs +++ b/Main.hs @@ -32,15 +32,15 @@ (imports, branch) ← parseFile f let done' = Set.insert f done let todo' = Set.union todo imports `Set.difference` done' - liftM (branch:) (parseFiles done' todo') + fmap (branch:) (parseFiles done' todo') 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 + ((imports,rules),parseErrors) ← fmap (parse ruleset) (readFile f) + unless (null parseErrors) $ do putStrLn $ "Parse errors in " ⧺ f ⧺ ":" putStr $ unlines $ map show parseErrors - imports ← liftM (Set.fromList . catMaybes) (mapM checkImport imports) + imports ← fmap (Set.fromList . catMaybes) (mapM checkImport imports) return (imports, Branch (takeBaseName f) [Leaf (show l ⧺ " -> " ⧺ show r) (buildRule l r) | (l,r) ← rules]) where checkImport i = do i ← canonicalizePath $ takeDirectory f `combine` i @@ -61,7 +61,7 @@ trsRules ← parseFiles Set.empty . Set.fromList =<< mapM canonicalizePath files let (t,parseErrors) = parse term termInput - when (not $ null parseErrors) $ do + unless (null parseErrors) $ do putStrLn "Parse errors in input term:" putStr $ unlines $ map show parseErrors diff --git a/Term.hs b/Term.hs --- a/Term.hs +++ b/Term.hs @@ -7,6 +7,8 @@ import Text.ParserCombinators.UU.BasicInstances as UU +type Parse a = P (Str Char String LineCol) a + data Term = App Term Term | Var Char deriving (Ord, Eq) type Import = FilePath @@ -22,38 +24,38 @@ maybeWrap str = if isComponent then "(" ⧺ str ⧺ ")" else str diverge = showComp True -parse ∷ Parser a → String → (a, [Error LineCol]) +parse ∷ Parse a → String → (a, [Error LineCol]) parse p inp = UU.parse ((,) <$> p <*> pEnd) (createStr (LineCol 0 0) inp) -var ∷ Parser Term +var ∷ Parse Term var = Var <$> alphaNum "variable" -term ∷ Parser Term +term ∷ Parse Term term = foldl1 App <$> pList1 (var <|> parens term) "term" where parens p = pSym '(' *> p <* pSym ')' -pImport ∷ Parser Import +pImport ∷ Parse Import pImport = pToken "import" *>ε*> pList1 asciiPrintable -ruleset ∷ Parser ([Import], [(Term,Term)]) +ruleset ∷ Parse ([Import], [(Term,Term)]) ruleset = (,) <$> pList (pImport <* newlines) <*> pList1 (rule <* newlines) -rule ∷ Parser (Term,Term) +rule ∷ Parse (Term,Term) rule = (,) <$> term <*ε<* arrow <*ε<*> term -- primitive parsers -newlines ∷ Parser () +newlines ∷ Parse () newlines = pMunch (`elem` "\n\r") *> pure () -ε ∷ Parser () -- spaces +ε ∷ Parse () -- spaces ε = pMunch (`elem` "\t ") *> pure () -arrow ∷ Parser String +arrow ∷ Parse String arrow = pToken "->" <|> pToken "→" "arrow" -alphaNum ∷ Parser Char +alphaNum ∷ Parse Char alphaNum = pLetter <|> pDigit "alphaNum" -asciiPrintable ∷ Parser Char +asciiPrintable ∷ Parse Char asciiPrintable = pRange ('!', '~') diff --git a/TermRewriting.hs b/TermRewriting.hs --- a/TermRewriting.hs +++ b/TermRewriting.hs @@ -4,7 +4,6 @@ import Prelude.Unicode import GraphRewriting import Data.Char (isLower) -import Control.Applicative import Data.Map (Map) import qualified Data.Map as Map import Term diff --git a/graph-rewriting-trs.cabal b/graph-rewriting-trs.cabal --- a/graph-rewriting-trs.cabal +++ b/graph-rewriting-trs.cabal @@ -1,5 +1,5 @@ Name: graph-rewriting-trs -Version: 0.1.9 +Version: 0.1.10 Copyright: (c) 2011, Jan Rochel License: BSD3 License-File: LICENSE @@ -7,29 +7,30 @@ Maintainer: jan@rochel.info Homepage: http://rochel.info/#graph-rewriting Build-Type: Simple -Synopsis: Evaluate first-order applicative term rewrite systems 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. +Synopsis: Interactive evaluation of first-order applicative term rewrite systems +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: Compilers/Interpreters, Application -Cabal-Version: >= 1.6 +Cabal-Version: >= 1.10 Data-Files: examples/*.trs Extra-Source-Files: AUTHORS Executable trs + Default-Language: Haskell2010 Main-Is: Main.hs Build-Depends: - base >= 4.8 && < 4.10, + base >= 4.9 && < 5, base-unicode-symbols >= 0.2 && < 0.3, - graph-rewriting >= 0.7.8, - graph-rewriting-layout >= 0.5.4, - graph-rewriting-gl >= 0.7.6, - uu-parsinglib >= 2.7 && < 2.10, - containers >= 0.4 && < 0.6, - GLUT >= 2.2 && < 2.8, - OpenGL >= 3.0 && < 3.1, - filepath >= 1.1 && < 1.5, - directory >= 1.0 && < 1.3 - Extensions: - UnicodeSyntax + graph-rewriting >= 0.7.8 && < 0.9, + graph-rewriting-layout >= 0.5.4 && < 0.6, + graph-rewriting-gl >= 0.7.6 && < 0.8, + uu-parsinglib >= 2.7 && < 3, + containers >= 0.4 && < 0.8, + GLUT >= 2.2 && < 3, + OpenGL >= 3.0 && < 4, + filepath >= 1.1 && < 2, + directory >= 1.0 && < 3 + Default-Extensions: UnicodeSyntax + Other-Extensions: FlexibleInstances FlexibleContexts MultiParamTypeClasses