Initial working version of Haskell Brainmess.
authorMichael Welch <michaelgwelch@gmail.com>
Sun, 19 Feb 2012 04:35:21 +0000 (22:35 -0600)
committerMichael Welch <michaelgwelch@gmail.com>
Sun, 19 Feb 2012 04:35:21 +0000 (22:35 -0600)
haskell/brainmess.hs [new file with mode: 0644]
haskell/program.hs
haskell/programtests.hs [new file with mode: 0644]
haskell/tape.hs
haskell/tapetests.hs [new file with mode: 0644]

diff --git a/haskell/brainmess.hs b/haskell/brainmess.hs
new file mode 100644 (file)
index 0000000..7dc3170
--- /dev/null
@@ -0,0 +1,12 @@
+module Main where
+
+import Program 
+import System
+import Tape
+
+main :: IO ()
+main = do
+            args <- getArgs
+            prog <- readFile $ args !! 0
+            run (Program prog 0) tape
+            return ()
index 034627f..b701552 100644 (file)
@@ -1,10 +1,10 @@
-
+module Program where
 import Tape
 import Data.Char
-import System
+import Debug.Trace
 
 -- The Program value constructor should be kept hidden
-data Program = Program String Int
+data Program = Program String Int deriving (Show, Eq)
 
 -- probably inefficient (rethink later)
 -- I'm not sure if behind the scenes haskell isn't a little smart about strings
@@ -15,21 +15,26 @@ fetch :: Program -> (Program, Char)
 fetch (Program cs pos) = ((Program cs (pos+1)), cs !! pos)
 
 jumpForward :: Program -> Program
-jumpForward p = jump 1 p 1
+jumpForward (Program s p) = (Program s ((match s (p-1) 1)+1))
 
 jumpBackward :: Program -> Program
-jumpBackward p = jump 1 p (-1)
+jumpBackward (Program s p) = (Program s (match s (p-1) (-1)))
+
 
+match :: String -> Int -> Int -> Int
+match s p i = match' s (p+i) 1 i
 
