Added Thue interpreter module

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
+