aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--fibo.rip6
-rw-r--r--rip-lang.txt36
-rw-r--r--rip.hs153
-rw-r--r--testif.rip4
4 files changed, 199 insertions, 0 deletions
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]