Fungi 1.0.2 → 1.0.3
raw patch · 83 files changed
+1792/−62 lines, 83 filesdep +haskell98dep +tuplebinary-added
Dependencies added: haskell98, tuple
Files
- Data/I.hs +2/−1
- Data/IntegralLike.hs +15/−2
- Data/Tuple/Map.hs +16/−0
- Fingerprint.hs +8/−7
- Fingerprint/BF93.hs +82/−0
- Fingerprint/BZRO.hs +89/−0
- Fingerprint/FIXP.hs +3/−1
- Fingerprint/MODE.hs +8/−6
- Fingerprint/NOP.hs +15/−0
- Fingerprint/NULL.hs +0/−1
- Fingerprint/ORTH.hs +1/−1
- Fungi.cabal +46/−3
- Fungi.hs +26/−6
- Instruction.hs +40/−10
- Mode.hs +4/−1
- ProcessArgs.hs +14/−8
- README +3/−0
- Semantics.hs +24/−12
- Tester.hs +79/−0
- Text/Help/Fingerprint.hs +68/−0
- Text/Help/Fingerprint/BASE.hs +19/−0
- Text/Help/Fingerprint/BF93.hs +33/−0
- Text/Help/Fingerprint/BOOL.hs +18/−0
- Text/Help/Fingerprint/BZRO.hs +79/−0
- Text/Help/Fingerprint/CPLI.hs +20/−0
- Text/Help/Fingerprint/FIXP.hs +30/−0
- Text/Help/Fingerprint/HRTI.hs +21/−0
- Text/Help/Fingerprint/MODE.hs +18/−0
- Text/Help/Fingerprint/MODU.hs +19/−0
- Text/Help/Fingerprint/NOP.hs +14/−0
- Text/Help/Fingerprint/NULL.hs +14/−0
- Text/Help/Fingerprint/ORTH.hs +28/−0
- Text/Help/Fingerprint/REFC.hs +35/−0
- Text/Help/Fingerprint/ROMA.hs +21/−0
- Text/Help/Fungi.hs +12/−1
- Text/PrintOption.hs +33/−1
- Version.hs +1/−1
- runTests.bash +1/−0
- tests/bad/execute.bf +1/−0
- tests/bad/fingers/bzro/quit.bf +1/−0
- tests/bad/quit.bf +1/−0
- tests/bad/quit2.bf +1/−0
- tests/base.bf +3/−0
- tests/bool.bf +2/−0
- tests/good/concurrent.bf +2/−0
- tests/good/concurrent2.bf +2/−0
- tests/good/direction.bf +6/−0
- tests/good/execute.bf +1/−0
- tests/good/fingers/bzro/bizarro_hover.bf +1/−0
- tests/good/fingers/bzro/goEast.bf +1/−0
- tests/good/fingers/bzro/hover_bizarro.bf +3/−0
- tests/good/fingers/bzro/reflectB.bf +1/−0
- tests/good/fingers/bzro/stop.bf +1/−0
- tests/good/fingers/bzro/stop_quit.bf +2/−0
- tests/good/fingers/bzro/stringmode.bf +1/−0
- tests/good/fingers/bzro/stringmode2.bf +5/−0
- tests/good/fingers/bzro/turnOffBizarro.bf +2/−0
- tests/good/fingers/mode/hoverEast.bf +1/−0
- tests/good/goAway.bf +23/−0
- tests/good/inputFile.bf +6/−0
- tests/good/inputFile.dat +3/−0
- tests/good/jumpForward.bf +7/−0
- tests/good/jumpOver.bf +2/−0
- tests/good/math.bf +4/−0
- tests/good/quit.bf +1/−0
- tests/good/stop.bf +1/−0
- tests/good/trampoline.bf +3/−0
- tests/good/turn.bf +7/−0
- tests/good/wrap.bf +10/−0
- tests/mode.bf +2/−0
- tests/mycology/license.txt +24/−0
- tests/mycology/mycology.b98 binary
- tests/mycology/mycorand.bf +16/−0
- tests/mycology/mycoterm.b98 +57/−0
- tests/mycology/mycotrds.b98 +64/−0
- tests/mycology/mycouser.b98 +25/−0
- tests/mycology/readme.txt +527/−0
- tests/mycology/sanity.bf +1/−0
- tests/refc.bf +2/−0
- tests/roma.bf +2/−0
- tests/string93Mode.bf +1/−0
- tests/stringMode.bf +1/−0
- tests/stringModeWrap.bf +6/−0
Data/I.hs view
@@ -5,6 +5,7 @@ import Data.Bits import Data.ByteSize import Data.Int+import Data.IntegralLike import Data.MaybeBounded import Text.PrettyShow@@ -14,7 +15,7 @@ ----------------------------------------------------------- -- The I type class is intentionally empty. Used to clump the type classes.-class (Bits i, ByteSize i, Integral i, MaybeBounded i, PrettyShow i, Random i, Read i) => I i where+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
Data/IntegralLike.hs view
@@ -3,6 +3,7 @@ ) where import Data.Char (ord)+import Data.Int ----------------------------------------------------------- @@ -16,9 +17,21 @@ instance IntegralLike Char where asIntegral = fromIntegral . ord +instance IntegralLike Integer where+ asIntegral = fromInteger+ instance IntegralLike Int where asIntegral = fromIntegral -instance IntegralLike Integer where- asIntegral = fromInteger+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/Tuple/Map.hs view
@@ -0,0 +1,16 @@+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+
Fingerprint.hs view
@@ -8,16 +8,20 @@ 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.REFC as REFC@@ -27,24 +31,21 @@ type Fingerprints i = Map Integer [(i, Instruction i ())] -mapFst :: (a -> c) -> (a, b) -> (c, b)-mapFst f (x, y) = (f x, y)--mapSnd :: (b -> c) -> (a, b) -> (a, c)-mapSnd f (x, y) = (x, f y)- asId :: String -> Integer asId = fromIntegral . foldl' (\fId x -> fId * 256 + x) 0 . map ord fingerprints :: (I i) => Fingerprints i-fingerprints = foldr (uncurry (insert . asId) . mapSnd (map $ mapFst asIntegral)) Map.empty [+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) , (REFC.name, REFC.semantics)
+ Fingerprint/BF93.hs view
@@ -0,0 +1,82 @@+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/BZRO.hs view
@@ -0,0 +1,89 @@+module Fingerprint.BZRO (+ name+ , semantics+ ) where++import Prelude hiding (lookup)++import Control.Monad.State.Strict++import Data.Char (chr, ord)+import Data.Map (Map)+import Data.Tuple.Map++import Space.Cell++import Env+import Instruction+import Ip+import Mode+import 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 $ removeOverlay Mode.Bizarro . getSemantics . currentIp+ case lookup i sem of+ Just instr -> instr+ Nothing -> unknownInstr i+ 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/FIXP.hs view
@@ -94,7 +94,9 @@ pow10 = 10 ^ (length (show pi) - 1) qInstr :: (I i) => Instruction i ()-qInstr = opInstr $ fromInteger . squareRoot . fromIntegral+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
Fingerprint/MODE.hs view
@@ -89,8 +89,10 @@ hInstr :: (I i) => Instruction i () hInstr = do- modify $ withIp $ toggleMode Mode.Hover- modify $ withSemantics $ Semantics.toggleOverlay Mode.Hover hovermodeInstructions+ 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@@ -100,8 +102,8 @@ sInstr :: (I i) => Instruction i () sInstr = do- modify $ withIp $ toggleMode Mode.Switch- modify $ withSemantics $ Semantics.toggleOverlay Mode.Switch switchmodeInstructions--+ modify $ withIp $ toggleMode mode+ modify $ withSemantics $ Semantics.toggleOverlay mode switchmodeInstructions+ where+ mode = Mode.Switch
+ Fingerprint/NOP.hs view
@@ -0,0 +1,15 @@+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 view
@@ -13,4 +13,3 @@ semantics :: (I i) => [(Char, Instruction i ())] semantics = zip ['A'..'Z'] $ repeat reverseInstr -
Fingerprint/ORTH.hs view
@@ -87,7 +87,7 @@ modify $ withSpace $ \s -> putCell s (chrCell x) $ takeV dim $ loc `append` 0 zInstr :: (I i) => Instruction i ()-zInstr = ifInstr nopInstr $ replicateM_ 2 moveByDeltaInstr+zInstr = ifInstr nopInstr trampolineInstr sInstr :: (I i) => Instruction i () sInstr = do
Fungi.cabal view
@@ -7,7 +7,7 @@ -- 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.2+Version: 1.0.3 -- A short (one-line) description of the package. Synopsis: An interpreter for Funge-98 programming languages, including Befunge.@@ -36,8 +36,22 @@ -- a README. -- Extra-source-files: -Cabal-version: >=1.2+Cabal-version: >= 1.6 +Extra-source-files:+ 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 @@ -57,6 +71,8 @@ , old-time >= 1.0 , process >= 1.0 , random >= 1.0+ , tuple >= 0.2+ , haskell98 >= 1.0 -- Modules not exported by this package. Other-modules:@@ -69,18 +85,22 @@ Data.LogicalBits Data.MaybeBounded Data.Stack+ 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.REFC@@ -98,12 +118,35 @@ 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.REFC+ Text.Help.Fingerprint.ROMA Text.PrettyShow Text.PrintOption UnknownInstruction Version- +++++ -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source. -- Build-tools: ++++
Fungi.hs view
@@ -1,5 +1,6 @@ module Fungi ( main+ , mycology ) where import Control.Exception (handle)@@ -18,31 +19,46 @@ import Space.Space -import System.Environment (getArgs)+import System (system)+import System.Environment (getArgs, withArgs) import System.Exit (ExitCode (..)) import System.FilePath (takeExtension) import System.IO hiding (hGetContents) -import Text.Help.Fungi (help)+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 -> help >> return ExitSuccess- | otherwise -> case argsFile args of- Nothing -> usage >> return ExitSuccess- Just file -> readSourceFile file >>= startFungi args file+ | 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@@ -93,6 +109,10 @@ 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 view
@@ -36,6 +36,36 @@ , 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 @@ -55,6 +85,7 @@ 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@@ -91,9 +122,6 @@ numToBool 0 = False numToBool _ = True -mapFst :: (a -> c) -> (a, b) -> (c, b)-mapFst f (x, y) = (f x, y)- whileM :: (Monad m) => (a -> m Bool) -> (a -> m a) -> a -> m a whileM mPred f x = mPred x >>= \bool -> if bool then f x >>= whileM mPred f@@ -114,8 +142,8 @@ ----------------------------------------------------------- -buildInstructions :: (Integral i) => [(Char, v)] -> Map i v-buildInstructions = Map.fromList . map (mapFst $ fromIntegral . ord)+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 $ [@@ -259,7 +287,7 @@ popStringInstr' = do x <- popInstr if x == 0- then return [0]+ then return [] else liftM (x :) popStringInstr' guardDim :: (I i) => Int -> Instruction i () -> Instruction i ()@@ -471,7 +499,7 @@ divideInstr = op2Instr $ guardZero div remainderInstr :: (I i) => Instruction i ()-remainderInstr = op2Instr $ guardZero mod+remainderInstr = op2Instr $ guardZero rem ----------------------------------------------------------- -- Strings@@ -479,7 +507,7 @@ stringmodeInstructions :: (I i) => (i -> Maybe (Instruction i ()), Map i (Maybe (Instruction i ()))) stringmodeInstructions = (,) (Just . pushInstr) $ buildInstructions [- ('"', Nothing)+ ('"', Just stringmodeInstr) , (' ', Just sgmlSpaceInstr) ] where@@ -491,8 +519,10 @@ stringmodeInstr :: (I i) => Instruction i () stringmodeInstr = do- modify $ withIp $ toggleMode Mode.String- modify $ withSemantics $ Semantics.toggleOverlay Mode.String stringmodeInstructions+ modify $ withIp $ toggleMode mode+ modify $ withSemantics $ Semantics.toggleOverlay mode stringmodeInstructions+ where+ mode = Mode.String fetchCharacterInstr :: (I i) => Instruction i () fetchCharacterInstr = do
Mode.hs view
@@ -7,9 +7,12 @@ ----------------------------------------------------------- data Mode- = Hover+ = Befunge93+ | Bizarro+ | Hover | Invert | String+ | String93 | Switch | Queue deriving (Show, Eq, Ord)
ProcessArgs.hs view
@@ -1,13 +1,6 @@ module ProcessArgs ( processArgs- , ProcessedArgs ()- , argsHelp- , argsDebugMode- , argsCellByteSize- , argsDim- , argsUnknownMode- , argsFile- , argsFungeArgs+ , ProcessedArgs (..) ) where import Control.Monad@@ -23,6 +16,8 @@ data ProcessedArgs = ProcessedArgs { argsHelp :: Bool+ , argsVersion :: Bool+ , argsFingerDoc :: Maybe String , argsDebugMode :: DebugMode , argsCellByteSize :: Maybe Int , argsDim :: Maybe Int@@ -35,6 +30,8 @@ defaultProcessedArgs :: ProcessedArgs defaultProcessedArgs = ProcessedArgs { argsHelp = False+ , argsVersion = False+ , argsFingerDoc = Nothing , argsDebugMode = DebugOff , argsCellByteSize = byteSize (0 :: Int) , argsDim = Nothing@@ -48,6 +45,8 @@ 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@@ -60,6 +59,13 @@ 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
+ README view
@@ -0,0 +1,3 @@+For information on how to use Fungi, run it with the --help command line argument:++fungi --help
Semantics.hs view
@@ -2,6 +2,9 @@ Semantics , mkSemantics , lookup+ , lookupBase+ , lookupFinger+ , lookupOverlay , pushFingerprint , popFingerprint , toggleOverlay@@ -43,30 +46,39 @@ } lookup :: (I i) => i -> Semantics env i -> Maybe (Instruction env i ())-lookup i sem = case lookupOverlay i $ map unlabel $ overlayInstrs sem of+lookup i sem = case lookupOverlay i sem of Just instr -> Just instr- Nothing -> case lookupFinger i $ fingerInstrs sem of+ Nothing -> case lookupFinger i sem of Just instr -> Just instr- Nothing -> lookupBase i $ baseInstrs sem+ Nothing -> lookupBase i sem -lookupOverlay :: (I i) => i -> [InfMap i (Instruction env i ())] -> Maybe (Instruction env i ())-lookupOverlay _ [] = Nothing-lookupOverlay i ((f, m) : ms) = case Map.lookup i m of+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 -> lookupOverlay' i ms Nothing -> case f i of Just instr -> Just instr- Nothing -> lookupOverlay i ms+ 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+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+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' }
+ Tester.hs view
@@ -0,0 +1,79 @@+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/Fingerprint.hs view
@@ -0,0 +1,68 @@+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.REFC as REFC+import qualified Fingerprint.ROMA as ROMA++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.REFC as H_REFC+import qualified Text.Help.Fingerprint.ROMA as H_ROMA++-----------------------------------------------------------++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)+ , (REFC.name, H_REFC.help)+ , (ROMA.name, H_ROMA.help)+ ]+
+ Text/Help/Fingerprint/BASE.hs view
@@ -0,0 +1,19 @@+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 view
@@ -0,0 +1,33 @@+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 view
@@ -0,0 +1,18 @@+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 view
@@ -0,0 +1,79 @@+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 Bizarro mode"+ ++ " is enabled after and while Hover 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 view
@@ -0,0 +1,20 @@+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 view
@@ -0,0 +1,30 @@+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 view
@@ -0,0 +1,21 @@+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 view
@@ -0,0 +1,18 @@+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 view
@@ -0,0 +1,19 @@+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 view
@@ -0,0 +1,14 @@+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 view
@@ -0,0 +1,14 @@+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 view
@@ -0,0 +1,28 @@+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/REFC.hs view
@@ -0,0 +1,35 @@+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 view
@@ -0,0 +1,21 @@+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/Fungi.hs view
@@ -44,8 +44,11 @@ (d, m) = x `divMod` 256 line :: IO ()-line = putStrLn $ replicate 80 '-'+line = putStrLn $ replicate maxWidth '-' +maxWidth :: Int+maxWidth = 80+ help :: IO () help = do line@@ -54,6 +57,8 @@ 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."@@ -84,5 +89,11 @@ ] 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/PrintOption.hs view
@@ -5,9 +5,10 @@ , showOption , PrintSettings (..) , defaultPrintSettings+ , fit ) where -import Data.List (stripPrefix)+import Data.List (stripPrefix, groupBy) ----------------------------------------------------------- @@ -129,4 +130,35 @@ 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
Version.hs view
@@ -9,5 +9,5 @@ handprint = 378447798 version :: String-version = "1.0.2"+version = "1.0.3"
+ runTests.bash view
@@ -0,0 +1,1 @@+runhaskell Tester.hs
+ tests/bad/execute.bf view
@@ -0,0 +1,1 @@+<q="exit 1"0
+ tests/bad/fingers/bzro/quit.bf view
@@ -0,0 +1,1 @@+"ORZB"4(n1B@
+ tests/bad/quit.bf view
@@ -0,0 +1,1 @@+1q
+ tests/bad/quit2.bf view
@@ -0,0 +1,1 @@+7q
+ tests/base.bf view
@@ -0,0 +1,3 @@+<v(4"BASE" + >nff6++ v+ I
+ tests/bool.bf view
@@ -0,0 +1,2 @@+<v(4"BOOL"+ > n23A n04A n40A n00A n23O n04O n40O n00O n23X n04X n40X n00X @
+ tests/good/concurrent.bf view
@@ -0,0 +1,2 @@+#vt@+ @
+ tests/good/concurrent2.bf view
@@ -0,0 +1,2 @@+#vt 0q+ > 1@
+ tests/good/direction.bf view
@@ -0,0 +1,6 @@+v1q q+ 1+ q0 <+> ^1q+1+q
+ tests/good/execute.bf view
@@ -0,0 +1,1 @@+<q="exit 0"0
+ tests/good/fingers/bzro/bizarro_hover.bf view
@@ -0,0 +1,1 @@+2j@1"ORZB"4("EDOM"4(n12BSj@@>@q@@@@@@
+ tests/good/fingers/bzro/goEast.bf view
@@ -0,0 +1,1 @@+"ORZB"4(n1B#@<q
+ tests/good/fingers/bzro/hover_bizarro.bf view
@@ -0,0 +1,3 @@+2j@1"EDOM"4(H"ORZB"4(n12Bj@@<@S@<^@@@@@@+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@<q@@@@@+@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+ tests/good/fingers/bzro/reflectB.bf view
@@ -0,0 +1,1 @@+"ORZB"4(n1B#qB@
+ tests/good/fingers/bzro/stop.bf view
@@ -0,0 +1,1 @@+"ORZB"4(n1Bq
+ tests/good/fingers/bzro/stop_quit.bf view
@@ -0,0 +1,2 @@+"ORZB"4(n1B#^tq+ <n@
+ tests/good/fingers/bzro/stringmode.bf view
@@ -0,0 +1,1 @@+"ORZB"4(nB''1@""'q
+ tests/good/fingers/bzro/stringmode2.bf view
@@ -0,0 +1,5 @@+v q q+ 1 1 @+>"ORZB"4(nB' '"Y''w' w' w1q+ 1 1 1+ q q q
+ tests/good/fingers/bzro/turnOffBizarro.bf view
@@ -0,0 +1,2 @@+"ORZB"4(nB#^B1q+ <Y1@
+ tests/good/fingers/mode/hoverEast.bf view
@@ -0,0 +1,1 @@+"EDOM"4(n1H>q0qq
+ tests/good/goAway.bf view
@@ -0,0 +1,23 @@+> v <+ :+ 7+ j+++^ 1<+^ _^+ -+ 0+^ < <+ |-3 ? 1-| + 0 2+ q 2 > ^+ -+^ _v+^ 3<++++++
+ tests/good/inputFile.bf view
@@ -0,0 +1,6 @@+<v1i"inputFile.dat"0012+ >qqqqqqqqqqqqqq+ qqqqqqqqqqqqqqq+ qqqqqqqqqqqqqqq+ qqqqqqqqqqqqqqq+ qqqqqqqqqqqqqqq
+ tests/good/inputFile.dat view
@@ -0,0 +1,3 @@+v+z+>zzzz0q
+ tests/good/jumpForward.bf view
@@ -0,0 +1,7 @@+11jv2jvv3jvvv v+>>>>>>>>>>>>>>1q+ > v+>>>>>>>>>>>>>>>v>5jvvvvv^>>>>>>>>>>>>>>>>v>>>>>1q1<>0f-j>>>>>>>>>>>>>>>11+ 1 >>>>>1q1<<<<<<<<<<<<<< ^^^^^<<<<+ q1<<<<<<<<<<<<<<<<<<<<<<<<>10j0q1<<<<<<<<<<<<<<<<<<<<<<+ ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
+ tests/good/jumpOver.bf view
@@ -0,0 +1,2 @@+;;1;;1; v ;0q+ > 1q
+ tests/good/math.bf view
@@ -0,0 +1,4 @@+15+4-3*6/6+4%3-v>1q1 < <+ >| >1!| + >!| >07-!|+ q1< >0q
+ tests/good/quit.bf view
@@ -0,0 +1,1 @@+q
+ tests/good/stop.bf view
@@ -0,0 +1,1 @@+@
+ tests/good/trampoline.bf view
@@ -0,0 +1,3 @@+#v# # 0q+ 1+ q
+ tests/good/turn.bf view
@@ -0,0 +1,7 @@+v++ vvvvvvvvvv<<+ >> ]^+> #^[vvvvvvvvvv0^+ ^1<<<<<<<<<<q+ q^^^^^^^^^^<
+ tests/good/wrap.bf view
@@ -0,0 +1,10 @@+v++++> ^++++ 0q >+
+ tests/mode.bf view
@@ -0,0 +1,2 @@+<v(4"MODE"+ >HIQS"HELLO!!!"@
+ tests/mycology/license.txt view
@@ -0,0 +1,24 @@+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 view
binary file changed (absent → 137952 bytes)
+ tests/mycology/mycorand.bf view
@@ -0,0 +1,16 @@+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 view
@@ -0,0 +1,57 @@+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 view
@@ -0,0 +1,64 @@+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 view
@@ -0,0 +1,25 @@+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 view
@@ -0,0 +1,527 @@+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 view
@@ -0,0 +1,1 @@+9876543210 ..... ..... #@ Intentionally invalid instruction, should reflect
+ tests/refc.bf view
@@ -0,0 +1,2 @@+<vn(4"REFC"+ >12R34R56RDDD@
+ tests/roma.bf view
@@ -0,0 +1,2 @@+<v(4"ROMA"+ >CDILMVX@
+ tests/string93Mode.bf view
@@ -0,0 +1,1 @@+<@"Hello world! My name is Betty."B(4"BF93"
+ tests/stringMode.bf view
@@ -0,0 +1,1 @@+<@"today is Monday!"
+ tests/stringModeWrap.bf view
@@ -0,0 +1,6 @@+v Upon exit, stack from top to bottom should be:+ GOOD: [60,64,32]+ BAD: [60,32,64,32]++> v +@ "<