diff options
| -rw-r--r-- | fibo.rip | 6 | ||||
| -rw-r--r-- | rip-lang.txt | 36 | ||||
| -rw-r--r-- | rip.hs | 153 | ||||
| -rw-r--r-- | testif.rip | 4 |
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] @@ -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] |