aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--README.md4
-rw-r--r--rip.hs167
-rw-r--r--stdlib.rip19
-rw-r--r--stdlibtest.rip25
4 files changed, 156 insertions, 59 deletions
diff --git a/README.md b/README.md
index cad48d7..8d20d91 100644
--- a/README.md
+++ b/README.md
@@ -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
diff --git a/rip.hs b/rip.hs
index 3ca7a29..3efd081 100644
--- a/rip.hs
+++ b/rip.hs
@@ -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 []
-
--- 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
+rip :: String -> IO ([Stackelem],Map.Map Stackelem Handle)
+rip s = rip' s Map.empty Map.empty []
+
+-- 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,'\'']
diff --git a/stdlib.rip b/stdlib.rip
index af428c3..432a9cf 100644
--- a/stdlib.rip
+++ b/stdlib.rip
@@ -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