diff options
| -rw-r--r-- | .gitignore | 3 | ||||
| -rw-r--r-- | rip.hs | 79 | ||||
| -rw-r--r-- | testif.rip | 1 |
3 files changed, 54 insertions, 29 deletions
diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..dc5aaf2 --- /dev/null +++ b/.gitignore @@ -0,0 +1,3 @@ +rip +*.hi +*.o @@ -2,33 +2,54 @@ module Main where import System.Environment import System.Exit +import Control.Exception import Data.Char +import Data.Either type Stackelem = Integer + +c_ripmode :: Bool +c_ripmode = True + + booltoint :: (Integral a) => Bool -> a booltoint False = 0 booltoint True = 1 -parenpairs :: String -> [(Int,Int)] +riperror :: String -> IO a +riperror s = do + if c_ripmode + then putStrLn "rip" + else putStrLn $ "ERROR: " ++ s + exitFailure + +fromRight :: Either a b -> b +fromRight (Right r) = r + +fromLeft :: Either a b -> a +fromLeft (Left l) = l + +parenpairs :: String -> Either String [(Int,Int)] parenpairs = go 0 [] -- index stack string - where go _ [] [] = [] + where go _ [] [] = Right [] go i st ('[':cs) = go (i+1) (i:st) cs - go i (s:st) (']':cs) = (s,i) : go (i+1) st cs - go i [] (']':cs) = error "rip -- unmatched closing bracket" + go i (s:st) (']':cs) = either Left (\x -> Right $ (s,i):x) $ go (i+1) st cs + go i [] (']':cs) = Left "rip -- unmatched closing bracket" go i st (_:cs) = go (i+1) st cs - go _ (_:_) [] = error "rip -- unmatched open bracket" + go _ (_:_) [] = Left "rip -- unmatched open bracket" -- returns string in and after codeblock -getcodeblock :: String -> Either () (String,String) -getcodeblock s = if head (dropWhile isSpace s) == '[' then Right (getcodeblock' s) else Left () +getcodeblock :: String -> Either String (String,String) +getcodeblock s = if head (dropWhile isSpace s) == '[' then getcodeblock' s else Left "rip -- no codeblock when expected" -getcodeblock' :: String -> (String,String) -getcodeblock' s = (inblock,afterblock) +getcodeblock' :: String -> Either String (String,String) +getcodeblock' s = either Left (\_ -> Right (inblock,afterblock)) parenserr where afterwhite = dropWhile isSpace s - parens = parenpairs afterwhite + parenserr = parenpairs afterwhite + parens = fromRight parenserr mainpair = minimum parens blockend = snd mainpair inblock = drop 1 $ take blockend afterwhite @@ -106,31 +127,34 @@ rip' (x:xs) st = case x of where (b:a:cs) = st 'I' -> - either - (\_ -> error "rip -- no block following I") - (\(inblock,afterblock) -> + let maybecb = getcodeblock xs + in case maybecb of + Left s -> riperror s + + Right (inblock,afterblock) -> if head st /= 0 then do newstack <- rip' inblock (tail st) rip' afterblock newstack - else rip' afterblock (tail st)) - (getcodeblock xs) + else rip' afterblock (tail st) 'W' -> - either - (\_ -> error "rip -- no block following W") - (\(inblock,afterblock) -> - let doloop st = do - newstack <- rip' inblock st - if head newstack /= 0 - then doloop $ tail newstack - else return newstack + let maybecb = getcodeblock xs + in case maybecb of + Left s -> riperror s + + Right (inblock,afterblock) -> + let + doloop st = do + newstack <- rip' inblock st + if head newstack /= 0 + then doloop $ tail newstack + else return newstack in if head st /= 0 then do newstack <- doloop (tail st) rip' afterblock newstack - else rip' afterblock (tail st)) - (getcodeblock xs) + else rip' afterblock (tail st) 'o' -> do putStr [chr (fromIntegral $ head st)] @@ -151,10 +175,7 @@ rip' (x:xs) st = case x of c | isSpace c -> rip' xs st - _ -> do - putStr "(error) Stack: " - print st - ioError (userError $ "Unknown command '" ++ [x,'\'']) + _ -> riperror $ "Unknown command '" ++ [x,'\''] main :: IO () @@ -4,3 +4,4 @@ D I [1 O] 1 S s I [0 O] 9io +h <-- this char errors |