summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Thue/Interpreter.hs66
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
+