summaryrefslogtreecommitdiff
path: root/Thue
diff options
context:
space:
mode:
Diffstat (limited to 'Thue')
-rw-r--r--Thue/Interpreter.hs77
-rw-r--r--Thue/Parser.hs84
-rw-r--r--Thue/Test.hs52
3 files changed, 0 insertions, 213 deletions
diff --git a/Thue/Interpreter.hs b/Thue/Interpreter.hs
deleted file mode 100644
index c53bff9..0000000
--- a/Thue/Interpreter.hs
+++ /dev/null
@@ -1,77 +0,0 @@
-module Thue.Interpreter (
- thue,
- extractInfix,
- nextInRange
- ) where
-
-
-import System.Random
-import Data.Maybe
-import Data.List
-import Thue.Parser
-
-
-
-
-thue :: ThueProgram -> IO ThueState
-thue program =
- let rules = thueRules program
- state = thueInitialState program
- gen = mkStdGen 4 --chosen by fair dice roll, guaranteed to be random
-
- in interpret state rules gen
-
-
-
-interpret :: ThueState -> [ThueRule] -> StdGen -> IO ThueState
-interpret state rules gen = do
- let possibleRules = rules `applicableTo` state
- ruleToApply = if (possibleRules == []) then (ThueRule "" "") else possibleRules !! num
- -- ^ dummy rule if no possible rules apply
-
- (num, gen') = nextInRange 0 (length possibleRules - 1) gen
-
- (before, after) = fromJust (extractInfix (original ruleToApply) state)
-
- state' <- case (replacement ruleToApply) of
- ":::" -> getLine >>= (\x -> return (before ++ x ++ after))
-
- '~':xs -> putStr xs >> return (before ++ after)
-
- x -> return (before ++ x ++ after)
-
- if (possibleRules == []) then return state else interpret state' rules gen'
-
-
-
-extractInfix :: Eq a => [a] -> [a] -> Maybe ([a], [a])
-extractInfix subList list =
- let f = (\pre cur -> case (stripPrefix subList cur) of
- Nothing -> f ((head cur):pre) (tail cur)
- Just x -> (reverse pre, x))
-
- in if (subList `isInfixOf` list) then Just (f [] list) else Nothing
-
-
-
-nextInRange :: Int -> Int -> StdGen -> (Int, StdGen)
-nextInRange low high random =
- let (genLow, genHigh) = genRange random
- (rawNext, random') = next random
-
- irawNext = fromIntegral rawNext
- igenLow = fromIntegral genLow
- igenHigh = fromIntegral genHigh
- ilow = fromIntegral low
- ihigh = fromIntegral high
-
- n' = ((irawNext - igenLow) / (igenHigh - igenLow)) * (ihigh - ilow) + ilow
-
- in (round n', random')
-
-
-
-applicableTo :: [ThueRule] -> ThueState -> [ThueRule]
-applicableTo ruleList state =
- filter (\r -> (original r) `isInfixOf` state) ruleList
-
diff --git a/Thue/Parser.hs b/Thue/Parser.hs
deleted file mode 100644
index 2ee41ae..0000000
--- a/Thue/Parser.hs
+++ /dev/null
@@ -1,84 +0,0 @@
-module Thue.Parser (
- ThueProgram(..),
- ThueRule(..),
- ThueState,
-
- parseThue
- ) where
-
-import Control.Applicative( some )
-import Text.ParserCombinators.Parsec
-
-
-
-data ThueProgram = ThueProgram { thueRules :: [ThueRule]
- , thueInitialState :: ThueState }
- deriving (Show, Eq)
-
-
-data ThueRule = ThueRule { original :: ThueState
- , replacement :: ThueState }
- deriving (Show, Eq)
-
-
-type ThueState = String
-
-
-
-
-parseThue :: String -> Either ParseError ThueProgram
-parseThue = parse thue "error"
-
-
-
-
-thue = do
- rs <- many rule
- separatorLine
- i <- initialState
- eof
- return (ThueProgram rs i)
-
-
-rule = do
- o <- ruleState
- separator
- r <- state
- eol
- return (ThueRule o r)
-
-
-separatorLine = whiteSpace >> separator >> whiteSpace >> eol
-separator = string "::="
- <?> "rule separator"
-
-
-initialState = do
- s <- state `sepEndBy` eol
- return (concat s)
-
-
-ruleState = some ruleStateChar
-
-
-ruleStateChar = noneOf "\n\r:"
- <|> try (char ':' >> notFollowedBy (string ":=") >> return ':')
- <?> "state character"
-
-
-state = many stateChar
-
-
-stateChar = noneOf "\n\r"
- <?> "state character"
-
-
-whiteSpace = many (oneOf "\t ")
-
-
-eol = try (string "\r\n")
- <|> try (string "\n\r")
- <|> try (string "\r")
- <|> try (string "\n")
- <?> "end of line"
-
diff --git a/Thue/Test.hs b/Thue/Test.hs
deleted file mode 100644
index 0273c48..0000000
--- a/Thue/Test.hs
+++ /dev/null
@@ -1,52 +0,0 @@
-module Thue.Test (
- parserTests,
- extractInfixTests,
- tests
- ) where
-
-
-import Test.HUnit
-import Text.Parsec.Error
-import Thue.Parser
-import Thue.Interpreter
-
-
-instance Eq Text.Parsec.Error.ParseError
-
-
-
-
-parser0 = (Right (ThueProgram [ThueRule "a" "b"] "a")) ~=? (parseThue "a::=b\n::=\na")
-
-parser1 = (Right (ThueProgram [] "b")) ~=? (parseThue "::=\nb")
-
-
-
-extractInfix0 = Nothing ~=? (extractInfix [1,2] [3,4,5])
-
-extractInfix1 = (Just ([1,2],[5,6])) ~=? (extractInfix [3,4] [1,2,3,4,5,6])
-
-extractInfix2 = (Just ([],[3,4])) ~=? (extractInfix [0,1,2] [0,1,2,3,4])
-
-extractInfix3 = (Just ([1],[])) ~=? (extractInfix [2,3] [1,2,3])
-
-extractInfix4 = (Just ([],[1])) ~=? (extractInfix [] [1])
-
-extractInfix5 = (Just ("before","after")) ~=? (extractInfix "middle" "beforemiddleafter")
-
-
-
-parserTests :: Test
-parserTests = TestList [parser0, parser1]
-
-
-
-extractInfixTests :: Test
-extractInfixTests = TestList [extractInfix0, extractInfix1, extractInfix2, extractInfix3, extractInfix4, extractInfix5]
-
-
-
-tests :: Test
-tests = case (parserTests, extractInfixTests) of
- (TestList a, TestList b) -> TestList (a ++ b)
-