diff options
| -rw-r--r-- | README.md | 4 | ||||
| -rw-r--r-- | rip.hs | 165 | ||||
| -rw-r--r-- | stdlib.rip | 19 | ||||
| -rw-r--r-- | stdlibtest.rip | 25 |
4 files changed, 155 insertions, 58 deletions
@@ -21,6 +21,10 @@ All stack items are signed bigints. - `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 +- `C`: open a socket connection to specified ip address, in 32- or 128-bit format for ipv4 or ipv6 resp., and port. Returns identifier +- `w`: takes identifier and char; writes char to specified socket (leaves socket on stack) +- `t`: takes identifier; takes char from specified socket and pushes it (leaves socket on stack) +- `c`: takes identifier; closes that connection - `F<bla>[code]`: define a function named "bla" with the body "code" - `<bla>`: call the function named "bla" - `$`: outputs a stackdump @@ -2,14 +2,18 @@ module Main where import System.Environment import System.Exit +import System.IO import System.IO.Error import Control.Exception import Control.Monad import Data.Char import Data.Either import Data.Maybe -import Data.List as List -import Data.Map.Strict as Map +import Data.List +import qualified Data.Map.Strict as Map +import Data.Map.Strict ((!)) +import Network.Socket +import Numeric type Stackelem = Integer @@ -41,13 +45,36 @@ fromLeft (Left l) = l ordI :: (Integral a) => Char -> a ordI = fromIntegral . ord -safeGetChar :: IO (Maybe Char) -safeGetChar = +pad :: a -> Int -> [a] -> [a] +pad c n s + | length s >= n = s + | otherwise = c : pad c (n-1) s + +getBytes :: Stackelem -> [Int] +getBytes = reverse . getBytes' + +getBytes' :: Stackelem -> [Int] +getBytes' 0 = [] +getBytes' n = fromIntegral m : getBytes' q + where (q,m) = divMod n 256 + +hex :: (Integral a, Show a) => a -> String +hex n = showHex n "" + +pairs :: [a] -> [(a,a)] +pairs [] = [] +pairs (a:b:cs) = (a,b) : pairs cs + +safeHGetChar :: Handle -> IO (Maybe Char) +safeHGetChar h = catch - (liftM Just getChar) + (liftM Just $ hGetChar h) ((\ex -> if isEOFError ex then return Nothing else ioError ex) :: IOError -> IO (Maybe Char)) +safeGetChar :: IO (Maybe Char) +safeGetChar = safeHGetChar stdin + parenpairs :: Char -> Char -> String -> Either String [(Int,Int)] parenpairs open close s = go 0 [] s -- index, stack, string @@ -104,41 +131,45 @@ getfuncname' (_:xs) = then Left "No closing '>' in function name" else Right name where - maybeidx = List.findIndex (== '>') xs + maybeidx = findIndex (== '>') xs name = take (fromJust maybeidx) xs -- returns the resulting stack -- rip: Rip InterPreter (recursive acronym) -rip :: String -> IO [Stackelem] -rip s = rip' s Map.empty [] +rip :: String -> IO ([Stackelem],Map.Map Stackelem Handle) +rip s = rip' s Map.empty Map.empty [] --- code function map stack resulting stack -rip' :: String -> Map.Map String String -> [Stackelem] -> IO [Stackelem] -rip' [] _ st = return st -rip' code@(x:xs) fns st = do +-- code function map filedesc table stack resulting stack +rip' :: String -- code + -> Map.Map String String -- function map + -> Map.Map Stackelem Handle -- filedecs table + -> [Stackelem] -- stack + -> IO ([Stackelem],Map.Map Stackelem Handle) -- resulting stack and filedesc table +rip' [] _ conns st = return (st,conns) +rip' code@(x:xs) fns conns st = do if c_debugmode then print st else return () case x of n | '0' <= n && n <= '9' -> - rip' xs fns (fromIntegral (ord n - ord '0') : st) + rip' xs fns conns (fromIntegral (ord n - ord '0') : st) 'P' -> - rip' xs fns (tail st) + rip' xs fns conns (tail st) 'S' -> - rip' xs fns (b:a:cs) + rip' xs fns conns (b:a:cs) where (a:b:cs) = st 'D' -> - rip' xs fns (head st : st) + rip' xs fns conns (head st : st) 'i' -> - rip' xs fns (head st + 1 : tail st) + rip' xs fns conns (head st + 1 : tail st) 'd' -> - rip' xs fns (head st - 1 : tail st) + rip' xs fns conns (head st - 1 : tail st) 'r' -> - rip' xs fns res + rip' xs fns conns res where n = fromIntegral $ head st newst = tail st @@ -146,7 +177,7 @@ rip' code@(x:xs) fns st = do res = tail begin ++ head begin : rest 'R' -> - rip' xs fns res + rip' xs fns conns res where n = fromIntegral $ head st newst = tail st @@ -154,46 +185,46 @@ rip' code@(x:xs) fns st = do res = last begin : init begin ++ rest --SLOW! 'l' -> - rip' xs fns (fromIntegral (length st) : st) + rip' xs fns conns (fromIntegral (length st) : st) 'a' -> - rip' xs fns (a + b : cs) + rip' xs fns conns (a + b : cs) where (b:a:cs) = st 's' -> - rip' xs fns (a - b : cs) + rip' xs fns conns (a - b : cs) where (b:a:cs) = st 'm' -> - rip' xs fns (a * b : cs) + rip' xs fns conns (a * b : cs) where (b:a:cs) = st 'q' -> - rip' xs fns (a `div` b : cs) + rip' xs fns conns (a `div` b : cs) where (b:a:cs) = st 'M' -> - rip' xs fns (a `mod` b : cs) + rip' xs fns conns (a `mod` b : cs) where (b:a:cs) = st 'p' -> - rip' xs fns (a ^ b : cs) + rip' xs fns conns (a ^ b : cs) where (b:a:cs) = st 'G' -> - rip' xs fns (booltoint (a > b) : cs) + rip' xs fns conns (booltoint (a > b) : cs) where (b:a:cs) = st 'L' -> - rip' xs fns (booltoint (a < b) : cs) + rip' xs fns conns (booltoint (a < b) : cs) where (b:a:cs) = st 'E' -> - rip' xs fns (booltoint (a == b) : cs) + rip' xs fns conns (booltoint (a == b) : cs) where (b:a:cs) = st 'n' -> - rip' xs fns (booltoint (head st == 0) : tail st) + rip' xs fns conns (booltoint (head st == 0) : tail st) 'I' -> let maybecb = getcodeblock xs @@ -203,9 +234,9 @@ rip' code@(x:xs) fns st = do Right (inblock,afterblock) -> if head st /= 0 then do - newstack <- rip' inblock fns (tail st) - rip' afterblock fns newstack - else rip' afterblock fns (tail st) + (newstack,newconns) <- rip' inblock fns conns (tail st) + rip' afterblock fns newconns newstack + else rip' afterblock fns conns (tail st) 'W' -> let maybecb = getcodeblock xs @@ -214,16 +245,16 @@ rip' code@(x:xs) fns st = do Right (inblock,afterblock) -> let - doloop st = do - newstack <- rip' inblock fns st + doloop st cn = do + (newstack,newconns) <- rip' inblock fns cn st if head newstack /= 0 - then doloop $ tail newstack - else return $ tail newstack + then doloop (tail newstack) newconns + else return (tail newstack,newconns) in if head st /= 0 then do - newstack <- doloop (tail st) - rip' afterblock fns newstack - else rip' afterblock fns (tail st) + (newstack,newconns) <- doloop (tail st) conns + rip' afterblock fns newconns newstack + else rip' afterblock fns conns (tail st) 'o' -> do let n = fromIntegral (head st) @@ -232,16 +263,46 @@ rip' code@(x:xs) fns st = do (\ex -> riperror $ "Invalid character value " ++ (show n)) (\c -> do putChar c - rip' xs fns (tail st)) + rip' xs fns conns (tail st)) res 'O' -> do putStr $ show (head st) - rip' xs fns (tail st) + rip' xs fns conns (tail st) 'g' -> do n <- liftM (maybe (-1) ord) safeGetChar - rip' xs fns (fromIntegral n : st) + rip' xs fns conns (fromIntegral n : st) + + 'C' -> do + let (portint:hostnameint:newst) = st + hostname = + if hostnameint < 2^32 + then intercalate "." $ map show $ getBytes hostnameint + else intercalate ":" $ map (\(a,b) -> pad '0' 2 (hex a) ++ pad '0' 2 (hex b)) $ pairs $ pad 0 16 $ getBytes hostnameint + addrinfo <- liftM head $ getAddrInfo (Just $ defaultHints {addrSocketType = Stream}) (Just hostname) (Just $ show portint) + sock <- socket (addrFamily addrinfo) Stream defaultProtocol + connect sock (addrAddress addrinfo) + h <- socketToHandle sock ReadWriteMode + let ident = fromIntegral $ succ $ Map.size conns + rip' xs fns (Map.insert ident h conns) $ ident : newst + + 'c' -> do + let (ident:newst) = st + hClose $ conns ! ident + let newconns = Map.delete ident conns + rip' xs fns newconns newst + + 'w' -> do + let (c:newst@(ident:_)) = st + hPutChar (conns ! ident) $ chr $ fromIntegral c + rip' xs fns conns newst + + 't' -> do + let (ident:_) = st + c <- liftM (maybe (-1) ordI) $ safeHGetChar $ conns ! ident + --c <- liftM ordI $ hGetChar $ conns ! ident + rip' xs fns conns $ c : st '<' -> case (getfuncname code) of @@ -250,8 +311,8 @@ rip' code@(x:xs) fns st = do Nothing -> riperror $ "Function '" ++ name ++ "' not found" Just s -> let newcode = drop (length name + 1) xs in do - newstack <- rip' s fns st - rip' newcode fns newstack + (newstack,newconns) <- rip' s fns conns st + rip' newcode fns newconns newstack 'F' -> case (getfuncname xs) of Left s -> riperror s @@ -260,22 +321,22 @@ rip' code@(x:xs) fns st = do Nothing -> case (getcodeblock $ drop (length name + 2) xs) of Left s -> riperror s Right (inblock,afterblock) -> - rip' afterblock (Map.insert name inblock fns) st + rip' afterblock (Map.insert name inblock fns) conns st '#' -> case (getfuncname xs) of Left s -> riperror s Right name -> do contents <- readFile name - rip' (contents ++ drop (length name + 2) xs) fns st + rip' (contents ++ drop (length name + 2) xs) fns conns st - '\'' -> rip' (tail xs) fns $ ordI (head xs) : st + '\'' -> rip' (tail xs) fns conns $ ordI (head xs) : st '$' -> do - (putStrLn . List.intercalate " " . List.map show . reverse) st - rip' xs fns st + (putStrLn . intercalate " " . map show . reverse) st + rip' xs fns conns st c | isSpace c -> - rip' xs fns st + rip' xs fns conns st _ -> riperror $ "Unknown command '" ++ [x,'\''] @@ -1,7 +1,7 @@ 0I[prints string; destructive] F<strprint>[ <strrev> - 97aDm + 28p SDW[ D3RD3rM o D3rq D] @@ -10,23 +10,23 @@ F<strprint>[ 0I[takes string char; returns string+char] F<strpush>[ - S97aDmma + S28pma ] 0I[reverses string in place] F<strrev>[ 0S DW[ - D 97aDm D 3r M 3r q 3r S 97aDm m a S + D 28p D 3r M 3r q 3r S 28p m a S D] P ] 0I[concatenates two strings] F<strcat>[ - <strrev> 97aDm S + <strrev> 28p S DW[ - S D 3r S D 3R M 4R 97aDmma 3r S D 3r q + S D 3r S D 3R M 4R 28pma 3r S D 3r q D] PP ] @@ -35,7 +35,7 @@ F<strcat>[ F<mkstr>[ 0S DW[ - D2aR 3R 97aDm m a S d + D2aR 3R 28p m a S d D] P ] @@ -145,3 +145,10 @@ F<varget>[ <varhaulup> SP ] + + +0I[takes socket and string; sends string to socket] +F<strsend>[ + <strrev> + DW[D28pM3RSwS28pqD]P +] diff --git a/stdlibtest.rip b/stdlibtest.rip index 6e2a8a1..8ca17a1 100644 --- a/stdlibtest.rip +++ b/stdlibtest.rip @@ -12,3 +12,28 @@ 'h'o'i 3<mkstr> <vardel> 'd'o'e'i 4<mkstr> <vardel> + + +0I[ + 27pd 238mp m i 0I[127.0.0.1] + 39iDDmmm 0I[3000] + C + + gDiW[ + w + gDi] + c +] + +'C'o'n'n'e'c't'i'n'g' 't'o' '1'7'8'.'6'2'.'2'3'9'.'7'9':'8'0'.'.'. 9i 6Dmdd<mkstr><strprint> +0I[178.62.239.79] + +98a9im8a 88mdd<strpush> 83m9imd<strpush> 89imd<strpush> 89im C +'G'E'T' '/' 'H'T'T'P'/'1'.'1' +'H'o's't':' 't'o'm's'm'e'd'i'n'g'.'c'o'm' +' +6Dmi<mkstr><strsend> +tDiW[ + o +tDi] +Pc |