diff options
| -rw-r--r-- | src/Thue/Interpreter.hs | 41 | ||||
| -rw-r--r-- | src/Thue/Parser.hs | 28 |
2 files changed, 44 insertions, 25 deletions
diff --git a/src/Thue/Interpreter.hs b/src/Thue/Interpreter.hs index 28aff93..3e82826 100644 --- a/src/Thue/Interpreter.hs +++ b/src/Thue/Interpreter.hs @@ -12,6 +12,15 @@ import Thue.Parser +data ThueVersion = Ver1 | Ver2a + deriving (Eq) + + +data Choice = Random StdGen + | First + | Last + + thue :: ThueProgram -> IO ThueState thue program = @@ -19,30 +28,42 @@ thue program = state = thueInitialState program gen = mkStdGen 4 --chosen by fair dice roll, guaranteed to be random - in interpret state rules gen + in interpret Ver1 rules (Random gen) state -interpret :: ThueState -> [ThueRule] -> StdGen -> IO ThueState -interpret state rules gen = +interpret :: ThueVersion -> [ThueRule] -> Choice -> ThueState -> IO ThueState +interpret ver rules gen state = let possibleRules = rules `applicableTo` state - ruleToApply = possibleRules !! num - - (num, gen') = nextInRange 0 (length possibleRules - 1) gen + (ruleToApply, gen') = choose possibleRules gen in if (possibleRules == []) then return state - else applyRule ruleToApply state >>= (\x -> interpret x rules gen') + else applyRule ver ruleToApply state >>= interpret ver rules gen' + +choose :: [ThueRule] -> Choice -> (ThueRule, Choice) +choose ruleList gen = + case gen of + First -> (head ruleList, First) -applyRule :: ThueRule -> ThueState -> IO ThueState -applyRule rule state = + Last -> (last ruleList, Last) + + Random g -> let (num, g') = nextInRange 0 (length ruleList - 1) g + in (ruleList !! num, Random g') + + + +applyRule :: ThueVersion -> ThueRule -> ThueState -> IO ThueState +applyRule ver rule state = let (before, after) = fromJust (extractInfix (original rule) state) + inputProc = if (ver == Ver1) then return . tStr else return . tLitStr + in case (replacement rule) of x | x == (tStr ":::") -> - getLine >>= return . toThueState >>= return . (before ++) . (++ after) + getLine >>= inputProc >>= return . (before ++) . (++ after) x:xs | x == (tCh '~') -> putStr (fromThueState xs) >> return (before ++ after) diff --git a/src/Thue/Parser.hs b/src/Thue/Parser.hs index 3ca937e..a9c2d96 100644 --- a/src/Thue/Parser.hs +++ b/src/Thue/Parser.hs @@ -4,11 +4,12 @@ module Thue.Parser ( ThueState, ThueChar(..), - tCh, - tStr, - parseThue, - toThueState, + + tCh, + tLit, + tStr, + tLitStr, fromThueState ) where @@ -48,24 +49,21 @@ parseThue = parse thue "error" -toThueState :: String -> ThueState -toThueState = map TChar - - - -fromThueState :: ThueState -> String -fromThueState = map tChar - - - tCh :: Char -> ThueChar tCh = TChar - +tLit :: Char -> ThueChar +tLit = TLit tStr :: String -> ThueState tStr = map TChar +tLitStr :: String -> ThueState +tLitStr = map TLit + +fromThueState :: ThueState -> String +fromThueState = map tChar + |