From 71a9dca53149ecd7913fd244fe5922d4aa0b0803 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Sun, 13 Apr 2014 18:48:30 +1000 Subject: More preparations for thuestates that aren't mere strings --- src/Thue/Interpreter.hs | 25 ++++++++++++++++--------- src/Thue/Parser.hs | 49 +++++++++++++++++++++++++++++++++++++------------ src/Thue/Test.hs | 4 ++-- 3 files changed, 55 insertions(+), 23 deletions(-) diff --git a/src/Thue/Interpreter.hs b/src/Thue/Interpreter.hs index 7c41718..28aff93 100644 --- a/src/Thue/Interpreter.hs +++ b/src/Thue/Interpreter.hs @@ -24,23 +24,30 @@ thue program = interpret :: ThueState -> [ThueRule] -> StdGen -> IO ThueState -interpret state rules gen = do +interpret state rules gen = let possibleRules = rules `applicableTo` state - ruleToApply = if (possibleRules == []) then (ThueRule "" "") else possibleRules !! num - -- ^ dummy rule if no possible rules apply + ruleToApply = possibleRules !! num (num, gen') = nextInRange 0 (length possibleRules - 1) gen - (before, after) = fromJust (extractInfix (original ruleToApply) state) + in if (possibleRules == []) + then return state + else applyRule ruleToApply state >>= (\x -> interpret x rules gen') - state' <- case (replacement ruleToApply) of - ":::" -> getLine >>= return . toThueState >>= (\x -> return (before ++ x ++ after)) - '~':xs -> return (fromThueState xs) >>= putStr >> return (before ++ after) - x -> return (before ++ x ++ after) +applyRule :: ThueRule -> ThueState -> IO ThueState +applyRule rule state = + let (before, after) = fromJust (extractInfix (original rule) state) - if (possibleRules == []) then return state else interpret state' rules gen' + in case (replacement rule) of + x | x == (tStr ":::") -> + getLine >>= return . toThueState >>= return . (before ++) . (++ after) + + x:xs | x == (tCh '~') -> + putStr (fromThueState xs) >> return (before ++ after) + + x -> return (before ++ x ++ after) diff --git a/src/Thue/Parser.hs b/src/Thue/Parser.hs index 10e9334..3ca937e 100644 --- a/src/Thue/Parser.hs +++ b/src/Thue/Parser.hs @@ -2,6 +2,10 @@ module Thue.Parser ( ThueProgram(..), ThueRule(..), ThueState, + ThueChar(..), + + tCh, + tStr, parseThue, toThueState, @@ -13,17 +17,23 @@ import Text.ParserCombinators.Parsec -data ThueProgram = ThueProgram { thueRules :: [ThueRule] - , thueInitialState :: ThueState } + +data ThueProgram = ThueProgram { thueRules :: [ThueRule] + , thueInitialState :: ThueState } deriving (Show, Eq) -data ThueRule = ThueRule { original :: ThueState - , replacement :: ThueState } +data ThueRule = ThueRule { original :: ThueState + , replacement :: ThueState } deriving (Show, Eq) -type ThueState = String +type ThueState = [ThueChar] + + +data ThueChar = TChar { tChar :: Char } + | TLit { tChar :: Char } + deriving (Show, Eq) @@ -33,13 +43,28 @@ parseThue = parse thue "error" +--parseThue2a :: String -> Either ParseError Thue2aProgram +--parseThue2a = parse thue2a "error" + + + toThueState :: String -> ThueState -toThueState = id +toThueState = map TChar fromThueState :: ThueState -> String -fromThueState = id +fromThueState = map tChar + + + +tCh :: Char -> ThueChar +tCh = TChar + + + +tStr :: String -> ThueState +tStr = map TChar @@ -70,18 +95,18 @@ initialState = do return (concat s) -ruleState = some ruleStateChar >>= return . toThueState +ruleState = some ruleStateChar -ruleStateChar = noneOf "\n\r:" - <|> try (char ':' >> notFollowedBy (string ":=") >> return ':') +ruleStateChar = (noneOf "\n\r:" >>= return . TChar) + <|> try (char ':' >> notFollowedBy (string ":=") >> return (TChar ':')) "state character" -state = many stateChar >>= return . toThueState +state = many stateChar -stateChar = noneOf "\n\r" +stateChar = (noneOf "\n\r" >>= return . TChar) "state character" diff --git a/src/Thue/Test.hs b/src/Thue/Test.hs index 0273c48..fcd8cde 100644 --- a/src/Thue/Test.hs +++ b/src/Thue/Test.hs @@ -16,9 +16,9 @@ instance Eq Text.Parsec.Error.ParseError -parser0 = (Right (ThueProgram [ThueRule "a" "b"] "a")) ~=? (parseThue "a::=b\n::=\na") +parser0 = (Right (ThueProgram [ThueRule (tStr "a") (tStr "b")] (tStr "a")) ) ~=? (parseThue "a::=b\n::=\na") -parser1 = (Right (ThueProgram [] "b")) ~=? (parseThue "::=\nb") +parser1 = (Right (ThueProgram [] (tStr "b")) ) ~=? (parseThue "::=\nb") -- cgit