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