packages feed

Fungi 1.0.4 → 1.0.5

raw patch · 120 files changed

+97/−6225 lines, 120 filesdep +transformersdep −haskell98dep ~ListZipperdep ~basedep ~bytestring

Dependencies added: transformers

Dependencies removed: haskell98

Dependency ranges changed: ListZipper, base, bytestring, containers, directory, filepath, mtl, mwc-random, old-time, process, random, tuple

Files

− CHANGELOG 
@@ -1,12 +0,0 @@-1.04-- Added RECD fingerprint.-- Added STRN fingerprint.-- While displaying modes for the current IP, the modes are now displayed such that more recent modes are displayed toward the left of less recent modes.-- Fixed an error in BZRO mode documentation. The errornous sentence was: "As an example, if Bizarro mode is enabled after and while Hover mode is enabled, (<) will subtract 1 from the IP's first delta coordinate." It is now corrected to say: "As an example, if Hover mode is enabled after and while Bizarro mode is enabled, (<) will subtract 1 from the IP's first delta coordinate."--1.0.3-- Added documentation for fingerprints via --finger-doc option.-- Fixed ORTH 'Z' instruction bug.-- Added BF93 fingerprint.-- Added BZRO fingerprint.-- Added NOP fingerprint.
− Data/ByteSize.hs 
@@ -1,30 +0,0 @@-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-
− Data/Deque.hs 
@@ -1,86 +0,0 @@-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)--
− Data/History.hs 
@@ -1,101 +0,0 @@-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]---
− Data/I.hs 
@@ -1,26 +0,0 @@-module Data.I (-    I-  ) where--import Data.Bits-import Data.ByteSize-import Data.Int-import Data.IntegralLike-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, IntegralLike 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-
− Data/IntegralLike.hs 
@@ -1,37 +0,0 @@-module Data.IntegralLike (-    IntegralLike (..)-  ) where--import Data.Char (ord)-import Data.Int---------------------------------------------------------------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 Integer where-  asIntegral = fromInteger--instance IntegralLike Int where-  asIntegral = fromIntegral--instance IntegralLike Int8 where-  asIntegral = fromIntegral--instance IntegralLike Int16 where-  asIntegral = fromIntegral--instance IntegralLike Int32 where-  asIntegral = fromIntegral--instance IntegralLike Int64 where-  asIntegral = fromIntegral-
− Data/Labeled.hs 
@@ -1,19 +0,0 @@-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 }-
− Data/LogicalBits.hs 
@@ -1,23 +0,0 @@-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-
− Data/MaybeBounded.hs 
@@ -1,36 +0,0 @@-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-
− Data/Stack.hs 
@@ -1,63 +0,0 @@-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)-
− Data/StackSet.hs 
@@ -1,59 +0,0 @@-module Data.StackSet (-    StackSet-  , empty-  , toList-  , insert-  , delete-  , member-  ) where--import Data.Labeled-import Data.List (sortBy)-import Data.Set (Set)-import qualified Data.Set as Set-import Data.Ord (comparing)---------------------------------------------------------------newtype Tagged l a = T { untag :: Labeled l a }--instance (Eq a) => Eq (Tagged l a) where-  T l1 == T l2 = unlabel l1 == unlabel l2--instance (Ord a) => Ord (Tagged l a) where-  compare (T l1) (T l2) = comparing unlabel l1 l2--type Tag = Int--data StackSet a = S !Tag (Set (Tagged Tag a))--empty :: StackSet a-empty = S maxBound Set.empty--toList :: StackSet a -> [a]-toList (S _ set) = map (unlabel . untag) $ sortBy (comparing $ getLabel . untag) $ Set.toList set--insert :: (Ord a) => a -> StackSet a -> StackSet a-insert x stackSet@(S n _) = if n > minBound-  then insert' x stackSet'-  else insert' x $ retag stackSet'-  where-    stackSet' = delete x stackSet--insert' :: (Ord a) => a -> StackSet a -> StackSet a-insert' x (S n set) = if n > minBound-  then S (n - 1) $ Set.insert (T $ label n x) set-  else error "StackSet.insert: Too many elements in stackset!"--retag :: (Ord a) => StackSet a -> StackSet a-retag = foldr insert' empty . toList--dummyTag :: a -> Tagged Tag a-dummyTag x = T $ label undefined x--delete :: (Ord a) => a -> StackSet a -> StackSet a-delete x (S n set) = S n $ Set.delete (dummyTag x) set--member :: (Ord a) => a -> StackSet a -> Bool-member x (S _ set) = Set.member (dummyTag x) set-
− Data/Tuple/Map.hs 
@@ -1,16 +0,0 @@-module Data.Tuple.Map (-    map1-  , map2-  ) where--import Data.Tuple.Select-import Data.Tuple.Update---------------------------------------------------------------map1 :: (Sel1 a1 a, Upd1 b a1 c) => (a -> b) -> a1 -> c-map1 f t = upd1 (f $ sel1 t) t--map2 :: (Sel2 a1 a, Upd2 b a1 c) => (a -> b) -> a1 -> c-map2 f t = upd2 (f $ sel2 t) t-
− Data/Vector.hs 
@@ -1,75 +0,0 @@-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-
− Debug/Debug.hs 
@@ -1,377 +0,0 @@-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-
− Debug/Debugger.hs 
@@ -1,40 +0,0 @@-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 } -
− Env.hs 
@@ -1,155 +0,0 @@-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-
− Fingerprint.hs 
@@ -1,62 +0,0 @@-module Fingerprint (-    Fingerprints-  , fingerprints-  ) where--import Data.Char (ord)-import Data.IntegralLike-import Data.List (foldl')-import Data.Map (Map)-import qualified Data.Map as Map-import Data.Tuple.Map--import Instruction--import qualified Fingerprint.BASE as BASE-import qualified Fingerprint.BF93 as BF93-import qualified Fingerprint.BOOL as BOOL-import qualified Fingerprint.BZRO as BZRO-import qualified Fingerprint.CPLI as CPLI-import qualified Fingerprint.FIXP as FIXP-import qualified Fingerprint.HRTI as HRTI-import qualified Fingerprint.MODE as MODE-import qualified Fingerprint.MODU as MODU-import qualified Fingerprint.NOP  as NOP-import qualified Fingerprint.NULL as NULL-import qualified Fingerprint.ORTH as ORTH-import qualified Fingerprint.RECD as RECD-import qualified Fingerprint.REFC as REFC-import qualified Fingerprint.ROMA as ROMA-import qualified Fingerprint.STRN as STRN---------------------------------------------------------------type Fingerprints i = Map Integer [(i, Instruction i ())]--asId :: String -> Integer-asId = fromIntegral . foldl' (\fId x -> fId * 256 + x) 0 . map ord--fingerprints :: (I i) => Fingerprints i-fingerprints = foldr (uncurry (insert . asId) . map2 (map $ map1 asIntegral)) Map.empty [-    (BASE.name, BASE.semantics)-  , (BF93.name, BF93.semantics)-  , (BOOL.name, BOOL.semantics)-  , (BZRO.name, BZRO.semantics)-  , (CPLI.name, CPLI.semantics)-  , (FIXP.name, FIXP.semantics)-  , (HRTI.name, HRTI.semantics)-  , (MODE.name, MODE.semantics)-  , (MODU.name, MODU.semantics)-  , (NOP.name,  NOP.semantics )-  , (NULL.name, NULL.semantics)-  , (ORTH.name, ORTH.semantics)-  , (RECD.name, RECD.semantics)-  , (REFC.name, REFC.semantics)-  , (ROMA.name, ROMA.semantics)-  , (STRN.name, STRN.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-
− Fingerprint/BASE.hs 
@@ -1,93 +0,0 @@-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-
− Fingerprint/BF93.hs 
@@ -1,82 +0,0 @@-module Fingerprint.BF93 (-    name-  , semantics-  ) where--import Prelude hiding (lookup)--import Control.Monad.State.Strict--import Data.Map (Map)--import System.Exit (exitWith, ExitCode (ExitSuccess))--import Env-import Instruction-import Ip-import Mode-import Semantics---------------------------------------------------------------name :: String-name = "BF93"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = [-    ('B', bInstr)-  ]--string93ModeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))-string93ModeInstructions = (,) (Just . pushInstr) $ buildInstructions [-    ('"', Just string93ModeInstr)-  ]--string93ModeInstr :: (I i) => Instruction i ()-string93ModeInstr = do-  modify $ withIp $ toggleMode mode-  modify $ withSemantics $ Semantics.toggleOverlay mode string93ModeInstructions-  where-    mode = Mode.String93--exitInstr :: (I i) => Instruction i ()-exitInstr = liftIO $ exitWith ExitSuccess--befunge93ModeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))-befunge93ModeInstructions = (,) (const $ Just reverseInstr) $ buildInstructions [-    ('"', Just string93ModeInstr)-  , ('@', Just exitInstr)-  , (' ', Just spaceInstr)-  , ('+', Just addInstr)-  , ('-', Just subtractInstr)-  , ('*', Just multiplyInstr)-  , ('/', Just divideInstr)-  , ('%', Just remainderInstr)-  , ('`', Just greaterThanInstr)-  , ('>', Just goEastInstr)-  , ('<', Just goWestInstr)-  , ('^', Just goNorthInstr)-  , ('v', Just goSouthInstr)-  , ('?', Just goAwayInstr)-  , ('_', Just eastWestIfInstr)-  , ('|', Just northSouthIfInstr)-  , (':', Just duplicateInstr)-  , ('\\',Just swapInstr)-  , ('$', Just popInstr_)-  , ('.', Just outputDecimalInstr)-  , (',', Just outputCharacterInstr)-  , ('#', Just trampolineInstr)-  , ('g', Just getInstr)-  , ('p', Just putInstr)-  , ('&', Just inputDecimalInstr)-  , ('~', Just inputCharacterInstr)-  , ('!', Just logicalNotInstr)-  ]--bInstr :: (I i) => Instruction i ()-bInstr = do-  modify $ withIp $ toggleMode mode-  modify $ withSemantics $ Semantics.toggleOverlay mode befunge93ModeInstructions-  where-    mode = Mode.Befunge93-
− Fingerprint/BOOL.hs 
@@ -1,32 +0,0 @@-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-
− Fingerprint/BZRO.hs 
@@ -1,86 +0,0 @@-module Fingerprint.BZRO (-    name-  , semantics-  ) where--import Control.Monad.State.Strict--import Data.Char (chr, ord)-import Data.Map (Map)-import Data.Maybe (fromMaybe)-import Data.Tuple.Map--import Space.Cell--import Env-import Instruction-import Ip-import Mode-import qualified Semantics---------------------------------------------------------------name :: String-name = "BZRO"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = [-    ('B', bInstr)-  ]--runInstructionInstr :: (I i) => Char -> Instruction i ()-runInstructionInstr c = do-  sem <- gets $ Semantics.removeOverlay Mode.Bizarro . getSemantics . currentIp-  fromMaybe (unknownInstr i) $ Semantics.lookup i sem-  where-    i = ordCell $ charToCell c--bizarroModeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))-bizarroModeInstructions = (,) f $ buildInstructions $ map (map2 $ Just . runInstructionInstr) [-    ('>', '<')-  , ('<', '>')-  , ('^', 'v')-  , ('v', '^')-  , ('h', 'l')-  , ('l', 'h')-  , ('[', ']')-  , (']', '[')-  , ('_', '|')-  , ('|', '_')-  , ('(', ')')-  , (')', '(')-  , ('{', '}')-  , ('}', '{')-  , ('+', '-')-  , ('-', '+')-  , ('*', '/')-  , ('/', '*')-  , ('i', 'o')-  , ('o', 'i')-  , ('&', '.')-  , ('.', '&')-  , ('~', ',')-  , (',', '~')-  , ('g', 'p')-  , ('p', 'g')-  , ('@', 'q')-  , ('q', '@')-  , ('\'','"')-  , ('"','\'')-  ]-  where-    f x = case cellToChar $ chrCell x of-      Just c-        | c `elem` ['0'..'9'] -> Just $ map runInstructionInstr "fedcba9876" !! (ord c - ord '0')-        | c `elem` ['a'..'f'] -> Just $ map runInstructionInstr "543210" !! (ord c - ord 'a')-        | c `elem` ['A'..'Z'] -> Just $ runInstructionInstr $ chr $ ord 'Z' + ord 'A' - ord c-        | otherwise -> Nothing-      Nothing -> Nothing--bInstr :: (I i) => Instruction i ()-bInstr = do-  modify $ withIp $ toggleMode mode-  modify $ withSemantics $ Semantics.toggleOverlay mode bizarroModeInstructions-  where-    mode = Mode.Bizarro-
− Fingerprint/CPLI.hs 
@@ -1,71 +0,0 @@-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-
− Fingerprint/FIXP.hs 
@@ -1,120 +0,0 @@-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 $ \x -> if x >= 0-  then fromInteger $ squareRoot $ fromIntegral x-  else x--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-
− Fingerprint/HRTI.hs 
@@ -1,64 +0,0 @@-module Fingerprint.HRTI (-    name-  , semantics-  ) where--import Control.Monad.State.Strict--import System.Time--import Env-import Instruction-import Ip---------------------------------------------------------------name :: String-name = "HRTI"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = [-    ('G', gInstr)-  , ('M', mInstr)-  , ('T', tInstr)-  , ('E', eInstr)-  , ('S', sInstr)-  ]--ten6 :: Integer-ten6 = 10 ^ (6 :: Integer)--diffMicro :: (I i) => ClockTime -> ClockTime -> i-diffMicro x = fromInteger . (`div` ten6) . tdPicosec . diffClockTimes x--gInstr :: (I i) => Instruction i ()-gInstr = do-  t <- liftIO $ do-    _ <- getClockTime-    x <- getClockTime-    y <- getClockTime-    return $ diffMicro y x-  pushInstr t--mInstr :: (I i) => Instruction i ()-mInstr = do-  t <- liftIO getClockTime-  modify $ withIp $ \ip -> ip { hrtiMark = Just t }--tInstr :: (I i) => Instruction i ()-tInstr = do-  ip <- gets currentIp-  case hrtiMark ip of-    Nothing -> reverseInstr-    Just t -> do-      t' <- liftIO getClockTime-      pushInstr $ diffMicro t' t--eInstr :: (I i) => Instruction i ()-eInstr = modify $ withIp $ \ip -> ip { hrtiMark = Nothing }--sInstr :: (I i) => Instruction i ()-sInstr = do-  pico <- liftIO $ liftM ctPicosec $ getClockTime >>= toCalendarTime-  pushInstr $ fromInteger $ pico `div` ten6-
− Fingerprint/MODE.hs 
@@ -1,109 +0,0 @@-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-  modify $ withSemantics $ Semantics.toggleOverlay mode hoverModeInstructions-  where-    mode = Mode.Hover--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-  modify $ withSemantics $ Semantics.toggleOverlay mode switchModeInstructions-  where-    mode = Mode.Switch-
− Fingerprint/MODU.hs 
@@ -1,28 +0,0 @@-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-
− Fingerprint/NOP.hs 
@@ -1,15 +0,0 @@-module Fingerprint.NOP (-    name-  , semantics-  ) where--import Instruction---------------------------------------------------------------name :: String-name = "NOP"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = zip ['A'..'Z'] $ repeat nopInstr-
− Fingerprint/NULL.hs 
@@ -1,15 +0,0 @@-module Fingerprint.NULL (-    name-  , semantics-  ) where--import Instruction---------------------------------------------------------------name :: String-name = "NULL"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = zip ['A'..'Z'] $ repeat reverseInstr-
− Fingerprint/ORTH.hs 
@@ -1,96 +0,0 @@-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 trampolineInstr--sInstr :: (I i) => Instruction i ()-sInstr = do-  s <- liftM (map $ fromMaybe '?') popStringInstr-  liftIO $ putStr s-
− Fingerprint/RECD.hs 
@@ -1,135 +0,0 @@-module Fingerprint.RECD (-    name-  , semantics-  ) where--import Control.Monad.State.Strict--import Data.Foldable (foldl', toList)-import Data.List (genericTake, genericDrop, intersperse)-import Data.Map (Map)-import Data.Maybe (fromMaybe)-import Data.Sequence (Seq)--import Env-import Instruction-import Ip-import Mode-import Semantics---------------------------------------------------------------name :: String-name = "RECD"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = [-    ('C', cInstr)-  , ('L', lInstr)-  , ('N', nInstr)-  , ('R', rInstr)-  , ('P', pInstr)-  , ('Q', qInstr)-  ]--recordingMode :: Mode-recordingMode = Mode.Record--learnInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))-learnInstructions = (,) (Just . learnInstr_) $ buildInstructions [-    ('L', Just lInstr)-  ]--recordInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))-recordInstructions = (,) (Just . recordInstr) $ buildInstructions [-    ('R', Just rInstr)-  ]--learnInstr_ :: (I i) => i -> Instruction i ()-learnInstr_ i = learnInstr i >> return ()--learnInstr :: (I i) => i -> Instruction i (Instruction i ())-learnInstr i = do-  sem <- gets $ Semantics.removeOverlay recordingMode . getSemantics . currentIp-  let instr = fromMaybe (unknownInstr i) $ Semantics.lookup i sem-  modify $ withIp $ record instr-  recordLen <- gets $ getRecordLength . currentIp-  modify $ withIp $ setRecordLength $! recordLen + 1-  return instr--recordInstr :: (I i) => i -> Instruction i ()-recordInstr = join . learnInstr--cInstr :: (I i) => Instruction i ()-cInstr = do-  recording <- gets $ testMode Mode.Record . currentIp-  learning <- gets $ testMode Mode.Learn . currentIp-  if recording || learning-    then reverseInstr-    else modify $ withIp clearRecordings--seqLength :: (Integral i) => Seq a -> i-seqLength = foldl' (\n _ -> n + 1) 0--nInstr :: (I i) => Instruction i ()-nInstr = gets (seqLength . getRecordings . currentIp) >>= pushInstr--lInstr :: (I i) => Instruction i ()-lInstr = do-  recording <- gets $ testMode Mode.Record . currentIp-  if recording-    then reverseInstr-    else do-      learning <- gets $ testMode Mode.Learn . currentIp-      when learning $ do-        recordLen <- gets $ getRecordLength . currentIp-        modify $ withIp $ setRecordLength 0-        pushInstr recordLen-      modify $ withIp $ toggleMode Mode.Learn-      modify $ withSemantics $ Semantics.toggleOverlay recordingMode learnInstructions--rInstr :: (I i) => Instruction i ()-rInstr = do-  learning <- gets $ testMode Mode.Learn . currentIp-  if learning-    then reverseInstr-    else do-      recording <- gets $ testMode Mode.Record . currentIp-      when recording $ do-        recordLen <- gets $ getRecordLength . currentIp-        modify $ withIp $ setRecordLength 0-        pushInstr recordLen-      modify $ withIp $ toggleMode Mode.Record-      modify $ withSemantics $ Semantics.toggleOverlay recordingMode recordInstructions--getRecordingsInstr :: (I i) => Instruction i [Instruction i ()]-getRecordingsInstr = do-  idx <- popInstr-  n <- popInstr-  let takeN = if n >= 0-        then genericTake n-        else id-  gets (takeN . genericDrop idx . toList . getRecordings . currentIp) --pInstr :: (I i) => Instruction i ()-pInstr = do-  recording <- gets $ testMode Mode.Record . currentIp-  learning <- gets $ testMode Mode.Learn . currentIp-  if recording || learning-    then reverseInstr-    else do-      modify $ withIp $ addMode Mode.Learn . addMode Mode.Record-      getRecordingsInstr >>= sequence_ . intersperse trampolineInstr-      modify $ withIp $ removeMode Mode.Learn . removeMode Mode.Record--qInstr :: (I i) => Instruction i ()-qInstr = do-  recording <- gets $ testMode Mode.Record . currentIp-  learning <- gets $ testMode Mode.Learn . currentIp-  if recording || learning-    then reverseInstr-    else do-      modify $ withIp $ addMode Mode.Learn . addMode Mode.Record-      getRecordingsInstr >>= sequence_-      modify $ withIp $ removeMode Mode.Learn . removeMode Mode.Record-
− Fingerprint/REFC.hs 
@@ -1,43 +0,0 @@-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-
− Fingerprint/ROMA.hs 
@@ -1,44 +0,0 @@-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-
− Fingerprint/STRN.hs 
@@ -1,168 +0,0 @@-module Fingerprint.STRN (-    name-  , semantics-  ) where--import Control.Monad.State.Strict--import Data.Char (isDigit, isSpace)-import Data.IntegralLike-import Data.List (tails, isPrefixOf, genericTake, genericDrop, genericLength, foldl')-import Data.Maybe (fromMaybe, listToMaybe)-import Data.MaybeBounded-import Data.Vector--import Space.Cell-import Space.Space--import System.IO (hFlush, stdout)--import Env-import Instruction-import Ip---------------------------------------------------------------name :: String-name = "STRN"--semantics :: (I i) => [(Char, Instruction i ())]-semantics = [-    ('A', aInstr)-  , ('C', cInstr)-  , ('D', dInstr)-  , ('F', fInstr)-  , ('G', gInstr)-  , ('I', iInstr)-  , ('L', lInstr)-  , ('M', mInstr)-  , ('N', nInstr)-  , ('P', pInstr)-  , ('R', rInstr)-  , ('S', sInstr)-  , ('V', vInstr)-  ]--pushStringInstr :: (I i) => [i] -> Instruction i ()-pushStringInstr str = do-  pushInstr 0-  pushVectorInstr $ mkVector $ reverse str--aInstr :: (I i) => Instruction i ()-aInstr = do-  s1 <- popStringInstr'-  s2 <- popStringInstr'-  pushStringInstr $ s1 ++ s2--cInstr :: (I i) => Instruction i ()-cInstr = do-  s1 <- popStringInstr'-  s2 <- popStringInstr'-  pushInstr $ case compare s1 s2 of-    GT -> 1-    LT -> -1-    EQ -> 0--dInstr :: (I i) => Instruction i ()-dInstr = do-  s <- liftM (map $ fromMaybe '?') popStringInstr-  liftIO $ putStr s--search :: (Eq a) => [a] -> [a] -> [a]-search needle = fromMaybe [] . listToMaybe . filter (needle `isPrefixOf`) . tails--fInstr :: (I i) => Instruction i ()-fInstr = do-  s1 <- popStringInstr'-  s2 <- popStringInstr'-  pushStringInstr $ search s2 s1--gInstr :: (I i) => Instruction i ()-gInstr = do-  env <- get-  let dim = getDim env-      space = getSpace env-      east = takeV dim $ 1 `cons` 0-      so = getStorageOffset $ currentIp env-      (minC, _, space') = minMaxCoords space-      minX = head $ unVector minC-      wrappingAdd v w  = let z = v + w-        in if inBounds space' z-          then z-          else minX `cons` (dropV 1 z)-  pos <- popDimVectorInstr-  let poses = iterate (wrappingAdd east) $ pos + so-      cells = map (cellAt space) poses-      vals = map ordCell cells-      str = takeWhile (/= 0) vals-  modify $ withSpace $ const space'-  pushStringInstr str--iInstr :: (I i) => Instruction i ()-iInstr = do-  str <- liftIO $ do-    hFlush stdout-    getLine-  pushStringInstr $ map asIntegral str--lInstr :: (I i) => Instruction i ()-lInstr = do-  n <- popInstr-  str <- popStringInstr'-  pushStringInstr $ genericTake n str--mInstr :: (I i) => Instruction i ()-mInstr = do-  n <- popInstr-  p <- popInstr-  str <- popStringInstr'-  pushStringInstr $ genericTake n $ genericDrop p str--nInstr :: (I i) => Instruction i ()-nInstr = do-  str <- popStringInstr'-  pushStringInstr str -- needs to be done like this because of Hover mode-  pushInstr $ genericLength str--pInstr :: (I i) => Instruction i ()-pInstr = do-  env <- get-  let dim = getDim env-      space = getSpace env-      east = takeV dim $ 1 `cons` 0-      so = getStorageOffset $ currentIp env-  pos <- popDimVectorInstr-  str <- liftM (++ [0]) popStringInstr'-  let cells = map chrCell str-      poses = iterate (east +) $ pos + so-      space' = foldl' (\s -> uncurry $ putCell s) space $ zip cells poses-  modify $ withSpace $ const space'--rInstr :: (I i) => Instruction i ()-rInstr = do-  n <- popInstr-  str <- popStringInstr'-  pushStringInstr $ reverse $ genericTake n $ reverse str--sInstr :: (I i) => Instruction i ()-sInstr = popInstr >>= pushStringInstr . map asIntegral . show--atoi :: (MaybeBounded i, Integral i) => String -> i-atoi str = n''-  where-    n'' = fromInteger $ maybe n' (min n' . fromIntegral) $ maybeMaxBound `asTypeOf` Just n''-    n' = maybe n (max n . fromIntegral) $ maybeMinBound `asTypeOf` Just n''-    n = case dropWhile isSpace str of-      "" -> 0-      '+':cs -> atoi' cs-      '-':cs -> negate $ atoi' cs-      cs -> atoi' cs--atoi' :: String -> Integer-atoi' = foldl' (\n c -> 10 * n + read [c]) 0 . takeWhile isDigit--vInstr :: (I i) => Instruction i ()-vInstr = do-  str <- liftM (map $ fromMaybe '?') popStringInstr-  pushInstr $ atoi str -
Fungi.cabal view
@@ -1,145 +1,103 @@--- 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+-- Initial Fungi.cabal generated by cabal init.  For further documentation,+--  see http://haskell.org/cabal/users-guide/ --- 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.4+name:                Fungi +-- The package version.  See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- http://www.haskell.org/haskellwiki/Package_versioning_policy+-- PVP summary:      +-+------- breaking API changes+--                   | | +----- non-breaking API additions+--                   | | | +--- code changes with no API change+version:             1.0.5+ -- A short (one-line) description of the package.-Synopsis:            	An interpreter for Funge-98 programming languages, including Befunge.+synopsis:            Funge-98 interpreter written in Haskell  -- 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.+-- description:          -License:             	BSD3+homepage:            https://github.com/thomaseding/fungi+license:             BSD3+license-file:        LICENSE+author:              Thomas Eding+maintainer:          thomasedingcode@gmail.com -License-file:        	LICENSE+category:            Compilers/Interpreters -Author:              	Thomas Eding+build-type:          Simple -Maintainer:          	thomasedingcode@gmail.com+-- Constraint on the version of Cabal needed to build this package.+cabal-version:       >=1.8 --- Copyright:            -Category:            	Compilers/Interpreters+executable fungi+  main-is:             Main.hs+  +  ghc-options:         -fsimpl-tick-factor=1000 -Build-type:          	Simple+  -- Modules included in this executable, other than Main.+  -- other-modules:       +  +  -- Other library packages from which modules are imported.+  build-depends:+    mwc-random == 0.13.*,+    containers == 0.5.*,+    mtl == 2.1.*,+    old-time == 1.1.*,+    bytestring == 0.10.*,+    ListZipper == 1.2.*,+    random == 1.0.*,+    filepath == 1.3.*,+    directory == 1.2.*,+    process == 1.1.*,+    transformers == 0.3.*,+    tuple == 0.3.*,+    base == 4.6.*+  +  -- Directories containing source files.+  hs-source-dirs:      src -Cabal-version:       	>= 1.6 -Extra-source-files:-	CHANGELOG-	README-	Tester.hs-	runTests.bash-	tests/*.bf-	tests/bad/*.bf-	tests/bad/fingers/bzro/*.bf-	tests/good/*.bf-	tests/good/*.dat-	tests/good/fingers/bzro/*.bf-	tests/good/fingers/mode/*.bf-	tests/mycology/*.bf-	tests/mycology/*.b98-	tests/mycology/*.txt -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-	, haskell98 >= 1.0-	, ListZipper >= 1.2-	, mtl >= 1.1-	, mwc-random >= 0.8-	, old-time >= 1.0-	, process >= 1.0-	, random >= 1.0-	, tuple >= 0.2-  --- 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.StackSet-	Data.Tuple.Map-	Data.Vector-	Debug.Debug-	Debug.Debugger-	Env-	Fingerprint-	Fingerprint.BASE-	Fingerprint.BF93-	Fingerprint.BOOL-	Fingerprint.BZRO-	Fingerprint.CPLI-	Fingerprint.FIXP-	Fingerprint.HRTI-	Fingerprint.MODE-	Fingerprint.MODU-	Fingerprint.NOP-	Fingerprint.NULL-	Fingerprint.ORTH-	Fingerprint.RECD-	Fingerprint.REFC-	Fingerprint.ROMA-	Fingerprint.STRN-	Fungi-	Instruction-	Interpreter-	Ip-	Math-	Mode-	ProcessArgs-	Random-	Semantics-	Space.Cell-	Space.Space-	System.IO.Buffering-	Text.Help.Debug-	Text.Help.Fingerprint-	Text.Help.Fungi-	Text.Help.Fingerprint.BASE-	Text.Help.Fingerprint.BF93-	Text.Help.Fingerprint.BOOL-	Text.Help.Fingerprint.BZRO-	Text.Help.Fingerprint.CPLI-	Text.Help.Fingerprint.FIXP-	Text.Help.Fingerprint.HRTI-	Text.Help.Fingerprint.MODE-	Text.Help.Fingerprint.MODU-	Text.Help.Fingerprint.NOP-	Text.Help.Fingerprint.NULL-	Text.Help.Fingerprint.ORTH-	Text.Help.Fingerprint.RECD-	Text.Help.Fingerprint.REFC-	Text.Help.Fingerprint.ROMA-	Text.Help.Fingerprint.STRN-	Text.PrettyShow-	Text.PrintOption-	UnknownInstruction-	Version+++++++++++++++++++++++++++++++++++
− Fungi.hs 
@@ -1,119 +0,0 @@-module Fungi (-    main-  , mycology-  ) 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 (system)-import System.Environment (getArgs, withArgs)-import System.Exit (ExitCode (..))-import System.FilePath (takeExtension)-import System.IO hiding (hGetContents)--import qualified Text.Help.Fingerprint-import qualified Text.Help.Fungi--import Env-import Fingerprint-import Instruction-import Interpreter-import ProcessArgs-import qualified Version---------------------------------------------------------------mycology :: IO ExitCode-mycology = do-  removeTemps-  ret <- withArgs ["--unknown", "debug", "tests/mycology/mycology.b98"] main-  removeTemps-  return ret-  where-    removeTemps = system "rm tests/mycology/mycotmp*.tmp" >> return ()--main :: IO ExitCode-main = do-  mArgs <- liftM processArgs getArgs-  case mArgs of-    Nothing -> badArgs >> return (ExitFailure 1)-    Just args-      | argsHelp args -> Text.Help.Fungi.help >> return ExitSuccess-      | argsVersion args -> version >> return ExitSuccess-      | otherwise -> case argsFingerDoc args of-          Just fingerName -> Text.Help.Fingerprint.help fingerName >> return ExitSuccess-          Nothing -> 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."--version :: IO ()-version = do-  putStrLn $ "Fungi version " ++ Version.version--badArgs :: IO ()-badArgs = putStrLn "Bad arguments." >> usage-
− Instruction.hs 
@@ -1,906 +0,0 @@-module Instruction (-    I-  , Instruction-  , buildInstructions-  , baseInstructions-  , lookupInstruction-  , runCurrentInstruction-  , currentInstruction--  , guardDim-  , guardZero--  , ifInstr-  , moveByDeltaInstr-  , setDeltaInstr-  , setPosInstr-  , opInstr-  , op2Instr-  , pushVectorInstr-  , popInstr-  , popNInstr_-  , popVectorInstr-  , popDimVectorInstr-  , popStringInstr-  , popStringInstr'-  , tryLiftIO--  , nopInstr-  , pushInstr-  , trampolineInstr-  , reverseInstr-  , loadSemanticsInstr-  , unloadSemanticsInstr-  , beginBlockInstr-  , endBlockInstr-  , turnLeftInstr-  , turnRightInstr-  , putInstr-  , getInstr-  , logicalNotInstr-  , goWestInstr-  , goEastInstr-  , goNorthInstr-  , goSouthInstr-  , goLowInstr-  , goHighInstr-  , northSouthIfInstr-  , eastWestIfInstr-  , stopInstr-  , quitInstr-  , subtractInstr-  , addInstr-  , multiplyInstr-  , divideInstr-  , outputFileInstr-  , inputFileInstr-  , outputCharacterInstr-  , inputCharacterInstr-  , outputDecimalInstr-  , inputDecimalInstr-  , stringModeInstr-  , fetchCharacterInstr-  , unknownInstr-  , spaceInstr-  , remainderInstr-  , greaterThanInstr-  , goAwayInstr-  , duplicateInstr-  , swapInstr-  , popInstr_--  ) 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.Tuple.Map-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--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, IntegralLike c) => [(c, v)] -> Map i v-buildInstructions = Map.fromList . map (map1 asIntegral)--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 []-    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 rem---------------------------------------------------------------- Strings--------------------------------------------------------------stringModeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ())))-stringModeInstructions = (,) (Just . pushInstr) $ buildInstructions [-    ('"', Just stringModeInstr)-  , (' ', 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-  modify $ withSemantics $ Semantics.toggleOverlay mode stringModeInstructions-  where-    mode = Mode.String--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 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 }-
− Interpreter.hs 
@@ -1,68 +0,0 @@-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-
− Ip.hs 
@@ -1,141 +0,0 @@-module Ip (-    Ip-  , mkIp--  , getId-  , getPos-  , getDelta-  , getSs-  , isAlive-  , getStorageOffset-  , getSemantics-  , hrtiMark---  , testMode-  , addMode-  , removeMode-  , toggleMode--  , record-  , clearRecordings-  , getRecordings-  , getRecordLength-  , setRecordLength--  , killIp-  , reverseIp-  , setPos-  , setDelta-  , setSs-  , setStorageOffset--  ) where--import Control.Monad.State.Strict--import Data.Deque-import Data.I-import Data.Map (Map)-import Data.StackSet (StackSet)-import qualified Data.StackSet as StackSet-import Data.Sequence-import qualified Data.Sequence as Seq-import Data.Stack-import Data.Vector--import System.Time (ClockTime)--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 :: StackSet Mode-  , hrtiMark :: Maybe ClockTime-  , getRecordings :: Seq (Instruction env i ())-  , getRecordLength :: i-  }--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 (StackSet.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 = StackSet.empty-  , hrtiMark = Nothing-  , getRecordings = Seq.empty-  , getRecordLength = 0-  }--testMode :: Mode -> Ip env i -> Bool-testMode mode = StackSet.member mode . modes--addMode :: Mode -> Ip env i -> Ip env i-addMode mode ip = ip { modes = StackSet.insert mode $ modes ip }--removeMode :: Mode -> Ip env i -> Ip env i-removeMode mode ip = ip { modes = StackSet.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 }--setRecordLength :: i -> Ip env i -> Ip env i-setRecordLength n ip = ip { getRecordLength = n }--clearRecordings :: Ip env i -> Ip env i-clearRecordings ip = ip { getRecordings = Seq.empty }--record :: Instruction env i () -> Ip env i -> Ip env i-record instr ip = ip { getRecordings = getRecordings ip |> instr }-
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2010, Thomas Eding+Copyright (c) 2015, Thomas Eding  All rights reserved.
− Main.hs 
@@ -1,14 +0,0 @@-module Main (-    main-  )-  where--import System.Exit--import qualified Fungi---------------------------------------------------------------main :: IO ()-main = Fungi.main >>= exitWith-
− Math.hs 
@@ -1,24 +0,0 @@-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-
− Mode.hs 
@@ -1,24 +0,0 @@-module Mode (-    Mode (..)-  ) where--import Text.PrettyShow---------------------------------------------------------------data Mode-  = Befunge93-  | Bizarro-  | Hover-  | Invert-  | Learn-  | Record-  | String-  | String93-  | Switch-  | Queue-  deriving (Show, Eq, Ord)--instance PrettyShow Mode where-  pshow = show-
− ProcessArgs.hs 
@@ -1,114 +0,0 @@-module ProcessArgs (-    processArgs-  , ProcessedArgs (..)-  ) where--import Control.Monad--import Data.ByteSize (byteSize)-import Data.Char (toLower)--import Debug.Debugger (DebugMode (..))--import UnknownInstruction---------------------------------------------------------------data ProcessedArgs = ProcessedArgs {-    argsHelp :: Bool-  , argsVersion :: Bool-  , argsFingerDoc :: Maybe String-  , 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-  , argsVersion = False-  , argsFingerDoc = Nothing-  , 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-  "--version" -> processVersion args-  "--finger-doc" -> processFingerDoc 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 }--processVersion :: [String] -> Maybe ProcessedArgs-processVersion args = processArgs args >>= \p -> return p { argsVersion = True }--processFingerDoc :: [String] -> Maybe ProcessedArgs-processFingerDoc [] = Nothing-processFingerDoc (arg:args) = processArgs args >>= \p -> return p { argsFingerDoc = Just arg }--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-  }-
− README 
@@ -1,11 +0,0 @@-For information on how to use Fungi, run the program with the --help command line argument.-Note that the --help option will list all implemented fingerprints.--fungi --help------------------------------------------------------------------------------------For information on how to use a fingerprint, run the program with the --finger-doc command line argument.--fungi --finger-doc NAME-
− Random.hs 
@@ -1,48 +0,0 @@-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-
− Semantics.hs 
@@ -1,135 +0,0 @@-module Semantics (-    Semantics-  , mkSemantics-  , lookup-  , lookupBase-  , lookupFinger-  , lookupOverlay-  , 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 sem of-  Just instr -> Just instr-  Nothing -> case lookupFinger i sem of-    Just instr -> Just instr-    Nothing -> lookupBase i sem--lookupOverlay :: (I i) => i -> Semantics env i -> Maybe (Instruction env i ())-lookupOverlay i = lookupOverlay' i . map unlabel . overlayInstrs--lookupFinger :: (I i) => i -> Semantics env i -> Maybe (Instruction env i ())-lookupFinger i = lookupFinger' i . fingerInstrs--lookupBase :: (I i) => i -> Semantics env i -> Maybe (Instruction env i ())-lookupBase i = lookupBase' i . baseInstrs--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-
− Space/Cell.hs 
@@ -1,49 +0,0 @@-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-
− Space/Space.hs 
@@ -1,162 +0,0 @@-module Space.Space (-    Space-  , mkSpace-  , cellAt-  , putCell-  , travelBy-  , minMaxCoords-  , putSpaceAt-  , inBounds-  ) 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')-
− System/IO/Buffering.hs 
@@ -1,17 +0,0 @@-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-
− Tester.hs 
@@ -1,79 +0,0 @@-module Tester (-    main-  ) where--import Control.Exception (handle)-import Control.Monad--import Data.List (sort, isSuffixOf)--import System.Directory (getDirectoryContents, doesFileExist, doesDirectoryExist)-import System.Environment (withArgs)-import System.Exit (ExitCode (..), exitSuccess, exitFailure)--import qualified Fungi---------------------------------------------------------------main :: IO ExitCode-main = do-  putStrLn "Running Tests..."-  (goodPasses, goodFailures) <- runTests goodTestDir-  (badFailures, badPasses) <- runTests badTestDir-  putStrLn "-----------------------------------------------------------"-  putStrLn $ "Good Passes: " ++ show goodPasses-  putStrLn $ "Good Failures: " ++ show goodFailures-  putStrLn "-----------------------------------------------------------"-  putStrLn $ "Bad Passes: " ++ show badPasses-  putStrLn $ "Bad Failures: " ++ show badFailures-  putStrLn "-----------------------------------------------------------"-  putStrLn $ "Total Tests Passed: " ++ show (goodPasses + badPasses)-  putStrLn $ "Total Tests Failed: " ++ show (goodFailures + badFailures)-  if (goodFailures + badFailures) > 0-    then return $ ExitFailure 1-    else return ExitSuccess-  where-    goodTestDir = "tests/good/"-    badTestDir = "tests/bad/"--getDirectoryFilesRecursive :: FilePath -> IO [FilePath]-getDirectoryFilesRecursive path = do-  contents <- liftM (filter (`notElem` [".", ".."])) $ getDirectoryContents path-  dirs <- filterM doesDirectoryExist $ map ((path ++) . (++ "/")) contents-  files <- filterM doesFileExist $ map (path ++) contents-  files' <- mapM getDirectoryFilesRecursive dirs-  return $ files ++ concat files'--runTests :: FilePath -> IO (Int, Int)-runTests testDir = do-  files <- return-    . sort -    . filter (\file -> any (`isSuffixOf` file) [".uf", ".u98", ".bf", ".b98", ".tf", ".t98"])-    =<< getDirectoryFilesRecursive testDir-  exitCodes <- mapM test files-  let numSuccesses = countSuccesses exitCodes-      numFailures = countFailures exitCodes-  return (numSuccesses, numFailures)--countSuccesses :: [ExitCode] -> Int-countSuccesses = length . filter (== ExitSuccess)--countFailures :: [ExitCode] -> Int-countFailures = length . filter (/= ExitSuccess)--printOnFail :: FilePath -> ExitCode -> IO ExitCode-printOnFail file exitCode@(ExitFailure n) = do-  putStrLn $ "Fail: " ++ file ++ ", with exit code " ++ show n-  return exitCode-printOnFail _ exitCode = return exitCode--test :: FilePath -> IO ExitCode-test file = do-  putStrLn $ ">>>> Testing: " ++ file-  exitCode <- handle return $ withArgs args Fungi.main-  putStr "\n>>>> "-  print exitCode-  return exitCode-  where-    args = ["--debug", "0", file]-
− Text/Help/Debug.hs 
@@ -1,52 +0,0 @@-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."-
− Text/Help/Fingerprint.hs 
@@ -1,74 +0,0 @@-module Text.Help.Fingerprint (-    help-  ) where--import qualified Data.Map as Map-import Data.Maybe (fromMaybe)--import qualified Fingerprint.BASE as BASE-import qualified Fingerprint.BF93 as BF93-import qualified Fingerprint.BOOL as BOOL-import qualified Fingerprint.BZRO as BZRO-import qualified Fingerprint.CPLI as CPLI-import qualified Fingerprint.FIXP as FIXP-import qualified Fingerprint.HRTI as HRTI-import qualified Fingerprint.MODE as MODE-import qualified Fingerprint.MODU as MODU-import qualified Fingerprint.NOP  as NOP-import qualified Fingerprint.NULL as NULL-import qualified Fingerprint.ORTH as ORTH-import qualified Fingerprint.RECD as RECD-import qualified Fingerprint.REFC as REFC-import qualified Fingerprint.ROMA as ROMA-import qualified Fingerprint.STRN as STRN--import qualified Text.Help.Fingerprint.BASE as H_BASE-import qualified Text.Help.Fingerprint.BF93 as H_BF93-import qualified Text.Help.Fingerprint.BOOL as H_BOOL-import qualified Text.Help.Fingerprint.BZRO as H_BZRO-import qualified Text.Help.Fingerprint.CPLI as H_CPLI-import qualified Text.Help.Fingerprint.FIXP as H_FIXP-import qualified Text.Help.Fingerprint.HRTI as H_HRTI-import qualified Text.Help.Fingerprint.MODE as H_MODE-import qualified Text.Help.Fingerprint.MODU as H_MODU-import qualified Text.Help.Fingerprint.NOP  as H_NOP-import qualified Text.Help.Fingerprint.NULL as H_NULL-import qualified Text.Help.Fingerprint.ORTH as H_ORTH-import qualified Text.Help.Fingerprint.RECD as H_RECD-import qualified Text.Help.Fingerprint.REFC as H_REFC-import qualified Text.Help.Fingerprint.ROMA as H_ROMA-import qualified Text.Help.Fingerprint.STRN as H_STRN---------------------------------------------------------------line :: IO ()-line = putStrLn $ replicate 80 '-'--noHelp :: String -> IO ()-noHelp finger = putStrLn $ "Unable to find fingerprint documentation for " ++ finger--help :: String -> IO ()-help finger = do-  line-  doc-  line-  where-    doc = fromMaybe (noHelp finger) $ Map.lookup finger $ Map.fromList [-        (BASE.name, H_BASE.help)-      , (BF93.name, H_BF93.help)-      , (BOOL.name, H_BOOL.help)-      , (BZRO.name, H_BZRO.help)-      , (CPLI.name, H_CPLI.help)-      , (FIXP.name, H_FIXP.help)-      , (HRTI.name, H_HRTI.help)-      , (MODE.name, H_MODE.help)-      , (MODU.name, H_MODU.help)-      , (NOP.name , H_NOP.help )-      , (NULL.name, H_NULL.help)-      , (ORTH.name, H_ORTH.help)-      , (RECD.name, H_RECD.help)-      , (REFC.name, H_REFC.help)-      , (ROMA.name, H_ROMA.help)-      , (STRN.name, H_STRN.help)-      ]-
− Text/Help/Fingerprint/BASE.hs 
@@ -1,19 +0,0 @@-module Text.Help.Fingerprint.BASE (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'B' "Pop X. Output X in base 2 followed by a space."-  p 'H' "Pop X. Output X in base 16 followed by a space."-  p 'I' "Pop N. Read input in base N."-  p 'N' "Pop X. Pop N. Output X in base N followed by a space."-  p 'O' "Pop X. Output X in base 8 followed by a space."-
− Text/Help/Fingerprint/BF93.hs 
@@ -1,33 +0,0 @@-module Text.Help.Fingerprint.BF93 (-    help-  ) where--import Data.List (intercalate)--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--maxWidth :: Int-maxWidth = 80--line :: IO ()-line = putStrLn $ replicate maxWidth '-'--help :: IO ()-help = do-  p 'B' "Toggle Befunge93 mode."-  line-  putStrLn "\n ** BEFUNGE93 MODE **\n"-  putStrLn "In Befunge93 mode, the following instructins take on new meaning: "-  p '"' $ "Toggle String93 mode. Like ordinary String mode, except contiguous spaces are not"-    ++ " collapsed. Instead, each space is pushed onto the stack."-  p '@' $ "Exit the program with exit code 0 regardless of the number of live IPs in the program."-  putStrLn $ fit maxWidth $ "In addition, the following instructions behave as the base Funge-98 instructions:\n"-    ++ (intercalate ", " $ map (\c -> '(' : c : ")") " +-*/%!`><^v?_|:\\$.,#gp&~") ++ ".\n"-    ++ "Every other instruction reflects. Thus there is no way for an IP to leave Befunge93 mode"-    ++ " via the BF93 fingerprint."-
− Text/Help/Fingerprint/BOOL.hs 
@@ -1,18 +0,0 @@-module Text.Help.Fingerprint.BOOL (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'A' "Pop Y. Pop X. Push 0 if X is 0. Else push Y."-  p 'N' "Pop X. Push 1 if X is 0. Else push 0."-  p 'O' "Pop Y. Pop X. Push X if X is not 0. Else push Y."-  p 'X' "Pop Y. Pop X. Push 1 if X is 0 and Y not 0 or if X is not 0 and Y is 0. Else push 1."-
− Text/Help/Fingerprint/BZRO.hs 
@@ -1,79 +0,0 @@-module Text.Help.Fingerprint.BZRO (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--maxWidth :: Int-maxWidth = 80--line :: IO ()-line = putStrLn $ replicate maxWidth '-'--correspondences :: [(Char, Char)]-correspondences = [-    ('>', '<')-  , ('<', '>')-  , ('^', 'v')-  , ('v', '^')-  , ('h', 'l')-  , ('l', 'h')-  , ('[', ']')-  , (']', '[')-  , ('_', '|')-  , ('|', '_')-  , ('(', ')')-  , (')', '(')-  , ('{', '}')-  , ('}', '{')-  , ('+', '-')-  , ('-', '+')-  , ('*', '/')-  , ('/', '*')-  , ('i', 'o')-  , ('o', 'i')-  , ('&', '.')-  , ('.', '&')-  , ('~', ',')-  , (',', '~')-  , ('g', 'p')-  , ('p', 'g')-  , ('@', 'q')-  , ('q', '@')-  , ('\'','"')-  , ('"','\'')-  ] ++ zip nums (reverse nums) ++ zip alphas (reverse alphas)-  where-    nums = "0123456789abcdef"-    alphas = ['A'..'Z']--help :: IO ()-help = do-  p 'B' "Toggle Bizarro mode."-  line-  putStrLn "\n ** BIZARRO MODE **\n"-  putStrLn $ fit maxWidth $ "In Bizarro mode, the following instructions on the left correspond to the corresponding"-    ++ " instruction on the right as if Bizarro mode were not on:\n"-  mapM_ (\(x, y) -> putStrLn $ "            " ++ [x] ++ "    --->    " ++ [y]) correspondences-  putStrLn ""-  putStrLn $ fit maxWidth $ "Note that if Bizarro mode is on, a (Y) instruction will"-    ++ " turn off Bizarro mode and (B) will not due to (Y) corresponding to (B) and vice-versa."-    ++ " Also note that the corresponding instructions are not necessarily the base Funge-98"-    ++ " instructions. For example, if Hover mode is and was enabled before Bizarro mode (see MODE fingerprint"-    ++ " for details on Hover mode), (<) will add 1 the IP's first delta coordinate"-    ++ " instead of setting the IP's delta to east (or west for that matter)."-    ++ " As with all modes, the most recent mode has priority. As an example, if Hover mode"-    ++ " is enabled after and while Bizarro mode is enabled, (<) will subtract 1 from the IP's first delta"-    ++ " coordinate. To alleviate any confusion about String mode, if String mode is enabled during Bizarro"-    ++ " mode, a (') instruction will push 39 onto the stack, and (\") will disable String mode despite the"-    ++ " fact that (') turns on String mode when Bizarro mode is on."-  putStrLn $ fit maxWidth $ "\nAll the clarifications above are not special rules. The only rule is that the"-    ++ " instructions correspond to other instructions based on symbols, not on semantics. The clarifications"-    ++ " assume 'usual' Bizarro mode circumstances, meaning some other mode or instruction is not radically"-    ++ " changing the behavior of Bizarro mode, other modes, instructions, and/or the interpreter."-
− Text/Help/Fingerprint/CPLI.hs 
@@ -1,20 +0,0 @@-module Text.Help.Fingerprint.CPLI (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'A' "Pop A. Pop B. Pop C. Pop D. Let E+Fi be the complex number (A+Bi)+(C+Di). Push E. Push F."-  p 'D' "Pop A. Pop B. Pop C. Pop D. Let E+Fi be the complex number (A+Bi)/(C+Di). Push E. Push F."-  p 'M' "Pop A. Pop B. Pop C. Pop D. Let E+Fi be the complex number (A+Bi)*(C+Di). Push E. Push F."-  p 'O' "Pop A. Pop B. Output the complex number (A+Bi) followed by a space."-  p 'S' "Pop A. Pop B. Pop C. Pop D. Let E+Fi be the complex number (A+Bi)-(C+Di). Push E. Push F."-  p 'V' "Pop A. Pop B. Push |A+Bi|. Note |A+Bi| = sqrt(A^2+B^2)."-
− Text/Help/Fingerprint/FIXP.hs 
@@ -1,30 +0,0 @@-module Text.Help.Fingerprint.FIXP (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'A' "Pop Y. Pop X. Push the bitwise AND of X and Y."-  p 'B' "Pop X. Push 10000*acos(X/10000). Angle is measured in degrees."-  p 'C' "Pop X. Push 10000*cos(X/10000). Angle is measured in degrees."-  p 'D' "Pop N. Let X be a random number be chosen uniformly from [0, |N|]. If X >= 0 then push N. Else push -N."-  p 'I' "Pop X. Push 10000*sin(X/10000). Angle is measured in degrees."-  p 'J' "Pop X. Push 10000*asin(X/10000). Angle is measured in degrees."-  p 'N' "Pop X. Push -X."-  p 'O' "Pop Y. Pop X. Push the bitwise OR of X and Y."-  p 'P' "Pop X. Push X*pi."-  p 'Q' "Pop X. If X >= 0 then push sqrt(X). Else push X."-  p 'R' "Pop Y. Pop X. Push X^B."-  p 'S' "Pop X. If X > 0 then push 1. If X < 0 then push -1. Else push 0."-  p 'T' "Pop X. Push 10000*tan(X/10000). Angle is measured in degrees."-  p 'U' "Pop X. Push 10000*atan(X/10000). Angle is measured in degrees."-  p 'V' "Pop X. Push |X|."-  p 'X' "Pop Y. Pop X. Push the bitwise XOR of X and Y."-
− Text/Help/Fingerprint/HRTI.hs 
@@ -1,21 +0,0 @@-module Text.Help.Fingerprint.HRTI (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'G' $ "Push the smallest clock tick the underlying system can reliably handle, measured in microseconds."-    ++ " Results may vary from call to call."-  p 'M' "Mark the current IP with a timestamp of the current time."-  p 'T' $ "If the current IP has been marked by 'M', push the number of microseconds between the current"-    ++ " time and the marked time. Otherwise reverse the IP."-  p 'E' "If the current IP has been marked by 'M', remove the mark."-  p 'S' "Push the number of microseconds since the last whole second."-
− Text/Help/Fingerprint/MODE.hs 
@@ -1,18 +0,0 @@-module Text.Help.Fingerprint.MODE (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'H' "Toggle Hover mode for the current IP. In Hover mode, the instructions '>', '<', '^', 'v', '|', and '_' treat the IP's delta relatively. That is, instead of setting its dx to 1 and the rest of its delta to 0, '>' would instead simply add 1 to its dx."-  p 'I' "Toggle Invert mode for the current IP. When Invert mode is active, cells are pushed on the stack onto the bottom instead of the top."-  p 'Q' "Toggle Queue mode for the current IP. When Queue mode is active, cells are popped off the stack from the bottom instead of the top."-  p 'S' "Toggle Switch mode. In Switch mode, the pairs of instructions '[' and ']', '{' and '}', and '(' and ')' are treated as switches. When one is executed, the cell it is located in is immediately overwritten with the other instruction of the pair, providing a switching mechanism and a way to seperate coincident IPs."-
− Text/Help/Fingerprint/MODU.hs 
@@ -1,19 +0,0 @@-module Text.Help.Fingerprint.MODU (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'M' $ "Pop Y. Pop X. Push the integer remainder, satisfying [(X `quot` Y)*Y + (X `rem` Y) == X],"-    ++ " where quot is integer division truncated toward zero."-  p 'U' "Same as 'M', but the pushes the absolute value of the result instead of its signed value."-  p 'R' $ "Pop Y. Pop X. Push the integer modulus, satisfying [(X `div` Y)*Y + (X `mod` Y) == X],"-    ++ " where div is integer division truncated toward negative infinity."-
− Text/Help/Fingerprint/NOP.hs 
@@ -1,14 +0,0 @@-module Text.Help.Fingerprint.NOP (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = mapM_ (flip p "Does nothing. Like the 'z' instruction.") ['A'..'Z']-
− Text/Help/Fingerprint/NULL.hs 
@@ -1,14 +0,0 @@-module Text.Help.Fingerprint.NULL (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = mapM_ (flip p "Reverse the IP's delta. Like the 'r' instruction.") ['A'..'Z']-
− Text/Help/Fingerprint/ORTH.hs 
@@ -1,28 +0,0 @@-module Text.Help.Fingerprint.ORTH (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'A' "Pop Y. Pop X. Push the bitwise AND of X and Y."-  p 'O' "Pop Y. Pop X. Push the bitwise OR of X and Y."-  p 'E' "Pop Y. Pop X. Push the bitwise XOR of X and Y."-  p 'X' "Pop X. Set the IP's position's x coordinate to X."-  p 'Y' "Pop Y. Set the IP's position's y coordinate to Y."-  p 'V' "Pop X. Set the IP's dx to X."-  p 'W' "Pop Y. Set the IP's dy to Y."-  p 'G' $ "If the dimension < 2 then reverse. Otherwise do the following: Pop Y. Pop X. Retrieve the value in"-    ++ " funge space at the coordinates (X,Y). Push that value. If the dimension > 2, then the higher"-    ++ " dimension coordinates are 0."-  p 'P' $ "If the dimension < 2 then reverse. Otherwise do the following: Pop Y. Pop X. Pop V. Place the value V in"-    ++ " funge space at the coordinates (X,Y). If the dimension > 2, then the higher dimension coordinates are 0."-  p 'Z' "Pop X. If X = 0, then trampoline (as in a '#' instruction). Else do nothing (as in a 'z' instruction)."-  p 'S' "Output a 0 terminated string: Pop X. If X = 0 then do nothing. Else output X as a character and repeat."-
− Text/Help/Fingerprint/RECD.hs 
@@ -1,48 +0,0 @@-module Text.Help.Fingerprint.RECD (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--maxWidth :: Int-maxWidth = 80--line :: IO ()-line = putStrLn $ replicate maxWidth '-'--help :: IO ()-help = do-  p 'C' "Clear all recordings from the current IP."-  p 'N' "Push the length of the current IP's recordings."-  p 'L' $ "Toggle Learn mode. If Learn mode was on and turns off, the number of additional recorded instructions"-    ++ " is pushed onto the stack."-  p 'R' $ "Toggle Record mode. If Record mode was on and turns off, the number of additional recorded instructions"-    ++ " is pushed onto the stack."-  p 'Q' $ "Pop P. Pop N. Let L = the length of the current IP's recordings. If N < 0 or P > L, do nothing."-    ++ " Otherwise select the IP's first min(N,L-P) recorded instructions after dropping max(P,0) of them and"-    ++ " execute them by the current IP. The IP does not automatically advance between"-    ++ " any of the executed instructions. The (Q) instruction takes a single tick."-  p 'P' $ "Pop P. Pop N. Let L = the length of the current IP's recordings. If N < 0 or P > L, do nothing."-    ++ " Otherwise select the IP's first min(N,L-P) recorded instructions after dropping max(P,0) of them and"-    ++ " execute them by the current IP. In between each executed instruction, the IP advances automatically."-    ++ " The phrase 'In between' should be taken literally, for the IP does not automatically advance after the last"-    ++ " executed instruction. That being said, the IP naturally advances after the (P) instruction completes."-    ++ " The (P) instruction takes a single tick."-  line-  putStrLn "\n ** LEARN MODE **\n"-  putStrLn $ fit maxWidth $ "While in Learn mode, all the RECD instructions except (N) and (L) act as if they reflect."-    ++ " Instead of executing the current instruction, the IP records the instruction. Circumstantial data, such"-    ++ " as the IP's state (stack, position, modes, delta, etc.), are not recorded. These recordings are appended"-    ++ " to previous recordings, if any. Learn mode and Record mode share recordings."-  line-  putStrLn "\n ** Record MODE **\n"-  putStrLn $ fit maxWidth $ "While in Record mode, all the RECD instructions except (N) and (R) act as if they reflect."-    ++ " In addition to executing the current instruction, the IP records the instruction. Circumstantial data, such"-    ++ " as the IP's state (stack, position, modes, delta, etc.), are not recorded. These recordings are appended"-    ++ " to previous recordings, if any. Learn mode and Record mode share recordings."-
− Text/Help/Fingerprint/REFC.hs 
@@ -1,35 +0,0 @@-module Text.Help.Fingerprint.REFC (-    help-  ) where--import Data.Int--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--maxWidth :: Int-maxWidth = 80--num32BitVals :: Integer-num32BitVals = fromIntegral maxB - fromIntegral minB-  where-    maxB = maxBound :: Int32-    minB = minBound :: Int32--help :: IO ()-help = do-  p 'R' $ "Pop a vector off the stack. Push a scalar onto the stack unique to that vector. If 'R' is called multiple"-    ++ " times with equivalent vectors, each one gets a different unique scalar. Should the interpreter run out"-    ++ " of unique values, an error message will be emitted, and the program will end. The number of unique values"-    ++ " is equivalent to the number of values the funge cell size can acquire. For example, if 32 bit integers"-    ++ " are used, 'R' can be used safely " ++ show num32BitVals ++ " times."-  p 'D' $ "Pop X. If X corresponds to a vector via the 'R' instruction, push that vector onto the stack."-    ++ " Otherwise reverse the current IP (X is still popped)."-  putStrLn $ fit maxWidth $ "Note that the memory used to keep these correspondences are never freed"-    ++ " during the execution of the program. Hence if used enough, it is more likely that the program will fail"-    ++ " due to too much memory being used than not being able to create a new unique value."-
− Text/Help/Fingerprint/ROMA.hs 
@@ -1,21 +0,0 @@-module Text.Help.Fingerprint.ROMA (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--help :: IO ()-help = do-  p 'C' "Push 100 onto the stack."-  p 'D' "Push 500 onto the stack."-  p 'I' "Push 1 onto the stack."-  p 'L' "Push 50 onto the stack."-  p 'M' "Push 1000 onto the stack."-  p 'V' "Push 5 onto the stack."-  p 'X' "Push 10 onto the stack."-
− Text/Help/Fingerprint/STRN.hs 
@@ -1,54 +0,0 @@-module Text.Help.Fingerprint.STRN (-    help-  ) where--import Text.PrintOption---------------------------------------------------------------p :: Char -> String -> IO ()-p c = printOption ' ' $ " " ++ [c] ++ " --"--maxWidth :: Int-maxWidth = 80--line :: IO ()-line = putStrLn $ replicate maxWidth '-'--help :: IO ()-help = do-  putStrLn $ fit maxWidth $ "All strings described by this fingerprint (STRN) are 0 terminated strings."-    ++ " By default, let variables of the form S or S# be strings. Strings are stored on the stack such that"-    ++ " the terminating 0 is popped last. Let |S| be defined to the the length of S"-    ++ " excluding the terminating 0. Note that strings are simply sequences of integer values."-  line-  p 'A' "Pop S1. Pop S2. Push the string formed by appending S2 to S1."-  p 'C' $ "Pop S1. Pop S2. Push 1 if S1 > S2. Push -1 if S1 < S2. Otherwise push 0. These comparisons are"-    ++ " done lexicographically."-  p 'D' $ "Output the string as Unicode characters to the standard output. Any numbers that cannot be converted"-    ++ " to Unicode characters are displayed as question marks ('?')."-  p 'F' $ "Pop S1. Pop S2. While S2 is not a prefix of S1 and S1 is not the empty string, drop a value from S1."-    ++ " Push the resulting string S1."-  p 'G' $ "Pop a vector V. Read a string from funge space beginning at V, heading east, until a 0 is encountered."-    ++ " The read string may wrap across the edge of space exactly as an IP would normally wrap with a delta of east."-    ++ " Push the read string."-  p 'I' $ "Read a line from the standard input. Push the resulting string onto the stack. The newline is not part of"-    ++ " the string."-  p 'L' $ "Pop N. Pop S. If N < 0, push the empty string. If N > |S|, push S. Otherwise push the string composed of"-    ++ " the first N values of S."-  p 'M' $ "Pop N. Pop P. Pop S. If N < 0 or P > |S|, push the empty string. If P < 0, let Z = S. Otherwise let Z be"-    ++ " the string S but with the first P characters removed. If N > |Z|, push Z. Otherwise push the string"-    ++ " consisting of the first N characters of Z."-  p 'N' "Pop S. Push S. Push |S|."-  p 'P' $ "Pop S. Pop a vector V. Store the string S in funge space at beginning at position V, heading east."-    ++ " Note that the terminating 0 is stored in funge space."-  p 'R' $ "Pop N. Pop S. If N < 0, push the empty string. If N > |S|, push S. Otherwise push the string"-    ++ " composed of the last N values of S."-  p 'S' $ "Pop N. Push the ASCII string representation of N. Note that if N < 0, a '-' (45) will be pushed last."-    ++ " If N >= 0, a '+' (43) is NOT pushed at all."-  p 'V' $ "Pop S. Let Z be the string S but with leading (Latin-1) whitespace stripped. Read an integer from Z,"-    ++ " optionally signed with a '+' (43) or a '-' (45). The reading is done until a value outside of '0'-'9'"-    ++ " (48-57) is encountered. Let N be the resulting integer or 0 if nothing can be read. If the cell size"-    ++ " is bounded, N will be appropriately constrained by the bounds. (For example, if the S = \"2147483648\","-    ++ "  N will be 2147483647, not -2147483648 if the cell size is 32 bits.) Push N."-
− Text/Help/Fungi.hs 
@@ -1,99 +0,0 @@-module Text.Help.Fungi (-    help-  ) where--import Data.ByteSize (byteSize)-import Data.Char (chr, toLower)-import Data.Int-import Data.List (sort, intercalate, nub)-import qualified Data.Map as Map-import Data.Maybe (fromMaybe)--import System.Environment (getProgName)-import System.FilePath (dropExtension)--import Text.PrintOption--import Fingerprint---------------------------------------------------------------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)-  ]--fingers :: String-fingers = intercalate ", " $ sort $ map (reverse . decode) $ Map.keys (fingerprints :: Fingerprints Integer)-  where-    decode x = if x == 0-      then ""-      else chr (fromInteger m) : decode d-      where-        (d, m) = x `divMod` 256--line :: IO ()-line = putStrLn $ replicate maxWidth '-'--maxWidth :: Int-maxWidth = 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."-  p ' ' "version" "Display version."-  p ' ' "finger-doc NAME" "Display documentation for the fingerprint with name NAME."-  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--" fingers-  line-  putStrLn $ fit maxWidth $ "There is also the +RTS option if Fungi was compiled via the GHC"-    ++ " (Glaskow Haskell Compiler). This option deals with run time options of the program and is not determined"-    ++ " by Fungi. Using this option may improve performance of Fungi. However, this option"-    ++ " (and options related to +RTS) is beyond the scope of this program. See GHC documentation"-    ++ " for more details."-  line-
− Text/PrettyShow.hs 
@@ -1,52 +0,0 @@-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-
− Text/PrintOption.hs 
@@ -1,164 +0,0 @@-module Text.PrintOption (-    printOptionWith-  , printOption-  , showOptionWith-  , showOption-  , PrintSettings (..)-  , defaultPrintSettings-  , fit-  ) where--import Data.List (stripPrefix, groupBy)---------------------------------------------------------------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--fit :: Int -> String -> String-fit maxWidth = fit' 0 . filter (/= " ") . groupBy (\x y -> all (`notElem` [x, y]) " \n")-  where-    fit' :: Int -> [String] -> String-    fit' n strs' = case strs' of -      [] -> ""-      [str] -> let len = length str-        in case str of-          "\n" -> "\n"-          _ -> if n == 0 && len >= maxWidth-            then str-            else if n + len > maxWidth-              then '\n' : str-              else str-      (str:strs@("\n":_)) -> let len = length str-        in case str of -          "\n" -> '\n' : fit' 0 strs-          _ -> if n == 0 && len >= maxWidth-            then str ++ fit' 0 strs-            else if n + len > maxWidth-              then '\n' : str ++ " " ++ fit' (len + 1) strs-              else str ++ fit' (n + len) strs-      (str:strs) -> let len = length str-        in case str of -          "\n" -> '\n' : fit' 0 strs-          _ -> if n == 0 && len >= maxWidth-            then str ++ "\n" ++ fit' 0 strs-            else if n + len + 1 > maxWidth-              then '\n' : str ++ " " ++ fit' (len + 1) strs-              else str ++ " " ++ fit' (n + len + 1) strs-
− UnknownInstruction.hs 
@@ -1,12 +0,0 @@-module UnknownInstruction (-    UnknownInstruction (..)-  ) where---------------------------------------------------------------data UnknownInstruction-  = ReverseUnknown-  | FailUnknown-  | DebugUnknown-  deriving (Show, Eq, Ord)-
− Version.hs 
@@ -1,13 +0,0 @@-module Version (-    handprint-  , version-  ) where---------------------------------------------------------------handprint :: Num a => a-handprint = 378447798--version :: String-version = "1.0.4"-
− runTests.bash 
@@ -1,1 +0,0 @@-runhaskell Tester.hs
+ src/Main.hs view
@@ -0,0 +1,14 @@+module Main (+    main+  )+  where++import System.Exit++import qualified Fungi++-----------------------------------------------------------++main :: IO ()+main = Fungi.main >>= exitWith+
− tests/bad/execute.bf 
@@ -1,1 +0,0 @@-<q="exit 1"0
− tests/bad/fingers/bzro/quit.bf 
@@ -1,1 +0,0 @@-"ORZB"4(n1B@
− tests/bad/quit.bf 
@@ -1,1 +0,0 @@-1q
− tests/bad/quit2.bf 
@@ -1,1 +0,0 @@-7q
− tests/base.bf 
@@ -1,3 +0,0 @@-<v(4"BASE"  - >nff6++    v-            I
− tests/bool.bf 
@@ -1,2 +0,0 @@-<v(4"BOOL"- > n23A n04A n40A n00A n23O n04O n40O n00O n23X n04X n40X n00X @
− tests/good/concurrent.bf 
@@ -1,2 +0,0 @@-#vt@- @
− tests/good/concurrent2.bf 
@@ -1,2 +0,0 @@-#vt           0q- >  1@
− tests/good/direction.bf 
@@ -1,6 +0,0 @@-v1q     q-        1-    q0  <->       ^1q-1-q
− tests/good/execute.bf 
@@ -1,1 +0,0 @@-<q="exit 0"0
− tests/good/fingers/bzro/bizarro_hover.bf 
@@ -1,1 +0,0 @@-2j@1"ORZB"4("EDOM"4(n12BSj@@>@q@@@@@@
− tests/good/fingers/bzro/goEast.bf 
@@ -1,1 +0,0 @@-"ORZB"4(n1B#@<q
− tests/good/fingers/bzro/hover_bizarro.bf 
@@ -1,3 +0,0 @@-2j@1"EDOM"4(H"ORZB"4(n12Bj@@<@S@<^@@@@@@-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@<q@@@@@-@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
− tests/good/fingers/bzro/reflectB.bf 
@@ -1,1 +0,0 @@-"ORZB"4(n1B#qB@
− tests/good/fingers/bzro/stop.bf 
@@ -1,1 +0,0 @@-"ORZB"4(n1Bq
− tests/good/fingers/bzro/stop_quit.bf 
@@ -1,2 +0,0 @@-"ORZB"4(n1B#^tq-            <n@
− tests/good/fingers/bzro/stringmode.bf 
@@ -1,1 +0,0 @@-"ORZB"4(nB''1@""'q
− tests/good/fingers/bzro/stringmode2.bf 
@@ -1,5 +0,0 @@-v                    q  q-                     1  1  @->"ORZB"4(nB'    '"Y''w' w' w1q-                     1  1  1-                     q  q  q
− tests/good/fingers/bzro/turnOffBizarro.bf 
@@ -1,2 +0,0 @@-"ORZB"4(nB#^B1q-           <Y1@
− tests/good/fingers/mode/hoverEast.bf 
@@ -1,1 +0,0 @@-"EDOM"4(n1H>q0qq
− tests/good/goAway.bf 
@@ -1,23 +0,0 @@->                   v            <-                    :-                    7-                    j---^                   1<-^                   _^-                    --                    0-^          <                 <-           |-3      ?      1-| -           0                 2-           q        2        >   ^-                    --^                   _v-^                   3<------
− tests/good/inputFile.bf 
@@ -1,6 +0,0 @@-<v1i"inputFile.dat"0012- >qqqqqqqqqqqqqq- qqqqqqqqqqqqqqq- qqqqqqqqqqqqqqq- qqqqqqqqqqqqqqq- qqqqqqqqqqqqqqq
− tests/good/inputFile.dat 
@@ -1,3 +0,0 @@-v-z->zzzz0q
− tests/good/jumpForward.bf 
@@ -1,7 +0,0 @@-11jv2jvv3jvvv   v->>>>>>>>>>>>>>1q-                        >                          v->>>>>>>>>>>>>>>v>5jvvvvv^>>>>>>>>>>>>>>>>v>>>>>1q1<>0f-j>>>>>>>>>>>>>>>11-               1   >>>>>1q1<<<<<<<<<<<<<< ^^^^^<<<<-               q1<<<<<<<<<<<<<<<<<<<<<<<<>10j0q1<<<<<<<<<<<<<<<<<<<<<<-                ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
− tests/good/jumpOver.bf 
@@ -1,2 +0,0 @@-;;1;;1;  v  ;0q-         > 1q
− tests/good/math.bf 
@@ -1,4 +0,0 @@-15+4-3*6/6+4%3-v>1q1 <    <-               >| >1!|   -                >!|  >07-!|-                q1<       >0q
− tests/good/quit.bf 
@@ -1,1 +0,0 @@-q
− tests/good/stop.bf 
@@ -1,1 +0,0 @@-@
− tests/good/trampoline.bf 
@@ -1,3 +0,0 @@-#v# #    0q- 1- q
− tests/good/turn.bf 
@@ -1,7 +0,0 @@-v--           vvvvvvvvvv<<-         >>          ]^->       #^[vvvvvvvvvv0^-         ^1<<<<<<<<<<q-          q^^^^^^^^^^<
− tests/good/wrap.bf 
@@ -1,10 +0,0 @@-v---->       ^----    0q  >-
− tests/mode.bf 
@@ -1,2 +0,0 @@-<v(4"MODE"- >HIQS"HELLO!!!"@
− tests/mycology/license.txt 
@@ -1,24 +0,0 @@-Copyright (c) 2006-2008, Matti Niemenmaa
-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 the project nor the names of its contributors may be
-	  used to endorse or promote products derived from this software without
-	  specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.
− tests/mycology/mycology.b98

binary file changed (137952 → absent bytes)

− tests/mycology/mycorand.bf 
@@ -1,16 +0,0 @@-p4v       p00+1g00      <<<<<                                                 v<
-  #>                   :    |                                                 ,"
-  > 1- :2+"^"\7p "^"32p:   |                                                  ,t
- v? 1- :2+">"\7p "^"33p:  |                                                   ,i
-  > 1- :2+"v"\7p "^"34p: |                                                    ,m
- >  1- :2+"<"\7p "^"35p:|                                                     ,e
-v                    +55<<<<<                             p6+1*36*88p6*54-1*95<"
->"     redro eht ni detareneg erew snoitcerid ehT">:#,_" tem saw ?">:#,_g1+."s"^
-
-After going in a direction:
-	Subtract one from the counter
-	Place >^v<, according to which direction was taken, in the string
-	Setup the following being done every time this path is taken again, then do it:
-		If the counter is zero, output the number of tries needed and the order of >^v< and stop
-		Add one to the number of tries needed
-		Go back to the ?
− tests/mycology/mycoterm.b98 
@@ -1,57 +0,0 @@-a".deneppah evah dluohs tahw fo noitpircsed dna desu dnammoc eht fo yltsom"v
-v   $_,#! #:<"All these tests are purely I/O related: output will consist "<
-
-> "MRET"4#v(na"...eunitnoc ot retne sserP"a".dedaol MRET">:#,_~$#vCv
-v"loaded."<      v                           "BAD: C reflected"an<
->" ton MR"v      v "C was called, the screen should have cleared."a<
-v     "TE"<      >:#,_a"...D-20 gnillaC"a>:#,_02-#vDa"enil D-20 eht evoba "v
->:#,_$v                v_,#! #:<;#"It reflected"an< ;"This should be right"<
-v   ,a<                >a"...D1 gnillaC"a>:#,_1#vDa"siht evoba enil knalb "v
-                v_,#! #:<;#"BAD: it reflected"an<      ;"There should be a"<
-                >a"...G4f gnillaC">:#,_f3#vGaaaa"enil D1 eht fo thgir eht "v
-         va_,#! #:<;#"BAD: it reflected"an<;"This should be placed by G to"<
-         >"...eunitnoc ot retne sserp ,SU5 htiw hpargarap dnoces eht r"v
-         v"second paragraph was"aa   Sv#Uv#5$~_,#! #:<a"Trying to clea"<
-               v  "BAD: 5U reflected"an  <
-               >;# "BAD: S reflected"a<  ;v
-         >" eht erehw eb won dluohs sihT" >:#,_a"...eunitnoc ot retne sserp"v
-         vaaaaaaaaLv#Hv#$~_,#! #:<"Trying to clear the first line with HL, "<
-                      >na"detcelfer H :DAB"            v
-                   >   na"detcelfer L :DAB"            v
-         >"saw enil tsrif eht erehw eb won dluohs sihT">:#,_v
-v                                                           <
-> "SRCN"4#v(na".dedaol SRCN">:#,_a"...eunitnoc ot retne sserp ,I1 gnillaC"a".nees eb lliw gnihton"v
-v"loaded."<               v", might not work after I: using S instead, so if R and S don't work, "<
->" ton SR"v               >:#,_~$                    1#vIa"...S gnitseT"#@Sa"...gniunitnoc"v
-v     "NC"< v"BAD: 1I reflected, can't test the rest"an<          v   S"S didn't reflect, "<
->           >:#,_a,@                                              >a"...R gnitseT"S#@Ra"tuptuo eb "v
-                                >na"stcelfer P :DAB"  v
-  vPPPPPPPPPPPPPPPPPPPPPPPPPPPPP^#"If this is visible, P works."aRS"R didn't reflect, there should"<
-  >na".krow t'nseod P ,deraeppa P tuoba egassem on fI">S           v
-
-   v"Some sort of beep should have resulted."aRBv# S"Testing B..."a<
-   v                      "BAD: B reflected"an  <
-
-   >SR0#vE  0#vN              >a"neercs eht ot deohce eb t'ndluohs yek eht dna retne sserp ot deen"v
-        >na"stcelfer E0 :DAB"S^S   <v"Press any key to continue... if 0E and 0N worked, you don't "<
-              >na"stcelfer N0 :DAB"^>SR#vG a\ >:!#v_:a%'0+\v
-                   v"BAD: G reflected"an<     ^     /a     <  <- . might not work: int to string
-   v             RS<                       "Got "$<              also used below
-
-   >'x#vU #vG 'x-#v_a"021 si GUx' :DOOG"  >SR 1#vK                    >a"...eunitnoc ot yek noitcn"v
-       >   na"detcelfer  Ux' :DAB"        ^     >na"stcelfer K1 :DAB"S^        vGv#RS"Press any fu"<
-           >a"detcelfer GUx' :DAB"        ^                 v"BAD: G reflected"an<
-                  >na"021 t'nsi GUx' :DAB"^                                    >\ >:!#v_:a%'0+\v
-  vMv#00G  RS"Going to test M, press enter to continue..."RS<"Got "$             ;^  ;<;/a     <
-    >na"C tset t'nac ,stcelfer M :DAB"                 v
-  >a"neercs eht fo pot eht ta eb dluohs sihT"SR  2#vCa"deraelc evah dluohs neercs eht fo tser ehT"v
-                                                       #
-   v"changed"aCv#1M22GRSa"Trying to overwrite above with M and C, press any key to continue..."aRS<
-               #                                       # 
-   >" evah dluohs enil si"SRa"eunitnoc ot yek yna sserP"SR0#vCa"deraelc evah dluohs neercs elohw "v
-                                                   v        <           v                    "The"<
-                                                       >                v
-               >              >                    >na"detcelfer C :DAB"v
-                        v"Press any key to try to end curses mode..."aRS<                     
-                        >SRGn#vIa"dekrow I0 :DOOG">:#,_@
-       @RS"BAD: 0I reflects"an<
− tests/mycology/mycotrds.b98 
@@ -1,64 +0,0 @@-1y2%!#v_"SDRT"4 #v(na".SDRT dedaoL">:#,_     a"..."v     v"Need Befunge-98."+550
-      >na"SDRT tset t'nac ,tnerrucnoc ton smialc y1 "$   >:#,_@
-                 >na".dedaol ton SDRT"                   ^
-vp22_,#! #:<"Splitting IP, concurrency better work"<
->122#vt#vSg\$#v_a"krow ot smees S :DOOG">:#,_'v65p#vC22g!#v_a"skrow C :DOOG"     v
-     >p@      >a"krow t'nseod S :DAB"v             >na"stcelfer C :DAB">:#,_@
-      p >na"stcelfer S :DAB"         >:#,_             v  $
-v     @                                                   >a"krow t'nseod C :DAB">:#,_n
-                                                       #
->a"...emit seunitnoc deppots si emit elihw PI eht gnitanimret fi gnikcehC">:#,_   #vtS@
-v"in case of failure, q will be used to quit."a _,#! #:<"GOOD: apparently it does"a<
->" ...levart emit tset ot gnitratS"a>:#,_a".detaeper eb t'ndluohs nurer eht gnirud tuptuo ,orez tniop"v
-v                      a"But note that if jumping backwards in time is implemented as rerunning from "<
->".desufnoc si reterpretni eht ,seilamona rehto era ereht ro segnahc tuptuo eht fo yna fI "  v
-v_,#! #:<"Much of the output up to and after now, including this, will be output many times."<
-
->#vt><  v        v           _,#! #:<"GOOD: 01-0V didn't reflect"aVv#0-1                       _,#! #:<
-  >"SDRT"4(n f6*aa+#vDa"tcelfer t'ndid D+aa*6f :DOOG">:#,_8d9a+**  #vTa"tcelfer t'ndid T**+a9d8 :DOOG"^
-                 ;  >na"detcelfer D+aa*6f :DAB">:#,_q               >na"detcelfer T**+a9d8   :DAB">:#,_q
->na"ylreporp emit hguorht pmuj t'nseod J :DAB" ^                   > na"detcelfer V0-10      :DAB"^<  :
-|!g11_,#! #:<"GOOD: stack retained after J"a   _v# ,k*b2pe2$'zzzz"GOOD: J jumps in space"a v#<    "
-            ^"BAD: stack not retained after J"an<        >;#_,#! #:<"BAD: V doesn't work"a0<;^    B
->a"emit hguorht pmuj ot sraeppa J :DOOG">:#,_#vI>a"..gnipmuj ,tcelfer t'ndid I :DOOG"3b*k, #vJ    A
-                 ;                            >                       na"detcelfer I :DAB"       #D^
- v$              <           q_,#! #:<"BAD: J reflected trying to jump back to the future"an<     :
-
- >#vG0" dehsup G :FEDNU">:#,_$.a")6985 eb dluohs ,DOOG saw gnihtyreve fi(">:#,_11pv               "
-   >na"stcelfer G :DAB" >:#,_$zzzz1111111111111111111111111111111111111111>:#$_11pv
-                            >na"pmuj detnaw od tonnac ,egral oot si P :DEFNU"                         ^
-v"jumping to tick 1976..."a_^#!`\         ,a. zzz,kd"UNDEF: P gave ":Pv# *+**9ad13<
->" ,enif si lav-P :DOOG"4b*k,zz                                1#vJv  >na"stcelfer P"             ^
-        X                                                        >   >na"detcelfer J"             ^
-v_,#! #:<a"GOOD: came back with IJ, IPs with same ID can coexist"an< ;
-#>                                                                     na"stcelfer R"             ^
->^                                >                                 na"detcelfer E10"             ^ <
-R                                                                            >na"detcelfer U-*:*aa0"^
->a"tcelfer t'ndid R :DOOG">:#,_1-#^Ea"tcelfer t'ndid E-100 :DOOG">:#,_aa*:*-#^U0a"tcelfer t'ndid U-*:" v
-v"d end up at the time that P gave..."a_v#!`+*8ó'\,a.,kd"UNDEF: P gave ":Pp+885: '_,#! #:<"GOOD: 0aa*" <
-'                                       >na"pmuj detnaw od tonnac ,egral oot si P :DEFNU"             ^
-l                                                                   012p@
->"uohs ,00001- kcit ta @ a ot gnipmuj ,enif si lav-P :DOOG"8a*c+k,#vJ;
-        "    @         >                ^                          > ^                            <<
-        >12g#^_n"$"d5*85*pzzv
-vzzzzzzzzzzzzzzzzzzzzzzzzzzz<
->a"dedeeccus evah ot sraeppa emit tseilrae eht ot pmuj :DOOG"a>:#,_#vt"SDRT"4(nzzzzzzzzzzzzzzzv       ;
-v"from being born..."a_^#!`\,a. zzz,kd"UNDEF: P gave ":P T:**+*aa789>#;"SDRT"4(n#;<           z  J^#E40T<
- "estroyed the t instruction that made me, setting Tardis with T and E and jumping back..."<vzzz-1*a9D'
->" fles tneverp ot 4077 kcit ot gniog ,enif si lav-P :DOOG"7a*4+k,z#vJ' 7a*1-4b*p'$d5*4b*pa^>z k,79bc***^
-zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz$>#zzzzzzzzzzzzzzzzzzzzzz #<    ^  ; v
-v"er back to wait for the first to arrive..."a     ,k*57azz "GOOD: got back and am still alive."a<      5
->"htruf pmuj rehtona dna ,kcab pmuj ot tuoba PI enO"9a*1+k,zzzz 77abb***+ T 169*D       v               a
-vzz "GOOD: P-val is fine for both jumps..."a_v#!`\,a. zzz,kd"UNDEF: P gave ":P ***dda5  <               d
->73a*+k,#vJ >zzzzzzzzzzzzzzzzzzzzzzzzv       >na"pmuj detnaw od tonnac ,egral oot si P :DEFNU">:#,_ q   d
-         > #^zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz#<       >   >           ^    *
- 132pa".pmuj ts1 diD"dk,zzz @       >a"emit no devirra PI ts1 :DOOG"47*zzzz]"Doing 2nd jump..."aD*b51T**<
- >032p'$:74d*p29a*+87*pzzzzzzzzzz32g|z                                     >      >k,I#^J
-v;                                  >a"emit no evirra t'ndid PI ts1 :FEDNU"57*zzzz^;  J^# $_,#! #:<zzz<
-                                     z                       vzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz<
-                                     >$$zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz^
-                                                             >zzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzzz^
-
->a"...89b.sdrtocym gnitixe ,enod llA"aa".enif si emit dnoces eht ylno gnivirra tI"v
-v      "Note that if the first IP didn't arrive on time both times, that is BAD."a<
->a"gnitset PI elpitlum morf denruter :DOOG"a>:#,_@
− tests/mycology/mycouser.b98 
@@ -1,25 +0,0 @@-92#v/4-#v_55+"4 = 2 / 9 :DOOG">:#,_92#v%1-#v_55+"1 = 2 % 9 :DOOG">:#,_ vv$$$$$$<
-   >055+ "stcelfer / :DAB"    ^>'",,@ >055+ "stcelfer % :DAB"    ^     5>$$$  v$
-        >055+"4 =! 2 / 9 :DAB"^^ a_,#! #:<;>055+"1 =! 2 % 9 :DAB"^;<   5v" wo"<$
-v,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,,"About to test division by zero..."+<>",de"v$
->10#v/#v_055+"0 = 0 / 1 :DOOG"   >:#,_  10#v%   #v_055+"0 = 0 % 1 :DOOG"v     "$
-    >05 5+"...)llits( stcelfer /"^        $0    $0"UNDEF: 1 / 0 != 0," <      d$
-       >055+"noisivid 89-egnuF tcerrocni r"# "o " "nevig rewsna gnorw "^      a"
-v"answer given or incorrect Funge-98 division"+55<       >      >:#,_#<#<    #ov
-                            <  >55+"stcel"v>55+"...)llits( stcelfer %"^v^    ""
->" gnorw ,0 =! 0 % 1 :FEDNU"^   @_,#! #:< # *25"UNDEF: STRN fingerprint not l"<v
-" :rebmun a tupni esaelP">:#,_#^&0" tog :FEDNU">:#,_$.$55+".tcerroc "         v>
-"yllufepoh si hcihw">:#,_           v     >"fer & :DAB"55+".dnim reveN">:#,_v >
->:#,_v#:"Please input a character: "<                                       <  X
- v < >#v~0" tog :FEDNU">:#,_$:."'",,$55+".tcerroc yllufepoh si hcihw '">:#,_   v
-#v~^  v>55+"stcelfer ~ :DAB"55+".dnim reveN"             >:#,_                 >
- > ">:#,_@" $$$$$$$ 52*:"~ & % / :snoitcurtsni gniwollof eht gnikcehc enod llA"v
-v55_,#! #:<"Loaded BASE fingerprint: testing I instruction."an(v#4"BASE"_,#! #:<
-    #:<"UNDEF: BASE fingerprint not loaded, won't check I."*520<  >:#,_@  v _,#!
-+  ;^>0\"detcelfer I :DAB"; x3*a5 a"BAD: & reflected. Never mind..."\0<   #
->"...krow snoitcurtsni 89-egnufeB gnimussA">:#,_" ?ni tupni daer ot esab hcihW"v
-v    # "Input a number in that base: "0,a.:$_,#! #:<"Selected base "\&^#_,#! #:<
->:#,_$#vI\" tog :FEDNU">:#,_$.a".tcerroc yllufepoh si hcihw">:#,_$   v$_,#! #:<"
-v".."an<;a"BAD: I reflected"a"As 10I should probably " <v n(v#4"STRN"<"^ "<"!:;
->".esab dilav a rof tcelfer t'ndluohs I ,& ekil evaheb"^>' v>025*".I kcehc t'n"^
- '"'I^#    _,#! #:<a"Loaded STRN: testing I. Please input:"<       v"UNDEF: got"
− tests/mycology/readme.txt 
@@ -1,527 +0,0 @@-This is the Mycology Befunge-98 test suite, by Matti "Deewiant" Niemenmaa.
-
-To contact me, E-mail me. The address for Mycology-related things is
-matti.niemenmaa+mycology at the domain iki.fi.
-
-Mycology is licensed under the so-called 3-clause BSD license. See license.txt
-for the text of the license.
-
-Contents of this readme:
-	Recent changes
-	Quick summary
-	More detailed info
-	Fingerprints
-	Notes on particular messages
-		"# across left edge"
-		"101-{}"
-		"4k #" and "2k ;;;5"
-		"2k6"
-	Old changes
-
-Recent changes
---------------
-
-	2010-04-01    - Fixed error message in bounds shrinking test.
-	2010-03-25    - New fingerprints: REXP and FING.
-	              - The y position error is no longer fatal.
-	              - Fixed stack misalignment in y test with bad storage offset.
-	              - Test o in linear text file mode. Thanks to Arvid Norlander
-	                for pointing out that it is possible after all.
-	2010-03-23    - New fingerprint: 3DSP.
-	2010-03-21    - Made the u complaint about the storage offset BAD, not
-	                UNDEF: in most cases it's an error and the tester should
-	                know when it isn't anyway.
-	2010-03-20    - Test proper bounds shrinking by y.
-	2010-03-19    - Test correct form feed handling.
-	              - Made the first negative space test use (-3,-2) instead of
-	                (-1,-1).
-	2010-03-18    - Don't test o if y claims it isn't supported.
-	              - INDV: check proper storage offset application.
-	              - Test ' with a value greater than 127.
-
-For pre-2010 changes, see the full changelog at the bottom of the file.
-
-Quick summary of how to test your Befunge interpreter:
--------------
-
-	- If, at any point, you get messages beginning with "BAD:", correct the
-	  issues before moving on to the next step.
-	- If your interpreter needs any command line switches for
-	  standard-conforming mode, use them.
-	- Run sanity.bf and make sure it outputs "0 1 2 3 4 5 6 7 8 9 ".
-	- Run mycology.b98, make sure it outputs "0 1 2 3 4 5 6 7 " and that there
-	  are no lines beginning with "BAD:" anywhere in the output.
-	- If your interpreter is Befunge-93 only, run mycorand.bf and examine the
-	  results.
-	- Run mycouser.b98: for complete testing, run it a few times and try giving
-	  it both valid and invalid input.
-	- If your interpreter should support one or both of the NCRS and TERM
-	  fingerprints, run mycoterm.b98.
-	- If your interpreter should support the TRDS fingerprint, run mycotrds.b98.
-
-More detailed info:
--------------------
-
-Files with the .bf extension are valid Befunge-93 source code, while *.b98 are
-intended for Befunge-98 interpreters. mycology.b98 and mycouser.b98 are
-exceptions: they work in both standards - if the standards are implemented
-correctly.
-
-Note for Befunge-93: mycology.b98 is much bigger than the 80x25 allowed in
-Befunge-93. If your interpreter bails out on a file bigger than the maximum
-allowed, you can simply take the 80x25 square starting at the top left corner
-of mycology.b98 into a separate file and use that for testing.
-
-In order to test the absolute basics of the interpreter, feed it the file
-sanity.bf. This tests that the IP (instruction pointer) begins at the correct
-point in Funge-Space and moves in the correct direction. In addition, it makes
-sure the following instructions work:
-
-Decimal  ASCII  Instruction
-
-  32            Space
-  35       #    Trampoline
-  46       .    Output Decimal
-  48       0    Push Zero
-  49       1    Push One
-  50       2    Push Two
-  51       3    Push Three
-  52       4    Push Four
-  53       5    Push Five
-  54       6    Push Six
-  55       7    Push Seven
-  56       8    Push Eight
-  57       9    Push Niner
-  64       @    Stop
-
-The above are the absolute minimum which the interpreter must support. In
-addition, it should reflect upon encountering an instruction it does not
-recognize.
-
-sanity.bf will, if the interpreter supports all of the above, output the string
-"0 1 2 3 4 5 6 7 8 9 ". If it doesn't, anything might happen: sanity.bf does
-_not_ fail safe.
-
-Hereafter the actual testing in mycology.b98 can be conducted. The initial
-behaviour of the program is to output a code, using the Output Decimal
-instruction, after having successfully tested a certain instruction. These
-codes are as follows:
-
-Code  Decimal  ASCII  Instruction         Notes
-
- 0      62       >    Go East
- 1     118       v    Go South
- 2      60       <    Go West
- 3      94       ^    Go North
- 4      36       $    Pop                 Explicitly testing whether popping an
-                                          empty stack works as it should is
-                                          done separately, later.
-
- 5      34       "    Toggle Stringmode   If no reflection on the instruction
-                                          occurs, but the string's contents are
-                                          interpreted as instructions, a second
-                                          "4 " is output before exiting.
-
- 6      95       _    East-West If        If the comparison is done incorrectly
-                                          (i.e. the wrong direction is taken)
-                                          an additional "5 " is output.
-
- 7      43       +    Add
-
-For example, if the interpreter emits only "0 1 ", the Go East and Go South
-instructions were correctly interpreted, but a reflection occurred upon meeting
-Go West. A conforming interpreter should output every code in the listing once.
-
-These tests are very simple, due to the basic nature of the instructions
-involved. All that is tested is whether a reflection occurs or not. If
-mycology.b98 claims that an instruction which appears to work perfectly is
-failing, make sure that the above do what they should.
-
-Having tested the above, mycology.b98 tests the Output Character instruction
-and hence reverts to plain English output. If there is no output after code 7,
-the Output Character instruction does not function as it should.
-
-The output format changes to lines beginning with "BAD:" or "GOOD:", followed
-by a description of what the interpreter does wrong or correctly, respectively.
-Some, but not all, "BAD" lines are followed by a Stop instruction - these tend
-to be features which are deemed useful enough that they are used later in the
-program. (Or, possibly, features which may be used later, but aren't: it's hard
-to modify Befunge source code after it's first written, so there may be some
-cases where a Stop isn't necessary but is there anyway.) In some cases, a Stop
-was added to simplify the code: the Befunge-93 area is particularly snarly,
-since space is at a premium.
-
-Some lines begin with "UNDEF:". This means that the specification is either
-ambiguous or completely ignorant of an issue, and so different possibilities
-are acceptable. It is possible that some such undefined cases may result in
-"BAD:" if the interpreter does something completely unexpected, but there is no
-"GOOD:" equivalent, only "UNDEF:".
-
-Some comment lines not beginning with "BAD:", "GOOD:", or "UNDEF:" are also
-emitted occasionally, in order to clarify what is going on.
-
-Other notes on mycology.b98:
-
-	Befunge-93 detection relies on the interpreter using only the first 80
-	characters of lines, since Befunge-93 has a Funge-Space of 80x25 cells.
-
-	The checks are generally very simple. For instance, if the Subtract or
-	Multiply instructions empty the stack, they will be considered to work
-	properly: only a few checks are done, and they all check for zero.
-
-	Instructions are assumed to work if they pass one test (for the more
-	complicated instructions, more tests are needed, but every behaviour of the
-	instruction is still tested only once). If, for instance, an instruction
-	works the first 41 times and randomly fails every third time after that,
-	Mycology will probably not detect it, but will silently fail or, in the
-	worst case, pass.
-
-	Instructions are assumed to be at least somewhat sane: e.g. | should either
-	reflect or pop a cell and cause the IP to start moving north or south. Not
-	east or west, or to teleport to a random location in Funge- Space, or push
-	72 ampersands onto the stack. It is the tester's responsibility, not
-	Mycology's, to make sure that the interpreter doesn't go crazy and perform
-	malicious acts. You use Mycology at your own risk.
-
-See the end of this file for notes on particular messages.
-
-The following instructions are _not_ tested by mycology.b98 (those preceded by
-an asterisk are tested if the interpreter is detected as supporting
-Befunge-98):
-
-Decimal  ASCII  Instruction
-
-  37       %    *Remainder
-  38       &    Input Decimal
-  47       /    *Divide
-  61       =    Execute
-  63       ?    *Go Away
- 126       ~    Input Character
-
-The division and input instructions are tested in mycouser.b98 because they all
-require user intervention (the division instructions only when dividing by
-zero, but I felt it would be better to not split the testing of an instruction
-into two files). Their correct behaviour is also very difficult to verify
-without a knowledgeable user.
-
-Go Away is tested separately in mycorand.bf because it takes too much space to
-fit in the Befunge-93 area of mycology.b98. If the Befunge-98 instruction Input
-File works, mycorand.bf is loaded using it and Go Away is thus tested in
-mycology.b98.
-
-Execute is completely untested, because to get a reliable result would require
-testing various commands and noting their behaviours on different platforms. An
-educated guess regarding the user's platform is in order, and overall it would
-be too complicated. It is simplest to test this manually, rather than to try to
-cater for all cases in a suite such as Mycology.
-
-Implementation notes regarding mycorand.bf:
-
-	Beware! If Go Away is unimplemented and thus reflects, an infinite loop
-	is entered!
-
-	The testing is very simple: it is only made sure that Go Away causes the
-	instruction pointer to go at least once in every cardinal direction,
-	though it is always encountered from the same direction.
-
-	The number of tries it took to successfully go in every direction is
-	output, so an interpreter's implementer can make sure the number
-	fluctuates somewhat. The order in which the directions were generated is
-	also output, so that it can be verified that the order isn't always the
-	same.
-
-Make sure that the interpreter successfully passes the Befunge-93 area of
-mycology.b98 before loading mycorand.bf or mycouser.bf!
-
-Regarding fingerprints
-----------------------
-
-mycology.b98 tests every fingerprint that I am aware of, apart from FNGR, SGNL,
-and WIND. It is completely up to the interpreter's writer(s) whether any should
-be supported: a completely specification-conforming interpreter does not need
-to support any fingerprint at all, as long as the ( "Load Semantics" and )
-"Unload Semantics" instructions perform correctly.
-
-FNGR is not tested because its specifications contradict the Befunge-98
-specifications. It contains operations for performing on a single fingerprint
-stack, but the specifications for Befunge-98 state that there should be a stack
-of semantics for each instruction in the range [A, Z]. RC/Funge-98, the (only,
-as far as I know) interpreter implementing FNGR, fails some of Mycology's tests
-due to this.
-
-SGNL is not tested simply because it is platform-specific. There is no
-technical obstacle to it, only my own convictions regarding platform-specific
-code. If anybody wishes to write code to test it, feel free to send it to me,
-it may be worthy of addition to Mycology.
-
-WIND is not tested because I do not wish to support it in my interpreter, and
-thus I didn't feel like writing tests for it. RC/Funge-98 is the only
-interpreter supporting it, and if I had discovered any bugs in it I would have
-had to delve into unfamiliar code to make it even possible to test the whole
-thing. I decided it was too much work and left it out. Once again, the addition
-of WIND to Mycology is perfectly fine, but I won't be the one to write the
-code.
-
-The list of fingerprints which are tested:
-
-	Official Cat's Eye Technologies fingerprints:
-
-		"HRTI"  0x48525449  High-Resolution Timer Interface
-		"MODE"  0x4d4f4445  Funge-98 Standard Modes
-		"MODU"  0x4d4f4455  Modulo Arithmetic Extension
-		"NULL"  0x4e554c4c  Funge-98 Null Fingerprint
-		"ORTH"  0x4f525448  Orthogonal Easement Library
-		"PERL"  0x5045524c  Generic Interface to the Perl Language
-		"REFC"  0x52454643  Referenced Cells Extension
-		"ROMA"  0x524f4d41  Funge-98 Roman Numerals
-		"TOYS"  0x544f5953  Funge-98 Standard Toys
-		"TURT"  0x54555254  Simple Turtle Graphics Library
-
-	RC/Funge-98 fingerprints:
-
-		In all cases, the documentation is considered the primary source of how
-		an instruction should behave. Precise semantics have been inferred from
-		the RC/Funge-98 source code where not properly documented.
-
-		For all fingerprints involving vectors, RC/Funge-98 doesn't, for some
-		reason, use the IP's storage offset. Thus, the tests assume the same
-		behaviour.
-
-		"3DSP"  0x33445350  3D space manipulation extension
-		"BASE"  0x42415345  I/O for numbers in other bases
-		"CPLI"  0x43504c49  Complex Integer extension
-		"DATE"  0x44415445  Date functions
-		"DIRF"  0x44495246  Directory functions extension
-		"EVAR"  0x45564152  Environment variables extension
-		"FILE"  0x46494c45  File I/O functions
-		"FING"  0x46494e47  Operate on single fingerprint semantics
-		"FIXP"  0x46495850  Some useful math functions
-		"FPSP"  0x46505350  Single precision floating point
-		"FPDP"  0x46504450  Double precision floating point
-		"FRTH"  0x46525448  Some common forth [sic] commands
-		"IIPC"  0x49495043  Inter IP [sic] communicaiton [sic] extension
-		"IMAP"  0x494d4150  Instruction remap extension
-		"INDV"  0x494e4456  Pointer functions
-		"REXP"  0x52455850  Regular Expression Matching
-		"SOCK"  0x534f434b  tcp/ip [sic] socket extension
-		"STRN"  0x5354524e  String functions
-		"SUBR"  0x53554252  Subroutine extension
-		"TERM"  0x5445524d  Terminal control functions
-		"TIME"  0x54494d45  Time and Date functions
-		"TRDS"  0x54524453  IP travel in time and space
-
-	Jesse van Herk's extensions to RC/Funge-98:
-
-		"JSTR"  0x4a535452
-		"NCRS"  0x4e435253  Ncurses [sic] extension
-
-	GLFunge98 fingerprints:
-
-		"SCKE"  0x53434b45
-
-Notes on particular messages output by mycology.b98
----------------------------------------------------
-
-"UNDEF: # across left edge..."
-..............................
-
-Here, the line and file cases are considered separately. This is because some
-interpreters consider the Funge-Space as a rectangle: see below, using 0 to
-mark empty cells which are outside Funge-Space.
-
->    v000
-v    >  >
-@00000000
-
-Even though the file doesn't contain the three spaces at the end of the first
-line, or any of the spaces at the end of the third line, the program's
-representation of Funge-Space does, because Funge-Space is padded out to the
-width of the longest line in the file.
-
-Because jumping across the edge of Funge-Space isn't mentioned in the
-specification, one cannot be sure as to what should happen. If it is considered
-that Funge-Space is infinitely surrounded by spaces, jumping across the edge of
-space shouldn't skip over anything. On the other hand, # jumps over "the next
-Funge-Space cell in [the instruction pointer's] path", which might not include
-this void.
-
-However, it may be that an existing space cell which is not part of this void
-is skipped over. Thus, both jumping over the edge of the physical edge of the
-file, with only the void in between, and jumping over the edge of a line which
-is shorter, but may contain the spaces as the 0s in the above example, are
-tested. Most interpreters have different behaviour for the two.
-
-"BAD: 101-{} doesn't leave stack top as 0 and next as 1"
-........................................................
-
-This is something which may be tricky to get right. Let's examine what happens.
-On each following line, the instruction comes first, followed by the stack
-stack, with the contents of each stack in square brackets, starting at the
-bottom.
-
-1 [1]
-0 [1, 0]
-1 [1, 0, 1]
-- [1, -1]
-
-This part is trivial. What happens next, however, varies.
-
-One incorrect possibility:
-{ [1, 0, 0], []
-} [1]
-
-Here, { pushes abs(-1) zeroes onto the SOSS before a new stack is pushed. Since
-there was no SOSS at that time, the zero pushed doesn't appear.
-
-This is the behaviour of the Flaming Bovine Befunge Interpreter version
-2003.0326, amended with the 2003.0722 and 2003.0726 patches.
-
-Another:
-{ [1, 0, 0], [0]
-} [1]
-
-It seems that here, abs(-1) zeroes are being pushed on the TOSS instead of the
-SOSS.
-
-This is the behaviour of the RC/Funge-98 interpreter, version 1.07, as well as
-of the RC/Funge-98 interpreter modified by Jesse van Herk, version 1.05.
-
-What should happen:
-{ [1, 0, 0, 0], []
-} [1, 0]
-
-This is the behaviour of the Conforming Concurrent Befunge-98 Interpreter,
-version 1.00.
-
-Let's see what the spec has to say about the subject:
-
-	"The { 'Begin Block' instruction pops a cell it calls n, then pushes a new
-	stack on the top of the stack stack, transfers n elements from the SOSS to
-	the TOSS, then pushes the storage offset as a vector onto the SOSS..."
-
-	"If n is negative, |n| zeroes are pushed onto the SOSS."
-
-In other words, { should:
-
-	Pop the -1 from the stack.                      [1]
-	Push a new stack on the stack stack.            [1], []
-	Since -1 < 0, push |-1| = 1 zero onto the SOSS. [1, 0], []
-	Push the storage offset onto the SOSS.          [1, 0, 0, 0], []
-
-"BAD: 4k #..." and "BAD: 2k ;;;5..."
-....................................
-
-In Funge-98, spaces and semicolons are ethereal. The "next instruction"
-mentioned in the spec refers specifically to the next instruction the
-interpreter would execute if the k would not be there.
-
-Hence, k always executes its operand at the k, but reaches past all spaces and
-semicolons to find the operand. Hence 2k ;;;5 should execute the 5 twice at the
-k. (See the next section for the reason why it should be executed a third time
-afterward.)
-
-"BAD: 2k6..."
-.............
-
-The specification does not say that the operand should be skipped over after
-execution. The only special case is when the amount of times to execute is
-zero.
-
-This means that 2k6 should indeed first push 2 sixes at the k, and then a third
-when encountering the 6 itself.
-
-This also means that there is no way to execute an instruction only once: 1k6
-results in two sixes. (Another IP may certainly modify the 6 immediately after
-the k is executed, but that's a somewhat unlikely case and not exactly a good
-way to handle this limitation.)
-
-The spec is somewhat unclear on the entirety of k, but both of the above issues
-have been confirmed with Chris Pressey.
-
-Old changes
------------
-
-	2009-05-13    - MycoTRDS accepts P-values greater than 0 and reports
-	                unacceptable values as UNDEF, not BAD.
-	2009-04-04    - Made the u test not abort if the storage offset isn't (0,0).
-	              - Bugfix: u outputs the correct error message if it fails with
-	                a positive count.
-	2009-03-31    - Bugfix: some w were misaligned in the TOYS test.
-	2009-03-29    - Bugfix: 1y bits testing was really broken, really fixed it
-	                now.
-	2009-03-28    - Update: FILE's R really should reflect at EOF.
-	              - Update: removed the 'G to an infinite loop' test from STRN,
-	                        it makes sense that it does indeed loop forever.
-	              - Bugfix: it was always claimed that I/O was buffered.
-	              - Bugfix: 1y being greater than 15 was complained about:
-	                        should have been 31.
-	2008-11-15    - ) with a negative count wasn't actually tested, ( was used
-	                both times.
-	2008-10-17    - If o doesn't work, it is reported that i in binary mode will
-	                not be tested.
-	2008-09-21    - Fixed a misalignment in the fingerprint loading code.
-	2008-09-16    - MycoTRDS now expects ticks to start from zero, thus the
-	                expected value of G is one lower.
-	2008-09-15    - Fixed a misalignment in the u test with a negative argument.
-	2008-09-14    - Made the wraparound with non-cardinal delta test catch a
-	                common case.
-	2008-09-13    - Bugfix: test for k with negative argument was expecting
-	                incorrect k behaviour.
-	              - Bugfix: "GOOD: SGML spaces" was never output, who knows for
-	                how long that's been disabled.
-	              - Bugfix: IMAP check for non-ASCII now says it works when it
-	                works.
-	              - Update: IMAP check for non-ASCII is now GOOD when it works
-	                and BAD otherwise, per the latest spec.
-	              - Update: IMAP now checks mappings outside range 0-255.
-	              - Update: INDV now expects the logical order, reporting BAD
-	                otherwise.
-	2008-09-12    - Reduce stacking in HRTI test.
-	              - Corrected typo in a TOYS error message.
-	2008-09-10    - Made the check for wraparound with non-cardinal delta a bit
-	                stricter (instead of a delta of (12,0) it uses (13,2)).
-	2008-09-06    - Fixed a misspelled error message in mycouser.b98 for
-	                Befunge-93 interpreters.
-	              - Fixed a bug in 2k6 testing that led to an infinite loop.
-	2008-08-30    - Fixed the case where SCKE is included in SOCK.
-	2008-08-28    - SOCK and SCKE fixed: much code still assumed that A
-	                overwrites the original socket, and thus wrong sockets were
-	                being given to K and P.
-	2008-08-20    - Bugfix: results for the ;; concurrency test were off by one.
-	              - Test new A and O instructions in SUBR.
-	2008-08-19    - Bugfix: results for the concurrency tests 5kz and "a  b"
-	                were incorrect.
-	2008-08-14    - New fingerprint: DATE.
-	2008-08-13    - I had managed to get the way y should work as a pick
-	                instruction completely wrong. Thanks to Johannes Laire for
-	                noticing this and notifying me.
-	2008-08-11    - Removed PNTR (the same as INDV), it wasn't meant to exist
-	                any more.
-	2008-08-09    - The new addition to the FILE fingerprint, D, is now tested.
-	              - Using it, created .tmp files can now be removed from within
-	                Mycology.
-	2008-07-26    - Thanks to Arvid Norlander, Chris Pressey, and Mike Riley,
-	                none of k is UNDEF any longer, and some tests were changed
-	                to reflect the intended behaviour.
-	              - Expanded the null byte test.
-	              - Bugfix: in SOCK, the original socket should /not/ be
-	                destroyed: flipped a GOOD and BAD.
-	2008-07-19    - Now testing whether null bytes are handled correctly.
-	2008-05-02    - Bugfix: mycouser.b98 had a forgotten r in place of a (.
-	2008-03-30    - Bugfix: J test in SUBR was misaligned.
-	2008-03-29    - Bugfix: D failing in TOYS had no error message.
-	              - Bugfex: L and R in TOYS had incorrect error messages.
-	2008-03-15    - Bugfix: time output for hours <= 10 was incorrect.
-	2008-03-13    - Bugfix: a missing ; caused an incorrect error message.
-	2008-03-11    - i and o are now UNDEF if unavailable.
-	              - PERL is now tested with "5-1" instead of the palindromic
-	                "2+2". Thanks to Alex Smith for the input.
-	2008-02-02    - 1k # now considered UNDEF.
-	2008-01-09    - More typos or incorrect messages.
-	2007-12-02    - Corrected some typos.
-	2007-09-22    - Minor bugfixes.
-	2007-09-20    - Public release.
-	2007-07-26    - Creation of mycoterm.b98 and mycotrds.b98.
-	2007-06-17    - Creation of mycouser.b98.
-	2007-01-06    - Creation of mycorand.bf.
-	2006-12-31    - Creation of sanity.bf and mycology.b98.
− tests/mycology/sanity.bf 
@@ -1,1 +0,0 @@-9876543210 ..... ..... #@ Intentionally invalid instruction, should reflect
− tests/refc.bf 
@@ -1,2 +0,0 @@-<vn(4"REFC"- >12R34R56RDDD@
− tests/roma.bf 
@@ -1,2 +0,0 @@-<v(4"ROMA"- >CDILMVX@
− tests/string93Mode.bf 
@@ -1,1 +0,0 @@-<@"Hello    world! My name is Betty."B(4"BF93"
− tests/stringMode.bf 
@@ -1,1 +0,0 @@-<@"today is    Monday!"
− tests/stringModeWrap.bf 
@@ -1,6 +0,0 @@-v   Upon exit, stack from top to bottom should be:-    GOOD: [60,64,32]-    BAD: [60,32,64,32]-->                                                      v   -@                                                     "<