From 19031d6c87120db91c2849ce367930f4b089e5e0 Mon Sep 17 00:00:00 2001
From: tomsmeding <hallo@tomsmeding.nl>
Date: Mon, 14 Sep 2015 22:49:24 +0200
Subject: cleanup of I and W, and addition of g and R

---
 rip-lang.txt |  3 +++
 rip.hs       | 74 ++++++++++++++++++++++++++++++++++++------------------------
 2 files changed, 48 insertions(+), 29 deletions(-)

diff --git a/rip-lang.txt b/rip-lang.txt
index 2c553cd..0eb43b8 100644
--- a/rip-lang.txt
+++ b/rip-lang.txt
@@ -10,6 +10,7 @@ D: duplicate
 i: increment
 d: decrement
 r: pops the number of items to rotate clockwise
+R: pops the number of items to rotate anti-clockwise
 + - * /: just what you expect
 > < =: comparisons; booleans are 1 and 0, as you expect
 [ ... ]: syntactical; a codeblock
@@ -17,6 +18,8 @@ I: pops boolean, conditionally executing the codeblock that should follow the I,
 W: I, but then "while" instead of "if"
 o: outputs the top value as an ascii char
 O: outputs the top value as a number
+g: gets a character and pushes the ascii value
+S: outputs a stackdump
 whitespace: nop
 
 
diff --git a/rip.hs b/rip.hs
index 3da26ea..e10ddb5 100644
--- a/rip.hs
+++ b/rip.hs
@@ -19,6 +19,20 @@ parenpairs = go 0 []
 	      go i st (_:cs) = go (i+1) st cs
 	      go _ (_:_) [] = error "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 -> (String,String)
+getcodeblock' s = (inblock,afterblock)
+	where
+		afterwhite = dropWhile isSpace s
+		parens = parenpairs afterwhite
+		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)
 rip :: String -> IO [Stackelem]
@@ -54,6 +68,14 @@ rip' (x:xs) st = case x of
 				(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!
+
 	'+' ->
 		rip' xs (a + b : cs)
 			where (b:a:cs) = st
@@ -83,41 +105,31 @@ rip' (x:xs) st = case x of
 			where (b:a:cs) = st
 
 	'I' ->
-		if head afterwhite /= '['
-			then error "rip -- no block following I"
-			else if head st /= 0
-				then do
-					newstack <- rip' inblock (tail st)
-					rip' afterblock newstack
-				else rip' afterblock st
-			where
-				afterwhite = dropWhile isSpace xs
-				parens = parenpairs afterwhite
-				mainpair = minimum parens
-				blockend = snd mainpair
-				inblock = drop 1 $ take blockend afterwhite
-				afterblock = drop (blockend + 1) afterwhite
+		either
+			(\_ -> error "rip -- no block following I")
+			(\(inblock,afterblock) ->
+				if head st /= 0
+					then do
+						newstack <- rip' inblock (tail st)
+						rip' afterblock newstack
+					else rip' afterblock (tail st))
+			(getcodeblock xs)
 
 	'W' ->
-		if head afterwhite /= '['
-			then error "rip -- no block following W"
-			else if head st /= 0
-				then do
-					newstack <- doloop (tail st)
-					rip' afterblock newstack
-				else rip' afterblock (tail st)
-			where
-				afterwhite = dropWhile isSpace xs
-				parens = parenpairs afterwhite
-				mainpair = minimum parens
-				blockend = snd mainpair
-				inblock = drop 1 $ take blockend afterwhite
-				afterblock = drop (blockend + 1) afterwhite
-				doloop st = do
+		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
+				in if head st /= 0
+					then do
+						newstack <- doloop (tail st)
+						rip' afterblock newstack
+					else rip' afterblock (tail st))
+			(getcodeblock xs)
 
 	'o' -> do
 		putStr [chr (fromIntegral $ head st)]
@@ -127,6 +139,10 @@ rip' (x:xs) st = case x of
 		putStr $ show (head st)
 		rip' xs (tail st)
 
+	'g' -> do
+		c <- getChar
+		rip' xs (fromIntegral (ord c) : st)
+
 	'S' -> do
 		print st
 		rip' xs st
-- 
cgit v1.2.3-54-g00ecf