-jump:: Int -> Program -> Int -> Program
-jump 0 p i  = p
-jump n (Program cs pos) i = jump n' (Program cs (pos+1)) i
-               where current = cs !! pos
-                     n' = if (current=='[') then n+i
+match' :: String -> Int -> Int -> Int -> Int
+{-match' s p n i | trace ("match'" ++ show s ++ " " ++ show p ++ " " ++ 
+    show n ++ " " ++ show i) False = undefined
+-}
+match' s p 0 i = p-i
+match' s p n i = match' s (p+i) n' i
+               where current = s !! p
+                     n' = if (current == '[') then n+i
                           else if (current == ']') then n-i
                           else n
 
-
 execute :: Char -> Program -> Tape -> IO Char -> (Char -> IO ()) 
            -> IO (Program, Tape)
 execute '>' p t _ _ = return (p, moveF t)
@@ -55,9 +60,3 @@ run p t = do
             (p'',t') <- execute i p' t getChar putChar
             if (endOfProgram p'') then return (p'',t') else (run p'' t')
 
-main :: IO ()
-main = do
-            args <- getArgs
-            prog <- readFile $ args !! 1
-            run (Program prog 0) tape
-            return ()
diff --git a/haskell/programtests.hs b/haskell/programtests.hs
new file mode 100644 (file)
index 0000000..a3e0147
--- /dev/null
@@ -0,0 +1,51 @@
+
+import Program 
+
+assertEqual :: (Eq a, Show a)  => a -> a -> String -> IO ()
+assertEqual x y s | x == y = return ()
+                  | otherwise = error $ "Expected: " ++ (show x) ++ ", Actual: "
+                        ++ (show y) ++ " - " ++ s
+
+jump_BaseCase :: IO ()
+jump_BaseCase = assertEqual expected actual "JB1"
+        where begin = Program "[]" 2
+              actual = jump 0 begin 1
+              expected = begin
+
+jump_BaseCase_Level1 :: IO()
+jump_BaseCase_Level1 = assertEqual expected actual "JB2"
+        where begin = Program "[]" 1
+              actual = jump 1 begin 1
+              expected = Program "[]" 2
+
+
+jumpForward_Simple :: IO()
+jumpForward_Simple = assertEqual expected actual "JF1"
+        where begin = Program "[]" 1
+              actual = jumpForward begin
+              expected = Program "[]" 2
+
+jumpForward_Simple2 :: IO()
+jumpForward_Simple2 = assertEqual expected actual "JF2"
+        where begin = Program "[    ]" 1
+              actual = jumpForward begin
+              expected = Program "[    ]" 6
+
+jumpForward_Simple3 :: IO()
+jumpForward_Simple3 = assertEqual expected actual "JF3"
+        where begin = Program "[ [ ]]" 1
+              actual = jumpForward begin
+              expected = Program "[ [ ]]" 6
+
+fetchTest :: IO()
+fetchTest = assertEqual (fst (fetch (Program "++" 1))) (Program "++" 2) "fetch"
+
+main :: IO ()
+main = do
+        jump_BaseCase
+       jump_BaseCase_Level1
+        jumpForward_Simple
+        jumpForward_Simple2
+        jumpForward_Simple3
+        fetchTest
+        return ()
index 739cc1f..1e09907 100644 (file)
@@ -2,7 +2,7 @@ module Tape where
 
 -- naive approach that just uses a regular list.
 
-data ListTraveler = Iterate [Int] Int deriving (Show)
+data ListTraveler = Iterate [Int] Int deriving (Show, Eq)
 
 traveler :: ListTraveler
 traveler = Iterate [0] 0
@@ -26,8 +26,10 @@ setCurrent (Iterate xs pos) val | pos == 0 = Iterate (val : tail xs) pos
                                         suffix = drop (pos+1) xs
 
 
-data Tape = Tape ListTraveler deriving (Show)
+data Tape = Tape ListTraveler deriving (Show, Eq)
 
+createTape :: [Int] -> Int -> Tape
+createTape is pos = Tape (Iterate is pos)
 tape :: Tape
 tape = Tape traveler
 
diff --git a/haskell/tapetests.hs b/haskell/tapetests.hs
new file mode 100644 (file)
index 0000000..2b47a31
--- /dev/null
@@ -0,0 +1,83 @@
+import Tape
+
+assertEqual :: (Eq a, Show a)  => a -> a -> String -> IO ()
+assertEqual x y s | x == y = return ()
+                  | otherwise = error $ "Expected: " ++ (show x) ++ ", Actual: "
+                        ++ (show y) ++ " - " ++ s
+
+
+tape_moveForward_InDefault :: IO ()
+tape_moveForward_InDefault = let expected = Tape (Iterate [0,0] 1)
+                                 actual = moveF tape
+                             in assertEqual expected actual "MF1"
+
+tape_moveForward_InMiddle :: IO ()
+tape_moveForward_InMiddle = assertEqual expected actual "MF2"
+        where expected = Tape (Iterate [1,3,5,7] 3)
+              begin = Tape (Iterate [1,3,5,7] 2)
+              actual = moveF begin 
+
+tape_moveForward_AtEnd :: IO()
+tape_moveForward_AtEnd = assertEqual expected actual "MF3"
+        where expected = Tape (Iterate [2,4,6,8,10,0] 5)
+              begin = Tape (Iterate [2,4,6,8,10] 4)
+              actual = moveF begin
+                            
+
+tape_moveBackward_InDefault :: IO ()
+tape_moveBackward_InDefault = let expected = Tape (Iterate [0,0] 0)
+                                  actual = moveR tape
+                             in assertEqual expected actual "MR1"
+
+tape_moveBackward_InMiddle :: IO ()
+tape_moveBackward_InMiddle = assertEqual expected actual "MR2"
+        where expected = Tape (Iterate [1,3,5,7] 2)
+              begin = Tape (Iterate [1,3,5,7] 3)
+              actual = moveR begin 
+
+tape_moveBackward_AtEnd :: IO()
+tape_moveBackward_AtEnd = assertEqual expected actual "MR3"
+        where expected = Tape (Iterate [2,4,6,8,10] 3)
+              begin = Tape (Iterate [2,4,6,8,10] 4)
+              actual = moveR begin
+
+tape_setCurrent :: IO()
+tape_setCurrent = assertEqual expected actual "SC1"
+        where begin = createTape [7, 9, 11, 13, 14] 2
+              actual = set begin 8
+              expected = createTape [7, 9, 8, 13, 14] 2
+
+tape_getCurrent :: IO ()
+tape_getCurrent = assertEqual expected actual "GC1"
+        where begin = createTape [99, 87, 65, 43] 3
+              actual = get begin
+              expected = 43
+
+
+tape_inc :: IO()
+tape_inc = assertEqual expected actual "Inc"
+        where begin = createTape [1,3,5,7] 2
+              actual = inc begin
+              expected = createTape [1,3,6,7] 2
+         
+tape_dec :: IO()
+tape_dec = assertEqual expected actual "Dec"
+        where begin = createTape [1,3,5,7] 2
+              actual = dec begin
+              expected = createTape [1,3,4,7] 2
+         
+
+main :: IO ()
+main = do
+    tape_moveForward_InDefault
+    tape_moveForward_InMiddle
+    tape_moveForward_AtEnd
+    tape_moveBackward_AtEnd
+    tape_moveBackward_InDefault
+    tape_moveBackward_AtEnd
+    tape_setCurrent
+    tape_getCurrent
+    tape_inc
+    tape_dec
+    return ()
+