diff --git a/Text/CTPL.hs b/Text/CTPL.hs
--- a/Text/CTPL.hs
+++ b/Text/CTPL.hs
@@ -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
diff --git a/Text/CTPL0.hs b/Text/CTPL0.hs
--- a/Text/CTPL0.hs
+++ b/Text/CTPL0.hs
@@ -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
diff --git a/Text/CTPL0n.hs b/Text/CTPL0n.hs
new file mode 100644
--- /dev/null
+++ b/Text/CTPL0n.hs
@@ -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
diff --git a/compiler.hs b/compiler.hs
new file mode 100644
--- /dev/null
+++ b/compiler.hs
@@ -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."
diff --git a/ctpl.cabal b/ctpl.cabal
--- a/ctpl.cabal
+++ b/ctpl.cabal
@@ -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
diff --git a/debugger.hs b/debugger.hs
new file mode 100644
--- /dev/null
+++ b/debugger.hs
@@ -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"