diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2014, Alejandro Cabrera + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Alejandro Cabrera nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/brainfuck-tut.cabal b/brainfuck-tut.cabal new file mode 100644 --- /dev/null +++ b/brainfuck-tut.cabal @@ -0,0 +1,33 @@ +-- Initial brainfuck-tut.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: brainfuck-tut +version: 0.5.1.0 +synopsis: A simple BF interpreter. +-- description: +license: BSD3 +license-file: LICENSE +author: Alejandro Cabrera +maintainer: cpp.cabrera@gmail.com +-- copyright: +category: Language +build-type: Simple +-- extra-source-files: +cabal-version: >=1.18 + +library + exposed-modules: + Language.Brainfuck.Eval, + Language.Brainfuck.Parse, + Language.Brainfuck.Types + build-depends: base >=4.7 && <4.8, array + hs-source-dirs: src + ghc-options: -Wall -O2 + default-language: Haskell2010 + +executable bfh + main-is: Language/Brainfuck/Interpreter.hs + build-depends: base >=4.7 && <4.8, array, brainfuck-tut + hs-source-dirs: src + ghc-options: -Wall -O2 + default-language: Haskell2010 diff --git a/src/Language/Brainfuck/Eval.hs b/src/Language/Brainfuck/Eval.hs new file mode 100644 --- /dev/null +++ b/src/Language/Brainfuck/Eval.hs @@ -0,0 +1,105 @@ +{-| +Module : Language.Brainfuck.Eval +Description : Evaluator for the BF language +Copyright : (c) Alejandro Cabrera, 2014 +License : BSD-3 +Maintainer : cpp.cabrera@gmail.com +Stability : experimental +Portability : POSIX +-} +module Language.Brainfuck.Eval ( + eval +) where + +import Data.Array ((//), (!)) +import Data.Char (ord, chr) +import Data.List (elemIndices) +import Data.Maybe (listToMaybe) +import Data.Word (Word8) + +import Language.Brainfuck.Types +import Language.Brainfuck.Parse + +{-| + +`eval` operates over the given tape, parses the string, and returns the state of the tape. + +Potential unhandled errors: + +* Out of bounds access to the tape +* Infinite loops +* Exceptions thrown by `print` +* Exceptions thrown by `putChar` + +Handled errors: + +* Matching jump not found for '[' and ']': terminate eval and return tape + +As a result of evaluating the BF program, the following instructions +are effectful: + +* ',': pauses evaluation to receive user input +* '.': prints the tape contents at DP as a Char + +Here's how `eval` might be called: + +>>> let tape = listArray (0,99) (replicate 100 0) +>>> eval tape "+.+." +TODO +>>> eval tape ",." +TODO + +-} +eval :: Tape -> String -> IO Tape +eval storage program = + let instructions = parse program + + in go storage instructions instructions 0 (PC 0) + + -- first set of instructions we advance over + -- second set of instructions are maintained for jump logic + where go :: Tape -> [Term] -> [Term] -> + DataPointer -> ProgramCounter -> IO Tape + go tape [] _ _ _ = return tape + go tape (IncDP:ops) os pos pc = go tape ops os (pos+1) (next pc) + go tape (DecDP:ops) os pos pc = go tape ops os (pos-1) (next pc) + go tape (IncByte:ops) os pos pc = + go (modPos tape pos (+1)) ops os pos (next pc) + go tape (DecByte:ops) os pos pc = + go (modPos tape pos (subtract 1)) ops os pos (next pc) + go tape (OutByte:ops) os pos pc = + (showAt tape pos) >> go tape ops os pos (next pc) + go tape (InByte:ops) os pos pc = do + c <- getChar + let b = fromIntegral $ ord c :: Word8 + go (tape // [(pos, b)]) ops os pos (next pc) + go tape (JumpForward:ops) os pos pc = if shouldJump Forward tape pos + then jump tape Forward os pos pc + else go tape ops os pos (next pc) + go tape (JumpBackward:ops) os pos pc = if shouldJump Backward tape pos + then jump tape Backward os pos pc + else go tape ops os pos (next pc) + + jump tape dir os pos (PC pc) = do + let jumpTo = findFunc dir pc (flipDir dir) os + case jumpTo of + Nothing -> print "jump not found" >> return tape + (Just p) -> go tape (drop p os) os pos (PC p) + + -- jump utilities + dirToJump Forward = JumpForward + dirToJump Backward = JumpBackward + shouldJump Forward tape pos = (tape ! pos) == 0 + shouldJump Backward tape pos = (tape ! pos) /= 0 + findIx p x = listToMaybe . filter p . elemIndices x + findIxAfter pos = findIx (>pos) + findIxBefore pos = findIx (>> bfh 10 '.+.+' +0 +1 +>>> bfh 10 '[...].' +0 +-} +module Main where + +import Control.Monad (void) +import Data.Array (listArray) +import System.Environment (getArgs) + +import Language.Brainfuck.Eval (eval) + +main :: IO () +main = do + args <- getArgs + case args of + (size:program:_) -> do + case (reads size :: [(Int, String)]) of + [(s,[])] -> void $ eval (mkTape s) program + _ -> putStrLn $ "error: could not parse size: " ++ size + _ -> putStrLn "usage: bfh " + where mkTape s = listArray (0,s-1) (replicate s 0) diff --git a/src/Language/Brainfuck/Parse.hs b/src/Language/Brainfuck/Parse.hs new file mode 100644 --- /dev/null +++ b/src/Language/Brainfuck/Parse.hs @@ -0,0 +1,28 @@ +{-| +Module : Language.Brainfuck.Parse +Description : Parser for the BF language +Copyright : (c) Alejandro Cabrera, 2014 +License : BSD-3 +Maintainer : cpp.cabrera@gmail.com +Stability : experimental +Portability : POSIX +-} +module Language.Brainfuck.Parse ( + parse +) where + +import Language.Brainfuck.Types (Term(..)) + +-- |A total function over the BF syntax. +parse :: String -> [Term] +parse [] = [] +parse (x:xs) = case x of + '>' -> IncDP : parse xs + '<' -> DecDP : parse xs + '+' -> IncByte : parse xs + '-' -> DecByte : parse xs + '.' -> OutByte : parse xs + ',' -> InByte : parse xs + '[' -> JumpForward : parse xs + ']' -> JumpBackward : parse xs + _ -> parse xs diff --git a/src/Language/Brainfuck/Types.hs b/src/Language/Brainfuck/Types.hs new file mode 100644 --- /dev/null +++ b/src/Language/Brainfuck/Types.hs @@ -0,0 +1,46 @@ +{-| +Module : Language.Brainfuck.Types +Description : Types used in the implementation of the BF language +Copyright : (c) Alejandro Cabrera, 2014 +License : BSD-3 +Maintainer : cpp.cabrera@gmail.com +Stability : experimental +Portability : POSIX +-} +module Language.Brainfuck.Types ( + Tape, + DataPointer, + ProgramCounter(..), + Term(..), + Direction(..) +) where + +import Data.Word (Word8) +import Data.Array + +-- |`Tape` is an alias for the interpreter storage type +type Tape = Array Int Word8 + +-- |`DataPointer` is an alias for the memory pointer +type DataPointer = Int + +{-| +`ProgramCounter` is a nominal type to track the current instruction +while distinguishing it from `DataPointer` +-} +newtype ProgramCounter = PC Int + +-- |`Term` represents the abstract syntax for the BF language +data Term + = IncDP -- ^ > + | DecDP -- ^ < + | IncByte -- ^ + + | DecByte -- ^ - + | OutByte -- ^ . + | InByte -- ^ , + | JumpForward -- ^ [ + | JumpBackward -- ^ ] + deriving (Show, Eq) + +-- |`Direction` is used to track which direction we're jumping in +data Direction = Forward | Backward deriving Eq