diff options
Diffstat (limited to 'src/Thue')
| -rw-r--r-- | src/Thue/Interpreter.hs | 25 | ||||
| -rw-r--r-- | src/Thue/Parser.hs | 49 | ||||
| -rw-r--r-- | 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")  | 
