summaryrefslogtreecommitdiff
path: root/bf.hs
diff options
context:
space:
mode:
authorDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-04 21:30:45 +0000
committerDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-04 21:30:45 +0000
commitfd9e2959452ff9f94ad40f26f4fb64c5fb597259 (patch)
tree5525d0a5252368878fe2f52cc08d261918854c7d /bf.hs
parenta519418a10475f69255cb0d38cc84edea853f6fc (diff)
downloadbf-fd9e2959452ff9f94ad40f26f4fb64c5fb597259.tar.bz2
Add interpreter
Diffstat (limited to 'bf.hs')
-rw-r--r--bf.hs40
1 files changed, 39 insertions, 1 deletions
diff --git a/bf.hs b/bf.hs
index 8b757b6..86dc8c1 100644
--- a/bf.hs
+++ b/bf.hs
@@ -1,5 +1,8 @@
import Text.Parsec
import Text.Parsec.String
+import Control.Monad.State
+import qualified Data.IntMap as M
+import Data.Word
data BFInstruction = GoBack | GoForward | Increment | Decrement | Input
| Output | Loop [BFInstruction]
@@ -40,9 +43,44 @@ parseInstruction = do
parseInstructions :: Parser [BFInstruction]
parseInstructions = many parseInstruction
+type BFRunner = StateT (Int, M.IntMap Word8) IO ()
+
+zeroise :: Maybe Word8 -> Word8
+zeroise = maybe 0 id
+
+runInstruction :: BFInstruction -> BFRunner
+
+runInstruction GoBack = modify (\(h,m) -> (h-1, m))
+runInstruction GoForward = modify (\(h,m) -> (h+1, m))
+runInstruction Increment = do
+ (bfHead, bfMap) <- get
+ let val = zeroise (M.lookup bfHead bfMap)
+ put (bfHead, M.insert bfHead (val + 1) bfMap)
+runInstruction Decrement = do
+ (bfHead, bfMap) <- get
+ let val = zeroise (M.lookup bfHead bfMap)
+ put (bfHead, M.insert bfHead (val - 1) bfMap)
+runInstruction Input = do
+ (bfHead, bfMap) <- get
+ c <- liftIO getChar
+ put (bfHead, M.insert bfHead (fromIntegral (fromEnum c)) bfMap)
+runInstruction Output = do
+ (bfHead, bfMap) <- get
+ let val = zeroise (M.lookup bfHead bfMap)
+ liftIO $ putChar $ toEnum $ fromIntegral val
+runInstruction loop@(Loop insns) = do
+ (bfHead, bfMap) <- get
+ let val = zeroise (M.lookup bfHead bfMap)
+ case val of
+ 0 -> return ()
+ _ -> runInstructions insns >> runInstruction loop
+
+runInstructions :: [BFInstruction] -> BFRunner
+runInstructions = mapM_ runInstruction
+
main :: IO ()
main = do
cont <- readFile "hello.bf"
case parse parseInstructions "hello.bf" cont of
Left e -> print e
- Right insn -> print insn
+ Right insns -> evalStateT (runInstructions insns) (0, M.empty)