diff options
| -rw-r--r-- | Thue/Interpreter.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/Thue/Interpreter.hs b/Thue/Interpreter.hs new file mode 100644 index 0000000..8555bab --- /dev/null +++ b/Thue/Interpreter.hs @@ -0,0 +1,66 @@ +module Interpreter ( + thue + ) where + + +import System.Random +import Parser + + + + +thue :: ThueProgram -> ThueState +thue program = + let rules = thueRules program + state = thueInitialState program + gen = mkStdGen 4 --chosen by fair dice roll, guaranteed to be random + + in interpret state rules gen + + + +interpret :: ThueState -> [ThueRule] -> RandomGen -> ThueState +interpret state rules gen = + let possibleRules = rules `applicableTo` state + ruleToApply = possibleRules !! num + + (num, gen') = nextInRange 0 (length possibleRules - 1) gen + + (before, after) = fromJust (extractInfix (original ruleToApply) state) + state' = before ++ (replacement ruleToApply) ++ after + + in if (possibleRules == []) then state else interpret state' rules gen' + + + +extractInfix :: [a] -> [a] -> Maybe ([a], [a]) +extractInfix subList list = + let f = (\pre cur -> case (stripPrefix subList cur) of + Nothing -> f (head cur):pre (tail cur) + Just x -> (reverse pre, x) + + in if (subList `isInfixOf` list) then Just f [] list else Nothing + + + +nextInRange :: Integer -> Integer -> RandomGen -> (Integer,RandomGen) +nextInRange low high random = + let (genLow, genHigh) = genRange random + (rawNext, random') = next random + + next = (\n -> let irawNext = fromIntegral rawNext + igenLow = fromIntegral genLow + igenHigh = fromIntegral genHigh + ilow = fromIntegral low + ihigh = fromIntegral high + n' = ((irawNext - igenLow) / (igenHigh - igenLow)) * (ihigh - ilow) + ilow + in round n' + + in (next, random') + + + +applicableTo :: [ThueRule] -> ThueState -> [ThueRule] +applicableTo ruleList state = + filter (\r -> (original r) `isInfixOf` state) ruleList + |