Parse.hs

{-|
Module      : Language.Brainfuck.Parse
Description : Parser for the BF language
Copyright   : (c) Allele Dev, 2014
License     : BSD-3
Maintainer  : allele.dev@gmail.com
Stability   : experimental
Portability : POSIX
-}
module Language.Brainfuck.Parse (
  parse,
  matchJumps,
  JumpPairs
) 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
  '?' -> OutDP : parse xs
  '+' -> IncByte : parse xs
  '-' -> DecByte : parse xs
  '.' -> OutByte : parse xs
  ',' -> InByte : parse xs
  '[' -> JumpForward : parse xs
  ']' -> JumpBackward : parse xs
  _   -> parse xs

-- |Possible failure modes for pre-computing jump locations
data JumpMatchError
  = ForwardJumpNotMatched Int
  | BackwardJumpNotMatched Int deriving Show

type JumpPairs = [(Int,Int)]

-- TODO: swap [(Int,Int)] with Map Int Int for efficiency
-- |Given a list of terms, precomputes jump locations for matching '[' ']'
-- |Respects nesting of '[' and ']' terms.
matchJumps :: [Term] -> Either JumpPairs JumpMatchError
matchJumps ts' = go ts' [] 0 []
  where go (JumpForward:t:ts) acc pos ret = go (t:ts) (pos:acc) (pos+1) ret
        go (JumpBackward:ts) (p:acc) pos ret = go ts acc (pos+1) ((p,pos):ret)
        go (JumpBackward:_) [] pos _ = Right $ BackwardJumpNotMatched pos
        go [JumpForward] _ pos _ = Right $ ForwardJumpNotMatched pos
        go [] (p:_) _ _ = Right $ ForwardJumpNotMatched p
        go [] [] _ ret = Left ret
        go (_:ts) acc pos ret = go ts acc (pos+1) ret