add 'n' and de-tabify because of ghc's new -fwarn-tabs

2 files changed, 173 insertions, 144 deletions

diff --git a/rip-lang.txt b/rip-lang.txt
index 72ae8cb..52de72c 100644
--- a/rip-lang.txt
+++ b/rip-lang.txt
@@ -13,6 +13,7 @@ r: pops the number of items to rotate clockwise
 R: pops the number of items to rotate anti-clockwise
 a s m q: + - * / (add, subtract, multiply, quotient (integer))
 G L E: greater, less, equal; booleans are 1 and 0, as you expect
+n: not; equivalent to 0E
 [ ... ]: syntactical; a codeblock
 I: pops boolean, conditionally executing the codeblock that should follow the I, depending on the boolean (aka "if")
 W: I, but then "while" instead of "if"
@@ -37,3 +38,8 @@ Fibonacci:
 	9io
 	D3r+
 1]
+
+
+Cat:
+
+gD01sEnW[ogD01sEn]
diff --git a/rip.hs b/rip.hs
index 6dddb20..9e390cd 100644
--- a/rip.hs
+++ b/rip.hs
@@ -2,7 +2,9 @@ module Main where
 
 import System.Environment
 import System.Exit
+import System.IO.Error
 import Control.Exception
+import Control.Monad
 import Data.Char
 import Data.Either
 
@@ -10,7 +12,10 @@ type Stackelem = Integer
 
 
 c_ripmode :: Bool
-c_ripmode = True
+c_ripmode = False
+
+c_debugmode :: Bool
+c_debugmode = False
 
 
 booltoint :: (Integral a) => Bool -> a
@@ -19,10 +24,10 @@ booltoint True = 1
 
 riperror :: String -> IO a
 riperror s = do
-	if c_ripmode
-		then putStrLn "rip"
-		else putStrLn $ "ERROR: " ++ s
-	exitFailure
+    if c_ripmode
+        then putStrLn "rip"
+        else putStrLn $ "ERROR: " ++ s
+    exitFailure
 
 fromRight :: Either a b -> b
 fromRight (Right r) = r
@@ -30,30 +35,37 @@ fromRight (Right r) = r
 fromLeft :: Either a b -> a
 fromLeft (Left l) = l
 
+safeGetChar :: IO (Maybe Char)
+safeGetChar =
+    catch
+        (liftM Just getChar)
+        ((\ex -> if isEOFError ex then return Nothing else ioError ex)
+            :: IOError -> IO (Maybe Char))
+
 parenpairs :: String -> Either String [(Int,Int)]
 parenpairs = go 0 []
-	--       index  stack   string
-	where go   _      []      []    = Right []
-	      go   i      st   ('[':cs) = go (i+1) (i:st) cs
-	      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   _    (_:_)     []    = Left "rip -- unmatched open bracket"
+    --       index  stack   string
+    where go   _      []      []    = Right []
+          go   i      st   ('[':cs) = go (i+1) (i:st) cs
+          go   i    (s:st) (']':cs) = either Left (\x -> Right $ (s,i):x) $ go (i+1) st cs
+          go   i      []   (']':cs) = Left "Unmatched closing bracket"
+          go   i      st    (_:cs)  = go (i+1) st cs
+          go   _    (_:_)     []    = Left "Unmatched open bracket"
 
 -- returns string in and after codeblock
 getcodeblock :: String -> Either String (String,String)
-getcodeblock s = if head (dropWhile isSpace s) == '[' then getcodeblock' s else Left "rip -- no codeblock when expected"
+getcodeblock s = if head (dropWhile isSpace s) == '[' then getcodeblock' s else Left "No codeblock when expected"
 
 getcodeblock' :: String -> Either String (String,String)
 getcodeblock' s = either Left (\_ -> Right (inblock,afterblock)) parenserr
-	where
-		afterwhite = dropWhile isSpace s
-		parenserr = parenpairs afterwhite
-		parens = fromRight parenserr
-		mainpair = minimum parens
-		blockend = snd mainpair
-		inblock = drop 1 $ take blockend afterwhite
-		afterblock = drop (blockend + 1) afterwhite
+    where
+        afterwhite = dropWhile isSpace s
+        parenserr = parenpairs afterwhite
+        parens = fromRight parenserr
+        mainpair = minimum parens
+        blockend = snd mainpair
+        inblock = drop 1 $ take blockend afterwhite
+        afterblock = drop (blockend + 1) afterwhite
 
 -- returns the resulting stack
 -- rip: Rip InterPreter (recursive acronym)
@@ -62,130 +74,141 @@ rip s = rip' s []
 
 rip' :: String -> [Stackelem] -> IO [Stackelem]
 rip' [] st = return st
