diff options
Diffstat (limited to 'Thue')
| -rw-r--r-- | Thue/Interpreter.hs | 77 | ||||
| -rw-r--r-- | Thue/Parser.hs | 84 | ||||
| -rw-r--r-- | Thue/Test.hs | 52 |
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) - |