I want to write an example for a language similar to Haskell called Frege. While the interpreter is conceptually easy, it is lengthy and looks still quite messy. Note that I don't want to use Parsec etc, as it isn't available yet in Frege. Please help me to improve the Haskell version.
import Data.Char
data Tape = Tape { left :: [Int], cell :: Int, right :: [Int] }
instance Show Tape where
show (Tape ls c rs) = show [reverse ls,[c],rs]
data Op = Plus | Minus | GoLeft | GoRight | Output | Input | Loop [Op] deriving (Eq, Show)
removeComments :: [Char] -> [Char]
removeComments xs = filter (`elem` "+-<>.,[]") xs
parseOp :: [Char] -> Maybe (Op, [Char])
parseOp ('+':cs) = Just (Plus, cs)
parseOp ('-':cs) = Just (Minus, cs)
parseOp ('<':cs) = Just (GoLeft, cs)
parseOp ('>':cs) = Just (GoRight, cs)
parseOp ('.':cs) = Just (Output, cs)
parseOp (',':cs) = Just (Input, cs)
parseOp ('[':cs) = case parseOps cs of
(prog, (']':cs')) -> Just (Loop prog, cs')
_ -> Nothing
parseOp _ = Nothing
parseOps :: [Char] -> ([Op],[Char])
parseOps cs = go cs [] where
go cs acc = case parseOp cs of
Nothing -> (reverse acc, cs)
Just (op, cs') -> go cs' (op:acc)
parse :: String -> [Op]
parse prog = case parseOps $ removeComments $ prog of
(ops, []) -> ops
(ops, rest) -> error $ "Parsed: " ++ show ops ++ ", Rest: " ++ rest
execute :: [Op] -> IO Tape
execute prog = exec prog (Tape [] 0 [])
exec :: [Op] -> Tape -> IO Tape
exec [] tape = return tape
exec (Plus:prog) (Tape ls c rs) = exec prog (Tape ls (c+1) rs)
exec (Minus:prog) (Tape ls c rs) = exec prog (Tape ls (c-1) rs)
exec (GoLeft:prog) (Tape ls c rs) =
let (hd,tl) = uncons ls in exec prog (Tape tl hd (c:rs))
exec (GoRight:prog) (Tape ls c rs) =
let (hd,tl) = uncons rs in exec prog (Tape (c:ls) hd tl)
exec (Output:prog) tape = do
printAsChar (cell tape)
exec prog tape
exec (Input:prog) (Tape ls _ rs) = do
n <- getChar
exec prog (Tape ls (digitToInt n) rs)
exec (Loop loop:prog) tape @ (Tape ls 0 rs) = exec prog tape
exec again@(Loop loop:prog) tape = do
tape' <- exec loop tape
exec (if (cell tape') == 0 then prog else again) tape'
uncons :: [Int] -> (Int,[Int])
uncons [] = (0,[])
uncons (x:xs) = (x,xs)
printAsChar :: Int -> IO ()
printAsChar i = putStr $ [chr i]
main = do
tape <- execute $ parse helloWorld
putStrLn $ "\n" ++ show tape ++ "\n"
helloWorld =
">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++" ++
"[<++++>-]<.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------." ++
"[-]>++++++++[<++++>-]<+.[-]++++++++++."
[Edit]
parseOp can be simplified to:
ops = [('+', Plus),('-', Minus),('<',GoLeft),('>',GoRight),('.',Output),(',',Input)]
parseOp :: [Char] -> Maybe (Op, [Char])
parseOp ('[':cs) = case parseOps cs of
(prog, (']':cs')) -> Just (Loop prog, cs')
_ -> Nothing
parseOp (c:cs) = fmap (flip (,) cs) $ lookup c ops
parseOp [] = Nothing
where
instead oflet/in
, but other than that, there's really not much I can see that could be simplified. \$\endgroup\$