-rip' (x:xs) st = case x of
-	n | '0' <= n && n <= '9' ->
-		rip' xs (fromIntegral (ord n - ord '0') : st)
-
-	'P' ->
-		rip' xs (tail st)
-
-	'S' ->
-		rip' xs (b:a:cs)
-			where (a:b:cs) = st
-
-	'D' ->
-		rip' xs (head st : st)
-
-	'i' ->
-		rip' xs (head st + 1 : tail st)
-
-	'd' ->
-		rip' xs (head st - 1 : tail st)
-
-	'r' ->
-		rip' xs res
-			where
-				n = head st
-				newst = tail st
-				(begin, rest) = (take (fromIntegral n) newst, drop (fromIntegral n) newst)
-				res = tail begin ++ head begin : rest
-
-	'R' ->
-		rip' xs res
-			where
-				n = head st
-				newst = tail st
-				(begin, rest) = (take (fromIntegral n) newst, drop (fromIntegral n) newst)
-				res = last begin : init begin ++ rest  --SLOW!
-
-	'a' ->
-		rip' xs (a + b : cs)
-			where (b:a:cs) = st
-
-	's' ->
-		rip' xs (a - b : cs)
-			where (b:a:cs) = st
-
-	'm' ->
-		rip' xs (a * b : cs)
-			where (b:a:cs) = st
-
-	'q' ->
-		rip' xs (a `div` b : cs)
-			where (b:a:cs) = st
-
-	'G' ->
-		rip' xs (booltoint (a > b) : cs)
-			where (b:a:cs) = st
-
-	'L' ->
-		rip' xs (booltoint (a < b) : cs)
-			where (b:a:cs) = st
-
-	'E' ->
-		rip' xs (booltoint (a == b) : cs)
-			where (b:a:cs) = st
-
-	'I' ->
-		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)
-
-	'W' ->
-		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)
-
-	'o' -> do
-		putStr [chr (fromIntegral $ head st)]
-		rip' xs (tail st)
-
-	'O' -> do
-		putStr $ show (head st)
-		rip' xs (tail st)
-
-	'g' -> do
-		c <- getChar
-		rip' xs (fromIntegral (ord c) : st)
-
-	'$' -> do
-		print st
-		rip' xs st
-
-	c | isSpace c ->
-		rip' xs st
-
-	_ -> riperror $ "Unknown command '" ++ [x,'\'']
+rip' (x:xs) st = do
+    if c_debugmode then print st else return ()
+    case x of
+        n | '0' <= n && n <= '9' ->
+            rip' xs (fromIntegral (ord n - ord '0') : st)
+
+        'P' ->
+            rip' xs (tail st)
+
+        'S' ->
+            rip' xs (b:a:cs)
+                where (a:b:cs) = st
+
+        'D' ->
+            rip' xs (head st : st)
+
+        'i' ->
+            rip' xs (head st + 1 : tail st)
+
+        'd' ->
+            rip' xs (head st - 1 : tail st)
+
+        'r' ->
+            rip' xs res
+                where
+                    n = fromIntegral $ head st
+                    newst = tail st
+                    (begin, rest) = (take n newst, drop n newst)
+                    res = tail begin ++ head begin : rest
+
+        'R' ->
+            rip' xs res
+                where
+                    n = fromIntegral $ head st
+                    newst = tail st
+                    (begin, rest) = (take n newst, drop n newst)
+                    res = last begin : init begin ++ rest  --SLOW!
+
+        'a' ->
+            rip' xs (a + b : cs)
+                where (b:a:cs) = st
+
+        's' ->
+            rip' xs (a - b : cs)
+                where (b:a:cs) = st
+
+        'm' ->
+            rip' xs (a * b : cs)
+                where (b:a:cs) = st
+
+        'q' ->
+            rip' xs (a `div` b : cs)
+                where (b:a:cs) = st
+
+        'G' ->
+            rip' xs (booltoint (a > b) : cs)
+                where (b:a:cs) = st
+
+        'L' ->
+            rip' xs (booltoint (a < b) : cs)
+                where (b:a:cs) = st
+
+        'E' ->
+            rip' xs (booltoint (a == b) : cs)
+                where (b:a:cs) = st
+
+        'n' ->
+            rip' xs (booltoint (head st == 0) : tail st)
+
+        'I' ->
+            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)
+
+        'W' ->
+            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)
+
+        'o' -> do
+            let n = fromIntegral (head st)
+            res <- try $ evaluate $ chr n :: IO (Either SomeException Char)
+            either
+                (\ex -> riperror $ "Invalid character value " ++ (show n))
+                (\c -> do
+                    putChar c
+                    rip' xs (tail st))
+                res
+
+        'O' -> do
+            putStr $ show (head st)
+            rip' xs (tail st)
+
+        'g' -> do
+            n <- liftM (maybe (-1) ord) safeGetChar
+            rip' xs (fromIntegral n : st)
+
+        '$' -> do
+            print st
+            rip' xs st
+
+        c | isSpace c ->
+            rip' xs st
+
+        _ -> riperror $ "Unknown command '" ++ [x,'\'']
 
 
 main :: IO ()
 main = do
-	argv <- getArgs
-	if length argv /= 1
-		then do
-			putStrLn "Pass a rip file as the command-line argument"
-			exitFailure
-		else do
-			source <- readFile (argv !! 0)
-			rip source
-			return ()
+    argv <- getArgs
+    if length argv /= 1
+        then do
+            putStrLn "Pass a rip file as the command-line argument"
+            exitFailure
+        else do
+            source <- readFile (argv !! 0)
+            rip source
+            return ()