ctpl 0.1.0.1 → 0.1.0.4
raw patch · 6 files changed
+900/−36 lines, 6 filesdep +arraydep ~basedep ~chatty-textdep ~chatty-utilsnew-component:exe:ctpl0debugnew-component:exe:ctplc
Dependencies added: array
Dependency ranges changed: base, chatty-text, chatty-utils
Files
- Text/CTPL.hs +80/−25
- Text/CTPL0.hs +88/−7
- Text/CTPL0n.hs +581/−0
- compiler.hs +38/−0
- ctpl.cabal +24/−4
- debugger.hs +89/−0
Text/CTPL.hs view
@@ -1,5 +1,8 @@+-- | Compiler for CTPL, generating CTPL0 code.+ module Text.CTPL where +import Control.Applicative hiding (many, Const, some) import Control.Monad import Data.Char import Data.Monoid@@ -7,48 +10,97 @@ import Text.Chatty.Parser.Carrier import qualified Text.CTPL0 as Null -data Procedure = Procedure { procName :: String, procInstr :: Instruction, procAddr :: Int }-data CTPLState = CTPLState { definedProcs :: [Procedure] }-data Exec a = Succ a | NoSuchProc String | SyntaxFault deriving Show-data CTPL a = CTPL { runCTPL :: CTPLState -> Exec (a, CTPLState, String -> String) }+-- | Compiler configuration.+data CCConfig = CCConfig {+ ccTarget :: CCTarget -- ^ Target VM+ } +-- | Target VM+data CCTarget = OldVM -- ^ produce output compatible with the old VM (Text.CTPL0)+ | NewVM -- ^ produce output for the new VM only (Text.CTPL0n)++-- | A parsed CTPL procedure.+data Procedure = Procedure {+ procName :: String, -- ^ Name of the procedure+ procInstr :: Instruction, -- ^ Instructions+ procAddr :: Int -- ^ Address (if already known)+ }++-- | Compiler state record+data CTPLState = CTPLState {+ definedProcs :: [Procedure] -- ^ Procedure already encountered+ }++-- | Monad displaying success or failure.+data Exec a = Succ a -- ^ Compilation succeeded :)+ | NoSuchProc String -- ^ Nope. Encountered a call to a procedure I can`t find.+ | SyntaxFault -- ^ Nope. Syntax fault. I have no idea what you`re trying to tell me.+ deriving Show++-- | The compiler's execution monad. Behaves like a 'StateT CTPLState' wrapped around a 'ReaderT CCConfig' wrapped around a 'WriterT String' wrapped around the 'Exec' monad.+data CTPL a = CTPL { runCTPL :: CTPLState -> CCConfig -> Exec (a, CTPLState, String -> String) }+ instance Monad Exec where return a = Succ a (Succ a) >>= f = f a (NoSuchProc s) >>= f = NoSuchProc s SyntaxFault >>= f = SyntaxFault +instance Applicative Exec where+ pure = return+ (<*>) = ap++instance Functor Exec where+ fmap = liftM+ instance Monad CTPL where- return a = CTPL $ \s -> return (a, s, id)- m >>= f = CTPL $ \s -> do- (a', s', f') <- runCTPL m s- (a'', s'', f'') <- runCTPL (f a') s'+ return a = CTPL $ \s cfg -> return (a, s, id)+ m >>= f = CTPL $ \s cfg -> do+ (a', s', f') <- runCTPL m s cfg+ (a'', s'', f'') <- runCTPL (f a') s' cfg return (a'', s'', f' . f'') +instance Applicative CTPL where+ pure = return+ (<*>) = ap++instance Functor CTPL where+ fmap = liftM++-- | Predefined compiler configuration. Generated code is compatible to both VMs.+oldConfig :: CCConfig+oldConfig = CCConfig{ccTarget=OldVM}++-- | Predefined compiler configuration. Generated code is compatible to the new VM only.+newConfig :: CCConfig+newConfig = CCConfig{ccTarget=NewVM}++-- | Gets the carried 'CTPLState' and runs a function on it. getState :: (CTPLState -> a) -> CTPL a-getState f = CTPL $ \s -> return (f s, s, id)+getState f = CTPL $ \s cfg -> return (f s, s, id) +-- | RUns a function on the carried 'CTPLState'. modState :: (CTPLState -> CTPLState) -> CTPL ()-modState f = CTPL $ \s -> return ((), f s, id)+modState f = CTPL $ \s cfg -> return ((), f s, id) emit :: String -> CTPL ()-emit str = CTPL $ \s -> return ((), s, (str++))+emit str = CTPL $ \s cfg -> return ((), s, (str++)) getProc :: String -> (Procedure -> a) -> CTPL a getProc nm f = do ps <- getState definedProcs case filter (\p -> procName p == nm) ps of- [] -> CTPL $ \_ -> NoSuchProc nm+ [] -> CTPL $ \_ _ -> NoSuchProc nm [p] -> return (f p) catchEmission :: CTPL () -> CTPL String-catchEmission m = CTPL $ \s -> do- (_,s',f') <- runCTPL m s+catchEmission m = CTPL $ \s cfg -> do+ (_,s',f') <- runCTPL m s cfg return (f' [], s', id) discardEmission :: CTPL a -> CTPL a-discardEmission m = CTPL $ \s -> do- (a,s',_) <- runCTPL m s+discardEmission m = CTPL $ \s cfg -> do+ (a,s',_) <- runCTPL m s cfg return (a, s', id) data NumSource = AX Int | CK0 Int | Buf NumSource Int | Const Int | Len Int | CP Int deriving Show@@ -290,10 +342,10 @@ -- Cd[ldbuf]Cmkj|q#!t EqCh d chs -> emit "Cd" >> dumpInstr (SetCK0 d) >> emit "Cmk" >> emit jumper >> emit (foldr q "!t" chs) >> return "" where q a b = "|q"++[a]++b -compile :: [Procedure] -> Instruction -> Exec String-compile ps main = do+compile :: [Procedure] -> Instruction -> CCConfig -> Exec String+compile ps main cfg = do let s0 = CTPLState (ps++[Procedure [] main 0])- (_, _, out) <- flip runCTPL s0 $ do+ (_, _, out) <- runCTPL (do ps <- getState definedProcs ps' <- allocProcs 7 ps modState $ \s -> s{definedProcs=ps'}@@ -301,7 +353,7 @@ emit "+" dumpAddr amain emit "jt"- forM_ ps' $ \p -> dumpInstr $ procInstr p+ forM_ ps' $ \p -> dumpInstr $ procInstr p) s0 cfg return $ out [] multiParse :: ChParser m => m ([Procedure], [Instruction])@@ -549,15 +601,18 @@ return $ EqCh ns chs parse :: String -> [] ([Procedure], [Instruction])-parse s = runCarrierT s multiParse+parse s = runCarrierT s $ do+ p <- multiParse+ many white+ return p -compileCTPL :: String -> Exec String-compileCTPL s = case parse s of+compileCTPL :: String -> CCConfig -> Exec String+compileCTPL s cfg = case parse s of [] -> SyntaxFault- (ps, is):_ -> compile ps (Compound is)+ (ps, is):_ -> compile ps (Compound is) cfg evalCTPL :: String -> String -> Int -> Null.Exec String evalCTPL program buffer limit =- case compileCTPL program of+ case compileCTPL program oldConfig of Succ bc -> Null.evalCTPL0 bc buffer limit _ -> Null.SynViol
Text/CTPL0.hs view
@@ -1,15 +1,64 @@-module Text.CTPL0 where+-- | The old CTPL0 virtual machine. This one is outdated, but will still be supported for a while. +module Text.CTPL0 (Exec(..), CTPL0(..), CTPL0State(..), BufferState(..), RegisterState(..), InfoState(..), unetx, endOfInstr, singleInstr, procInstrs, evalCTPL0', evalCTPL0) where++import Control.Applicative import Control.Monad import Data.Char import Data.Chatty.AVL import Data.List -data BufferState = BufferState { leftBehind :: String, thisChar :: Char, rightPending :: String }-data RegisterState = RegisterState { ax :: Integer, mk :: [String], rk :: [Int], ck :: [Int], cp :: Bool }-data InfoState = InfoState { instrStats :: AVL (Char, Int) }-data CTPL0State = CTPL0State { bufferState :: BufferState, programState :: BufferState, registerState :: RegisterState, infoState :: InfoState }-data Exec a = Succ a | Expired | ConfViol | SynViol deriving Show+-- | A character buffer. Represented as a triplet of left behind chars, the current char and the pending chars.+data BufferState = BufferState {+ leftBehind :: String, -- ^ Already seen. String reversed!+ thisChar :: Char, -- ^ The current char.+ rightPending :: String -- ^ The pending chars.+ }++-- | A record for register and stack state.+data RegisterState = RegisterState {+ ax :: Integer, -- ^ Accumulator register (AX)+ mk :: [String], -- ^ Tape stack (MK)+ rk :: [Int], -- ^ Return address stack (RK)+ ck :: [Int], -- ^ Number stack (CK). The top element may be used like a register.+ cp :: Bool -- ^ If set, the next instruction will use the top element of CK instead of AX. (Say: ``SX is CK top'' in contrast to ``SX is AX'')+ }++-- | A statistics record (might be used by a profiler some time in future...)+data InfoState = InfoState {+ instrStats :: AVL (Char, Int) -- ^ Statistics on how often each instruction has been executed.+ }++-- | The overall state record.+data CTPL0State = CTPL0State {+ bufferState :: BufferState, -- ^ Tape buffer.+ programState :: BufferState, -- ^ Program buffer.+ registerState :: RegisterState, -- ^ Register state record.+ infoState :: InfoState -- ^ Statistics record.+ }++-- | Monad displaying success or failure.+data Exec a = Succ a -- ^ Execution succeeded :)+ | Expired -- ^ Nope. Time has expired. Program took too long to finish. You might want to increase time limit.+ | ConfViol -- ^ Nope. Confidence violation. This may have several reasons, e.g. popping from an empty stack, jumping out of program bounds, ...+ | SynViol -- ^ Nope. Syntax violation. I encountered an instruction (or condition) I do not understand.+ deriving Show++instance Monad Exec where+ return = Succ+ (Succ a) >>= f = f a+ Expired >>= f = Expired+ ConfViol >>= f = ConfViol+ SynViol >>= f = SynViol++instance Applicative Exec where+ pure = return+ (<*>) = ap++instance Functor Exec where+ fmap = liftM++-- | The VM's execution monad. Behaves like a 'StateT' carrying a 'CTPL0State' wrapped around the 'Exec' monad. Also responsible for time consumption and passing. newtype CTPL0 a = CTPL0 { runCTPL0 :: Int -> CTPL0State -> Exec (a, CTPL0State, Int) } instance Monad CTPL0 where@@ -21,45 +70,64 @@ ConfViol -> ConfViol SynViol -> SynViol +instance Applicative CTPL0 where+ pure = return+ (<*>) = ap++instance Functor CTPL0 where+ fmap = liftM++-- | Gets the carried 'CTPL0State' and runs a function on it. getState :: (CTPL0State -> a) -> CTPL0 a getState f = CTPL0 $ \i k -> Succ (f k, k, i) +-- | Runs a function on the carried 'CTPL0State'. modState :: (CTPL0State -> CTPL0State) -> CTPL0 () modState f = CTPL0 $ \i k -> Succ ((), f k, i) +-- | Consume virtual time. Raise 'Expired' if limit is reached. consumeTime :: CTPL0 () consumeTime = CTPL0 $ \i k -> if i >= 1 then Succ ((), k, i-1) else Expired +-- | Raise a 'ConfViol'. confViol :: CTPL0 a confViol = CTPL0 $ \_ _ -> ConfViol +-- | Raise a 'SynViol'. synViol :: CTPL0 a synViol = CTPL0 $ \_ _ -> SynViol +-- | Modify the tape buffer`s state by running a function on it. modBufferState :: (BufferState -> BufferState) -> CTPL0 () modBufferState f = modState $ \s -> s{bufferState = f $ bufferState s} +-- | Modify the program buffer`s state by running a function on it. modProgramState :: (BufferState -> BufferState) -> CTPL0 () modProgramState f = modState $ \s -> s{programState = f $ programState s} +-- | Modify the register state record by running a function on it. modRegisterState :: (RegisterState -> RegisterState) -> CTPL0 () modRegisterState f = modState $ \s -> s{registerState = f $ registerState s} +-- | Walk in the buffer. A positive number specifies walking to the right, a negative one to the left. walkBuffer :: Int -> BufferState -> BufferState walkBuffer 0 s = s walkBuffer i s | i < 0 = BufferState (drop (-i) $ leftBehind s) (head $ drop (-i-1) $ leftBehind s) (reverse (take (-i-1) $ leftBehind s) ++ [thisChar s] ++ rightPending s) | i > 0 = BufferState (reverse (take (i-1) (rightPending s)) ++ [thisChar s] ++ leftBehind s) (head $ drop (i-1) $ rightPending s) (drop i $ rightPending s) +-- | Fetch the next instruction. getInstr :: CTPL0 Char getInstr = do k <- getState $ thisChar . programState modProgramState $ walkBuffer 1 return k +-- | Have we reached the end of the program tape? endOfInstr :: CTPL0 Bool endOfInstr = getState $ null . rightPending . programState +-- | Fetch numeric argument (as many digits as we can get) instrNumArg :: CTPL0 Int instrNumArg = do ks <- getState $ \s -> takeWhile isDigit (thisChar (programState s) : rightPending (programState s))@@ -67,6 +135,7 @@ modProgramState $ walkBuffer $ length ks return $ read ks +-- | Fetch string argument (delimited by '$') instrDelimArg :: CTPL0 String instrDelimArg = do ks <- getState $ \s -> takeWhile (/='$') (thisChar (programState s) : rightPending (programState s))@@ -76,24 +145,29 @@ modProgramState $ walkBuffer 1 return ks +-- | Get position in program buffer. getIP :: CTPL0 Int getIP = getState $ length . leftBehind . programState +-- | Get position in tape buffer. getCP :: CTPL0 Int getCP = getState $ length . leftBehind . bufferState +-- | Are we able to walk that far in the program buffer? canRelJump :: Int -> CTPL0 Bool canRelJump 0 = return True canRelJump i | i < 0 = getState $ (>= -i) . length . leftBehind . programState | i > 0 = getState $ (>= i) . length . rightPending . programState +-- | Are we able to walk that far in the tape buffer? canRelWalk :: Int -> CTPL0 Bool canRelWalk 0 = return True canRelWalk i | i < 0 = getState $ (>= -i) . length . leftBehind . bufferState | i > 0 = getState $ (>= i) . length . rightPending . bufferState +-- | Run an action (first arg) iff the test (second arg) succeeds. Raise 'ConfViol' otherwise. provided :: CTPL0 a -> CTPL0 Bool -> CTPL0 a provided act test = do b <- test@@ -101,15 +175,17 @@ then act else confViol --- SX points to AX by default, but to CK(0) after 'C'+-- | SX is AX by default, but CK top after `C' sx :: RegisterState -> Integer sx r | cp r = fromIntegral $ head $ ck r sx r = ax r +-- | Set SX (AX or CK top) value. setSX :: Integer -> RegisterState -> RegisterState setSX i r | cp r = r{ck=fromIntegral i : tail (ck r)} setSX i r = r{ax=i} +-- | Run the next instruction in program. singleInstr :: CTPL0 () singleInstr = do i <- getInstr@@ -314,12 +390,14 @@ -- Catch others o -> synViol +-- | Run the entire program. procInstrs :: CTPL0 () procInstrs = singleInstr `asLongAs` liftM not endOfInstr where asLongAs act test = do b <- test when b $ act >> asLongAs act test +-- | A handy wrapper around 'procInstrs'. Arguments: program, tape, time limit. Results: tape, leftover time, AX, CK top, instruction stats. evalCTPL0' :: String -> String -> Int -> Exec (String, Int, Integer, Int, [] (Char, Int)) evalCTPL0' program buffer limit = let state0 = CTPL0State buffer0 program0 register0 info0@@ -338,6 +416,7 @@ SynViol -> SynViol Expired -> Expired +-- | Another handy wrapper around 'procInstr'. Less clumsy than 'evalCTPL0'', but provides less information. Arguments: program, tape, time limit. Results: tape only. evalCTPL0 :: String -> String -> Int -> Exec String evalCTPL0 program buffer limit = case evalCTPL0' program buffer limit of@@ -346,6 +425,7 @@ SynViol -> SynViol Expired -> Expired +-- | Remove a trailing ETX (if there is one). unetx :: String -> String unetx [] = [] unetx s@@ -353,6 +433,7 @@ | last s == chr 3 = init s | otherwise = s +-- | Append right before the trailing ETX. If there is no ETX, string will be appended at the end. appendBeforeETX :: String -> String -> String appendBeforeETX [] t = t appendBeforeETX s t
+ Text/CTPL0n.hs view
@@ -0,0 +1,581 @@+{-# LANGUAGE TupleSections, FlexibleInstances #-}++-- | The new CTPL0 virtual machine.++module Text.CTPL0n where++import Control.Applicative+import Control.Arrow+import Control.Monad+import Control.Monad.ST+import Data.Array.MArray as M+import Data.Array.ST+import Data.Array.Unboxed+import Data.Char+import Data.List+import Data.STRef++-- | The VM`s state record.+data CTPL0State s = CTPL0State {+ bufferContent :: !(Buffer s), -- ^ Tape buffer+ programContent :: UArray Int Char, -- ^ Program buffer+ bufferPointer :: !Int, -- ^ Tape pointer+ programPointer :: !Int, -- ^ Program pointer+ cp :: !Bool, -- ^ If set, the next instruction will use the top element of CK instead of AX. (Say: ``SX is CK top'' in contrast to ``SX is AX'')+ ax :: !Int, -- ^ Accumulator register (AX)+ mk :: [Buffer s], -- ^ Tape stack (MK)+ rk :: [Int], -- ^ Return address stack (RK)+ ck :: [Int] -- ^ Number stack (CK). The top element may be used like a register.+ }++-- | The VM`s configuration. Immutable during execution.+data VMConfig = VMConfig {+ maxTime :: !Int, -- ^ Initial time limit.+ maxConditRecurs :: !Int, -- ^ Maximum recursion depth for `x' condition (FUTURE)+ maxBufferMeasure :: !Int, -- ^ Maximum buffer size (FUTURE)+ initBufferMeasure :: !Int, -- ^ Initial buffer size.+ vmFeatures :: [VMFeature] -- ^ Enabled feature instructions.+ }++-- | Optional feature instructions.+data VMFeature = RandomF -- ^ enable `Xr' instruction for random number retrieval (FUTURE)+ | FilterF -- ^ enable `Xfs', `Xfd', `Xff' instructions for setting predefined filters on the tape (FUTURE)+ | CustomFilterF -- ^ enable `Xfc' instruction for setting custom filters on the tape (FUTURE; won't work without FilterF)+ | InterruptsF -- ^ enable `Xi' instruction for setting and calling interrupts (FUTURE)++-- | Predefined VM configuration, very restrictive. Allows 10000 cycles, no recursive conditions, no feature instructions, at maximum 3000 chars on tape.+safeVM :: VMConfig+safeVM = VMConfig{ maxTime=10000, maxConditRecurs=0,+ maxBufferMeasure=3000, initBufferMeasure=0,+ vmFeatures=[] }++-- | Predefined VM configuration, very permissive. Allows 10 million cycles, 10 levels of recursion, all available feature instructions, at maximum 30000 chars on tape.+fullVM :: VMConfig+fullVM = VMConfig{ maxTime=10000000, maxConditRecurs=10,+ maxBufferMeasure=30000, initBufferMeasure=0,+ vmFeatures=[RandomF, FilterF, CustomFilterF, InterruptsF] }++-- | Monad displaying success or failure. A close relative of the 'Either' monad.+data Exec a = Succ a -- ^ Execution succeeded :)+ | Fail !Fail -- ^ Nope. See 'Fail' type.++instance Monad Exec where+ return = Succ+ fail = Fail . Dead+ (Succ a) >>= f = f a+ (Fail e) >>= f = Fail e++instance Applicative Exec where+ pure = return+ (<*>) = ap++instance Functor Exec where+ fmap = liftM++-- | Possible errors.+data Fail = Expired -- ^ Time has expired. Program took too long to finish. You might want to increase time limit.+ | ConfViol -- ^ Confidence violation. This may have several reasons, e.g. popping from an empty stack, jumping out of program bounds, ...+ | SynViol -- ^ Syntax violation. I encountered an instruction (or condition) I do not understand.+ | Dead String -- ^ Program requested abort (FUTURE)++-- | The VM's execution monad. Behaves like a 'ReaderT' carrying a 'CTPL0State' reference and a 'VMConfig' wrapped around the 'ST' and the 'Exec' monad. Also responsible for time consumption and passing.+newtype CTPL0 s a = CTPL0 { runCTPL0 :: Int ->+ STRef s (CTPL0State s) ->+ VMConfig ->+ ST s (Exec (a, Int)) }++-- | A tape buffer, implemented by wrapping modifiers around a mutable array.+data Buffer s = Insertion { insPlace :: !Int, insLength :: !Int, insContent :: String, insNext :: Buffer s } -- ^ Character insertion+ | Deletion { delPlace :: !Int, delLength :: !Int, delNext :: Buffer s } -- ^ Character deletion+ | MBuffer { bufArray :: STUArray s Int Char } -- ^ The core: the mutable array++instance Show Fail where+ show Expired = "<Fatal: Time expired.>"+ show ConfViol = "<Fatal: Confidence violation.>"+ show SynViol = "<Fatal: Syntax violation.>"+ show (Dead s) = "<Error: "++s++">"++instance Show (Exec String) where+ show (Succ a) = a+ show (Fail f) = show f+ +-- | Read a char from a tape buffer.+readBuffer :: Buffer s -> Int -> ST s Char+readBuffer (MBuffer a) i = readArray a i+readBuffer (Insertion p l c n) i+ | i < p = readBuffer n i+ | i >= p+l = readBuffer n (i-l)+ | otherwise = return (c !! (i-p))+readBuffer (Deletion p l n) i+ | i < p = readBuffer n i+ | otherwise = readBuffer n (i+l)++-- | Write a char to the tape buffer.+writeBuffer :: Buffer s -> Int -> Char -> ST s (Buffer s)+writeBuffer (MBuffer a) i e = writeArray a i e >> return (MBuffer a)+writeBuffer (Insertion p l c n) i e+ | i < p = Insertion p l c <$> writeBuffer n i e+ | i >= p+l = Insertion p l c <$> writeBuffer n (i-l) e+ | otherwise = return $ Insertion p l (take (i-p) c ++ [e] ++ drop (i-p+1) c) n+writeBuffer (Deletion p l n) i e+ | i < p = Deletion p l <$> writeBuffer n i e+ | otherwise = Deletion p l <$> writeBuffer n (i+l) e++-- | Is the given position accessible in the tape buffer?+accBuffer :: Buffer s -> Int -> ST s Bool+accBuffer (MBuffer a) i = do+ b <- M.getBounds a+ return (snd b >= i)+accBuffer (Insertion p l c n) i+ | i < p = accBuffer n i+ | i >= p+l = accBuffer n (i-l)+ | otherwise = return True+accBuffer (Deletion p l n) i+ | i < p = accBuffer n i+ | otherwise = accBuffer n (i+l)++-- | Join the tape buffer to a string.+joinBuffer :: Buffer s -> ST s String+joinBuffer (MBuffer a) = M.getElems a+joinBuffer (Insertion p l c n) = do+ nb <- joinBuffer n+ let (a,b) = splitAt p nb+ return (a ++ c ++ b)+joinBuffer (Deletion p l n) = do+ nb <- joinBuffer n+ let (a,b) = splitAt p nb+ return (a ++ drop l b)++-- | Insert a string into the tape buffer.+insBuffer :: Buffer s -> Int -> String -> ST s (Buffer s)+insBuffer (MBuffer a) i e = return $ Insertion i (length e) e (MBuffer a)+insBuffer (Insertion p l c n) i e+ | i < p = Insertion (p+length e) l c <$> insBuffer n i e+ | i >= p+l = Insertion p l c <$> insBuffer n (i-l) e+ | i >= p && (i+length e) <= p+l =+ return $ Insertion p (l+length e) (a++e++b) n+ | otherwise = return $ Insertion i (length e) e $ Insertion p l c n+ where (a,b) = splitAt (i-p) c+insBuffer (Deletion p l n) i e+ | i < p = Deletion (p+length e) l <$> insBuffer n i e+ | i > p = Deletion p l <$> insBuffer n (i+l) e+ | otherwise = return $ Insertion i (length e) e $ Deletion p l n++-- | Delete a char from the tape buffer.+delBuffer :: Buffer s -> Int -> ST s (Buffer s)+delBuffer (MBuffer a) i = return $ Deletion i 1 $ MBuffer a+delBuffer (Insertion p l c n) i+ | i < p = Insertion (p-1) l c <$> delBuffer n i+ | i >= p+l = Insertion p l c <$> delBuffer n (i-l)+ | otherwise = return $ Insertion p (l-1) (a++b) n+ where (a,_:b) = splitAt (i-p) c+delBuffer (Deletion p l n) i+ | i < p = Deletion (p-1) l <$> delBuffer n i+ | i > p = Deletion p l <$> delBuffer n (i+l)+ | otherwise = return $ Deletion p (l+1) n++-- | Get a list of ETX positions in the tape buffer.+etxBuffer :: Buffer s -> ST s [Int]+etxBuffer (MBuffer a) = do+ es <- M.getElems a+ return $ elemIndices '\3' es+etxBuffer (Insertion p l c n) = do+ ne <- etxBuffer n+ let ie = elemIndices '\3' c+ return $ sort (map (+p) ie ++ map (\ne' -> if ne' < p then ne' else ne' + l) ne)+etxBuffer (Deletion p l n) = do+ ne <- etxBuffer n+ return $ map (\ne -> if ne < p then ne else ne-l) $ filter (/=p) ne++-- | Clone the tape buffer (fixing all modifiers into the newly created mutable array)+cloneBuffer :: Buffer s -> ST s (Buffer s)+cloneBuffer b = do+ s <- joinBuffer b+ a <- M.newListArray (0, length s - 1) s+ return $ MBuffer a++-- | Get the tape buffer`s length.+measBuffer :: Buffer s -> ST s Int+measBuffer (MBuffer a) = snd <$> M.getBounds a+measBuffer (Insertion p l c n) = (+l) <$> measBuffer n+measBuffer (Deletion p l n) = subtract l <$> measBuffer n++instance Monad (CTPL0 s) where+ return a = CTPL0 $ \i ref cfg -> return $ Succ (a,i)+ m >>= f = CTPL0 $ \i ref cfg -> do+ r <- runCTPL0 m i ref cfg+ case r of+ Succ (a, i') -> runCTPL0 (f a) i' ref cfg+ Fail f -> return $ Fail f++instance Functor (CTPL0 s) where+ fmap = liftM++instance Applicative (CTPL0 s) where+ pure = return+ (<*>) = ap++-- | Run an 'ST' action inside a compatible 'CTPL0' block+liftST :: ST s a -> CTPL0 s a+liftST m = CTPL0 $ \i ref cfg -> Succ <$> (,i) <$> m++-- | A handy wrapper around 'procInstrs'. Arguments: program, tape, config. Results: tape, leftover time, AX, CK top.+evalCTPL0' :: String -> String -> VMConfig -> Exec (String, Int, Int, Int)+evalCTPL0' program buffer cfg = runST $ do+ let limit = maxTime cfg+ bufsize = max (initBufferMeasure cfg) (length buffer+1)+ bc <- newListArray (0, bufsize-1) (buffer ++ '\3' : replicate (bufsize-length buffer-1) '\0')+ let pc = listArray (0, length program - 1) program+ st = CTPL0State (MBuffer bc) pc 0 0 False 0 [] [length program] [0]+ ref <- newSTRef st+ r <- runCTPL0 procInstrs limit ref cfg{initBufferMeasure=bufsize}+ case r of+ Succ (_, i') -> do+ st <- readSTRef ref+ buf <- joinBuffer (bufferContent st)+ return $ Succ (takeWhile (/='\3') buf, i', ax st, if null (ck st) then 0 else head $ ck st)+ Fail f -> return $ Fail f++-- | Another handy wrapper around 'procInstrs'. Less clumsy than 'evalCTPL0'', but provides less information. Arguments: program, tape, config. Results: tape only.+evalCTPL0 :: String -> String -> VMConfig -> Exec String+evalCTPL0 program buffer cfg =+ case evalCTPL0' program buffer cfg of+ Succ (s,_,_,_) -> Succ s+ Fail f -> Fail f++-- | Gets the carried 'CTPL0State' and runs a function on it.+getState :: (CTPL0State s -> a) -> CTPL0 s a+getState f =+ CTPL0 $ \i ref cfg -> do+ st <- readSTRef ref+ return $ Succ (f st, i)++-- | Runs a function on the carried 'CTPL0State'.+modState :: (CTPL0State s -> CTPL0State s) -> CTPL0 s ()+modState f =+ CTPL0 $ \i ref cfg -> do+ modifySTRef ref f+ return $ Succ ((), i)++-- | Consume virtual time. Raise 'Expired' if limit is reached.+consumeTime :: CTPL0 s ()+consumeTime = CTPL0 $ \i ref cfg -> if i >= 1 then return (Succ ((), i-1)) else return (Fail Expired)++-- | Raise a 'ConfViol'.+confViol :: CTPL0 s a+confViol = CTPL0 $ \_ _ _ -> return $ Fail ConfViol++-- | Raise a 'SynViol'.+synViol :: CTPL0 s a+synViol = CTPL0 $ \_ _ _ -> return $ Fail SynViol++-- | Raise a 'Dead'.+die :: String -> CTPL0 s a+die s = CTPL0 $ \_ _ _ -> return . Fail $ Dead s++-- | Fetch the next instruction.+getInstr :: CTPL0 s Char+getInstr = do+ (c,p) <- getState (programContent &&& programPointer)+ modState (\st -> st{programPointer=programPointer st+1})+ return (c ! p)++-- | Have we reached the end of the program tape?+endOfInstr :: CTPL0 s Bool+endOfInstr = do+ (m,p) <- getState (snd . bounds . programContent &&& programPointer)+ return (m < p)++-- | Fetch numeric argument (as many digits as we can get)+instrNumArg :: CTPL0 s Int+instrNumArg = do+ (c,p) <- getState (programContent &&& programPointer)+ if snd (bounds c) <= p || not (isDigit (c!p)) then synViol else+ let coll p | snd (bounds c) <= p = ""+ coll p | not (isDigit (c!p)) = ""+ coll p = (c!p) : coll (p+1)+ str = coll p+ in do+ modState $ \st -> st{programPointer=programPointer st+length str}+ return $ read str++-- | Fetch string argument (delimited by '$')+instrDelimArg :: CTPL0 s String+instrDelimArg = do+ (c,p) <- getState (programContent &&& programPointer)+ if snd (bounds c) < p then synViol else+ let coll p | snd (bounds c) < p = ""+ coll p | (c!p) == '$' = "$"+ coll p = (c!p) : coll (p+1)+ str = coll p+ in do+ modState $ \st -> st{programPointer=programPointer st+length str}+ unless (last str == '$') synViol+ return $ init str++-- | Run an action (first arg) iff the test (second arg) succeeds. Raise 'ConfViol' otherwise.+provided :: CTPL0 s a -> CTPL0 s Bool -> CTPL0 s a+provided act test = do+ b <- test+ if b+ then act+ else confViol++-- | SX is AX by default, but CK top after 'C'.+sx :: CTPL0State s -> Int+sx r | cp r = head $ ck r+sx r = ax r++-- | Set SX (AX or CK top) value.+setSX :: Int -> CTPL0State s -> CTPL0State s+setSX i r | cp r = if null (ck r) then r{ck=[i]} else r{ck=i:tail (ck r)}+setSX i r = r{ax=i}++-- | Run the next instruction in program.+singleInstr :: CTPL0 s ()+singleInstr = do+ i <- getInstr+ consumeTime+ case i of+ -- Walk left+ '<' -> modState (\st -> st{bufferPointer=bufferPointer st-1})+ `provided` getState (\st -> bufferPointer st > 0)+ -- Walk right+ '>' -> modState (\st -> st{bufferPointer=bufferPointer st+1})+ `provided` do+ (p,c) <- getState (bufferPointer &&& bufferContent)+ liftST $ accBuffer c (p+1)+ + -- Inc SX+ '+' -> do+ num <- instrNumArg+ modState $ \st -> setSX (sx st + num) st+ -- Dec SX+ '-' -> do+ num <- instrNumArg+ modState $ \st -> setSX (sx st - num) st+ -- Insert char, go after+ 'i' -> do+ ch <- getInstr `provided` liftM not endOfInstr+ (p,c) <- getState (bufferPointer &&& bufferContent)+ c' <- liftST $ insBuffer c p [ch]+ modState $ \st -> st{bufferContent=c',bufferPointer=bufferPointer st + 1}+ -- Insert string, go after+ 'I' -> do+ str <- instrDelimArg+ (p,c) <- getState (bufferPointer &&& bufferContent)+ c' <- liftST $ insBuffer c p str+ modState $ \st -> st{bufferContent=c',bufferPointer=bufferPointer st + length str}+ -- Replace char, stay+ 'r' -> do+ ch <- getInstr `provided` liftM not endOfInstr+ (p,c) <- getState (bufferPointer &&& bufferContent)+ c' <- liftST $ writeBuffer c p ch+ modState $ \st -> st{bufferContent=c'}+ -- Delete char+ 'x' -> do+ (p,c) <- getState (bufferPointer &&& bufferContent)+ c' <- liftST $ delBuffer c p+ modState $ \st -> st{bufferContent=c'}+ -- Append char, don't walk+ 'a' -> do+ ch <- getInstr `provided` liftM not endOfInstr+ (p,c) <- getState (bufferPointer &&& bufferContent)+ etx <- liftST $ etxBuffer c+ case etx of+ [] -> confViol+ etx:_ -> do+ c' <- liftST $ writeBuffer c etx ch+ c'' <- liftST $ writeBuffer c' (etx+1) '\3'+ modState $ \st -> st{bufferContent=c''}+ when (etx<p) $ modState $ \st -> st{bufferPointer=bufferPointer st + 1}+ -- Append string, don't walk+ 'A' -> do+ str <- instrDelimArg+ (p,c) <- getState (bufferPointer &&& bufferContent)+ etx <- liftST $ etxBuffer c+ case etx of+ [] -> confViol+ etx:_ -> do+ (c',etx') <- foldl (\l r -> do (c,etx) <- l; c' <- liftST $ writeBuffer c etx r; return (c,etx+1)) (return (c,etx)) str+ c'' <- liftST $ writeBuffer c' etx' '\3'+ modState $ \st -> st{bufferContent=c''}+ when (etx<p) $ modState $ \st -> st{bufferPointer=bufferPointer st + 1}+ -- Set SX=0+ '0' -> do+ modState $ setSX 0+ -- Set SX=CP+ 'Q' -> do+ modState $ \st -> setSX (bufferPointer st) st+ -- Set CP=SX+ 'm' -> do+ modState (\st -> st{bufferPointer=sx st}) `provided` do+ (c,s) <- getState (bufferContent &&& sx)+ liftST $ accBuffer c s+ -- Choose CK(0) for SX+ 'C' -> modState (\st -> st{cp=True}) `provided` getState (not . null . ck)+ -- Load [CP] into SX+ 'l' -> do+ (p,c) <- getState (bufferPointer &&& bufferContent)+ s <- liftST $ readBuffer c p+ modState $ \st -> setSX (ord s) st+ -- Save SX into [CP]+ 's' -> do+ (p,(c,s)) <- getState (bufferPointer &&& bufferContent &&& sx)+ c' <- liftST $ writeBuffer c p (chr s)+ modState $ \st -> st{bufferContent=c'}+ -- Push SX onto CK+ 'd' -> modState $ \st -> st{ck=sx st : ck st}+ -- Pop AX from CK+ 'D' -> modState (\st -> st{ax=head $ ck st, ck=tail $ ck st})+ `provided` getState (not . null . ck)+ -- Pop CK, discard+ 'k' -> modState (\st -> st{ck=tail $ ck st})+ `provided` getState (not . null . ck)+ -- Set SX=LEN+ 'L' -> do+ c <- getState bufferContent+ etx <- liftST $ etxBuffer c+ case etx of+ [] -> confViol+ etx':_ -> modState $ setSX etx'+ -- Swap tape and MK(0)+ 'H' ->+ modState (\st -> st{mk=bufferContent st : tail (mk st), bufferContent=head (mk st)})+ `provided` getState (not . null . mk)+ -- Push entire tape to MK+ 't' -> do+ c <- getState bufferContent+ c' <- liftST $ cloneBuffer c+ modState $ \st -> st{mk=c' : mk st}+ -- Push [CP] to MK+ 'y' -> do+ (c,p) <- getState (bufferContent &&& bufferPointer)+ (ch,len,a) <- liftST $ do+ ch <- readBuffer c p+ len <- measBuffer c+ a <- newListArray (0,len) (ch : '\3' : replicate (len-1) '\0')+ return (ch,len,a)+ modState $ \st -> st{mk=MBuffer a : mk st}+ -- Pop MK, discard content+ 'p' -> modState (\st -> st{mk=tail $ mk st})+ `provided` getState (not . null . mk)+ -- Append [CP] to MK(0)+ 'Y' -> (do+ (c,(p,a)) <- getState (bufferContent &&& bufferPointer &&& head . mk)+ ch <- liftST $ readBuffer c p+ etx <- liftST $ etxBuffer a+ case etx of+ [] -> confViol+ etx':_ -> do+ a' <- liftST $ writeBuffer a etx' ch+ a'' <- liftST $ writeBuffer a' (etx'+1) '\3'+ modState (\st -> st{mk=a'':tail (mk st)}))+ `provided` getState (not . null . mk)+ -- Peek MK, insert, go after+ 'P' -> (do+ (c,(p,a)) <- getState (bufferContent &&& bufferPointer &&& head . mk)+ js <- liftST $ joinBuffer a+ let s = takeWhile (/='\3') js+ c' <- liftST $ insBuffer c p s+ modState $ \st -> st{bufferContent=c',bufferPointer=bufferPointer st+length s})+ `provided` getState (not . null . mk)+ -- Absolute jump to SX+ 'j' -> do+ a <- getState sx+ b <- singleCond+ when b $ modState $ \st -> st{programPointer=a}+ -- Relative jump by SX+ 'J' -> do+ a <- getState sx+ b <- singleCond+ when b $ modState $ \st -> st{programPointer=a+programPointer st}+ -- Call procedure at SX, push IP to RK+ 'c' -> do+ a <- getState sx+ b <- singleCond+ when b $ modState $ \st -> st{rk=(programPointer st):rk st, programPointer=a}+ -- Return to RK(0), pop RK+ 'f' -> (modState $ \st -> st{programPointer=head (rk st), rk=tail (rk st)})+ `provided` getState (not . null . rk)+ -- Swap MK(0) and MK(1)+ 'h' ->+ modState (\st -> st{mk=(mk st !! 1):(mk st !! 0):(drop 2 $ mk st)})+ `provided` getState ((>=2) . length . mk)+ -- Catch others+ o -> synViol+ {-do+ ip <- getState programPointer+ die ("SynViol in singleInstr: " ++ [o] ++ " (pos "++ show ip++")")-}+ unless (i=='C') $ modState $ \st -> st{cp=False}+++-- | Evaluate a condition.+singleCond :: CTPL0 s Bool+singleCond = do+ i <- getInstr `provided` liftM not endOfInstr+ case i of+ -- Is uppercase?+ 'U' -> do+ (c, p) <- getState (bufferContent &&& bufferPointer)+ isUpper <$> liftST (readBuffer c p)+ -- Is lowercase?+ 'L' -> do+ (c, p) <- getState (bufferContent &&& bufferPointer)+ isLower <$> liftST (readBuffer c p)+ -- SX = 0?+ 'z' -> getState ((==0) . sx)+ -- Always true+ 't' -> return True+ -- Is digit?+ 'N' -> do+ (c, p) <- getState (bufferContent &&& bufferPointer)+ isDigit <$> liftST (readBuffer c p)+ -- End of buffer?+ 'e' -> do+ (c, p) <- getState (bufferContent &&& bufferPointer)+ realEnd <- not <$> liftST (accBuffer c (p+1))+ etxEnd <- if realEnd then return '\3' else liftST (readBuffer c p)+ return (etxEnd == '\3') + -- Negation+ '!' -> not <$> singleCond+ -- Disjunction+ '|' -> (||) <$> singleCond <*> singleCond+ -- Conjunction+ '&' -> (&&) <$> singleCond <*> singleCond+ -- match char?+ 'q' -> do+ ch <- getInstr `provided` liftM not endOfInstr+ (c, p) <- getState (bufferContent &&& bufferPointer)+ a <- liftST $ readBuffer c p+ return (a == ch)+ -- CP < SX ?+ 'l' -> uncurry (<) <$> getState (bufferPointer &&& sx)+ -- CP > SX ?+ 'g' -> uncurry (>) <$> getState (bufferPointer &&& sx)+ -- CP == SX ?+ 'E' -> uncurry (==) <$> getState (bufferPointer &&& sx)+ -- toggle SX+ 'C' -> modState (\st -> st{cp=not $ cp st}) >> singleCond+ `provided` getState (not . null . ck)+ -- AX == CK(0) ?+ '=' -> uncurry (==) <$> getState (ax &&& head . ck)+ `provided` getState (not . null . ck)+ -- AX < CK(0) ?+ '<' -> uncurry (<) <$> getState (ax &&& head . ck)+ `provided` getState (not . null . ck)+ -- AX > CK(0) ?+ '>' -> uncurry (>) <$> getState (ax &&& head . ck)+ `provided` getState (not . null . ck)+ -- pop CK, discard, continue+ 'k' -> (modState (\st -> st{ck=tail $ ck st}) >> singleCond)+ `provided` getState (not . null . ck)+ -- Catch others+ o -> synViol++-- | Run the entire program.+procInstrs :: CTPL0 s ()+procInstrs = singleInstr `asLongAs` (not <$> endOfInstr)+ where asLongAs act test = do+ b <- test+ when b $ act >> act `asLongAs` test
+ compiler.hs view
@@ -0,0 +1,38 @@+import System.Environment+import System.IO+import Text.CTPL++comp :: String -> CCConfig -> IO ()+comp str cfg =+ case compileCTPL str cfg of+ Succ a -> putStrLn a+ NoSuchProc nm ->+ hPutStrLn stderr ("Error: No such procedure \""++nm++"\".")+ SyntaxFault ->+ hPutStrLn stderr "Error: Syntax fault."++main = do+ args <- getArgs+ case args of+ ["--old"] -> do+ str <- getContents+ comp str oldConfig+ ["--new"] -> do+ str <- getContents+ comp str newConfig+ ["--old", f] -> do+ str <- readFile f+ comp str oldConfig+ ["--new", f] -> do+ str <- readFile f+ comp str newConfig+ ["--help"] -> do+ putStrLn "ctplc 0.1"+ putStrLn "-------------"+ putStrLn "A compiler for CTPL."+ putStrLn "Synapsis:"+ putStrLn " ctplc --old [<program-file>]"+ putStrLn " Compiles the given file (or stdin) for the old (and new) VM."+ putStrLn " ctplc --new [<program-file>]"+ putStrLn " Compiles the given file (or stdin) for the new VM only."+ _ -> hPutStrLn stderr "Don't know what to do. See --help for help."
ctpl.cabal view
@@ -10,7 +10,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.1.0.1+version: 0.1.0.4 -- A short (one-line) description of the package. synopsis: A programming language for text modification.@@ -31,6 +31,8 @@ -- patches. maintainer: m@doomanddarkness.eu +homepage: http://doomanddarkness.eu/pub/ctpl+ -- A copyright notice. -- copyright: @@ -48,7 +50,7 @@ library -- Modules exported by the library.- exposed-modules: Text.CTPL, Text.CTPL0+ exposed-modules: Text.CTPL, Text.CTPL0, Text.CTPL0n -- Modules included in this library but not exported. -- other-modules: @@ -57,11 +59,29 @@ -- other-extensions: -- Other library packages from which modules are imported.- build-depends: base >=4.6 && <4.8, chatty-text >=0.6 && <0.7, chatty-utils >=0.7.1.2 && <0.8+ build-depends: base >=4.6 && <4.9,+ chatty-text >=0.6,+ chatty-utils >=0.7.1.2,+ array >= 0.5 -- Directories containing source files. -- hs-source-dirs: -- Base language which the package is written in. default-language: Haskell2010- ++executable ctpl0debug+ build-depends: base >= 4.6 && <4.9,+ chatty-text >=0.6,+ chatty-utils >=0.7.1.2,+ array >= 0.5+ main-is: debugger.hs+ default-language: Haskell2010++executable ctplc+ build-depends: base >= 4.6 && <4.9,+ chatty-text >=0.6,+ chatty-utils >=0.7.1.2,+ array >= 0.5+ main-is: compiler.hs+ default-language: Haskell2010
+ debugger.hs view
@@ -0,0 +1,89 @@+import Control.Applicative+import Control.Monad+import Control.Monad.ST+import Data.STRef+import Data.Array.Unboxed+import Data.Array.ST+import Data.Char+import Data.Chatty.AVL+import Data.List+import System.Environment+import qualified Text.CTPL0 as Old+import qualified Text.CTPL0n as New++debugOld :: String -> String -> IO ()+debugOld prog str =+ let state0 = Old.CTPL0State buffer0 program0 register0 info0+ buffer0+ | null str = Old.BufferState [] (chr 3) []+ | otherwise = Old.BufferState [] (head str) (tail str ++ [chr 3])+ program0+ | null prog = Old.BufferState [] (chr 3) []+ | otherwise = Old.BufferState [] (head prog) (tail prog ++ [chr 3])+ register0 = Old.RegisterState 0 [] [length prog] [0] False+ info0 = Old.InfoState EmptyAVL+ imprf avl = sortBy (\b a -> snd a `compare` snd b) $ avlInorder avl+ in debugOldProg 10000 state0++debugOldProg :: Int -> Old.CTPL0State -> IO ()+debugOldProg limit state =+ let prst (Old.CTPL0State b p r f) i m =+ putStrLn (show (Old.unetx (reverse (Old.leftBehind b) ++ [Old.thisChar b] ++ Old.rightPending b)) ++ " I="++show i++" AX="++show (Old.ax r)++" CK="++concat(intersperse ":" (map show $ Old.ck r))++" IP=" ++ show (length $ Old.leftBehind p)++ " BP="++ show (length $ Old.leftBehind b) ++ " | "++m)+ in case Old.runCTPL0 Old.endOfInstr limit state of+ Old.Succ (True, st, i) -> prst st i "Program finished."+ Old.Succ (False, st, i) ->+ case Old.runCTPL0 Old.singleInstr limit state of+ Old.Succ (_, st, i) -> do+ prst st i "<>"+ debugOldProg i st+ Old.Expired -> putStrLn "Expired."+ Old.SynViol -> putStrLn "Syntax violation."+ Old.ConfViol -> putStrLn "Confidence violation."+ +debugNew :: String -> String -> IO ()+debugNew prog str = mapM_ putStrLn $ runST $ do+ let limit = New.maxTime New.safeVM+ bufsize = max (New.initBufferMeasure New.safeVM) (length str+1)+ bc <- newListArray (0, bufsize-1) (str++'\3':replicate (bufsize-length str-1) '\0')+ let pc = listArray (0, length prog - 1) prog+ state0 = New.CTPL0State (New.MBuffer bc) pc 0 0 False 0 [] [length prog] [0]+ ref <- newSTRef state0+ debugNewProg limit ref New.safeVM++debugNewProg :: Int -> STRef s (New.CTPL0State s) -> New.VMConfig -> ST s [String]+debugNewProg limit state cfg =+ let prst ref i m = do+ New.CTPL0State bc pc bp pp cp ax mk rk ck <- readSTRef ref+ buf <- New.joinBuffer bc+ return (show buf ++ " I=" ++ show i ++ " AX=" ++ show ax ++ " CK="++concat(intersperse ":" $ map show ck) ++ " IP=" ++ show pp ++ " BP="++show bp++" | "++m)+ in do+ r <- New.runCTPL0 New.endOfInstr limit state cfg+ case r of+ New.Succ (True, i) -> return <$> prst state i "Program finished."+ New.Succ (False, i) -> do+ r <- New.runCTPL0 New.singleInstr limit state cfg+ case r of+ New.Succ (_, i) -> (:) <$> prst state i "<>" <*> debugNewProg i state cfg+ New.Fail f -> return [show f]++main = do+ args <- getArgs+ case args of+ ["--old", progf, buff] -> do+ prog <- readFile progf+ buf <- readFile buff+ debugOld (init prog) (init buf)+ ["--new", progf, buff] -> do+ prog <- readFile progf+ buf <- readFile buff+ debugNew (init prog) (init buf)+ ["--help"] -> do+ putStrLn "ctpl0debug 0.1"+ putStrLn "----------------"+ putStrLn "A debugger for CTPL0 (both VMs)"+ putStrLn "Synapsis:"+ putStrLn " ctpl0debug --old <program-file> <input-file>"+ putStrLn " Debugs execution with the old VM"+ putStrLn " ctpl0debug --new <program-file> <input-file>"+ putStrLn " Debugs execution with the new VM"+ _ -> putStrLn "Don't know what to do. See --help for help"