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