diff options
| -rw-r--r-- | rip-lang.txt | 3 | ||||
| -rw-r--r-- | rip.hs | 74 |
2 files changed, 48 insertions, 29 deletions
diff --git a/rip-lang.txt b/rip-lang.txt index 2c553cd..0eb43b8 100644 --- a/rip-lang.txt +++ b/rip-lang.txt @@ -10,6 +10,7 @@ D: duplicate i: increment d: decrement r: pops the number of items to rotate clockwise +R: pops the number of items to rotate anti-clockwise + - * /: just what you expect > < =: comparisons; booleans are 1 and 0, as you expect [ ... ]: syntactical; a codeblock @@ -17,6 +18,8 @@ I: pops boolean, conditionally executing the codeblock that should follow the I, 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 +g: gets a character and pushes the ascii value +S: outputs a stackdump whitespace: nop @@ -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 |