diff --git a/Data/ByteSize.hs b/Data/ByteSize.hs
new file mode 100644
--- /dev/null
+++ b/Data/ByteSize.hs
@@ -0,0 +1,30 @@
+module Data.ByteSize (
+    ByteSize (..)
+  ) where
+
+import Data.Bits
+import Data.Int
+
+-----------------------------------------------------------
+
+class ByteSize a where
+  byteSize :: a -> Maybe Int
+
+instance ByteSize Integer where
+  byteSize _ = Nothing
+
+instance ByteSize Int where
+  byteSize _ = Just $ bitSize (0 :: Int) `div` 8
+
+instance ByteSize Int8 where
+  byteSize _ = Just $ bitSize (0 :: Int8) `div` 8
+
+instance ByteSize Int16 where
+  byteSize _ = Just $ bitSize (0 :: Int16) `div` 8
+
+instance ByteSize Int32 where
+  byteSize _ = Just $ bitSize (0 :: Int32) `div` 8
+
+instance ByteSize Int64 where
+  byteSize _ = Just $ bitSize (0 :: Int64) `div` 8
+
diff --git a/Data/Deque.hs b/Data/Deque.hs
new file mode 100644
--- /dev/null
+++ b/Data/Deque.hs
@@ -0,0 +1,86 @@
+module Data.Deque (
+    Deque
+  , mkDeque
+  , mkDeque1
+  , isEmpty
+  , depth
+  , Data.Deque.toList
+  , pop
+  , popBottom
+  , top
+  , bottom
+  , dig
+  , digBottom
+  , push
+  , pushBottom
+  ) where
+
+import qualified Data.Foldable as Foldable
+import Data.List (genericDrop, intercalate)
+import Data.Sequence
+import qualified Data.Sequence as Sequence
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+newtype Deque a = D (Seq a)
+  deriving (Show, Eq, Ord)
+
+instance (PrettyShow a) => PrettyShow (Deque a) where
+  pshow (D s) = Prelude.concat [ []
+    , "["
+    , intercalate "," . map pshow $ Foldable.toList s
+    , "..]"
+    ]
+
+-----------------------------------------------------------
+
+mkDeque :: Deque a
+mkDeque = D empty
+
+mkDeque1 :: a -> Deque a
+mkDeque1 = D . singleton
+
+isEmpty :: Deque a -> Bool
+isEmpty (D s) = Sequence.null s
+
+depth :: Deque a -> Integer
+depth (D s) = Foldable.foldl' (\l _ -> 1 + l) 0 s
+
+toList :: Deque a -> [a]
+toList (D s) = Foldable.toList s
+
+pop :: Deque a -> Deque a
+pop (D s) = case viewl s of
+  _ :< s' -> D s'
+  EmptyL -> D empty
+
+popBottom :: Deque a -> Deque a
+popBottom (D s) = case viewr s of
+  s' :> _ -> D s'
+  EmptyR -> D empty
+
+top :: Deque a -> Maybe a
+top (D s) = case viewl s of
+  x :< _ -> Just x
+  EmptyL -> Nothing
+
+bottom :: Deque a -> Maybe a
+bottom (D s) = case viewr s of
+  _ :> x -> Just x
+  EmptyR -> Nothing
+
+dig :: (Integral i) => i -> Deque a -> Maybe a
+dig n = top . head . genericDrop n . iterate pop
+
+digBottom :: (Integral i) => i -> Deque a -> Maybe a
+digBottom n = top . head . genericDrop n . iterate popBottom
+
+push :: a -> Deque a -> Deque a
+push x (D s) = D (x <| s)
+
+pushBottom :: a -> Deque a -> Deque a
+pushBottom x (D s) = D (s |> x)
+
+
diff --git a/Data/History.hs b/Data/History.hs
new file mode 100644
--- /dev/null
+++ b/Data/History.hs
@@ -0,0 +1,101 @@
+module Data.History (
+    History (getSize)
+  , empty
+  , fromHistory
+  , fromList
+  , toList
+  , push
+  , pop
+  , popN
+  , lookup
+  ) where
+
+import Prelude hiding (lookup)
+
+import Data.IntMap (IntMap)
+import qualified Data.IntMap as IntMap
+import Data.Maybe (fromMaybe, mapMaybe)
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+data History a = History {
+    getSize :: Int
+  , getReplacePos :: Int
+  , getMap :: IntMap a
+  }
+  deriving
+    (Show)
+
+instance (PrettyShow a) => PrettyShow (History a) where
+  pshow = ("History " ++) . pshow . toList
+
+empty :: Int -> History a
+empty n = fromList (Just n) []
+
+fromHistory :: Maybe Int -> History a -> History a
+fromHistory Nothing h = h
+fromHistory (Just newSize) h
+  | newSize >= getSize h = h { getSize = newSize }
+  | otherwise = fromList (Just newSize) $ take newSize $ toList h -- TODO : Make this more efficient if needed
+
+fromList :: Maybe Int -> [a] -> History a
+fromList mSize xs = foldr push History { 
+    getSize = size
+  , getReplacePos = 0
+  , getMap = IntMap.empty
+  } xs
+  where
+    size = fromMaybe (length xs) mSize
+
+getHeadPos :: History a -> Int
+getHeadPos h = if rpos - 1 < 0
+  then getSize h - 1
+  else rpos - 1
+  where
+    rpos = getReplacePos h
+
+fromLogicalPos :: History a -> Int -> Int
+fromLogicalPos h pos = if pos <= hpos
+  then hpos - pos
+  else size + hpos - pos
+  where
+    size = getSize h
+    hpos = getHeadPos h
+
+push :: a -> History a -> History a
+push x h = h {
+    getMap = IntMap.insert rpos x $ getMap h
+  , getReplacePos = if rpos + 1 < getSize h
+      then rpos + 1
+      else 0
+  }
+  where
+    rpos = getReplacePos h
+
+pop :: History a -> History a
+pop h = h {
+    getMap = IntMap.delete (getHeadPos h) $ getMap h
+  , getReplacePos = if rpos - 1 < 0
+      then getSize h - 1
+      else rpos - 1
+  }
+  where
+    rpos = getReplacePos h
+
+popN :: Int -> History a -> History a
+popN n = head . drop n . iterate pop
+
+lookup :: Int -> History a -> Maybe a
+lookup pos h
+  | 0 <= pos && pos < size = IntMap.lookup (fromLogicalPos h pos) $ getMap h
+  | otherwise = Nothing
+  where
+    size = getSize h
+
+toList :: History a -> [a]
+toList h = mapMaybe (`lookup` h) [0 .. getSize h - 1]
+
+
+
diff --git a/Data/I.hs b/Data/I.hs
new file mode 100644
--- /dev/null
+++ b/Data/I.hs
@@ -0,0 +1,25 @@
+module Data.I (
+    I
+  ) where
+
+import Data.Bits
+import Data.ByteSize
+import Data.Int
+import Data.MaybeBounded
+
+import Text.PrettyShow
+
+import Random
+
+-----------------------------------------------------------
+
+-- The I type class is intentionally empty. Used to clump the type classes.
+class (Bits i, ByteSize i, Integral i, MaybeBounded i, PrettyShow i, Random i, Read i) => I i where
+
+instance I Integer where
+instance I Int where
+instance I Int8 where
+instance I Int16 where
+instance I Int32 where
+instance I Int64 where
+
diff --git a/Data/IntegralLike.hs b/Data/IntegralLike.hs
new file mode 100644
--- /dev/null
+++ b/Data/IntegralLike.hs
@@ -0,0 +1,24 @@
+module Data.IntegralLike (
+    IntegralLike (..)
+  ) where
+
+import Data.Char (ord)
+
+-----------------------------------------------------------
+
+class IntegralLike a where
+  asIntegral :: (Integral i) => a -> i
+
+instance IntegralLike Bool where
+  asIntegral False = 0
+  asIntegral True = 1
+
+instance IntegralLike Char where
+  asIntegral = fromIntegral . ord
+
+instance IntegralLike Int where
+  asIntegral = fromIntegral
+
+instance IntegralLike Integer where
+  asIntegral = fromInteger
+
diff --git a/Data/Labeled.hs b/Data/Labeled.hs
new file mode 100644
--- /dev/null
+++ b/Data/Labeled.hs
@@ -0,0 +1,19 @@
+module Data.Labeled (
+    Labeled (getLabel, unlabel)
+  , label
+  ) where
+
+-----------------------------------------------------------
+
+data Labeled l a = Labeled {
+    getLabel :: l
+  , unlabel :: a
+  }
+  deriving (Show)
+
+label :: l -> a -> Labeled l a
+label = Labeled
+
+instance Functor (Labeled l) where
+  fmap f l = l { unlabel = f $ unlabel l }
+
diff --git a/Data/LogicalBits.hs b/Data/LogicalBits.hs
new file mode 100644
--- /dev/null
+++ b/Data/LogicalBits.hs
@@ -0,0 +1,23 @@
+module Data.LogicalBits (
+    logicalBit
+  , testLogicalBit
+  ) where
+
+import Prelude hiding (fromInteger, toInteger)
+
+import Data.Bits
+
+-----------------------------------------------------------
+
+toInt :: (Integral a) => a -> Int
+toInt = fromIntegral
+
+fromInt :: (Integral a) => Int -> a
+fromInt = fromIntegral
+
+logicalBit :: (Bits a, Integral a) => Int -> a
+logicalBit = fromInt . bit
+
+testLogicalBit :: (Bits a, Integral a) => a -> Int -> Bool
+testLogicalBit n = testBit $ toInt n
+
diff --git a/Data/MaybeBounded.hs b/Data/MaybeBounded.hs
new file mode 100644
--- /dev/null
+++ b/Data/MaybeBounded.hs
@@ -0,0 +1,36 @@
+module Data.MaybeBounded (
+    MaybeBounded (..)
+  ) where
+
+import Data.Int
+
+-----------------------------------------------------------
+
+class MaybeBounded a where
+  maybeMaxBound :: Maybe a
+  maybeMinBound :: Maybe a
+
+instance MaybeBounded Integer where
+  maybeMaxBound = Nothing
+  maybeMinBound = Nothing
+
+instance MaybeBounded Int where
+  maybeMaxBound = Just maxBound
+  maybeMinBound = Just minBound
+
+instance MaybeBounded Int8 where
+  maybeMaxBound = Just maxBound
+  maybeMinBound = Just minBound
+
+instance MaybeBounded Int16 where
+  maybeMaxBound = Just maxBound
+  maybeMinBound = Just minBound
+
+instance MaybeBounded Int32 where
+  maybeMaxBound = Just maxBound
+  maybeMinBound = Just minBound
+
+instance MaybeBounded Int64 where
+  maybeMaxBound = Just maxBound
+  maybeMinBound = Just minBound
+
diff --git a/Data/Stack.hs b/Data/Stack.hs
new file mode 100644
--- /dev/null
+++ b/Data/Stack.hs
@@ -0,0 +1,63 @@
+module Data.Stack (
+    Stack
+  , mkStack
+  , mkStack1
+  , isEmpty
+  , depth
+  , toList
+  , pop
+  , top
+  , dig
+  , push
+  ) where
+
+import Data.List (genericDrop, genericLength, intercalate)
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+newtype Stack a = S [a]
+  deriving (Show, Eq, Ord)
+
+instance (PrettyShow a) => PrettyShow (Stack a) where
+  pshow (S xs) = concat [ []
+    , "["
+    , intercalate "," . map pshow $ xs
+    , "..]"
+    ]
+
+-----------------------------------------------------------
+
+mkStack :: Stack a
+mkStack = S []
+
+mkStack1 :: a -> Stack a
+mkStack1 x = S [x]
+
+isEmpty :: Stack a -> Bool
+isEmpty (S []) = True
+isEmpty _      = False
+
+depth :: Stack a -> Integer
+depth (S xs) = genericLength xs
+
+toList :: Stack a -> [a]
+toList (S xs) = xs
+
+pop :: Stack a -> Stack a
+pop (S xs) = case xs of
+  _ : ys -> S ys
+  [] -> S []
+
+top :: Stack a -> Maybe a
+top (S xs) = case xs of
+  y : _ -> Just y
+  [] -> Nothing
+
+dig :: (Integral i) => i -> Stack a -> Maybe a
+dig n = top . head . genericDrop n . iterate pop
+
+push :: a -> Stack a -> Stack a
+push x (S xs) = S (x : xs)
+
diff --git a/Data/Vector.hs b/Data/Vector.hs
new file mode 100644
--- /dev/null
+++ b/Data/Vector.hs
@@ -0,0 +1,75 @@
+module Data.Vector (
+    Vector
+  , unVector
+  , mkVector
+  , takeV
+  , dropV
+  , reverseV
+  , zipWithV
+  , foldrV
+  , cons
+  , append
+  , liftOrd
+  ) where
+
+import Data.List (intercalate)
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+newtype Vector a = Vector { unVector :: [a] }
+  deriving (Show, Eq)
+
+instance (PrettyShow a) => PrettyShow (Vector a) where
+  pshow (Vector xs) = '(' : intercalate "," (map pshow xs) ++ ")"
+
+instance Functor Vector where
+  fmap f = Vector . map f . unVector
+
+instance (Num a) => Num (Vector a) where
+  fromInteger = Vector . repeat . fromInteger
+  negate = fmap negate
+  signum = fmap signum
+  abs = fmap abs
+  (+) = zipWithV' (+)
+  (-) = zipWithV' (-)
+  (*) = zipWithV' (*)
+
+mkVector :: [a] -> Vector a
+mkVector = Vector
+
+liftOrd :: (a -> a -> Bool) -> (Vector a -> Vector a -> Bool)
+liftOrd f xs = and . unVector . zipWithV f xs
+
+dropV :: Int -> Vector a -> Vector a
+dropV n = mkVector . drop n . unVector
+
+takeV :: Int -> Vector a -> Vector a
+takeV n = mkVector . take n . unVector
+
+reverseV :: Vector a -> Vector a
+reverseV = mkVector . reverse . unVector
+
+zipWithV :: (a -> b -> c) -> Vector a -> Vector b -> Vector c
+zipWithV f (Vector xs) (Vector ys) = Vector $ zipWith f xs ys
+
+zipWithV' :: (Num a, Num b) => (a -> b -> c) -> Vector a -> Vector b -> Vector c
+zipWithV' f (Vector xs) (Vector ys) = Vector $ zipWith' f xs ys
+
+zipWith' :: (Num a, Num b) => (a -> b -> c) -> [a] -> [b] -> [c]
+zipWith' _ [] [] = []
+zipWith' f (x:xs) [] = f x 0 : zipWith' f xs []
+zipWith' f [] (y:ys) = f 0 y : zipWith' f [] ys
+zipWith' f (x:xs) (y:ys) = f x y : zipWith' f xs ys
+
+foldrV :: (a -> b -> b) -> b -> Vector a -> b
+foldrV f z = foldr f z . unVector
+
+infixr 5 `cons`, `append`
+cons :: a -> Vector a -> Vector a
+x `cons` (Vector xs) = Vector (x : xs)
+
+append :: Vector a -> Vector a -> Vector a
+append xs ys = foldrV cons ys xs
+
diff --git a/Debug/Debug.hs b/Debug/Debug.hs
new file mode 100644
--- /dev/null
+++ b/Debug/Debug.hs
@@ -0,0 +1,377 @@
+module Debug.Debug (
+    runDebugger
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.Char (ord)
+import qualified Data.Deque as Deque
+import qualified Data.History as History
+import Data.List (intercalate, genericReplicate, stripPrefix, isPrefixOf, genericTake)
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as Set
+import Data.Vector
+
+import Debug.Debugger hiding (runDebugger)
+
+import Space.Cell
+import Space.Space
+
+import System.Exit (exitSuccess)
+import System.IO (stdin, stdout, hFlush, hGetLine)
+import System.IO.Buffering (withBuffering, BufferMode (..))
+
+import Text.Help.Debug (help)
+import Text.PrettyShow
+
+import Env
+import Instruction
+import Ip
+
+-----------------------------------------------------------
+
+updateHistory :: (I i) => Env i -> Env i
+updateHistory env = withHistory' (History.push envNoHist) env
+  where
+    withHistory' = withDebugger . withHistory
+    envNoHist = withHistory' (const $ History.empty 0) env
+
+runDebugger :: (I i) => Instruction i ()
+runDebugger = runDebugger' >> modify updateHistory
+
+runDebugger' :: (I i) => Instruction i ()
+runDebugger' = do
+  env <- get
+  let dim = getDim env
+      toss = currentToss env
+      debugger = getDebugger env
+      breakPoints = getBreakPoints debugger
+      watchExprs = getWatchExprs debugger
+      currPos = getPos $ currentIp env
+  case getDebugMode debugger of
+    DebugOff -> return ()
+    DebugContinue
+      | genericTake dim (unVector currPos) `Set.member` breakPoints -> stepDebug >> go
+      | any (`isPrefixOf` Deque.toList toss) $ Set.toList watchExprs -> stepDebug >> go
+      | otherwise -> return ()
+    DebugStep -> go
+  where
+    go :: (I i) => Instruction i ()
+    go = do
+      liftIO $ putChar '\n'
+      cellDebug
+      ipDebug
+      sDebug
+      gets (getLocaleRads . getDebugger) >>= localeDebug . Just . mapPair fromIntegral
+      fetchDebugCommand
+
+fetchDebugCommand :: (I i) => Instruction i ()
+fetchDebugCommand = do
+  cmd <- liftIO $ do
+    putStr "> "
+    hFlush stdout
+    withBuffering LineBuffering stdin hGetLine
+  case delimWords "'\"" cmd of
+    Nothing -> do
+      liftIO $ putStrLn $ "Unknown command: " ++ cmd
+      fetchDebugCommand
+    Just cmd' -> case mapHead (dropWhile (== '-')) cmd' of
+      [] -> return ()
+      "?" : []
+        -> helpDebug >> fetchDebugCommand
+      "back" : []
+        -> backDebug "1"
+      "back" : arg : []
+        -> backDebug arg
+      "break" : args
+        -> breakDebug args >> fetchDebugCommand
+      "breaks" : []
+        -> breaksDebug >> fetchDebugCommand
+      "cell" : []
+        -> cellDebug >> fetchDebugCommand
+      "cellat" : args
+        -> cellatDebug args >> fetchDebugCommand
+      "clear" : args
+        -> clearDebug args >> fetchDebugCommand
+      "continue" : []
+        -> continueDebug
+      "dim" : []
+        -> dimDebug >> fetchDebugCommand
+      "exit" : []
+        -> quitDebug
+      "help" : []
+        -> helpDebug >> fetchDebugCommand
+      "ip" : []
+        -> ipDebug >> fetchDebugCommand
+      "locale" : []
+        -> localeDebug Nothing >> fetchDebugCommand
+      "locale" : rad : []
+        -> localeDebug (fmap duplicate $ tryRead rad) >> fetchDebugCommand
+      "locale" : xrad : yrad : []
+        -> localeDebug (liftM2 (,) (tryRead xrad) (tryRead yrad)) >> fetchDebugCommand
+      "nodebug" : []
+        -> nodebugDebug
+      "pop" : arg : []
+        -> popDebug arg >> fetchDebugCommand
+      "push" : args
+        -> pushDebug args >> fetchDebugCommand
+      "quit" : []
+        -> quitDebug
+      "record" : arg : []
+        -> recordDebug arg >> fetchDebugCommand
+      "setpos" : args
+        -> setposDebug args >> fetchDebugCommand
+      "space" : []
+        -> spaceDebug >> fetchDebugCommand
+      "s" : []
+        -> sDebug >> fetchDebugCommand
+      "setlocale" : xrad : yrad : []
+        -> setlocaleDebug xrad yrad >> fetchDebugCommand
+      "ss" : []
+        -> ssDebug >> fetchDebugCommand
+      "step" : []
+        -> stepDebug >> fetchDebugCommand
+      "unshowable" : arg : []
+        -> unshowableDebug arg >> fetchDebugCommand
+      "unwatch" : args
+        -> unwatchDebug args >> fetchDebugCommand
+      "watch" : args
+        -> watchDebug args >> fetchDebugCommand
+      "watches" : []
+        -> watchesDebug >> fetchDebugCommand
+      _ 
+        -> liftIO (putStrLn $ "Unknown command: " ++ cmd) >> fetchDebugCommand
+
+mapPair :: (a -> b) -> (a, a) -> (b, b)
+mapPair f (x, y) = (f x, f y)
+
+duplicate :: a -> (a, a)
+duplicate x = (x, x)
+
+mapHead :: (a -> a) -> [a] -> [a]
+mapHead _ [] = []
+mapHead f (x:xs) = f x : xs
+
+delimWords :: String -> String -> Maybe [String]
+delimWords delims str = fmap (reverse . dropWhile (== "") . reverse) $ delimWords' delims str
+
+delimWords' :: String -> String -> Maybe [String]
+delimWords' _ "" = Just [""]
+delimWords' delims (c:cs)
+  | c == ' ' = fmap ("" :) $ delimWords' delims $ dropWhile (== ' ') cs
+  | c `elem` delims = fmap (mapHead (\str -> c : takeWhile (/= c) cs ++ str ++ [c])) $ delimWords'' c cs
+  | otherwise = fmap (mapHead (c:)) $ delimWords' delims cs
+  where
+    delimWords'' currDelim = delimWords' delims <=< stripPrefix [currDelim] . dropWhile (/= currDelim)
+
+-----------------------------------------------------------
+
+readVector :: (I i) => [String] -> Maybe (Vector i)
+readVector [] = Nothing
+readVector strs = case tryReadList strs of
+  Nothing -> Nothing
+  Just ns -> Just $ mkVector $ ns ++ repeat 0
+
+tryRead :: (Read a) => String -> Maybe a
+tryRead str = case reads str of
+  [(x, "")] -> Just x
+  _ -> Nothing
+
+tryReadList :: (Read a) => [String] -> Maybe [a]
+tryReadList [] = Just []
+tryReadList (str:strs) = tryRead str >>= \x -> fmap (x :) $ tryReadList strs
+
+readCells :: (I i) => [String] -> [Maybe i]
+readCells [] = []
+readCells (str:strs) = case str of
+  '\'' : str' -> readString '\'' str'
+  '"'  : str' -> readString '"'  str'
+  "" -> readCells strs
+  _ -> case tryRead str of
+    Just n -> Just n : readCells strs
+    Nothing -> case str of
+      [c] -> (Just . fromIntegral . ord) c : readCells strs
+      _ -> Nothing : readCells strs
+  where
+    readString quote s = case sequence (readString' quote s) of
+      Nothing -> Nothing : readCells strs
+      Just cells -> cells ++ readCells strs
+    --
+    readString' _ "" = [Nothing]
+    readString' quote (c:cs)
+      | c == quote = case cs of
+        "" -> []
+        _ -> [Nothing]
+      | otherwise = (Just . Just . fromIntegral . ord) c : readString' quote cs
+    
+-----------------------------------------------------------
+
+invalidVector :: Instruction i ()
+invalidVector = liftIO $ putStrLn "Invalid vector."
+
+invalidArgument :: Instruction i ()
+invalidArgument = liftIO $ putStrLn "Invalid argument."
+
+-----------------------------------------------------------
+
+backDebug :: (I i) => String -> Instruction i ()
+backDebug arg = case tryRead arg of 
+  Nothing -> invalidArgument
+  Just n -> if n <= 0
+    then invalidArgument >> fetchDebugCommand
+    else do
+      hist <- gets $ getHistory . getDebugger
+      case History.lookup (n - 1) hist of
+        Nothing -> do
+          liftIO $ putStrLn "Not enough history. Try again."
+          fetchDebugCommand
+        Just env' -> do
+          let hist' = History.popN n hist
+          put env'
+          modify $ withDebugger $ \d -> d { getDebugMode = DebugStep, getHistory = hist' }
+          runDebugger'
+
+breakDebug :: (I i) => [String] -> Instruction i ()
+breakDebug args = case readVector args of
+  Nothing -> invalidVector
+  Just pos -> modify $ addBreakPoint $ unVector pos
+
+breaksDebug :: (I i) => Instruction i ()
+breaksDebug = do
+  breakPoints <- gets $ Set.toList . getBreakPoints . getDebugger
+  liftIO $ mapM_ pprint breakPoints
+
+cellDebug :: (I i) => Instruction i ()
+cellDebug = gets currentCell >>= liftIO . pprint
+
+cellatDebug :: (I i) => [String] -> Instruction i ()
+cellatDebug args = case readVector args of
+  Nothing -> invalidVector
+  Just pos -> do
+    dim <- gets getDim
+    gets getSpace >>= liftIO . pprint . flip cellAt (takeV dim $ pos `append` 0)
+
+clearDebug :: (I i) => [String] -> Instruction i ()
+clearDebug args
+  | args == ["*"] = modify $ withDebugger $ withBreakPoints $ const Set.empty
+  | otherwise = case readVector args of
+      Nothing -> invalidVector
+      Just pos -> modify $ removeBreakPoint $ unVector pos
+
+continueDebug :: (I i) => Instruction i ()
+continueDebug = modify $ withDebugger $ \d -> d { getDebugMode = DebugContinue }
+
+dimDebug :: (I i) => Instruction i ()
+dimDebug = gets getDim >>= liftIO . pprint 
+
+helpDebug :: Instruction i ()
+helpDebug = liftIO help
+
+ipDebug :: (I i) => Instruction i ()
+ipDebug = gets currentIp >>= liftIO . pprint
+
+localeDebug :: (I i) => Maybe (Int, Int) -> Instruction i ()
+localeDebug mrads = do
+  env <- get
+  let unshowableCellChar = getUnshowableChar env
+      dim = getDim env
+      s = getSpace env
+      pos = getPos . currentIp $ env
+      defaultRads = getLocaleRads $ getDebugger env
+      (xrad, yrad) = mapPair (fromIntegral . min 666 . max 1) $ fromMaybe defaultRads mrads
+      top = "+" ++ rep xrad '-' ++ "v" ++ rep xrad '-' ++ "+"
+      bot = "+" ++ rep xrad '-' ++ "^" ++ rep xrad '-' ++ "+"
+      topRows = intercalate "\n" ["|" ++ chars2 [[x, y] | x <- [-xrad .. xrad]] ++ "|" | y <- [-yrad .. -1]]
+      midRow  = ">" ++ chars1 [[x, 0] | x <- [-xrad .. xrad]] ++ "<"
+      botRows = intercalate "\n" ["|" ++ chars2 [[x, y] | x <- [-xrad .. xrad]] ++ "|" | y <- [1 .. yrad]]
+      str = unlines [top, topRows, midRow, botRows, bot]
+      disp xs = takeV dim $ pos + mkVector xs
+      chars1 = map (showCell . cellAt s . disp)
+      chars2 = if dim >= 2
+        then chars1
+        else const . rep (2 * xrad + 1) $ ' '
+      showCell = fromMaybe unshowableCellChar . cellToPrintableChar
+  liftIO $ putStrLn str
+  where
+    rep = genericReplicate
+
+nodebugDebug :: (I i) => Instruction i ()
+nodebugDebug = modify $ withDebugger $ \d -> d { getDebugMode = DebugOff }
+
+popDebug :: (I i) => String -> Instruction i ()
+popDebug arg = case tryRead arg :: Maybe Integer of
+  Nothing -> invalidArgument
+  Just n -> popNInstr_ n
+
+pushDebug :: (I i) => [String] -> Instruction i ()
+pushDebug args = case sequence $ readCells args of
+  Nothing -> invalidArgument
+  Just cells -> pushVectorInstr $ mkVector $ reverse cells
+
+quitDebug :: (I i) => Instruction i ()
+quitDebug = liftIO exitSuccess
+
+recordDebug :: (I i) => String -> Instruction i ()
+recordDebug arg = case tryRead arg of
+  Nothing -> invalidArgument
+  Just n -> modify $ withDebugger $ withHistory $ History.fromHistory $ Just n
+
+setposDebug :: (I i) => [String] -> Instruction i ()
+setposDebug args = case readVector args of
+  Nothing -> invalidVector
+  Just pos -> setPosInstr pos
+
+spaceDebug :: (I i) => Instruction i ()
+spaceDebug = gets getSpace >>= liftIO . pprint
+
+sDebug :: (I i) => Instruction i ()
+sDebug = do
+  toss <- gets currentToss
+  let ptInt = pshow toss
+      ptGuts = id 
+        . words 
+        . map (\c -> if c == ',' then ' ' else c) 
+        . reverse 
+        . drop 3 
+        . reverse 
+        . drop 1 
+        $ ptInt
+      ptChar = "[" ++ intercalate "," (map (showChr . read) ptGuts) ++ "..]"
+  liftIO $ putStrLn ptChar >> putStrLn ptInt
+  where
+    showChr :: Integer -> String
+    showChr n = maybe "\\???" show $ cellToChar $ chrCell n
+
+setlocaleDebug :: (I i) => String -> String -> Instruction i ()
+setlocaleDebug xrad yrad = case tryRead xrad of
+  Nothing -> invalidArgument
+  Just xrad' -> case tryRead yrad of
+    Nothing -> invalidArgument
+    Just yrad' -> modify $ withDebugger $ \d -> d {
+        getLocaleRads = (xrad', yrad')
+      }
+
+ssDebug :: (I i) => Instruction i ()
+ssDebug = gets currentSs >>= liftIO . pprint 
+
+stepDebug :: (I i) => Instruction i ()
+stepDebug = modify $ withDebugger $ \d -> d { getDebugMode = DebugStep }
+
+unshowableDebug :: (I i) => String -> Instruction i ()
+unshowableDebug str = case str of 
+  [c] -> modify $ \env -> env { getUnshowableChar = c }
+  _ -> invalidArgument
+
+unwatchDebug :: (I i) => [String] -> Instruction i ()
+unwatchDebug args = case sequence $ readCells args of 
+  Nothing -> invalidArgument
+  Just cells -> modify $ withDebugger $ withWatchExprs $ Set.delete cells
+
+watchDebug :: (I i) => [String] -> Instruction i ()
+watchDebug args = case sequence $ readCells args of 
+  Nothing -> invalidArgument
+  Just cells -> modify $ withDebugger $ withWatchExprs $ Set.insert cells
+
+watchesDebug :: (I i) => Instruction i ()
+watchesDebug = gets (Set.toList . getWatchExprs . getDebugger) >>= liftIO . mapM_ pprint
+
diff --git a/Debug/Debugger.hs b/Debug/Debugger.hs
new file mode 100644
--- /dev/null
+++ b/Debug/Debugger.hs
@@ -0,0 +1,40 @@
+module Debug.Debugger (
+    Debugger (..)
+  , DebugMode (..)
+  , withBreakPoints
+  , withWatchExprs
+  , withHistory
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.History
+import Data.Set (Set)
+
+-----------------------------------------------------------
+
+type Instruction env i = StateT (env i) IO
+
+-----------------------------------------------------------
+
+data DebugMode = DebugStep | DebugContinue | DebugOff
+  deriving (Show, Eq, Ord)
+
+data Debugger env i = Debugger {
+    getDebugMode :: DebugMode
+  , runDebugger :: Instruction env i ()
+  , getBreakPoints :: Set [i]
+  , getWatchExprs :: Set [i]
+  , getHistory :: !(History (env i))
+  , getLocaleRads :: (Int, Int)
+  }
+
+withBreakPoints :: (Set [i] -> Set [i]) -> Debugger env i -> Debugger env i
+withBreakPoints f d = d { getBreakPoints = f $ getBreakPoints d }
+
+withWatchExprs :: (Set [i] -> Set [i]) -> Debugger env i -> Debugger env i
+withWatchExprs f d = d { getWatchExprs = f $ getWatchExprs d }
+
+withHistory :: (History (env i) -> History (env i)) -> Debugger env i -> Debugger env i
+withHistory f d = d { getHistory = f $ getHistory d } 
+
diff --git a/Env.hs b/Env.hs
new file mode 100644
--- /dev/null
+++ b/Env.hs
@@ -0,0 +1,155 @@
+module Env (
+    Env (..)
+  , mkEnv
+  , withDebugger
+  , withIp
+  , withIps
+  , withSpace
+  , withSs
+  , withToss
+  , withSemantics
+  , currentCell
+  , currentIp
+  , currentSs
+  , currentToss
+  , addSpawnedIp
+  , addBreakPoint
+  , removeBreakPoint
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.Deque
+import Data.I
+import Data.List (genericTake)
+import Data.List.Zipper (Zipper)
+import qualified Data.List.Zipper as Zipper
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe (fromMaybe)
+import Data.MaybeBounded
+import qualified Data.Set as Set
+import Data.Stack
+import qualified Data.Stack as Stack
+import Data.Vector
+
+import Debug.Debugger
+
+import Space.Cell
+import Space.Space
+
+import Ip
+import Semantics
+import UnknownInstruction
+
+
+-----------------------------------------------------------
+
+type Instruction i = StateT (Env i) IO
+
+type Fingerprints i = Map Integer [(i, Instruction i ())]
+
+data Env i = Env {
+    getIps :: Zipper (Ip Env i)
+  , getDebugger :: Debugger Env i
+  , getDim :: Int
+  , getSpace :: Space i
+  , getSpawnedIps :: [Ip Env i]
+  , getValidIds :: [i]
+  , getUnshowableChar :: Char
+  , getUnknownMode :: UnknownInstruction
+  , getProgName :: String
+  , getFungeArgs :: [String]
+  , getFingerprints :: Fingerprints i
+  , getValidReferences :: [i]
+  , getReferenceMap :: Map i (Vector i)
+  }
+
+mkEnv :: (I i) => Int
+        -> Space i 
+        -> UnknownInstruction 
+        -> Debugger Env i 
+        -> String 
+        -> [String] 
+        -> Fingerprints i 
+        -> Map i (Instruction i ())
+        -> Env i
+mkEnv dim space unknownMode debugger progName args fingerprints baseSemantics = Env {
+    getIps = Zipper.fromList [mkIp dim ident baseSemantics]
+  , getDebugger = debugger
+  , getDim = dim
+  , getSpace = space
+  , getSpawnedIps = []
+  , getValidIds = idents
+  , getUnshowableChar = '®'
+  , getUnknownMode = unknownMode
+  , getProgName = progName
+  , getFungeArgs = args
+  , getFingerprints = fingerprints
+  , getValidReferences = uniqueVals
+  , getReferenceMap = Map.empty
+  }
+  where
+    ident : idents = uniqueVals
+
+uniqueVals :: (I i) => [i]
+uniqueVals = case maybeMaxBound of
+  Nothing -> [0 ..]
+  Just maxN -> [0 .. maxN] ++ case maybeMinBound of 
+    Nothing -> iterate (subtract 1) (-1)
+    Just minN -> init [minN .. 0]
+
+currentIp :: Env i -> Ip Env i
+currentIp = Zipper.cursor . getIps
+
+setCurrentIp :: Ip Env i -> Env i -> Env i
+setCurrentIp ip = withIps $ Zipper.replace ip
+
+withDebugger :: (Debugger Env i -> Debugger Env i) -> Env i -> Env i
+withDebugger f env = env { getDebugger = f $ getDebugger env }
+
+withIp :: (Ip Env i -> Ip Env i) -> Env i -> Env i
+withIp f env = setCurrentIp (f $ currentIp env) env
+
+withIps :: (Zipper (Ip Env i) -> Zipper (Ip Env i)) -> Env i -> Env i
+withIps f env = env { getIps = f $ getIps env }
+
+withSemantics :: (Semantics Env i -> Semantics Env i) -> Env i -> Env i
+withSemantics f = withIp $ \ip -> ip { getSemantics = f $ getSemantics ip }
+
+withSpace :: (Space i -> Space i) -> Env i -> Env i
+withSpace f env = env { getSpace = f $ getSpace env }
+
+withSs :: (Stack (Deque i) -> Stack (Deque i)) -> Env i -> Env i
+withSs f = withIp $ \ip -> ip { getSs = f $ getSs ip }
+
+withToss :: (Deque i -> Deque i) -> Env i -> Env i
+withToss f = withSs $ \ss -> case Stack.top ss of
+  Just s -> Stack.push (f s) $ Stack.pop ss
+  Nothing -> mkStack1 $ f mkDeque
+
+currentSs :: Env i -> Stack (Deque i)
+currentSs = getSs . currentIp
+
+currentToss :: Env i -> Deque i
+currentToss = fromMaybe mkDeque . Stack.top . currentSs
+
+currentCell :: (Integral i) => Env i -> Cell i
+currentCell env = cellAt s pos
+  where
+    s = getSpace env
+    pos = getPos . currentIp $ env
+
+addSpawnedIp :: Ip Env i -> Env i -> Env i
+addSpawnedIp ip env = env { getSpawnedIps = ip : getSpawnedIps env }
+
+addBreakPoint :: (I i) => [i] -> Env i -> Env i
+addBreakPoint pos env = withDebugger (withBreakPoints $ Set.insert pos') env
+  where
+    pos' = genericTake (getDim env) $ pos ++ repeat 0
+
+removeBreakPoint :: (I i) => [i] -> Env i -> Env i
+removeBreakPoint pos env = withDebugger (withBreakPoints $ Set.delete pos') env
+  where
+    pos' = genericTake (getDim env) $ pos ++ repeat 0
+
diff --git a/Fingerprint.hs b/Fingerprint.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint.hs
@@ -0,0 +1,54 @@
+module Fingerprint (
+    fingerprints
+  ) where
+
+import Data.Char (ord)
+import Data.IntegralLike
+import Data.List (foldl')
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Instruction
+
+import qualified Fingerprint.BASE as BASE
+import qualified Fingerprint.BOOL as BOOL
+import qualified Fingerprint.CPLI as CPLI
+import qualified Fingerprint.FIXP as FIXP
+import qualified Fingerprint.MODE as MODE
+import qualified Fingerprint.MODU as MODU
+import qualified Fingerprint.NULL as NULL
+import qualified Fingerprint.ORTH as ORTH
+import qualified Fingerprint.REFC as REFC
+import qualified Fingerprint.ROMA as ROMA
+
+-----------------------------------------------------------
+
+type Fingerprints i = Map Integer [(i, Instruction i ())]
+
+mapFst :: (a -> c) -> (a, b) -> (c, b)
+mapFst f (x, y) = (f x, y)
+
+mapSnd :: (b -> c) -> (a, b) -> (a, c)
+mapSnd f (x, y) = (x, f y)
+
+asId :: String -> Integer
+asId = fromIntegral . foldl' (\fId x -> fId * 256 + x) 0 . map ord
+
+fingerprints :: (I i) => Fingerprints i
+fingerprints = foldr (uncurry (insert . asId) . mapSnd (map $ mapFst asIntegral)) Map.empty [
+    (BASE.name, BASE.semantics)
+  , (BOOL.name, BOOL.semantics)
+  , (CPLI.name, CPLI.semantics)
+  , (FIXP.name, FIXP.semantics)
+  , (MODE.name, MODE.semantics)
+  , (MODU.name, MODU.semantics)
+  , (NULL.name, NULL.semantics)
+  , (ORTH.name, ORTH.semantics)
+  , (REFC.name, REFC.semantics)
+  , (ROMA.name, ROMA.semantics)
+  ]
+  where
+    insert k v m = if Map.member k m
+      then error $ "Fingerprint.fingerprints: Duplicate entry for fingerprint " ++ show k
+      else Map.insert k v m
+
diff --git a/Fingerprint/BASE.hs b/Fingerprint/BASE.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/BASE.hs
@@ -0,0 +1,93 @@
+module Fingerprint.BASE (
+    name
+  , semantics
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.Char (chr, ord, toLower)
+import Data.Maybe (isNothing)
+import Data.MaybeBounded
+
+import Numeric (showIntAtBase)
+
+import System.IO (stdin, stdout, hFlush)
+import System.IO.Buffering (BufferMode (..), withBuffering)
+
+import Instruction
+
+-----------------------------------------------------------
+
+name :: String
+name = "BASE"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('B', outputBaseInstr 2)
+  , ('H', outputBaseInstr 16)
+  , ('I', inputBaseInstr)
+  , ('N', popInstr >>= outputBaseInstr)
+  , ('O', outputBaseInstr 8)
+  ]
+
+intToDigit :: Int -> Char
+intToDigit i
+  | 0 <= i && i <= 9 = chr $ ord '0' + i
+  | otherwise = chr $ ord 'a' - 10 + i
+
+outputBaseInstr :: (I i) => i -> Instruction i ()
+outputBaseInstr base
+  | 2 <= base && base <= 36 = do
+      n <- popInstr
+      outcome <- tryLiftIO $ do
+        when (n < 0) $ putChar '-'
+        putStr $ showIntAtBase base intToDigit (abs n) " "
+      when (isNothing outcome) reverseInstr
+  | otherwise = popInstr >> reverseInstr
+
+inputBaseInstr :: (I i) => Instruction i ()
+inputBaseInstr = do
+  base <- popInstr
+  if 2 <= base && base <= 36
+    then do
+      outcome <- tryLiftIO $ do
+        hFlush stdout
+        withBuffering NoBuffering stdin $ const $ getBase base
+      maybe reverseInstr pushInstr outcome
+    else reverseInstr  
+
+toBase :: (Integral i) => i -> Char -> Maybe Integer
+toBase base c
+  | '0' <= c && c <= '9' = checkSize $ fromIntegral $ ord c - ord '0'
+  | 'a' <= c' && c' <= 'z' = checkSize $ fromIntegral $ ord c' + 10 - ord 'a'
+  | otherwise = Nothing
+  where
+    c' = toLower c
+    checkSize n = if n < fromIntegral base
+      then Just n
+      else Nothing
+
+getBase :: (I i) => i -> IO i
+getBase base = do
+  c <- getChar
+  case toBase base c of
+    Just k -> case maybeMaxBound `asTypeOf` Just base of
+      Just bound -> if k > fromIntegral bound
+        then getBase base
+        else getBase' base k
+      Nothing -> getBase' base k
+    Nothing -> getBase base
+
+getBase' :: (I i) => i -> Integer -> IO i
+getBase' base n = do
+  c <- getChar
+  case toBase base c of
+    Just k -> let
+      n' = fromIntegral base * n + k
+      in case maybeMaxBound `asTypeOf` Just base of
+        Just bound -> if n' > fromIntegral bound
+          then return $ fromIntegral n
+          else getBase' base n'
+        Nothing -> getBase' base n'
+    Nothing -> return $ fromIntegral n
+
diff --git a/Fingerprint/BOOL.hs b/Fingerprint/BOOL.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/BOOL.hs
@@ -0,0 +1,32 @@
+module Fingerprint.BOOL (
+    name
+  , semantics
+  ) where
+
+import Instruction
+
+-----------------------------------------------------------
+
+name :: String
+name = "BOOL"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('A', aInstr)
+  , ('N', logicalNotInstr)
+  , ('O', oInstr)
+  , ('X', xInstr)
+  ]
+
+aInstr :: (I i) => Instruction i ()
+aInstr = op2Instr $ \x y -> if x == 0 then 0 else y
+
+oInstr :: (I i) => Instruction i ()
+oInstr = op2Instr $ \x y -> if x /= 0 then x else y
+
+xInstr :: (I i) => Instruction i ()
+xInstr = op2Instr $ \x y -> case () of
+  _ | x == 0 && y == 0 -> 0
+    | x == 0 || y == 0 -> 1
+    | otherwise -> 0
+
diff --git a/Fingerprint/CPLI.hs b/Fingerprint/CPLI.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/CPLI.hs
@@ -0,0 +1,71 @@
+module Fingerprint.CPLI (
+    name
+  , semantics
+  ) where
+
+import Control.Monad
+
+import Data.Maybe (isNothing)
+
+import Instruction
+import Math
+
+-----------------------------------------------------------
+
+name :: String
+name = "CPLI"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('A', aInstr)
+  , ('D', dInstr)
+  , ('M', mInstr)
+  , ('S', sInstr)
+  , ('O', oInstr)
+  , ('V', vInstr)
+  ]
+
+complexInstr :: (I i) => (i -> i -> i -> i -> (i, i)) -> Instruction i ()
+complexInstr op = do
+  d <- popInstr
+  c <- popInstr
+  b <- popInstr 
+  a <- popInstr
+  let (e, f) = op a b c d
+  pushInstr e
+  pushInstr f
+
+aInstr :: (I i) => Instruction i ()
+aInstr = complexInstr $ \a b c d -> (a + c, b + d)
+
+mapPair :: (a -> b) -> (a, a) -> (b, b)
+mapPair f (x, y) = (f x, f y)
+
+dInstr :: (I i) => Instruction i ()
+dInstr = complexInstr $ \a' b' c' d' -> let
+  [a, b, c, d] = map fromIntegral [a', b', c', d']
+  denom = c*c + d*d
+  in mapPair fromInteger ((a*c + b*d) `div` denom, (b*c - a*d) `div` denom)
+
+mInstr :: (I i) => Instruction i ()
+mInstr = complexInstr $ \a' b' c' d' -> let
+  [a, b, c, d] = map fromIntegral [a', b', c', d']
+  in mapPair fromInteger (a*c - b*d, b*c + a*d)
+
+sInstr :: (I i) => Instruction i ()
+sInstr = complexInstr $ \a b c d -> (a - c, b - d)
+
+oInstr :: (I i) => Instruction i ()
+oInstr = do
+  b <- popInstr
+  a <- popInstr
+  let signB = if b >= 0 then "+" else "-"
+  outcome <- tryLiftIO $ putStr $ '(' : show a ++ signB ++ show (abs b) ++ "i) "
+  when (isNothing outcome) reverseInstr
+  
+
+vInstr :: (I i) => Instruction i ()
+vInstr = op2Instr $ \a' b' -> let
+  (a, b) = mapPair fromIntegral (a', b')
+  in fromInteger $ squareRoot $ a*a + b*b
+
diff --git a/Fingerprint/FIXP.hs b/Fingerprint/FIXP.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/FIXP.hs
@@ -0,0 +1,118 @@
+module Fingerprint.FIXP (
+    name
+  , semantics
+  ) where
+
+import Prelude hiding (pi)
+import qualified Prelude
+
+import Control.Monad.State.Strict
+
+import Data.Bits ((.&.), (.|.), xor)
+
+import Instruction
+import Math
+import Random
+
+-----------------------------------------------------------
+
+name :: String
+name = "FIXP"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('A', aInstr)
+  , ('B', bInstr)
+  , ('C', cInstr)
+  , ('D', dInstr)
+  , ('I', iInstr)
+  , ('J', jInstr)
+  , ('N', nInstr)
+  , ('O', oInstr)
+  , ('P', pInstr)
+  , ('Q', qInstr)
+  , ('R', rInstr)
+  , ('S', sInstr)
+  , ('T', tInstr)
+  , ('U', uInstr)
+  , ('V', vInstr)
+  , ('X', xInstr)
+  ]
+
+trigInstr :: (I i) => (Double -> Double) -> Instruction i ()
+trigInstr op = opInstr $ \deg -> let
+  deg' = fromInteger $ fromIntegral deg `mod` (360 * scale)
+  rad = pi * deg' / scale / 180
+  res = op rad
+  in round $ res * scale
+  where
+    pi = Prelude.pi
+    scale :: (Num a) => a
+    scale = 10000
+
+itrigInstr :: (I i) => (Double -> Double) -> Instruction i ()
+itrigInstr op = opInstr $ \x -> let
+  x' = fromIntegral x / scale
+  rad = op x'
+  deg = rad * 180 / pi
+  in round $ deg * scale
+  where
+    pi = Prelude.pi
+    scale :: (Num a) => a
+    scale = 10000
+
+aInstr :: (I i) => Instruction i ()
+aInstr = op2Instr (.&.)
+
+bInstr :: (I i) => Instruction i ()
+bInstr = itrigInstr acos
+
+cInstr :: (I i) => Instruction i ()
+cInstr = trigInstr cos
+
+dInstr :: (I i) => Instruction i ()
+dInstr = popInstr >>= liftIO . uniformN >>= pushInstr
+  where
+    uniformN n = liftM (signum n *) $ uniformR (0, abs n)
+
+iInstr :: (I i) => Instruction i ()
+iInstr = trigInstr sin
+
+jInstr :: (I i) => Instruction i ()
+jInstr = itrigInstr asin
+
+nInstr :: (I i) => Instruction i ()
+nInstr = opInstr negate
+
+oInstr :: (I i) => Instruction i ()
+oInstr = op2Instr (.|.)
+
+pInstr :: (I i) => Instruction i ()
+pInstr = opInstr $ \x -> fromInteger $ (fromIntegral x * pi) `div` pow10
+  where
+    pi = 3141592653589793
+    pow10 = 10 ^ (length (show pi) - 1)
+
+qInstr :: (I i) => Instruction i ()
+qInstr = opInstr $ fromInteger . squareRoot . fromIntegral
+
+rInstr :: (I i) => Instruction i ()
+rInstr = op2Instr $ \x y -> if y >= 0
+  then x ^ y
+  else 0
+
+sInstr :: (I i) => Instruction i ()
+sInstr = opInstr signum
+
+tInstr :: (I i) => Instruction i ()
+tInstr = trigInstr tan
+
+uInstr :: (I i) => Instruction i ()
+uInstr = itrigInstr atan
+
+vInstr :: (I i) => Instruction i ()
+vInstr = opInstr abs
+
+xInstr :: (I i) => Instruction i ()
+xInstr = op2Instr xor
+
diff --git a/Fingerprint/MODE.hs b/Fingerprint/MODE.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/MODE.hs
@@ -0,0 +1,107 @@
+module Fingerprint.MODE (
+    name
+  , semantics
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.Map (Map)
+import Data.Vector
+
+import Space.Cell
+import Space.Space
+
+import Env
+import Instruction
+import Ip
+import qualified Mode
+import qualified Semantics
+
+-----------------------------------------------------------
+
+name :: String
+name = "MODE"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('H', hInstr)
+  , ('I', iInstr)
+  , ('Q', qInstr)
+  , ('S', sInstr)
+  ]
+
+-----------------------------------------------------------
+
+addDeltaInstr :: (I i) => [i] -> Instruction i ()
+addDeltaInstr ds = do
+  env <- get
+  let dim = getDim env
+      delta = getDelta $ currentIp env
+      delta' = unVector $ delta + mkVector (take dim $ ds ++ repeat 0)
+  setDeltaInstr delta'
+
+hoverGoEastInstr :: (I i) => Instruction i ()
+hoverGoEastInstr = addDeltaInstr [1]
+
+hoverGoWestInstr :: (I i) => Instruction i ()
+hoverGoWestInstr = addDeltaInstr [-1]
+
+hoverGoNorthInstr :: (I i) => Instruction i ()
+hoverGoNorthInstr = guardDim 2 $ addDeltaInstr [0, -1]
+
+hoverGoSouthInstr :: (I i) => Instruction i ()
+hoverGoSouthInstr = guardDim 2 $ addDeltaInstr [0, 1]
+
+hoverEastWestIfInstr :: (I i) => Instruction i ()
+hoverEastWestIfInstr = ifInstr hoverGoWestInstr hoverGoEastInstr
+
+hoverNorthSouthIfInstr :: (I i) => Instruction i ()
+hoverNorthSouthIfInstr = guardDim 2 $ ifInstr hoverGoNorthInstr hoverGoSouthInstr
+
+hovermodeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))
+hovermodeInstructions = (,) (const Nothing) $ buildInstructions [
+    ('>', Just hoverGoEastInstr)
+  , ('<', Just hoverGoWestInstr)
+  , ('^', Just hoverGoNorthInstr)
+  , ('v', Just hoverGoSouthInstr)
+  , ('|', Just hoverNorthSouthIfInstr)
+  , ('_', Just hoverEastWestIfInstr)
+  ]
+
+-----------------------------------------------------------
+
+setCurrentCellInstr :: (I i) => Char -> Instruction i ()
+setCurrentCellInstr c = do
+  pos <- gets $ getPos . currentIp
+  modify $ withSpace $ \s -> putCell s (charToCell c) pos
+
+switchmodeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))
+switchmodeInstructions = (,) (const Nothing) $ buildInstructions [
+    ('[', Just $ setCurrentCellInstr ']' >> turnLeftInstr)
+  , (']', Just $ setCurrentCellInstr '[' >> turnRightInstr)
+  , ('{', Just $ setCurrentCellInstr '}' >> beginBlockInstr)
+  , ('}', Just $ setCurrentCellInstr '{' >> endBlockInstr)
+  , ('(', Just $ setCurrentCellInstr ')' >> loadSemanticsInstr)
+  , (')', Just $ setCurrentCellInstr '(' >> unloadSemanticsInstr)
+  ]
+
+-----------------------------------------------------------
+
+hInstr :: (I i) => Instruction i ()
+hInstr = do
+  modify $ withIp $ toggleMode Mode.Hover
+  modify $ withSemantics $ Semantics.toggleOverlay Mode.Hover hovermodeInstructions
+
+iInstr :: (I i) => Instruction i ()
+iInstr = modify $ withIp $ toggleMode Mode.Invert
+
+qInstr :: (I i) => Instruction i ()
+qInstr = modify $ withIp $ toggleMode Mode.Queue
+
+sInstr :: (I i) => Instruction i ()
+sInstr = do
+  modify $ withIp $ toggleMode Mode.Switch
+  modify $ withSemantics $ Semantics.toggleOverlay Mode.Switch switchmodeInstructions
+
+
+
diff --git a/Fingerprint/MODU.hs b/Fingerprint/MODU.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/MODU.hs
@@ -0,0 +1,28 @@
+module Fingerprint.MODU (
+    name
+  , semantics
+  ) where
+
+import Instruction
+
+-----------------------------------------------------------
+
+name :: String
+name = "MODU"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('M', mInstr)
+  , ('U', uInstr)
+  , ('R', rInstr)
+  ]
+
+mInstr :: (I i) => Instruction i ()
+mInstr = op2Instr $ guardZero mod
+
+uInstr :: (I i) => Instruction i ()
+uInstr = op2Instr $ guardZero (\x -> abs . mod x)
+
+rInstr :: (I i) => Instruction i ()
+rInstr = op2Instr $ guardZero rem
+
diff --git a/Fingerprint/NULL.hs b/Fingerprint/NULL.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/NULL.hs
@@ -0,0 +1,16 @@
+module Fingerprint.NULL (
+    name
+  , semantics
+  ) where
+
+import Instruction
+
+-----------------------------------------------------------
+
+name :: String
+name = "NULL"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = zip ['A'..'Z'] $ repeat reverseInstr
+
+
diff --git a/Fingerprint/ORTH.hs b/Fingerprint/ORTH.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/ORTH.hs
@@ -0,0 +1,96 @@
+module Fingerprint.ORTH (
+    name
+  , semantics
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.Bits
+import Data.Maybe (fromMaybe)
+import Data.Vector
+
+import Space.Cell
+import Space.Space
+
+import Env
+import Instruction
+import Ip
+
+-----------------------------------------------------------
+
+name :: String
+name = "ORTH"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('A', aInstr)
+  , ('E', eInstr)
+  , ('G', gInstr)
+  , ('O', oInstr)
+  , ('P', pInstr)
+  , ('S', sInstr)
+  , ('V', vInstr)
+  , ('W', wInstr)
+  , ('X', xInstr)
+  , ('Y', yInstr)
+  , ('Z', zInstr)
+  ]
+
+aInstr :: (I i) => Instruction i ()
+aInstr = op2Instr (.&.)
+
+oInstr :: (I i) => Instruction i ()
+oInstr = op2Instr (.|.)
+
+eInstr :: (I i) => Instruction i ()
+eInstr = op2Instr xor
+
+overlay :: [Maybe a] -> Vector a -> Vector a
+overlay = zipWithV f . mkVector . (++ repeat Nothing)
+  where
+    f = flip fromMaybe
+
+xInstr :: (I i) => Instruction i ()
+xInstr = do
+  x <- popInstr
+  modify $ withIp $ \ip -> ip { getPos = overlay [Just x] $ getPos ip }
+
+yInstr :: (I i) => Instruction i ()
+yInstr = do
+  x <- popInstr
+  modify $ withIp $ \ip -> ip { getPos = overlay [Nothing, Just x] $ getPos ip }
+
+vInstr :: (I i) => Instruction i ()
+vInstr = do
+  x <- popInstr
+  modify $ withIp $ \ip -> ip { getDelta = overlay [Just x] $ getDelta ip }
+
+wInstr :: (I i) => Instruction i ()
+wInstr = do
+  x <- popInstr
+  modify $ withIp $ \ip -> ip { getDelta = overlay [Nothing, Just x] $ getDelta ip }
+
+gInstr :: (I i) => Instruction i ()
+gInstr = guardDim 2 $ do
+  loc <- liftM reverseV $ popVectorInstr (2 :: Int)
+  env <- get
+  let dim = getDim env
+      s = getSpace env
+      x = ordCell $ cellAt s $ takeV dim $ loc `append` 0
+  pushInstr x
+
+pInstr :: (I i) => Instruction i ()
+pInstr = guardDim 2 $ do
+  dim <- gets getDim
+  loc <- liftM reverseV $ popVectorInstr (2 :: Int)
+  x <- popInstr
+  modify $ withSpace $ \s -> putCell s (chrCell x) $ takeV dim $ loc `append` 0
+
+zInstr :: (I i) => Instruction i ()
+zInstr = ifInstr nopInstr $ replicateM_ 2 moveByDeltaInstr
+
+sInstr :: (I i) => Instruction i ()
+sInstr = do
+  s <- liftM (map $ fromMaybe '?') popStringInstr
+  liftIO $ putStr s
+
diff --git a/Fingerprint/REFC.hs b/Fingerprint/REFC.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/REFC.hs
@@ -0,0 +1,43 @@
+module Fingerprint.REFC (
+    name
+  , semantics
+  ) where
+
+import Control.Monad.State.Strict
+
+import qualified Data.Map as Map
+
+import System.Exit (exitFailure)
+
+import Env
+import Instruction
+
+-----------------------------------------------------------
+
+name :: String
+name = "REFC"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('R', rInstr)
+  , ('D', dInstr)
+  ]
+
+rInstr :: (I i) => Instruction i ()
+rInstr = do
+  refs <- gets getValidReferences
+  case refs of
+    [] -> liftIO $ do
+      putStrLn "REFC fingerprint: Cannot create a unique reference for vector."
+      exitFailure
+    r : rs -> do
+      vec <- popDimVectorInstr
+      pushInstr r
+      refMap <- gets $ Map.insert r vec . getReferenceMap
+      modify $ \env -> env { getReferenceMap = refMap, getValidReferences = rs }
+
+dInstr :: (I i) => Instruction i ()
+dInstr = do
+  r <- popInstr
+  gets getReferenceMap >>= maybe reverseInstr pushVectorInstr . Map.lookup r
+
diff --git a/Fingerprint/ROMA.hs b/Fingerprint/ROMA.hs
new file mode 100644
--- /dev/null
+++ b/Fingerprint/ROMA.hs
@@ -0,0 +1,44 @@
+module Fingerprint.ROMA (
+    name
+  , semantics
+  ) where
+
+import Instruction
+
+-----------------------------------------------------------
+
+name :: String
+name = "ROMA"
+
+semantics :: (I i) => [(Char, Instruction i ())]
+semantics = [
+    ('C', cInstr)
+  , ('D', dInstr)
+  , ('I', iInstr)
+  , ('L', lInstr)
+  , ('M', mInstr)
+  , ('V', vInstr)
+  , ('X', xInstr)
+  ]
+
+cInstr :: (I i) => Instruction i ()
+cInstr = pushInstr 100
+
+dInstr :: (I i) => Instruction i ()
+dInstr = pushInstr 500
+
+iInstr :: (I i) => Instruction i ()
+iInstr = pushInstr 1
+
+lInstr :: (I i) => Instruction i ()
+lInstr = pushInstr 50
+
+mInstr :: (I i) => Instruction i ()
+mInstr = pushInstr 1000
+
+vInstr :: (I i) => Instruction i ()
+vInstr = pushInstr 5
+
+xInstr :: (I i) => Instruction i ()
+xInstr = pushInstr 10
+
diff --git a/Fungi.cabal b/Fungi.cabal
new file mode 100644
--- /dev/null
+++ b/Fungi.cabal
@@ -0,0 +1,108 @@
+-- Fungi.cabal auto-generated by cabal init. For additional options,
+-- see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                	Fungi
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version:             	1.0
+
+-- A short (one-line) description of the package.
+Synopsis:            	An interpreter for Funge-98 programming languages, including Befunge.
+
+-- A longer description of the package.
+Description:		Fungi is a standards compliant Funge-98 interpreter equipped with an integrated debugger.
+			Supports funges of arbitrary dimensions, including Unefunge, Befunge, and Trefunge.
+			Allows limited control of funge cell size.
+			Several fingerprints are implemented.
+
+License:             	BSD3
+
+License-file:        	LICENSE
+
+Author:              	Thomas Eding
+
+Maintainer:          	thomasedingcode@gmail.com
+
+-- Copyright:           
+
+Category:            	Compilers/Interpreters
+
+Build-type:          	Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+-- Extra-source-files:  
+
+Cabal-version:       	>=1.2
+
+
+Executable: 		fungi
+
+Main-is:             	Main.hs
+
+GHC-options: 		-Wall
+
+Build-depends:
+	  base >= 4.2 && < 5
+	, bytestring >= 0.9
+	, containers >= 0.3
+	, directory >= 1.0
+	, filepath >= 1.1
+	, ListZipper >= 1.2
+	, mtl >= 1.1
+	, mwc-random >= 0.8
+	, old-time >= 1.0
+	, process >= 1.0
+	, random >= 1.0
+  
+-- Modules not exported by this package.
+Other-modules:
+	  Data.ByteSize
+	, Data.Deque
+	, Data.History
+	, Data.I
+	, Data.IntegralLike
+	, Data.Labeled
+	, Data.LogicalBits
+	, Data.MaybeBounded
+	, Data.Stack
+	, Data.Vector
+	, Debug.Debug
+	, Debug.Debugger
+	, Env
+	, Fingerprint
+	, Fingerprint.BASE
+	, Fingerprint.BOOL
+	, Fingerprint.CPLI
+	, Fingerprint.FIXP
+	, Fingerprint.MODE
+	, Fingerprint.MODU
+	, Fingerprint.NULL
+	, Fingerprint.ORTH
+	, Fingerprint.REFC
+	, Fingerprint.ROMA
+	, Fungi
+	, Instruction
+	, Interpreter
+	, Ip
+	, Math
+	, Mode
+	, ProcessArgs
+	, Random
+	, Semantics
+	, Space.Cell
+	, Space.Space
+	, System.IO.Buffering
+	, Text.Help.Debug
+	, Text.Help.Fungi
+	, Text.PrettyShow
+	, Text.PrintOption
+	, UnknownInstruction
+	, Version
+  
+-- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+-- Build-tools:         
+  
diff --git a/Fungi.hs b/Fungi.hs
new file mode 100644
--- /dev/null
+++ b/Fungi.hs
@@ -0,0 +1,99 @@
+module Fungi (
+    main
+  ) where
+
+import Control.Exception (handle)
+import Control.Monad
+
+import Data.ByteSize (byteSize)
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS (hGetContents)
+import qualified Data.History as History
+import Data.Int
+import Data.Maybe (fromMaybe)
+import qualified Data.Set as Set
+
+import Debug.Debug
+import Debug.Debugger
+
+import Space.Space
+
+import System.Environment (getArgs)
+import System.Exit (ExitCode (..))
+import System.FilePath (takeExtension)
+import System.IO hiding (hGetContents)
+
+import Text.Help.Fungi (help)
+
+import Env
+import Fingerprint
+import Instruction
+import Interpreter
+import ProcessArgs
+
+-----------------------------------------------------------
+
+main :: IO ExitCode
+main = do
+  mArgs <- liftM processArgs getArgs
+  case mArgs of
+    Nothing -> badArgs >> return (ExitFailure 1)
+    Just args
+      | argsHelp args -> help >> return ExitSuccess
+      | otherwise -> case argsFile args of
+          Nothing -> usage >> return ExitSuccess
+          Just file -> readSourceFile file >>= startFungi args file
+
+readSourceFile :: FilePath -> IO ByteString
+readSourceFile file = withFile file ReadMode $ \hdl -> BS.hGetContents hdl
+
+runFirst :: (Monad m) => [m (Maybe a)] -> m (Maybe a)
+runFirst [] = return Nothing
+runFirst (m:ms) = m >>= maybe (runFirst ms) (return . Just)
+
+startFungi :: ProcessedArgs -> FilePath -> ByteString -> IO ExitCode
+startFungi args file fileContents = do
+  ret <- runFirst [
+      whenSize Nothing $ runFungi (env :: Env Integer)
+    , whenSize (byteSize (0 :: Int)) $ runFungi (env :: Env Int)
+    , whenSize (byteSize (0 :: Int8)) $ runFungi (env :: Env Int8)
+    , whenSize (byteSize (0 :: Int16)) $ runFungi (env :: Env Int16)
+    , whenSize (byteSize (0 :: Int32)) $ runFungi (env :: Env Int32)
+    , whenSize (byteSize (0 :: Int64)) $ runFungi (env :: Env Int64)
+    ]
+  maybe (usage >> return (ExitFailure 1)) return ret
+  where
+    dim = fromMaybe (detectDim file) $ argsDim args
+    debugger :: (I i) => Debugger Env i
+    debugger = Debugger {
+        getDebugMode = argsDebugMode args
+      , Debug.Debugger.runDebugger = Debug.Debug.runDebugger
+      , getBreakPoints = Set.empty
+      , getWatchExprs = Set.empty
+      , getHistory = History.empty 0
+      , getLocaleRads = (7, 3)
+      }
+    space :: (I i) => Space i
+    space = mkSpace dim fileContents
+    env :: (I i) => Env i
+    env = mkEnv dim space (argsUnknownMode args) debugger file (argsFungeArgs args) fingerprints baseInstructions
+    whenSize size action = if size == argsCellByteSize args
+      then fmap Just $ handle return action
+      else return Nothing
+
+detectDim :: FilePath -> Int
+detectDim file = case takeExtension file of
+  ".uf" -> 1
+  ".u98" -> 1
+  ".bf" -> 2
+  ".b98" -> 2
+  ".tf" -> 3
+  ".t98" -> 3
+  _ -> 2
+
+usage :: IO ()
+usage = putStrLn "See --help for usage."
+
+badArgs :: IO ()
+badArgs = putStrLn "Bad arguments." >> usage
+
diff --git a/Instruction.hs b/Instruction.hs
new file mode 100644
--- /dev/null
+++ b/Instruction.hs
@@ -0,0 +1,874 @@
+module Instruction (
+    I
+  , Instruction
+  , buildInstructions
+  , baseInstructions
+  , lookupInstruction
+  , runCurrentInstruction
+
+  , guardDim
+  , guardZero
+
+  , ifInstr
+  , moveByDeltaInstr
+  , setDeltaInstr
+  , setPosInstr
+  , opInstr
+  , op2Instr
+  , pushVectorInstr
+  , popInstr
+  , popNInstr_
+  , popVectorInstr
+  , popDimVectorInstr
+  , popStringInstr
+  , tryLiftIO
+
+  , nopInstr
+  , pushInstr
+  , trampolineInstr
+  , reverseInstr
+  , loadSemanticsInstr
+  , unloadSemanticsInstr
+  , beginBlockInstr
+  , endBlockInstr
+  , turnLeftInstr
+  , turnRightInstr
+  , putInstr
+  , getInstr
+  , logicalNotInstr
+
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.ByteSize
+import qualified Data.ByteString.Char8 as BS (hGetContents, unpack)
+import Data.Char (ord)
+import Data.Deque
+import qualified Data.Deque as Deque
+import Data.I
+import Data.IntegralLike
+import Data.List (foldl', genericLength, genericReplicate, intercalate)
+import Data.LogicalBits
+import Data.MaybeBounded
+import Data.Maybe (isNothing, fromMaybe)
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.Stack as Stack
+import Data.Vector
+
+import Debug.Debugger
+
+import Space.Cell
+import Space.Space
+
+import System.Cmd (system)
+import System.Directory (canonicalizePath)
+import System.Environment (getEnvironment)
+import System.Exit (exitWith, exitFailure, ExitCode (..))
+import System.FilePath (pathSeparator, takeDirectory, isAbsolute)
+import System.IO (IOMode (..), withFile, hPutStr, hFlush, hGetChar, stdout, stdin)
+import System.IO.Buffering (BufferMode (..), withBuffering)
+import System.Random (randomRIO)
+import System.Time (CalendarTime (..), getClockTime, toCalendarTime)
+
+import Text.PrettyShow
+
+import Env
+import Ip
+import qualified Mode
+import qualified Semantics
+import UnknownInstruction
+import Version
+
+-----------------------------------------------------------
+
+infixr 9 `o`
+o :: (c -> d) -> (a -> b -> c) -> (a -> b -> d)
+o = (.).(.)
+
+numToBool :: (Num a) => a -> Bool
+numToBool 0 = False
+numToBool _ = True
+
+mapFst :: (a -> c) -> (a, b) -> (c, b)
+mapFst f (x, y) = (f x, y)
+
+whileM :: (Monad m) => (a -> m Bool) -> (a -> m a) -> a -> m a
+whileM mPred f x = mPred x >>= \bool -> if bool
+  then f x >>= whileM mPred f
+  else return x
+
+whileM_ :: (Monad m) => m Bool -> m () -> m ()
+whileM_ mBool m = whileM (const mBool) (const m) ()
+
+genericReplicateM :: (Integral i, Monad m) => i -> m a -> m [a]
+genericReplicateM = sequence `o` genericReplicate
+
+genericReplicateM_ :: (Integral i, Monad m) => i -> m a -> m ()
+genericReplicateM_ = sequence_ `o` genericReplicate
+
+-----------------------------------------------------------
+
+type Instruction i = StateT (Env i) IO
+
+-----------------------------------------------------------
+
+buildInstructions :: (Integral i) => [(Char, v)] -> Map i v
+buildInstructions = Map.fromList . map (mapFst $ fromIntegral . ord)
+
+baseInstructions :: (I i) => Map i (Instruction i ())
+baseInstructions = buildInstructions $ [
+    (' ', spaceInstr)
+  , ('!', logicalNotInstr)
+  , ('"', stringmodeInstr)
+  , ('#', trampolineInstr)
+  , ('$', popInstr_)
+  , ('%', remainderInstr)
+  , ('&', inputDecimalInstr)
+  , ('\'',fetchCharacterInstr)
+  , ('(', loadSemanticsInstr)
+  , (')', unloadSemanticsInstr)
+  , ('*', multiplyInstr)
+  , ('+', addInstr)
+  , (',', outputCharacterInstr)
+  , ('-', subtractInstr)
+  , ('.', outputDecimalInstr)
+  , ('/', divideInstr)
+  , ('0', pushInstr 0)
+  , ('1', pushInstr 1)
+  , ('2', pushInstr 2)
+  , ('3', pushInstr 3)
+  , ('4', pushInstr 4)
+  , ('5', pushInstr 5)
+  , ('6', pushInstr 6)
+  , ('7', pushInstr 7)
+  , ('8', pushInstr 8)
+  , ('9', pushInstr 9)
+  , (':', duplicateInstr)
+  , (';', jumpOverInstr)
+  , ('<', goWestInstr)
+  , ('=', executeInstr)
+  , ('>', goEastInstr)
+  , ('?', goAwayInstr)
+  , ('@', stopInstr)
+  , ('[', turnLeftInstr)
+  , ('\\',swapInstr)
+  , (']', turnRightInstr)
+  , ('^', goNorthInstr)
+  , ('_', eastWestIfInstr)
+  , ('`', greaterThanInstr)
+  , ('a', pushInstr 10)
+  , ('b', pushInstr 11)
+  , ('c', pushInstr 12)
+  , ('d', pushInstr 13)
+  , ('e', pushInstr 14)
+  , ('f', pushInstr 15)
+  , ('g', getInstr)
+  , ('h', goHighInstr)
+  , ('i', inputFileInstr)
+  , ('j', jumpForwardInstr)
+  , ('k', iterateInstr)
+  , ('l', goLowInstr)
+  , ('m', highLowIfInstr)
+  , ('n', clearStackInstr)
+  , ('o', outputFileInstr)
+  , ('p', putInstr)
+  , ('q', quitInstr)
+  , ('r', reverseInstr)
+  , ('s', storeCharacterInstr)
+  , ('t', splitInstr)
+  , ('u', stackUnderStackInstr)
+  , ('v', goSouthInstr)
+  , ('w', compareInstr)
+  , ('x', absoluteDeltaInstr)
+  , ('y', getSysInfoInstr)
+  , ('z', nopInstr)
+  , ('{', beginBlockInstr)
+  , ('|', northSouthIfInstr)
+  , ('}', endBlockInstr)
+  , ('~', inputCharacterInstr)
+  ] ++ zip ['A'..'Z'] (repeat reverseInstr)
+
+lookupInstruction :: (I i) => i -> Instruction i ()
+lookupInstruction i = do
+  sem <- gets $ getSemantics . currentIp
+  fromMaybe (unknownInstr i) $ Semantics.lookup i sem
+
+unknownInstr :: (I i) => i -> Instruction i ()
+unknownInstr i = do
+  env <- get
+  case getUnknownMode env of
+    ReverseUnknown -> reverseInstr
+    FailUnknown -> liftIO $ do
+      printUnknown
+      exitFailure
+    DebugUnknown -> do
+      liftIO $ do
+        printUnknown
+        pprint $ getPos $ currentIp env
+      debug
+      reverseInstr
+  where
+    printUnknown = putStrLn $ "\n\n*** Uknown instruction ord: " ++ pshow i
+
+-----------------------------------------------------------
+
+currentInstruction :: (I i) => Env i -> Instruction i ()
+currentInstruction = lookupInstruction . ordCell . currentCell
+
+runCurrentInstruction :: (I i) => Instruction i ()
+runCurrentInstruction = do
+  env <- get
+  runDebugger (getDebugger env)
+  env' <- get
+  currentInstruction env'
+
+debug :: Instruction i ()
+debug = do
+  modify $ withDebugger $ \d -> d { getDebugMode = DebugStep }
+  gets getDebugger >>= runDebugger
+
+-----------------------------------------------------------
+
+popInstr_ :: (I i) => Instruction i ()
+popInstr_ = popInstr >> return ()
+
+pushVectorInstr :: (I i) => Vector i -> Instruction i ()
+pushVectorInstr = mapM_ pushInstr . unVector
+
+popVectorInstr :: (I i, Integral n) => n -> Instruction i (Vector i)
+popVectorInstr = liftM mkVector . popNInstr
+
+popNInstr :: (I i, Integral n) => n -> Instruction i [i]
+popNInstr n = liftM reverse $ genericReplicateM n popInstr
+
+popNInstr_ :: (I i, Integral n) => n -> Instruction i ()
+popNInstr_ n = genericReplicateM_ n popInstr
+
+popDimInstr :: (I i) => Instruction i [i]
+popDimInstr = gets getDim >>= popNInstr
+
+popDimVectorInstr :: (I i) => Instruction i (Vector i)
+popDimVectorInstr = gets getDim >>= popVectorInstr
+
+popStringInstr :: (I i) => Instruction i [Maybe Char]
+popStringInstr = liftM (map $ cellToChar . chrCell) popStringInstr'
+
+popStringInstr' :: (I i) => Instruction i [i]
+popStringInstr' = do
+  x <- popInstr
+  if x == 0
+    then return [0]
+    else liftM (x :) popStringInstr'
+
+guardDim :: (I i) => Int -> Instruction i () -> Instruction i ()
+guardDim dim instr = do
+  env <- get
+  if getDim env < dim
+    then reverseInstr
+    else instr
+
+opInstr :: (I i) => (i -> i) -> Instruction i ()
+opInstr op = popInstr >>= pushInstr . op
+
+op2Instr :: (I i) => (i -> i -> i) -> Instruction i ()
+op2Instr op = do
+  y <- popInstr 
+  x <- popInstr
+  pushInstr $ op x y
+
+-----------------------------------------------------------
+
+nopInstr :: (I i) => Instruction i ()
+nopInstr = return ()
+
+-----------------------------------------------------------
+-- Direction Changing
+-----------------------------------------------------------
+
+setDeltaInstr :: (I i) => [i] -> Instruction i ()
+setDeltaInstr delta = do
+  dim <- gets getDim
+  let delta' = take dim $ delta ++ repeat 0
+  modify $ withIp $ setDelta $ mkVector delta'
+
+goEastInstr :: (I i) => Instruction i ()
+goEastInstr = setDeltaInstr [1]
+
+goWestInstr :: (I i) => Instruction i ()
+goWestInstr = setDeltaInstr [-1]
+
+goNorthInstr :: (I i) => Instruction i ()
+goNorthInstr = guardDim 2 $ setDeltaInstr [0, -1]
+
+goSouthInstr :: (I i) => Instruction i ()
+goSouthInstr = guardDim 2 $ setDeltaInstr [0, 1]
+
+goHighInstr :: (I i) => Instruction i ()
+goHighInstr = guardDim 3 $ setDeltaInstr [0, 0, 1]
+
+goLowInstr :: (I i) => Instruction i ()
+goLowInstr = guardDim 3 $ setDeltaInstr [0, 0, -1]
+
+randElem :: [a] -> IO a
+randElem xs = (xs !!) `fmap` randomRIO (0, length xs - 1)
+
+goAwayInstr :: (I i) => Instruction i ()
+goAwayInstr = do
+  dim <- gets getDim
+  delta <- liftIO $ do
+    dir <- randElem [-1, 1]
+    axis <- randElem [0 .. dim - 1]
+    return $ genericReplicate axis 0 ++ [dir]
+  setDeltaInstr delta
+
+turnRightInstr :: (I i) => Instruction i ()
+turnRightInstr = guardDim 2 $ modify $ withIp turn
+  where
+    turn ip = setDelta (mkVector $ [-y, x] ++ zs) ip
+      where
+        ([x, y], zs) = splitAt 2 . unVector . getDelta $ ip
+
+turnLeftInstr :: (I i) => Instruction i ()
+turnLeftInstr = replicateM_ 3 turnRightInstr
+
+reverseInstr :: (I i) => Instruction i ()
+reverseInstr = modify $ withIp reverseIp
+
+absoluteDeltaInstr :: (I i) => Instruction i ()
+absoluteDeltaInstr = popDimInstr >>= setDeltaInstr
+
+-----------------------------------------------------------
+-- Flow Control
+-----------------------------------------------------------
+
+setPosInstr :: (I i) => Vector i -> Instruction i ()
+setPosInstr = modify . withIp . setPos
+
+trampolineInstr :: (I i) => Instruction i ()
+trampolineInstr = do
+  env <- get
+  let s = getSpace env
+      ip = currentIp env
+      delta = getDelta ip
+      pos = getPos ip
+  modify $ withIp $ setPos $ (pos `travelBy` delta) s
+
+trampolineBackInstr :: (I i) => Instruction i ()
+trampolineBackInstr = reverseInstr >> trampolineInstr >> reverseInstr
+
+moveByDeltaInstr :: (I i) => Instruction i ()
+moveByDeltaInstr = modify $ withIp $ \ip -> let
+  pos = getPos ip
+  delta = getDelta ip
+  in ip { getPos = pos + delta }
+
+moveBackByDeltaInstr :: (I i) => Instruction i ()
+moveBackByDeltaInstr = reverseInstr >> moveByDeltaInstr >> reverseInstr
+
+stopInstr :: (I i) => Instruction i ()
+stopInstr = modify $ \env -> let
+  ip = currentIp env
+  ident = getId ip
+  env' = env { getValidIds = ident : getValidIds env }
+  in killIp `withIp` env'
+
+atInstr :: (I i) => Char -> Instruction i Bool
+atInstr c = gets $ (charToCell c ==) . currentCell
+
+spaceInstr :: (I i) => Instruction i ()
+spaceInstr = whileM_ (atInstr ' ') trampolineInstr >> runCurrentInstruction
+
+jumpOverInstr :: (I i) => Instruction i ()
+jumpOverInstr = trampolineInstr >> jump >> trampolineInstr >> runCurrentInstruction
+  where
+    jump = whileM_ (liftM not $ atInstr ';') trampolineInstr
+
+jumpForwardInstr :: (I i) => Instruction i ()
+jumpForwardInstr = do
+  n <- popInstr
+  genericReplicateM_ (abs n) $ if n >= 0
+    then trampolineInstr
+    else trampolineBackInstr
+
+quitInstr :: (I i) => Instruction i ()
+quitInstr = do
+  exitVal <- popInstr
+  liftIO $ if exitVal == 0
+    then exitWith ExitSuccess
+    else let
+      maxInt = fromIntegral (maxBound :: Int)
+      exitVal' = fromIntegral $ min maxInt exitVal
+      in exitWith $ ExitFailure exitVal'
+
+anyM :: (Monad m) => [m Bool] -> m Bool
+anyM = foldr (liftM2 (||)) $ return False
+
+iterateInstr :: (I i) => Instruction i ()
+iterateInstr = do
+  initPos <- gets $ getPos . currentIp
+  n <- popInstr
+  trampolineInstr
+  whileM_ (anyM $ map atInstr " ;") trampolineInstr
+  instr <- gets currentInstruction
+  when (n > 0) $ do
+    setPosInstr initPos
+    genericReplicateM_ n instr
+
+-----------------------------------------------------------
+-- Decision Making
+-----------------------------------------------------------
+
+logicalNotInstr :: (I i) => Instruction i ()
+logicalNotInstr = opInstr (asIntegral . not . numToBool)
+
+greaterThanInstr :: (I i) => Instruction i ()
+greaterThanInstr = op2Instr (asIntegral `o` (>))
+
+ifInstr :: (I i) => Instruction i a -> Instruction i a -> Instruction i a
+ifInstr trueInstr falseInstr = popInstr >>= \n -> if n == 0
+  then falseInstr
+  else trueInstr
+
+eastWestIfInstr :: (I i) => Instruction i ()
+eastWestIfInstr = ifInstr goWestInstr goEastInstr
+
+northSouthIfInstr :: (I i) => Instruction i ()
+northSouthIfInstr = guardDim 2 $ ifInstr goNorthInstr goSouthInstr
+
+highLowIfInstr :: (I i) => Instruction i ()
+highLowIfInstr = guardDim 3 $ ifInstr goHighInstr goLowInstr
+
+compareInstr :: (I i) => Instruction i ()
+compareInstr = guardDim 2 $ do
+  y <- popInstr
+  x <- popInstr
+  case compare x y of
+    LT -> turnLeftInstr
+    GT -> turnRightInstr
+    EQ -> nopInstr
+
+-----------------------------------------------------------
+-- Integers
+-----------------------------------------------------------
+
+addInstr :: (I i) => Instruction i ()
+addInstr = op2Instr (+)
+
+subtractInstr :: (I i) => Instruction i ()
+subtractInstr = op2Instr (-)
+
+multiplyInstr :: (I i) => Instruction i ()
+multiplyInstr = op2Instr (*)
+
+guardZero :: (Num a) => (a -> a -> a) -> (a -> a -> a)
+guardZero f x y = if y == 0
+  then 0
+  else f x y
+
+divideInstr :: (I i) => Instruction i ()
+divideInstr = op2Instr $ guardZero div
+
+remainderInstr :: (I i) => Instruction i ()
+remainderInstr = op2Instr $ guardZero mod
+
+-----------------------------------------------------------
+-- Strings
+-----------------------------------------------------------
+
+stringmodeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))
+stringmodeInstructions = (,) (Just . pushInstr) $ buildInstructions [
+    ('"', Nothing)
+  , (' ', Just sgmlSpaceInstr)
+  ]
+  where
+    spaceOrd = ordCell $ charToCell ' '
+    sgmlSpaceInstr = do
+      pushInstr spaceOrd
+      whileM_ (atInstr ' ') trampolineInstr
+      moveBackByDeltaInstr
+
+stringmodeInstr :: (I i) => Instruction i ()
+stringmodeInstr = do
+  modify $ withIp $ toggleMode Mode.String
+  modify $ withSemantics $ Semantics.toggleOverlay Mode.String stringmodeInstructions
+
+fetchCharacterInstr :: (I i) => Instruction i ()
+fetchCharacterInstr = do
+  trampolineInstr
+  x <- gets $ ordCell . currentCell
+  pushInstr x
+
+storeCharacterInstr :: (I i) => Instruction i ()
+storeCharacterInstr = do
+  trampolineInstr
+  pos <- gets $ getPos . currentIp
+  pushVectorInstr pos
+  putInstr
+
+-----------------------------------------------------------
+-- Stack Manipulation
+-----------------------------------------------------------
+
+popInstr :: (I i) => Instruction i i
+popInstr = do
+  qm <- gets $ testMode Mode.Queue . currentIp
+  liftM (fromMaybe 0) $ if qm
+    then do
+      x <- gets $ bottom . currentToss
+      modify $ withToss popBottom
+      return x
+    else do
+      x <- gets $ Deque.top . currentToss
+      modify $ withToss Deque.pop
+      return x
+
+pushInstr :: (I i) => i -> Instruction i ()
+pushInstr n = do
+  im <- gets $ testMode Mode.Invert . currentIp
+  modify $ withToss $ if im
+    then pushBottom n
+    else Deque.push n
+
+duplicateInstr :: (I i) => Instruction i ()
+duplicateInstr = popInstr >>= replicateM_ 2 . pushInstr
+
+swapInstr :: (I i) => Instruction i ()
+swapInstr = replicateM 2 popInstr >>= mapM_ pushInstr
+
+clearStackInstr :: (I i) => Instruction i ()
+clearStackInstr = modify $ withToss $ const mkDeque
+
+-----------------------------------------------------------
+-- Stack Stack Manipulation
+-----------------------------------------------------------
+
+beginBlockInstr :: (I i) => Instruction i ()
+beginBlockInstr = do
+  n <- popInstr
+  elts <- popVectorInstr n
+  ip <- gets currentIp
+  pushVectorInstr $ mkVector $ genericReplicate (negate n) 0
+  pushVectorInstr $ getStorageOffset ip
+  let so = getPos ip + getDelta ip
+  modify $ \env -> setStorageOffset so `withIp` (Stack.push mkDeque `withSs` env)
+  pushVectorInstr elts
+
+guardSoss :: (I i) => Instruction i () -> Instruction i ()
+guardSoss instr = do
+  noSoss <- gets $ Stack.isEmpty . Stack.pop . currentSs
+  if noSoss
+    then reverseInstr
+    else instr
+
+endBlockInstr :: (I i) => Instruction i ()
+endBlockInstr = guardSoss $ do
+  n <- popInstr
+  elts <- popVectorInstr n
+  modify $ withSs Stack.pop
+  popDimVectorInstr >>= modify . withIp . setStorageOffset
+  if n >= 0
+    then pushVectorInstr elts
+    else popNInstr_ $ abs n
+
+stackUnderStackInstr :: (I i) => Instruction i ()
+stackUnderStackInstr = guardSoss $ do
+  n <- popInstr
+  case compare n 0 of
+    GT -> do
+      toss <- gets currentToss
+      modify $ withSs Stack.pop
+      elts <- popVectorInstr n
+      modify $ withSs $ Stack.push toss
+      pushVectorInstr $ reverseV elts
+    LT -> do
+      elts <- popVectorInstr $ abs n
+      toss <- gets currentToss
+      modify $ withSs Stack.pop
+      pushVectorInstr $ reverseV elts
+      modify $ withSs $ Stack.push toss
+    EQ -> nopInstr
+
+-----------------------------------------------------------
+-- Funge-Space Storage
+-----------------------------------------------------------
+
+putInstr :: (I i) => Instruction i ()
+putInstr = do
+  loc <- popDimVectorInstr
+  x <- popInstr
+  offset <- gets $ getStorageOffset . currentIp
+  modify $ withSpace $ \s -> putCell s (chrCell x) $ loc + offset
+
+getInstr :: (I i) => Instruction i ()
+getInstr = do
+  loc <- popDimVectorInstr
+  env <- get
+  let s = getSpace env
+      offset = getStorageOffset $ currentIp env
+      x = ordCell $ cellAt s $ loc + offset
+  pushInstr x
+
+-----------------------------------------------------------
+-- Standard Input/Output
+-----------------------------------------------------------
+
+tryLiftIO :: IO a -> Instruction i (Maybe a)
+tryLiftIO io = liftIO $ catch (liftM Just io) $ \e -> const (return Nothing) (e :: IOError)
+
+isDigit :: Char -> Bool
+isDigit = (`elem` ['0'..'9'])
+
+outputDecimalInstr :: (I i) => Instruction i ()
+outputDecimalInstr = do
+  x <- popInstr
+  outcome <- tryLiftIO $ putStr $ show x ++ " "
+  when (isNothing outcome) reverseInstr
+
+outputCharacterInstr :: (I i) => Instruction i ()
+outputCharacterInstr = do
+  c <- liftM (fromMaybe '?' . cellToChar . chrCell) popInstr
+  outcome <- tryLiftIO $ putChar c
+  when (isNothing outcome) reverseInstr
+
+inputCharacterInstr :: (I i) => Instruction i ()
+inputCharacterInstr = do
+  outcome <- tryLiftIO $ do
+    hFlush stdout
+    withBuffering NoBuffering stdin hGetChar
+  case outcome of
+    Nothing -> reverseInstr
+    Just c -> let
+      n = fromIntegral $ ord c
+      in pushInstr n
+
+inputDecimalInstr :: (I i) => Instruction i ()
+inputDecimalInstr = do
+  ident <- gets $ getId . currentIp
+  outcome <- tryLiftIO $ do
+    hFlush stdout
+    withBuffering NoBuffering stdin $ const $ getDecimal ident
+  maybe reverseInstr pushInstr outcome
+
+getDecimal :: (I i) => i -> IO i
+getDecimal iType = do
+  c <- getChar
+  let k = read [c] :: Integer
+      k' = fromInteger k
+  if isDigit c
+    then case maybeMaxBound `asTypeOf` Just iType of
+      Just bound -> if k > fromIntegral bound
+        then getDecimal iType
+        else getDecimal' k'
+      Nothing -> getDecimal' k'
+    else getDecimal iType
+
+getDecimal' :: (I i) => i -> IO i
+getDecimal' n = do
+  c <- getChar
+  if isDigit c
+    then let
+      k = read [c]
+      n' = 10 * (fromIntegral n :: Integer) + k
+      n'' = fromInteger n'
+      in case maybeMaxBound `asTypeOf` Just n of
+        Just bound -> if n' > fromIntegral bound
+          then return n
+          else getDecimal' n''
+        Nothing -> getDecimal' n''
+    else return n
+    
+-----------------------------------------------------------
+-- File Input/Output
+-----------------------------------------------------------
+
+canonicalizePath' :: (I i) => FilePath -> Instruction i FilePath
+canonicalizePath' path = if isAbsolute path
+  then return path
+  else do
+    progName <- gets getProgName
+    dir <- liftIO $ liftM takeDirectory $ canonicalizePath progName
+    return $ dir ++ [pathSeparator] ++ path
+
+inputFileInstr :: (I i) => Instruction i ()
+inputFileInstr = do
+  env <- get
+  let space = getSpace env
+      so = getStorageOffset $ currentIp env
+      dim = getDim env
+      east = takeV dim $ 1 `cons` 0
+  mFilepath <- liftM sequence popStringInstr
+  flag <- popInstr
+  va <- liftM (so +) popDimVectorInstr
+  case mFilepath of
+    Nothing -> reverseInstr
+    Just filepath -> do
+      cfilepath <- canonicalizePath' filepath
+      m_space_vb <- tryLiftIO $ if testLogicalBit flag 0
+        then do
+          cells <- withFile cfilepath ReadMode $ \handle -> liftM (map charToCell . BS.unpack) $ BS.hGetContents handle
+          let space' = foldl' (\s (c, p) -> putCell s c p) space $ zip cells $ iterate (+ east) va
+              vb = (takeV dim $ genericLength cells `cons` 0)
+          return (space', vb)
+        else do
+          kidSpace <- withFile cfilepath ReadMode $ \handle -> do
+            contents <- BS.hGetContents handle
+            return $ mkSpace dim contents
+          let (minPos, maxPos, _) = minMaxCoords kidSpace
+              vb = maxPos - minPos + takeV dim 1
+              space' = putSpaceAt va space kidSpace
+          return (space', vb)
+      case m_space_vb of
+        Nothing -> reverseInstr
+        Just (space', vb) -> do
+          pushVectorInstr vb
+          pushVectorInstr va
+          modify $ withSpace $ const space'
+
+linearize :: String -> String
+linearize = unlines . map (reverse . dropWhile (== ' ') . reverse) . lines
+
+outputFileInstr :: (I i) => Instruction i ()
+outputFileInstr = do
+  env <- get
+  let dim = getDim env
+      space = getSpace env
+      so = getStorageOffset $ currentIp env
+  mFilepath <- liftM sequence popStringInstr
+  flag <- popInstr
+  va <- popDimVectorInstr
+  vb <- liftM (subtract $ takeV dim 1) popDimVectorInstr
+  let va' = va + so
+      (_ : ~(_ : as)) = unVector va
+      (xb : ~(yb : _)) = unVector vb
+      xs = [0 .. xb]
+      ys = [0 .. yb]
+      cellGrid = if dim == 1
+        then [[cellAt space $ va' + mkVector [x] | x <- xs]]
+        else [[cellAt space $ va' + mkVector (x : y : as) | x <- xs] | y <- ys]
+      mStr = liftM unlines $ mapM (mapM cellToChar) cellGrid
+  case liftM2 (,) mFilepath mStr of
+    Nothing -> reverseInstr
+    Just (filepath, str) -> do
+      cfilepath <- canonicalizePath' filepath
+      outcome <- tryLiftIO $ withFile cfilepath WriteMode $ \handle -> hPutStr handle $ if testLogicalBit flag 0
+        then linearize str
+        else str
+      when (isNothing outcome) reverseInstr
+
+-----------------------------------------------------------
+-- System Execution
+-----------------------------------------------------------
+
+executeInstr :: (I i) => Instruction i ()
+executeInstr = do
+  mStr <- liftM sequence popStringInstr
+  case mStr of
+    Nothing -> pushInstr 1
+    Just str -> do
+      exitCode <- liftIO $ system str
+      pushInstr $ fromIntegral $ case exitCode of
+        ExitSuccess -> 0
+        ExitFailure k -> k
+
+-----------------------------------------------------------
+-- System Information Retrieval
+-----------------------------------------------------------
+
+getSysInfoInstr :: (I i) => Instruction i ()
+getSysInfoInstr = do
+  envVars <- liftIO getEnvironment
+  CalendarTime {
+      ctYear = year
+    , ctMonth = month
+    , ctDay = day
+    , ctHour = hour
+    , ctMin = mins
+    , ctSec = sec
+    } <- liftIO $ getClockTime >>= toCalendarTime
+  n <- popInstr
+  env <- get
+  let dim = getDim env
+      dim' = fromIntegral dim
+      ip = currentIp env
+      space = getSpace env
+      progName = getProgName env
+      args = getFungeArgs env
+      ss = getSs ip
+      (minPos, maxPos, space') = minMaxCoords space
+  do
+  {- 20 -} pushVectorInstr $ joinStrs $ map (\(x, y) -> x ++ "=" ++ y) envVars
+  {- 19 -} pushVectorInstr $ joinStrs $ progName : args
+  {- 18 -} pushVectorInstr $ mkVector $ reverse $ map (fromIntegral . Deque.depth) $ Stack.toList ss
+  {- 17 -} pushInstr $ fromIntegral $ Stack.depth ss
+  {- 16 -} pushInstr $ fromIntegral $ hour * 256 * 256 + mins * 256 + sec
+  {- 15 -} pushInstr $ fromIntegral $ (year - 1900) * 256 * 256 + (fromEnum month + 1) * 256 + day
+  {- 14 -} pushVectorInstr $ maxPos - minPos
+  {- 13 -} pushVectorInstr minPos
+  {- 12 -} pushVectorInstr $ getStorageOffset ip
+  {- 11 -} pushVectorInstr $ getDelta ip
+  {- 10 -} pushVectorInstr $ getPos ip
+  {- 09 -} pushInstr 0
+  {- 08 -} pushInstr $ getId ip
+  {- 07 -} pushInstr $ fromIntegral dim
+  {- 06 -} pushInstr $ fromIntegral $ ord pathSeparator
+  {- 05 -} pushInstr 1
+  {- 04 -} pushInstr $ read $ filter isDigit $ show version
+  {- 03 -} pushInstr handprint
+  {- 02 -} pushInstr $ maybe (-1) fromIntegral $ byteSize n
+  {- 01 -} pushInstr $ 0x01 + 0x02 + 0x04 + 0x08 + 0x10
+  when (n > 0) $ do
+    cell <- gets $ fromMaybe 0 . Deque.dig (n - 1) . currentToss
+    put env
+    pushInstr cell
+  when (n <= 0 || (9 + 3 * dim' < n && n <= 9 + 5 * dim')) $ modify $ withSpace $ const space' 
+  where
+    joinStrs = mkVector . map (fromIntegral . ord) . ("\0\0\0" ++) . intercalate "\0" . map reverse
+
+-----------------------------------------------------------
+-- Fingerprints
+-----------------------------------------------------------
+
+fingerprintId :: (Integral i) => Vector i -> Integer
+fingerprintId vec = fromIntegral $ foldl' (\fId x -> fId * 256 + x) 0 xs
+  where
+    xs = unVector vec
+
+loadSemanticsInstr :: (I i) => Instruction i ()
+loadSemanticsInstr = do
+  count <- popInstr
+  fId <- liftM (fingerprintId . reverseV) $ popVectorInstr count
+  mFingerprint <- gets $ Map.lookup fId . getFingerprints
+  case mFingerprint of
+    Nothing -> reverseInstr
+    Just fingerprint -> do
+      modify $ withSemantics $ Semantics.pushFingerprint fingerprint
+      pushInstr $ fromIntegral fId
+      pushInstr 1
+
+unloadSemanticsInstr :: (I i) => Instruction i ()
+unloadSemanticsInstr = do
+  count <- popInstr
+  fId <- liftM (fingerprintId . reverseV) $ popVectorInstr count
+  mFingerprint <- gets $ Map.lookup fId . getFingerprints
+  case mFingerprint of
+    Nothing -> reverseInstr
+    Just fingerprint -> modify $ withSemantics $ Semantics.popFingerprint fingerprint
+
+-----------------------------------------------------------
+-- Concurrent Funge-98
+-----------------------------------------------------------
+
+splitInstr :: (I i) => Instruction i ()
+splitInstr = do
+  env <- get
+  let ip = currentIp env
+  case getValidIds env of
+    [] -> liftIO $ do
+      putStrLn "Cannot create a unique ID for new IP."
+      exitFailure
+    ident : idents -> let
+      newIp = ip { getId = ident, getDelta = negate . getDelta $ ip }
+      in modify $ const $ addSpawnedIp newIp $ env { getValidIds = idents }
+
diff --git a/Interpreter.hs b/Interpreter.hs
new file mode 100644
--- /dev/null
+++ b/Interpreter.hs
@@ -0,0 +1,68 @@
+module Interpreter (
+    runFungi
+  ) where
+
+import Control.Arrow ((&&&))
+import Control.Monad.State.Strict
+
+import qualified Data.List.Zipper as Zipper
+
+import System.Exit (ExitCode, exitSuccess)
+
+import Env
+import Instruction
+import Ip
+
+-----------------------------------------------------------
+
+data RunResult i = RunResult {
+    getLiveIps :: [Ip Env i]
+  , getResultEnv :: Env i
+  }
+
+runFungi :: (I i) => Env i -> IO ExitCode
+runFungi = evalStateT $ forever runEnvRound
+
+runEnvRound :: (I i) => Instruction i ()
+runEnvRound = do
+  noIps <- gets $ Zipper.emptyp . getIps
+  if noIps
+    then liftIO exitSuccess
+    else do
+      runResult <- runEnvRound'
+      let ips = Zipper.fromList $ getLiveIps runResult
+      modify $ \env -> env { getIps = ips }
+      advanceIps
+
+runEnvRound' :: (I i) => Instruction i (RunResult i)
+runEnvRound' = do
+  ips <- gets getIps
+  case Zipper.safeCursor ips of
+    Nothing -> do
+      env <- get
+      return RunResult {
+          getLiveIps = []
+        , getResultEnv = env
+        }
+    Just _ -> do
+      runCurrentInstruction
+      (ip, spawnedIps) <- gets $ currentIp &&& getSpawnedIps
+      let liveIps = spawnedIps ++ [ip | isAlive ip]
+      modify $ \env -> withIps Zipper.right env {
+          getSpawnedIps = []
+        , getValidIds = [getId ip | not $ isAlive ip] ++ getValidIds env
+        }
+      runResult <- runEnvRound'
+      let liveIps' = liveIps ++ getLiveIps runResult
+      return runResult { getLiveIps = liveIps' }
+
+advanceIps :: (I i) => Instruction i ()
+advanceIps = do
+  ips <- gets getIps
+  case Zipper.safeCursor ips of
+    Nothing -> modify $ withIps Zipper.start
+    Just _ -> do
+      trampolineInstr
+      modify $ withIps Zipper.right
+      advanceIps
+
diff --git a/Ip.hs b/Ip.hs
new file mode 100644
--- /dev/null
+++ b/Ip.hs
@@ -0,0 +1,114 @@
+module Ip (
+    Ip
+  , mkIp
+
+  , getId
+  , getPos
+  , getDelta
+  , getSs
+  , isAlive
+  , getStorageOffset
+  , getSemantics
+
+  , testMode
+  , addMode
+  , removeMode
+  , toggleMode
+
+  , killIp
+  , reverseIp
+  , setPos
+  , setDelta
+  , setSs
+  , setStorageOffset
+
+  ) where
+
+import Control.Monad.State.Strict
+
+import Data.Deque
+import Data.I
+import Data.Map (Map)
+import Data.Set (Set)
+import qualified Data.Set as Set
+import Data.Stack
+import Data.Vector
+
+import Text.PrettyShow
+
+import Mode
+import Semantics
+
+-----------------------------------------------------------
+
+type Instruction env i = StateT (env i) IO
+
+data Ip env i = Ip {
+    getId :: i
+  , getPos :: Vector i
+  , getDelta :: Vector i
+  , getSs :: Stack (Deque i)
+  , isAlive :: Bool
+  , getStorageOffset :: !(Vector i)
+  , getSemantics :: Semantics env i
+  , modes :: Set Mode
+  }
+
+instance (PrettyShow i) => PrettyShow (Ip env i) where
+  pshow ip = concat [ []
+    , "(IP"
+    , " "
+    , "id=" ++ pshow (getId ip)
+    , " "
+    , "pos=" ++ pshow (getPos ip)
+    , " "
+    , "delta=" ++ pshow (getDelta ip)
+    , " "
+    , "modes=" ++ pshow (Set.toList $ modes ip)
+    , ")"
+    ]
+
+mkIp :: (I i) => Int -> i -> Map i (Instruction env i ()) -> Ip env i
+mkIp dim ident baseSemantics = Ip {
+    getId = ident
+  , getPos = takeV dim 0
+  , getDelta = takeV dim (1 `cons` 0)
+  , getSs = mkStack1 mkDeque
+  , isAlive = True
+  , getStorageOffset = takeV dim 0
+  , getSemantics = mkSemantics baseSemantics
+  , modes = Set.empty
+  }
+
+testMode :: Mode -> Ip env i -> Bool
+testMode mode = Set.member mode . modes
+
+addMode :: Mode -> Ip env i -> Ip env i
+addMode mode ip = ip { modes = Set.insert mode $ modes ip }
+
+removeMode :: Mode -> Ip env i -> Ip env i
+removeMode mode ip = ip { modes = Set.delete mode $ modes ip }
+
+toggleMode :: Mode -> Ip env i -> Ip env i
+toggleMode mode ip = if testMode mode ip
+  then removeMode mode ip
+  else addMode mode ip
+
+killIp :: Ip env i -> Ip env i
+killIp ip = ip { isAlive = False }
+
+reverseIp :: (Num i) => Ip env i -> Ip env i
+reverseIp ip = ip { getDelta = negate . getDelta $ ip }
+
+setPos :: (Num i) => Vector i -> Ip env i -> Ip env i
+setPos pos ip = ip { getPos = pos }
+
+setDelta :: (Num i) => Vector i -> Ip env i -> Ip env i
+setDelta delta ip = ip { getDelta = delta }
+
+setSs :: Stack (Deque i) -> Ip env i -> Ip env i
+setSs s ip = ip { getSs = s }
+
+setStorageOffset :: Vector i -> Ip env i -> Ip env i
+setStorageOffset v ip = ip { getStorageOffset = v }
+
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2010, Thomas Eding
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Thomas Eding nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,13 @@
+module Main (
+  )
+  where
+
+import System.Exit
+
+import qualified Fungi
+
+-----------------------------------------------------------
+
+main :: IO ExitCode
+main = Fungi.main
+
diff --git a/Math.hs b/Math.hs
new file mode 100644
--- /dev/null
+++ b/Math.hs
@@ -0,0 +1,24 @@
+module Math (
+    squareRoot
+  ) where
+
+-----------------------------------------------------------
+
+-- The following code was aquired from:
+-- http://www.haskell.org/haskellwiki/Generic_number_type#squareRoot
+
+(^!) :: Num a => a -> Int -> a
+(^!) x n = x^n
+ 
+squareRoot :: Integer -> Integer
+squareRoot 0 = 0
+squareRoot 1 = 1
+squareRoot n =
+   let twopows = iterate (^!2) 2
+       (lowerRoot, lowerN) =
+          last $ takeWhile ((n>=) . snd) $ zip (1:twopows) twopows
+       newtonStep x = div (x + div n x) 2
+       iters = iterate newtonStep (squareRoot (div n lowerN) * lowerRoot)
+       isRoot r  =  r^!2 <= n && n < (r+1)^!2
+   in  head $ dropWhile (not . isRoot) iters
+
diff --git a/Mode.hs b/Mode.hs
new file mode 100644
--- /dev/null
+++ b/Mode.hs
@@ -0,0 +1,19 @@
+module Mode (
+    Mode (..)
+  ) where
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+data Mode
+  = Hover
+  | Invert
+  | String
+  | Switch
+  | Queue
+  deriving (Show, Eq, Ord)
+
+instance PrettyShow Mode where
+  pshow = show
+
diff --git a/ProcessArgs.hs b/ProcessArgs.hs
new file mode 100644
--- /dev/null
+++ b/ProcessArgs.hs
@@ -0,0 +1,108 @@
+module ProcessArgs (
+    processArgs
+  , ProcessedArgs ()
+  , argsHelp
+  , argsDebugMode
+  , argsCellByteSize
+  , argsDim
+  , argsUnknownMode
+  , argsFile
+  , argsFungeArgs
+  ) where
+
+import Control.Monad
+
+import Data.ByteSize (byteSize)
+import Data.Char (toLower)
+
+import Debug.Debugger (DebugMode (..))
+
+import UnknownInstruction
+
+-----------------------------------------------------------
+
+data ProcessedArgs = ProcessedArgs {
+    argsHelp :: Bool
+  , argsDebugMode :: DebugMode
+  , argsCellByteSize :: Maybe Int
+  , argsDim :: Maybe Int
+  , argsUnknownMode :: UnknownInstruction
+  , argsFile :: Maybe FilePath
+  , argsFungeArgs :: [String]
+  }
+  deriving (Show, Eq, Ord)
+
+defaultProcessedArgs :: ProcessedArgs
+defaultProcessedArgs = ProcessedArgs {
+    argsHelp = False
+  , argsDebugMode = DebugOff
+  , argsCellByteSize = byteSize (0 :: Int)
+  , argsDim = Nothing
+  , argsUnknownMode = ReverseUnknown
+  , argsFile = Nothing
+  , argsFungeArgs = []
+  }
+
+processArgs :: [String] -> Maybe ProcessedArgs
+processArgs [] = Just defaultProcessedArgs
+processArgs (arg:args) = case arg of
+  "--help" -> processHelp args
+  "-?" -> processHelp args
+  "--debug" -> processDebug args
+  "-d" -> processDebug args
+  "--cell-size" -> processCellSize args
+  "-s" -> processCellSize args
+  "--dim" -> processDim args
+  "-n" -> processDim args
+  "--unknown" -> processUknown args
+  "-u" -> processUknown args
+  _ -> processFile arg args
+
+processHelp :: [String] -> Maybe ProcessedArgs
+processHelp args = processArgs args >>= \p -> return p { argsHelp = True }
+
+processUknown :: [String] -> Maybe ProcessedArgs
+processUknown [] = Nothing
+processUknown (arg:args) = case mUnknownMode of
+  Nothing -> Nothing
+  Just unknownMode -> processArgs args >>= \p -> return p { argsUnknownMode = unknownMode }
+  where
+    mUnknownMode = case map toLower arg of
+      "reverse" -> Just ReverseUnknown
+      "fail" -> Just FailUnknown
+      "debug" -> Just DebugUnknown
+      _ -> Nothing
+
+processDebug :: [String] -> Maybe ProcessedArgs
+processDebug [] = processArgs [] >>= \p -> return p { argsDebugMode = DebugStep }
+processDebug (arg:args) = case mDebugMode of
+  Nothing -> processArgs (arg:args) >>= \p -> return p { argsDebugMode = DebugStep }
+  Just debugMode -> processArgs args >>= \p -> return p { argsDebugMode = debugMode }
+  where
+    mDebugMode = case map toLower arg of
+      "0" -> Just DebugOff
+      "1" -> Just DebugStep
+      "false" -> Just DebugOff
+      "true" -> Just DebugStep
+      "off" -> Just DebugOff
+      "on" -> Just DebugStep
+      _ -> Nothing
+
+processDim :: [String] -> Maybe ProcessedArgs
+processDim [] = Nothing
+processDim (arg:args) = case reads arg of
+  [(n, "")] -> processArgs args >>= \p -> return p { argsDim = Just n }
+  _ -> Nothing
+
+processCellSize :: [String] -> Maybe ProcessedArgs
+processCellSize [] = Nothing
+processCellSize (arg:args) = case reads arg of
+  [(n, "")] -> processArgs args >>= \p -> return p { argsCellByteSize = guard (n > 0) >> Just n }
+  _ -> Nothing
+
+processFile :: FilePath -> [String] -> Maybe ProcessedArgs
+processFile file args = processArgs [] >>= \p -> return p {
+    argsFile = Just file
+  , argsFungeArgs = args
+  }
+
diff --git a/Random.hs b/Random.hs
new file mode 100644
--- /dev/null
+++ b/Random.hs
@@ -0,0 +1,48 @@
+module Random (
+    Random (..)
+  ) where
+
+import Control.Monad
+
+import Data.Int
+
+import System.Random.MWC (GenIO, Variate)
+import qualified System.Random.MWC as MWC
+
+-----------------------------------------------------------
+
+class Random a where
+  uniformR :: (a, a) -> IO a
+
+-----------------------------------------------------------
+
+uniformR' :: Variate a => (a, a) -> GenIO -> IO a
+uniformR' = MWC.uniformR
+
+uniformRIO :: Variate a => (a, a) -> IO a
+uniformRIO = MWC.withSystemRandom . uniformR'
+
+mapPair :: (a -> b) -> (a, a) -> (b, b)
+mapPair f (x, y) = (f x, f y)
+
+fromInt64 :: Int64 -> Integer
+fromInt64 = fromIntegral
+
+instance Random Integer where
+  uniformR = liftM fromInt64 . uniformRIO . mapPair fromInteger
+
+instance Random Int where
+  uniformR = uniformRIO
+
+instance Random Int8 where
+  uniformR = uniformRIO
+
+instance Random Int16 where
+  uniformR = uniformRIO
+
+instance Random Int32 where
+  uniformR = uniformRIO
+
+instance Random Int64 where
+  uniformR = uniformRIO
+
diff --git a/Semantics.hs b/Semantics.hs
new file mode 100644
--- /dev/null
+++ b/Semantics.hs
@@ -0,0 +1,123 @@
+module Semantics (
+    Semantics
+  , mkSemantics
+  , lookup
+  , pushFingerprint
+  , popFingerprint
+  , toggleOverlay
+  , addOverlay
+  , removeOverlay
+  ) where
+
+import Prelude hiding (lookup)
+
+import Control.Monad.State.Strict
+
+import Data.Char (ord)
+import Data.I
+import Data.Labeled
+import Data.Map (Map)
+import qualified Data.Map as Map
+
+import Mode
+
+-----------------------------------------------------------
+
+type Instruction env i = StateT (env i) IO
+
+type InfMap k v = (k -> Maybe v, Map k (Maybe v))
+
+-----------------------------------------------------------
+
+data Semantics env i = S {
+    baseInstrs :: Map i (Instruction env i ())
+  , fingerInstrs :: Map i [Instruction env i ()]
+  , overlayInstrs :: [Labeled Mode (InfMap i (Instruction env i ()))]
+  }
+
+mkSemantics :: (I i) => Map i (Instruction env i ()) -> Semantics env i
+mkSemantics base = S {
+    baseInstrs = base
+  , fingerInstrs = Map.fromList $ zip [fromIntegral $ ord c | c <- ['A'..'Z']] $ repeat []
+  , overlayInstrs = []
+  }
+
+lookup :: (I i) => i -> Semantics env i -> Maybe (Instruction env i ())
+lookup i sem = case lookupOverlay i $ map unlabel $ overlayInstrs sem of
+  Just instr -> Just instr
+  Nothing -> case lookupFinger i $ fingerInstrs sem of
+    Just instr -> Just instr
+    Nothing -> lookupBase i $ baseInstrs sem
+
+lookupOverlay :: (I i) => i -> [InfMap i (Instruction env i ())] -> Maybe (Instruction env i ())
+lookupOverlay _ [] = Nothing
+lookupOverlay i ((f, m) : ms) = case Map.lookup i m of
+  Just mInstr -> case mInstr of
+    Just instr -> Just instr
+    Nothing -> lookupOverlay i ms
+  Nothing -> case f i of
+    Just instr -> Just instr
+    Nothing -> lookupOverlay i ms
+
+lookupFinger :: (I i) => i -> Map i [Instruction env i ()] -> Maybe (Instruction env i ())
+lookupFinger i m = case Map.lookup i m of
+  Nothing -> Nothing
+  Just [] -> Nothing
+  Just (instr:_) -> Just instr
+
+lookupBase :: (I i) => i -> Map i (Instruction env i ()) -> Maybe (Instruction env i ())
+lookupBase = Map.lookup
+
+pushFingerprint :: (I i) => [(i, Instruction env i ())] -> Semantics env i -> Semantics env i
+pushFingerprint assocs sem = sem { fingerInstrs = m' }
+  where
+    m = fingerInstrs sem
+    m' = foldr add m assocs
+    add (i, instr) = Map.adjust (instr:) i
+
+popFingerprint :: (I i) => [(i, Instruction env i ())] -> Semantics env i -> Semantics env i
+popFingerprint assocs sem = sem { fingerInstrs = m' }
+  where
+    m = fingerInstrs sem
+    m' = foldr (remove . fst) m assocs
+    remove = Map.adjust tail
+
+addOverlay :: (I i)
+        => Mode
+        -> (i -> Maybe (Instruction env i ()), Map i (Maybe (Instruction env i ())))
+        -> Semantics env i
+        -> Semantics env i
+addOverlay mode f_m sem = if mode `elem` map getLabel (overlayInstrs sem)
+  then sem
+  else addOverlay' mode f_m sem
+
+addOverlay' :: (I i)
+        => Mode
+        -> (i -> Maybe (Instruction env i ()), Map i (Maybe (Instruction env i ())))
+        -> Semantics env i
+        -> Semantics env i
+addOverlay' mode f_m sem = sem { overlayInstrs = imap : overlayInstrs sem }
+  where
+    imap = label mode f_m
+
+removeOverlay :: (I i) => Mode -> Semantics env i -> Semantics env i
+removeOverlay mode sem = sem { overlayInstrs = removeOverlay' mode $ overlayInstrs sem }
+
+removeOverlay' :: (I i)
+        => Mode
+        -> [Labeled Mode (InfMap i (Instruction env i ()))]
+        -> [Labeled Mode (InfMap i (Instruction env i ()))]
+removeOverlay' _ [] = []
+removeOverlay' mode (m:ms) = if getLabel m == mode
+  then ms
+  else m : removeOverlay' mode ms
+
+toggleOverlay :: (I i)
+        => Mode
+        -> (i -> Maybe (Instruction env i ()), Map i (Maybe (Instruction env i ())))
+        -> Semantics env i
+        -> Semantics env i
+toggleOverlay mode f_m sem = if mode `elem` map getLabel (overlayInstrs sem)
+  then removeOverlay mode sem
+  else addOverlay' mode f_m sem
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/Space/Cell.hs b/Space/Cell.hs
new file mode 100644
--- /dev/null
+++ b/Space/Cell.hs
@@ -0,0 +1,49 @@
+module Space.Cell (
+    Cell
+  , chrCell
+  , ordCell
+  , cellToChar
+  , cellToPrintableChar
+  , charToCell
+  ) where
+
+import Data.Char (chr, ord, isPrint)
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+newtype Cell i = Cell { unCell :: i }
+  deriving (Show, Eq, Ord)
+
+instance (Integral i) => PrettyShow (Cell i) where
+  pshow cell = concat [ ""
+    , "(Cell "
+    , maybe "'\\???'" show . cellToChar $ cell
+    , " "
+    , show . ordCell $ cell
+    , ")"
+    ]
+
+chrCell :: i -> Cell i
+chrCell = Cell
+
+ordCell :: Cell i -> i
+ordCell = unCell
+
+cellToChar :: (Integral i) => Cell i -> Maybe Char
+cellToChar (Cell n) = if minB <= n && n <= maxB
+  then Just . chr $ fromIntegral n
+  else Nothing
+  where
+    minB = fromIntegral . ord $ minBound
+    maxB = fromIntegral . ord $ maxBound
+
+cellToPrintableChar :: (Integral i) => Cell i -> Maybe Char
+cellToPrintableChar cell = cellToChar cell >>= \c -> if isPrint c
+  then Just c
+  else Nothing
+
+charToCell :: (Num i) => Char -> Cell i
+charToCell = Cell . fromIntegral . ord
+
diff --git a/Space/Space.hs b/Space/Space.hs
new file mode 100644
--- /dev/null
+++ b/Space/Space.hs
@@ -0,0 +1,161 @@
+module Space.Space (
+    Space
+  , mkSpace
+  , cellAt
+  , putCell
+  , travelBy
+  , minMaxCoords
+  , putSpaceAt
+  ) where
+
+import Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as BS
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Vector
+
+import Space.Cell
+
+import Text.PrettyShow
+
+-----------------------------------------------------------
+
+data Conservative a = Precise !a | Imprecise !a
+  deriving (Show, Eq, Ord)
+
+isPrecise :: Conservative a -> Bool
+isPrecise (Precise _) = True
+isPrecise _ = False
+
+toImprecise :: Conservative a -> Conservative a
+toImprecise (Precise x) = Imprecise x
+toImprecise c = c
+
+conservativeVal :: Conservative a -> a
+conservativeVal (Precise x) = x
+conservativeVal (Imprecise x) = x
+
+instance Functor Conservative where
+  fmap f (Precise x) = Precise $ f x
+  fmap f (Imprecise x) = Imprecise $ f x
+
+instance (PrettyShow a) => PrettyShow (Conservative a) where
+  pshow (Precise x) = "Precise " ++ pshow x
+  pshow (Imprecise x) = "Imprecise" ++ pshow x
+
+-----------------------------------------------------------
+
+type CellMap i = Map [i] (Cell i)
+
+data Space i = Space {
+    spaceMap :: CellMap i
+  , spaceDim :: Int
+  , conservativeMinMaxCoords :: !(Conservative (Vector i, Vector i))
+  }
+  deriving (Show, Eq)
+
+instance (PrettyShow i, Integral i) => PrettyShow (Space i) where
+  pshow s = concat [ []
+    , "(Space"
+    , " "
+    , "(min,max)=" ++ pshow (conservativeMinMaxCoords s)
+    , " "
+    , "assocs=" ++ pshow (Map.assocs . spaceMap $ s)
+    , ")"
+    ]
+
+mkSpace :: (Integral i) => Int -> ByteString -> Space i
+mkSpace dim str
+  | dim <= 0  = error "Space.Space.mkSpace given a non-positive dimension"
+  | otherwise = case BS.foldl' f (0, 0, 0, space, '\0') str of
+      (_, _, _, s, _) -> s
+  where
+    origin = mkVector $ replicate dim 0
+    space = Space {
+        spaceMap = Map.empty
+      , spaceDim = dim
+      , conservativeMinMaxCoords = Precise (origin, origin)
+      }
+    f (x, y, z, s, p) c = case c of
+      ' ' -> (x + 1, y, z, s, c)
+      '\r'-> guardDim 2 (0, y + 1, z, s, c)
+      '\n'-> guardDim 2 $ if p == '\r'
+        then (x, y, z, s, c)
+        else (0, y + 1, z, s, c)
+      '\f'-> guardDim 3 (0, 0, z + 1, s, c)
+      _   -> let
+        v = take dim $ [x, y, z] ++ repeat 0
+        s' = putCell s (charToCell c) $ mkVector v
+        in (x + 1, y, z, s', c)
+      where
+        guardDim n t = if dim >= n
+          then t
+          else (x, y, z, s, c)
+
+cellAt :: (Integral i) => Space i -> Vector i -> Cell i
+cellAt s pos = Map.findWithDefault (charToCell ' ') (unVector pos) $ spaceMap s
+
+updateMinMaxCoords :: (Ord i) => (Vector i, Vector i) -> Vector i -> (Vector i, Vector i)
+updateMinMaxCoords (minPos, maxPos) pos = (zipWithV min minPos pos, zipWithV max maxPos pos)
+
+putCell :: (Num i, Ord i) => Space i -> Cell i -> Vector i -> Space i
+putCell s c pos
+  | charToCell ' ' == c = if strictInBounds s pos
+    then s {
+        spaceMap = Map.delete (unVector pos) m
+      }
+    else if inBounds s pos
+      then s {
+          spaceMap = Map.delete (unVector pos) m
+        , conservativeMinMaxCoords = toImprecise $ conservativeMinMaxCoords s
+        }
+      else s
+  | otherwise = s {
+        spaceMap = Map.insert (unVector pos) c m
+      , conservativeMinMaxCoords = fmap (`updateMinMaxCoords` pos) $ conservativeMinMaxCoords s
+      }
+  where
+    m = spaceMap s
+
+inBounds :: (Ord i) => Space i -> Vector i -> Bool
+inBounds s pos = minPos <=~ pos && pos <=~ maxPos
+  where
+    (<=~) = liftOrd (<=)
+    (minPos, maxPos) = conservativeVal $ conservativeMinMaxCoords s
+
+strictInBounds :: (Ord i) => Space i -> Vector i -> Bool
+strictInBounds s pos = minPos <~ pos && pos <~ maxPos
+  where
+    (<~) = liftOrd (<)
+    (minPos, maxPos) = conservativeVal $ conservativeMinMaxCoords s
+
+travelBy :: (Integral i) => Vector i -> Vector i -> Space i -> Vector i
+(pos `travelBy` delta) s = if inBounds s pos'
+  then pos'
+  else wrap pos delta s
+  where
+    dim = spaceDim s
+    pos' = takeV dim (pos + delta)
+
+wrap :: (Integral i) => Vector i -> Vector i -> Space i -> Vector i
+wrap pos delta s = (delta +) . head . dropWhile (inBounds s) . iterate (subtract delta) $ pos
+
+minMaxCoords :: (Integral i) => Space i -> (Vector i, Vector i, Space i)
+minMaxCoords s = if isPrecise $ conservativeMinMaxCoords s
+  then (cMinPos, cMaxPos, s)
+  else case Map.lookup (unVector cMinPos) m >> Map.lookup (unVector cMaxPos) m of
+    Just _ -> (cMinPos, cMaxPos, s)
+    Nothing -> let
+      (minPos, maxPos) = Map.foldWithKey f (0, 0) $ spaceMap s
+      f k _ z = updateMinMaxCoords z $ mkVector k
+      s' = s { conservativeMinMaxCoords = Precise (minPos, maxPos) }
+      in (minPos, maxPos, s')
+  where
+    m = spaceMap s
+    (cMinPos, cMaxPos) = conservativeVal $ conservativeMinMaxCoords s
+
+putSpaceAt :: (Integral i) => Vector i -> Space i -> Space i -> Space i
+putSpaceAt pos baseSpace = Map.foldWithKey f baseSpace . spaceMap
+  where
+    f pos' cell space = putCell space cell (pos + mkVector pos')
+
diff --git a/System/IO/Buffering.hs b/System/IO/Buffering.hs
new file mode 100644
--- /dev/null
+++ b/System/IO/Buffering.hs
@@ -0,0 +1,17 @@
+module System.IO.Buffering (
+    withBuffering
+  , BufferMode (..)
+  ) where
+
+import System.IO
+
+-----------------------------------------------------------
+
+withBuffering :: BufferMode -> Handle -> (Handle -> IO a) -> IO a
+withBuffering buff hdl io = do
+  origBuff <- hGetBuffering hdl
+  hSetBuffering hdl buff
+  res <- io hdl
+  hSetBuffering hdl origBuff
+  return res
+
diff --git a/Text/Help/Debug.hs b/Text/Help/Debug.hs
new file mode 100644
--- /dev/null
+++ b/Text/Help/Debug.hs
@@ -0,0 +1,52 @@
+module Text.Help.Debug (
+    help
+  ) where
+
+import Text.PrintOption
+
+-----------------------------------------------------------
+
+p :: Char -> String -> String -> IO ()
+p = printOption
+
+help :: IO ()
+help = do
+  putStrLn "Note: Help commands do not need '-' characters in front of them."
+  putStrLn "Values of the form POS are space separated numbers."
+  putStrLn "Values of the form VALS are space separated VAL constructs."
+  putStrLn "Values of the form VAL can be any one of the following:"
+  putStrLn "    - A number."
+  putStrLn "    - A single non-quote character."
+  putStrLn "    - A quoted set of characters. Single and double quotes allowed."
+  putStrLn "-----------------------------------------------------------"
+  p '?' "help" "Displays this message."
+  p ' ' "exit" "Exit the program."
+  p ' ' "quit" "Same as 'exit'."
+  p ' ' "back [N=1]" "Enable step mode and try to move back in time N interpreter rounds."
+  p ' ' "break POS" "Create a breakpoint at POS."
+  p ' ' "breaks" "Display all registered breakpoints."
+  p ' ' "cell" "Display the current cell."
+  p ' ' "cellat POS" "Display the cell at POS."
+  p ' ' "clear POS" "Remove breakpoint at POS."
+  p ' ' "clear *" "Remove all breakpoints"
+  p ' ' "continue" "Disable step mode."
+  p ' ' "dim" "Dispay the funge space dimensions."
+  p ' ' "ip" "Dispay the current ip"
+  p ' ' "locale XRAD YRAD" "Display the area around the current ip. Only shows cells in the X-Y plane."
+  p ' ' "locale RAD" "Same as 'locale RAD RAD'."
+  p ' ' "locale" "Same as 'locale XRAD YRAD', where XRAD and YRAD can be set using 'setlocale'."
+  p ' ' "nodebug" "Turn off the debugger."
+  p ' ' "pop N" "Pops the top N values off the TOSS."
+  p ' ' "push VALS" "Push VALS onto the stack. VAL's toward the right are pushed first."
+  p ' ' "record N" "Guarantees that 'back' can go back M time steps, provided M <= N and M rounds have passed since 'record N' was invoked."
+  p ' ' "setpos POS" "Set the position of the current ip to POS."
+  p ' ' "space" "Lists more information that you want to know about the funge space. Warning: This will list every cell and its position."
+  p ' ' "s" "Show the TOSS of the current ip."
+  p ' ' "setlocale XRAD YRAD" "Defaults the radii displayed by 'locale' to XRAD and YRAD."
+  p ' ' "ss" "Show the stack stack of the current ip."
+  p ' ' "step" "Enable step mode."
+  p ' ' "unshowable CHAR" "Makes the debugger display CHAR for unshowable cells in 'locale'. By default, '®' is used."
+  p ' ' "unwatch VALS" "Remove any watchpoints that watch VALS."
+  p ' ' "watch VALS" "Creates a watchpoint that watches VALS. Causes the debugger to break when the top of the TOSS is VALS. Left VAL's correspond to top stack values."
+  p ' ' "watches" "Display all watch points."
+
diff --git a/Text/Help/Fungi.hs b/Text/Help/Fungi.hs
new file mode 100644
--- /dev/null
+++ b/Text/Help/Fungi.hs
@@ -0,0 +1,90 @@
+module Text.Help.Fungi (
+    help
+  ) where
+
+import Data.ByteSize (byteSize)
+import Data.Char (toLower)
+import Data.Int
+import Data.List (sort, intercalate, nub)
+import Data.Maybe (fromMaybe)
+
+import System.Environment (getProgName)
+import System.FilePath (dropExtension)
+
+import Text.PrintOption
+
+-----------------------------------------------------------
+
+p :: Char -> String -> String -> IO ()
+p = printOption
+
+b :: Char -> String -> String -> IO ()
+b = printOptionWith defaultPrintSettings { bulletDelim = Just "***" }
+
+supportedSizes :: String
+supportedSizes = intercalate ", " $ map show $ sort $ nub $ map (fromMaybe 0) [
+    byteSize (0 :: Integer)
+  , byteSize (0 :: Int)
+  , byteSize (0 :: Int8)
+  , byteSize (0 :: Int16)
+  , byteSize (0 :: Int32)
+  , byteSize (0 :: Int64)
+  ]
+
+fingerprints :: String
+fingerprints = intercalate ", " $ sort [
+    "BASE"
+  , "BOOL"
+  , "CPLI"
+  , "FIXP"
+  , "MODE"
+  , "MODU"
+  , "NULL"
+  , "ORTH"
+  , "REFC"
+  , "ROMA"
+  ]
+
+line :: IO ()
+line = putStrLn $ replicate 80 '-'
+
+help :: IO ()
+help = do
+  line
+  progName <- fmap (map toLower . dropExtension) getProgName
+  putStrLn $ "Usage: " ++ progName ++ " [OPTIONS] [PROGRAM FILE] [PROGRAM ARGS]"
+  line
+  putStrLn $ "Options:"
+  p '?' "help" "Display this help message."
+  b 'd' "debug [MODE=1]" $ concat [
+      "Run program using debugger."
+    , "***MODE=1,on,true: Run debugger in step mode."
+    , "***MODE=0,off,false: Run without debugger."
+    , "\nDefault is off."
+    ]
+  p 's' "cell-size SIZE" $ concat [
+      "Set the funge cell byte size to SIZE.\n"
+    , "Supported sizes are " ++ supportedSizes ++ ".\n"
+    , "If SIZE <= 0 then cell size is unbounded.\n"
+    , "Default is " ++ show (fromMaybe 0 $ byteSize (0 :: Int)) ++ "."
+    ]
+  b 'n' "dim DIM" $ concat [
+      "Set the funge dimensions to DIM."
+    , "\nDefault depends on file extension:"
+    , "***uf u98: 1"
+    , "***bf b98: 2"
+    , "***tf t98: 3"
+    , "\nAll other extensions default to 2."
+    , "\nAllowed values: 0 < DIM <= " ++ show (maxBound :: Int) ++ "."
+    ]
+  b 'u' "unknown MODE" $ concat [
+      "What to do when encountering an unknown instruction."
+    , "***MODE=reverse: Reverse on unknown instruction."
+    , "***MODE=debug: Launch debugger on unknown instruction. Instruction reverses."
+    , "***MODE=fail: Terminate program on unknown instruction."
+    , "\nDefault is reverse."
+    ]
+  line
+  p ' ' "FINGERPRINTS--" fingerprints
+  line
+
diff --git a/Text/PrettyShow.hs b/Text/PrettyShow.hs
new file mode 100644
--- /dev/null
+++ b/Text/PrettyShow.hs
@@ -0,0 +1,52 @@
+module Text.PrettyShow (
+    PrettyShow (..)
+  , pprint
+  ) where
+
+import Data.Int
+
+-----------------------------------------------------------
+
+class PrettyShow a where
+  pshow :: a -> String
+  pshowList :: [a] -> String
+  pshowList [] = "[]"
+  pshowList (x:xs) = '[' : pshow x ++ pshowl xs
+    where
+      pshowl [] = "]"
+      pshowl (y:ys) = ',' : pshow y ++ pshowl ys
+
+instance (PrettyShow a) => PrettyShow [a] where
+  pshow = pshowList
+
+instance PrettyShow Bool where
+  pshow = show
+
+instance PrettyShow Char where
+  pshow = show
+  pshowList = flip showList ""
+  
+instance PrettyShow Integer where
+  pshow = show
+
+instance PrettyShow Int where
+  pshow = show
+
+instance PrettyShow Int8 where
+  pshow = show
+
+instance PrettyShow Int16 where
+  pshow = show
+
+instance PrettyShow Int32 where
+  pshow = show
+
+instance PrettyShow Int64 where
+  pshow = show
+
+instance (PrettyShow a, PrettyShow b) => PrettyShow (a, b) where
+  pshow (a, b) = "(" ++ pshow a ++ "," ++ pshow b ++ ")"
+
+pprint :: (PrettyShow a) => a -> IO ()
+pprint = putStrLn . pshow
+
diff --git a/Text/PrintOption.hs b/Text/PrintOption.hs
new file mode 100644
--- /dev/null
+++ b/Text/PrintOption.hs
@@ -0,0 +1,132 @@
+module Text.PrintOption (
+    printOptionWith
+  , printOption
+  , showOptionWith
+  , showOption
+  , PrintSettings (..)
+  , defaultPrintSettings
+  ) where
+
+import Data.List (stripPrefix)
+
+-----------------------------------------------------------
+
+data PrintSettings = PrintSettings {
+    descriptionColumn :: Int
+  , maxColumn :: Int
+  , newLinePadding :: String
+  , bulletDisplay :: String
+  , bulletIndent :: String
+  , bulletDelim :: Maybe String
+  }
+
+defaultPrintSettings :: PrintSettings
+defaultPrintSettings = PrintSettings {
+    descriptionColumn = 30
+  , maxColumn = 80
+  , newLinePadding = replicate 2 ' '
+  , bulletDisplay = "- "
+  , bulletIndent = "  "
+  , bulletDelim = Nothing
+  }
+
+afterLast :: (Eq a) => a -> [a] -> [a]
+afterLast x xs = afterLast' xs xs
+  where
+    afterLast' [] zs = zs
+    afterLast' (y:ys) zs = if x == y
+      then afterLast' ys ys
+      else afterLast' ys zs
+
+mapTail :: (a -> a) -> [a] -> [a]
+mapTail _ [] = []
+mapTail f (x:xs) = x : map f xs
+
+appendLineIfTooLong :: PrintSettings -> String -> String
+appendLineIfTooLong settings optionDisplay = if furthestCol < descCol - 1
+  then optionDisplay
+  else optionDisplay ++ "\n"
+  where
+    descCol = descriptionColumn settings
+    furthestCol = foldr (max . length) 0 $ lines optionDisplay
+
+columnize :: PrintSettings -> Int -> String -> String
+columnize settings maxWidth string = columnize' string "" "" False
+  where
+    padding = newLinePadding settings
+    bulDelim = bulletDelim settings
+    bulDisp = bulletDisplay settings
+    bulIndent = bulletIndent settings
+    --
+    columnize' :: String -> String -> String -> Bool -> String
+    columnize' str currLine' currWord bulleted = case bulDelim >>= (`stripPrefix` str) of
+      Just str' -> if overflowsWith currWord
+        then currLine <+> currWord <++> columnize' str' bulDisp "" True
+        else currLine ++ currWord <++> columnize' str' bulDisp "" True
+      Nothing -> case str of
+        "" -> if overflowsWith currWord
+          then currLine <+> currWord
+          else currLine ++ currWord
+        ' ':cs -> if overflowsWith currWord
+          then currLine <+> columnize' cs "" (currWord ++ " ") bulleted
+          else if overflowsWith $ currWord ++ " "
+            then currLine ++ currWord <+> columnize' cs "" "" bulleted
+            else columnize' cs (currLine ++ currWord ++ " ") "" bulleted
+        '\n':cs -> if overflowsWith currWord
+          then currLine <+> columnize' ('\n':cs) currWord "" False
+          else currLine ++ currWord <++> columnize' cs "" "" False
+        c:cs -> columnize' cs currLine (currWord ++ [c]) bulleted
+      where
+        currLine = dropWhile (== ' ') currLine'
+        bulLen = if bulleted
+          then length bulDisp
+          else 0
+        overflowsWith s = length (currLine ++ s) + bulLen > maxWidth
+        infixr 5 <++>
+        s1 <++> s2 = s1 ++ "\n" ++ padding ++ s2
+        infixr 5 <+>
+        s1 <+> s2 = if bulleted
+          then s1 ++ "\n" ++ padding ++ bulIndent ++ s2
+          else s1 <++> s2
+
+constrainDescriptionWidth :: PrintSettings -> String -> String
+constrainDescriptionWidth settings = columnize settings (maxCol - descCol)
+  where
+    maxCol = maxColumn settings
+    descCol = descriptionColumn settings
+
+showOptionWith :: PrintSettings -> Char -> String -> String -> String
+showOptionWith settings shortOption fullOption description =
+  opDisp ++ padding ++ 
+    ( id
+    . unlines
+    . mapTail (replicate (descCol - 1) ' ' ++) 
+    . lines
+    . constrainDescriptionWidth settings
+    $ description)
+  where
+    descCol = descriptionColumn settings
+    hasShort = shortOption /= ' '
+    hasFull = fullOption /= ""
+    opDisp = appendLineIfTooLong settings $ "" 
+      ++ "  "
+      ++ [if hasShort then '-' else ' ']
+      ++ [shortOption] 
+      ++ (if hasFull && hasShort then ", --" else "")
+      ++ (if hasFull && not hasShort then "  --" else "")
+      ++ fullOption
+    paddingLen = descCol - 1 - length (afterLast '\n' opDisp)
+    padding = replicate paddingLen ' '
+
+showOption :: Char -> String -> String -> String
+showOption = showOptionWith defaultPrintSettings
+
+dot4 :: (e -> f) -> (a -> b -> c -> d -> e) -> (a -> b -> c -> d -> f)
+dot4 f g x y z = f . g x y z
+
+printOptionWith :: PrintSettings -> Char -> String -> String -> IO ()
+printOptionWith = putStr `dot4` showOptionWith
+
+printOption :: Char -> String -> String -> IO ()
+printOption = printOptionWith defaultPrintSettings
+
diff --git a/UnknownInstruction.hs b/UnknownInstruction.hs
new file mode 100644
--- /dev/null
+++ b/UnknownInstruction.hs
@@ -0,0 +1,12 @@
+module UnknownInstruction (
+    UnknownInstruction (..)
+  ) where
+
+-----------------------------------------------------------
+
+data UnknownInstruction
+  = ReverseUnknown
+  | FailUnknown
+  | DebugUnknown
+  deriving (Show, Eq, Ord)
+
diff --git a/Version.hs b/Version.hs
new file mode 100644
--- /dev/null
+++ b/Version.hs
@@ -0,0 +1,13 @@
+module Version (
+    handprint
+  , version
+  ) where
+
+-----------------------------------------------------------
+
+handprint :: Num a => a
+handprint = 378447798
+
+version :: Double
+version = 1.0
+