Rearranging files

4 files changed, 196 insertions, 0 deletions

diff --git a/src/Fractran/Example.hs b/src/Fractran/Example.hs
new file mode 100644
index 0000000..43d8cc8
--- /dev/null
+++ b/src/Fractran/Example.hs
@@ -0,0 +1,46 @@
+module Fractran.Example (
+    addition,
+    multiply,
+    prime2,
+    prime10short,
+    prime10) where
+
+
+import Fractran.Parser
+
+
+
+
+-- some simple fractran programs
+
+
+-- these ones need an initial input added of the appropriate form
+
+-- input: 2^a * 3^b
+-- output: 3^(a+b)
+addition :: [(Int,Int)]
+addition = [(3,2)]
+
+-- input: 2^a * 3^b
+-- output: 5^ab
+multiply :: [(Int,Int)]
+multiply = [(13,21), (385,13), (1,7), (3,11), (7,2), (1,3)]
+
+
+
+
+-- these ones are already in ready to interpret, FractranProgram form
+
+-- input: 2
+-- output: a sequence containing all prime powers of 2
+prime2 :: FractranProgram
+prime2 = FractranProgram [(17,91), (78,85), (19,51), (23,38), (29,33), (77,29), (95,23), (77,19), (1,17), (11,13), (13,11), (15,14), (15,2), (55,1)] 2
+
+-- input: 10
+-- output: a sequence containing all prime powers of 10
+prime10short :: FractranProgram
+prime10short = FractranProgram [(3,11), (847,45), (143,6), (7,3), (10,91), (3,7), (36,325), (1,2), (36,5)] 10
+
+prime10 :: FractranProgram
+prime10 = FractranProgram [(7,3), (99,98), (13,49), (39,35), (36,91), (10,143), (49,13), (7,11), (1,2), (91,1)] 10
+
diff --git a/src/Fractran/Interpreter.hs b/src/Fractran/Interpreter.hs
new file mode 100644
index 0000000..1393991
--- /dev/null
+++ b/src/Fractran/Interpreter.hs
@@ -0,0 +1,29 @@
+module Fractran.Interpreter (
+    fractran
+	) where
+
+
+import Fractran.Parser
+
+
+
+
+fractran :: FractranProgram -> [Int]
+fractran program =
+    let prog = map (\(x,y) -> (fromIntegral x, fromIntegral y)) (fractions program)
+        f = (\p v -> if (p == [])
+                     then []
+                     else let (curX, curY) = head p
+                              newV = v * curX / curY
+                          in if (isInt newV)
+                             then newV : (f prog newV)
+                             else f (tail p) v)
+        result = map round (f prog (fromIntegral (initialValue program)))
+    in (initialValue program) : result
+
+
+
+isInt :: (RealFrac a) => a -> Bool
+isInt x =
+    x == fromInteger (round x)
+
diff --git a/src/Fractran/Parser.hs b/src/Fractran/Parser.hs
new file mode 100644
index 0000000..95aa954
--- /dev/null
+++ b/src/Fractran/Parser.hs
@@ -0,0 +1,68 @@
+module Fractran.Parser (
+    FractranProgram(..),
+
+    parseFractran
+    ) where
+
+
+import Control.Applicative( some )
+import Text.ParserCombinators.Parsec
+
+
+
+data FractranProgram = FractranProgram { fractions :: [(Int,Int)]
+                                       , initialValue :: Int }
+    deriving (Show, Eq)
+
+
+
+
+parseFractran :: String -> Either ParseError FractranProgram
+parseFractran = parse fractran "error"
+
+
+
+
+fractran = do
+    whiteSpace
+    value <- initVal
+    fractionList <- many intPair
+    eof
+    return (FractranProgram fractionList value)
+
+
+intPair = do
+    numerator <- wholeNumber
+    slash
+    denominator <- positiveNumber
+    whiteSpace
+    return (numerator,denominator)
+
+
+slash  =  char '/'
+      <?> "slash character"
+
+
+initVal = do
+    value <- wholeNumber
+    whiteSpace
+    return value
+
+
+wholeNumber = do
+    value <- some digit
+    return (read value)
+
+
+positiveNumber = do
+    firstDigit <- nonZeroDigit
+    rest <- many digit
+    return (read (firstDigit:rest))
+
+
+nonZeroDigit  =  oneOf "123456789"
+             <?> "non-zero digit"
+
+
+whiteSpace = many (oneOf "\t\n\r ")
+
diff --git a/src/Fractran/Test.hs b/src/Fractran/Test.hs
new file mode 100644
index 0000000..2b507b1
--- /dev/null
+++ b/src/Fractran/Test.hs
@@ -0,0 +1,53 @@
+module Fractran.Test (
+	parserTests,
+	interpreterTests,
+	tests
+    ) where
+
+
+import Test.HUnit
+import Text.Parsec.Error
+import Fractran.Parser
+import Fractran.Interpreter
+import Fractran.Example
+
+
+instance Eq Text.Parsec.Error.ParseError
+
+
+
+
+parser0 = (Right (FractranProgram [] 2)) ~=? (parseFractran "2")
+
+parser1 = (Right (FractranProgram [] 2)) ~=? (parseFractran "2\n")
+
+parser2 = (Right (FractranProgram [] 2)) ~=? (parseFractran "\n2")
+
+parser3 = (Right (FractranProgram [(1,2)] 2)) ~=? (parseFractran "2 1/2")
+
+parser4 = (Right (FractranProgram [(2,3)] 3)) ~=? (parseFractran "3\n \n2/3\n")
+
+
+
+interpreter0 = [108,162,243] ~=? (fractran (FractranProgram addition 108))
+
+interpreter1 = [2,15,825,725,1925,2275,425,390,330,290,770,910,170,156,132,116,308,364,68,4] ~=? (take 20 (fractran prime2))
+
+interpreter2 = [5] ~=? (fractran (FractranProgram addition 5))
+
+
+
+parserTests :: Test
+parserTests = TestList [parser0, parser1,parser2, parser3, parser4]
+
+
+
+interpreterTests :: Test
+interpreterTests = TestList [interpreter0, interpreter1, interpreter2]
+
+
+
+tests :: Test
+tests = case (parserTests, interpreterTests) of
+	(TestList a, TestList b) -> TestList (a ++ b)
+