aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore3
-rw-r--r--rip.hs79
-rw-r--r--testif.rip1
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
diff --git a/rip.hs b/rip.hs
index 3c2ab2b..6dddb20 100644
--- a/rip.hs
+++ b/rip.hs
@@ -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 ()
diff --git a/testif.rip b/testif.rip
index f4ebcee..03e1694 100644
--- a/testif.rip
+++ b/testif.rip
@@ -4,3 +4,4 @@ D I [1 O]
1 S s
I [0 O]
9io
+h <-- this char errors