From 71a9dca53149ecd7913fd244fe5922d4aa0b0803 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
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(-)
(limited to 'src/Thue')
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