diff options
Diffstat (limited to 'rip.hs')
-rw-r--r-- | rip.hs | 153 |
1 files changed, 153 insertions, 0 deletions
@@ -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 () |