From 3aefc346f893c14a0832e09807e7687f03a68590 Mon Sep 17 00:00:00 2001
From: tomsmeding <hallo@tomsmeding.nl>
Date: Sun, 13 Sep 2015 21:52:36 +0200
Subject: Initial!

---
 fibo.rip     |   6 +++
 rip-lang.txt |  36 ++++++++++++++
 rip.hs       | 153 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 testif.rip   |   4 ++
 4 files changed, 199 insertions(+)
 create mode 100644 fibo.rip
 create mode 100644 rip-lang.txt
 create mode 100644 rip.hs
 create mode 100644 testif.rip

diff --git a/fibo.rip b/fibo.rip
new file mode 100644
index 0000000..0033d14
--- /dev/null
+++ b/fibo.rip
@@ -0,0 +1,6 @@
+01
+1W[
+	DO
+	9io
+	D3r+
+1]
diff --git a/rip-lang.txt b/rip-lang.txt
new file mode 100644
index 0000000..2c553cd
--- /dev/null
+++ b/rip-lang.txt
@@ -0,0 +1,36 @@
+Rip -- a stack-based rip language
+=================================
+
+All stack items are integers, of unspecified but constant size
+
+0-9: push value
+p: pop
+s: swap
+D: duplicate
+i: increment
+d: decrement
+r: pops the number of items to rotate clockwise
++ - * /: just what you expect
+> < =: comparisons; booleans are 1 and 0, as you expect
+[ ... ]: 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"
+o: outputs the top value as an ascii char
+O: outputs the top value as a number
+whitespace: nop
+
+
+Any error causes the interpreter to exit, saying "rip".
+
+
+Example code
+------------
+
+Fibonacci:
+
+01
+1W[
+	DO
+	9io
+	D3r+
+1]
diff --git a/rip.hs b/rip.hs
new file mode 100644
index 0000000..3da26ea
--- /dev/null
+++ b/rip.hs
@@ -0,0 +1,153 @@
+module Main where
+
+import System.Environment
+import System.Exit
+import Data.Char
+
+type Stackelem = Integer
+
+booltoint :: (Integral a) => Bool -> a
+booltoint False = 0
+booltoint True = 1
+
+parenpairs :: String -> [(Int,Int)]
+parenpairs = go 0 []
+	where go _ [] [] = []
+	      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 st (_:cs) = go (i+1) st cs
+	      go _ (_:_) [] = error "rip -- unmatched open bracket"
+
+-- returns the resulting stack
+-- rip: Rip InterPreter (recursive acronym)
+rip :: String -> IO [Stackelem]
+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
+
+	'+' ->
+		rip' xs (a + b : cs)
+			where (b:a:cs) = st
+
+	'-' ->
+		rip' xs (a - b : cs)
+			where (b:a:cs) = st
+
+	'*' ->
+		rip' xs (a * b : cs)
+			where (b:a:cs) = st
+
+	'/' ->
+		rip' xs (a `div` b : cs)
+			where (b:a:cs) = st
+
+	'>' ->
+		rip' xs (booltoint (a > b) : cs)
+			where (b:a:cs) = st
+
+	'<' ->
+		rip' xs (booltoint (a < b) : cs)
+			where (b:a:cs) = st
+
+	'=' ->
+		rip' xs (booltoint (a == b) : cs)
+			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
+
+	'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
+					newstack <- rip' inblock st
+					if head newstack /= 0
+						then doloop $ tail newstack
+						else return newstack
+
+	'o' -> do
+		putStr [chr (fromIntegral $ head st)]
+		rip' xs (tail st)
+
+	'O' -> do
+		putStr $ show (head st)
+		rip' xs (tail st)
+
+	'S' -> do
+		print st
+		rip' xs st
+
+	c | isSpace c ->
+		rip' xs st
+
+	_ -> do
+		putStr "(error) Stack: "
+		print st
+		ioError (userError $ "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 ()
diff --git a/testif.rip b/testif.rip
new file mode 100644
index 0000000..b11c6b1
--- /dev/null
+++ b/testif.rip
@@ -0,0 +1,4 @@
+2 1 >
+I [1 O]
+2 1 <
+I [0 O]
-- 
cgit v1.2.3-70-g09d2