diff options
author | Jed Barber <jjbarber@y7mail.com> | 2014-02-07 23:22:16 +1100 |
---|---|---|
committer | Jed Barber <jjbarber@y7mail.com> | 2014-02-07 23:22:16 +1100 |
commit | 7054599bbf955574fad1ae65cf6ab7eb117cfa17 (patch) | |
tree | 4c2e156ac19ff46d427ec4779f58842ea449c6e8 | |
parent | 862d0b8e2ad71c6cc6268608130167deff08dab7 (diff) |
Fixed miscellaneous minor errors
-rw-r--r-- | Fractran/Interpreter.hs | 8 | ||||
-rw-r--r-- | Thue/Interpreter.hs | 58 | ||||
-rw-r--r-- | Thue/Parser.hs | 2 | ||||
-rw-r--r-- | misc.hs | 5 |
4 files changed, 38 insertions, 35 deletions
diff --git a/Fractran/Interpreter.hs b/Fractran/Interpreter.hs index 0427aed..b62f279 100644 --- a/Fractran/Interpreter.hs +++ b/Fractran/Interpreter.hs @@ -19,5 +19,11 @@ fractran program = then newV : (f prog newV) else f (tail p) v) result = map round (f prog (fromIntegral (initialValue program))) - in value : result + in (initialValue program) : result + + + +isInt :: (RealFrac a) => a -> Bool +isInt x = + x == fromInteger (round x) diff --git a/Thue/Interpreter.hs b/Thue/Interpreter.hs index 8555bab..6022038 100644 --- a/Thue/Interpreter.hs +++ b/Thue/Interpreter.hs @@ -1,9 +1,11 @@ module Interpreter ( - thue - ) where + thue + ) where import System.Random +import Data.Maybe +import Data.List import Parser @@ -11,56 +13,56 @@ 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 + 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 :: ThueState -> [ThueRule] -> StdGen -> ThueState interpret state rules gen = - let possibleRules = rules `applicableTo` state - ruleToApply = possibleRules !! num + 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 + (before, after) = fromJust (extractInfix (original ruleToApply) state) + state' = before ++ (replacement ruleToApply) ++ after - in if (possibleRules == []) then state else interpret state' rules gen' + in if (possibleRules == []) then state else interpret state' rules gen' -extractInfix :: [a] -> [a] -> Maybe ([a], [a]) +extractInfix :: Eq a => [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) + 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 + in if (subList `isInfixOf` list) then Just (f [] list) else Nothing -nextInRange :: Integer -> Integer -> RandomGen -> (Integer,RandomGen) +nextInRange :: Int -> Int -> StdGen -> (Int, StdGen) nextInRange low high random = - let (genLow, genHigh) = genRange random - (rawNext, random') = next 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' + irawNext = fromIntegral rawNext + igenLow = fromIntegral genLow + igenHigh = fromIntegral genHigh + ilow = fromIntegral low + ihigh = fromIntegral high - in (next, random') + n' = ((irawNext - igenLow) / (igenHigh - igenLow)) * (ihigh - ilow) + ilow + + in (round n', random') applicableTo :: [ThueRule] -> ThueState -> [ThueRule] applicableTo ruleList state = - filter (\r -> (original r) `isInfixOf` state) ruleList + filter (\r -> (original r) `isInfixOf` state) ruleList diff --git a/Thue/Parser.hs b/Thue/Parser.hs index 3073014..1eb7943 100644 --- a/Thue/Parser.hs +++ b/Thue/Parser.hs @@ -17,7 +17,7 @@ data ThueProgram = ThueProgram { thueRules :: [ThueRule] data ThueRule = ThueRule { original :: ThueState , replacement :: ThueState } - deriving (Show) + deriving (Show, Eq) type ThueState = String @@ -1,11 +1,6 @@ -isInt :: (RealFrac a) => a -> Bool -isInt x = - x == fromInteger (round x) - - modulo :: Int -> Int -> Int modulo x y = |