{-# LANGUAGE MultiWayIf, BangPatterns #-} import Data.Word import Data.Char data Tape = Tape { negatives :: [Word8], currentTape :: !Word8, positives :: [Word8] } mkTape = Tape (repeat 0) 0 (repeat 0) shiftLeft (Tape (x:left) curr right) = Tape left x (curr:right) shiftRight (Tape left curr (x:right)) = Tape (curr:left) x right modifyTape f (Tape left curr right) = Tape left (f curr) right newtype Stack a = Stack [a] push x (Stack s) = Stack (x:s) top (Stack s) = head s pop (Stack (s:ss)) = Stack ss evalReal program = eval 0 (Stack [0]) mkTape where eval !curr !loops !tape = if | length program == curr -> return () | command == '[' -> (if | skip || currentTape tape == 0 -> eval (curr + 1) (push (-1) loops) tape | otherwise -> eval (curr + 1) (push curr loops) tape) | command == ']' -> (if | skip || currentTape tape == 0 -> eval (curr + 1) (pop loops) tape | otherwise -> eval (top loops + 1) loops tape) | skip -> nextCommand tape | command == '+' -> nextCommand (modifyTape (+1) tape) | command == '-' -> nextCommand (modifyTape (subtract 1) tape) | command == '>' -> nextCommand (shiftRight tape) | command == '<' -> nextCommand (shiftLeft tape) | command == '.' -> putChar (chr $ fromIntegral $ currentTape tape) >> nextCommand tape | command == ',' -> getChar >>= \x -> return (tape {currentTape = (fromIntegral $ ord x)}) >> nextCommand tape | otherwise -> nextCommand tape where nextCommand = eval (curr + 1) loops skip = top loops == (-1) command = program !! curr main = evalReal "->+>+++>>+>++>+>+++>>+>++>>>+>+>+>++>+>>>>+++>+>>++>+>+++>>++>++>>+>>+>++>++>+>>>>+++>+>>>>++>++>>>>+>>++>+>+++>>>++>>++++++>>+>>++>+>>>>+++>>+++++>>+>+++>>>++>>++>>+>>++>+>+++>>>++>>+++++++++++++>>+>>++>+>+++>+>+++>>>++>>++++>>+>>++>+>>>>+++>>+++++>>>>++>>>>+>+>++>>+++>+>>>>+++>+>>>>+++>+>>>>+++>>++>++>+>+++>+>++>++>>>>>>++>+>+++>>>>>+++>>>++>+>+++>+>+>++>>>>>>++>>>+>>>++>+>>>>+++>+>>>+>>++>+>++++++++++++++++++>>>>+>+>>>+>>++>+>+++>>>++>>++++++++>>+>>++>+>>>>+++>>++++++>>>+>++>>+++>+>+>++>+>+++>>>>>+++>>>+>+>>++>+>+++>>>++>>++++++++>>+>>++>+>>>>+++>>++++>>+>+++>>>>>>++>+>+++>>+>++>>>>+>+>++>+>>>>+++>>+++>>>+[[->>+<<]<+]+++++[->+++++++++<]>.[+]>>[<<+++++++[->+++++++++<]>-.------------------->-[-<.<+>>]<[+]<+>>>]<<<[-[-[-[>>+<++++++[->+++++<]]>++++++++++++++<]>+++<]++++++[->+++++++<]>+<<<-[->>>++<<<]>[->>.<<]<<]"