diff --git a/bf-optimize.cabal b/bf-optimize.cabal index ca802e7..cd815da 100644 --- a/bf-optimize.cabal +++ b/bf-optimize.cabal @@ -29,7 +29,6 @@ library Language.Brainfuck.Instruction Language.Brainfuck.Instruction.Compressed Language.Brainfuck.Instruction.Extended - Language.Brainfuck.Interpreter other-modules: Paths_bf_optimize autogen-modules: @@ -38,9 +37,7 @@ library src ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints build-depends: - QuickCheck - , base >=4.7 && <5 - , quickcheck-instances + base >=4.7 && <5 , text , vector default-language: Haskell2010 @@ -55,10 +52,8 @@ executable bf-optimize-exe app ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: - QuickCheck - , base >=4.7 && <5 + base >=4.7 && <5 , bf-optimize - , quickcheck-instances , text , vector default-language: Haskell2010 @@ -67,8 +62,6 @@ test-suite bf-optimize-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: - Arbitrary.InvalidBrainfuckText - Arbitrary.ValidBrainfuckText Paths_bf_optimize autogen-modules: Paths_bf_optimize @@ -76,10 +69,8 @@ test-suite bf-optimize-test test ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: - QuickCheck - , base >=4.7 && <5 + base >=4.7 && <5 , bf-optimize - , quickcheck-instances , text , vector default-language: Haskell2010 diff --git a/package.yaml b/package.yaml index 3b9462d..8aebee4 100644 --- a/package.yaml +++ b/package.yaml @@ -23,8 +23,6 @@ dependencies: - base >= 4.7 && < 5 - text - vector -- QuickCheck -- quickcheck-instances ghc-options: - -Wall diff --git a/src/Language/Brainfuck.hs b/src/Language/Brainfuck.hs index c348315..0d0e320 100644 --- a/src/Language/Brainfuck.hs +++ b/src/Language/Brainfuck.hs @@ -1,8 +1,7 @@ {-# LANGUAGE ImportQualifiedPost #-} {-# LANGUAGE ViewPatterns #-} {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE LambdaCase #-} -module Language.Brainfuck (parse, ParseFailure, render) where +module Language.Brainfuck (parse, ParseFailure) where import Control.Monad ((<$!>)) import Control.Monad.ST (runST, ST) @@ -15,12 +14,11 @@ import Data.Vector qualified as Vector import Data.Vector.Mutable qualified as MutableVector import Language.Brainfuck.Instruction ( Instruction(..) ) -import qualified Data.List as List data ParseFailure = UnexpectedClosingBracket Int -- closing bracket position | UnmatchedOpenBracket Int -- opening bracket position - deriving stock (Show, Eq) + deriving stock (Show) -- | Convert a Text to a list of instructions, discard all comments. -- @@ -85,21 +83,3 @@ parse text = runST $ do -- >>> parse $ Text.pack "[]]" -- Left (UnexpectedClosingBracket 2) - -render :: Vector Instruction -> Text -render = Text.concat . List.map renderSingle . Vector.toList - where - renderSingle = \case - Increment -> Text.singleton '+' - Decrement -> Text.singleton '-' - MoveLeft -> Text.singleton '<' - MoveRight -> Text.singleton '>' - ReadByte -> Text.singleton ',' - PutByte -> Text.singleton '.' - Loop body -> Text.concat [Text.singleton '[', render body, Text.singleton ']'] - --- >>> import Test.QuickCheck.Instances.Vector () --- >>> import Test.QuickCheck.Arbitrary (arbitrary) --- >>> render <$> Gen.generate arbitrary --- "<,<>,<,." - diff --git a/src/Language/Brainfuck/Instruction.hs b/src/Language/Brainfuck/Instruction.hs index 80a52aa..a1a6a70 100644 --- a/src/Language/Brainfuck/Instruction.hs +++ b/src/Language/Brainfuck/Instruction.hs @@ -1,13 +1,7 @@ {-# LANGUAGE DerivingStrategies #-} -{-# LANGUAGE InstanceSigs #-} module Language.Brainfuck.Instruction (Instruction(..)) where import Data.Vector ( Vector ) -import Test.QuickCheck.Gen (Gen) -import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary)) -import Test.QuickCheck.Instances.Vector () - -import qualified Test.QuickCheck.Gen as Gen data Instruction = Increment @@ -18,20 +12,3 @@ data Instruction | PutByte | Loop (Vector Instruction) deriving stock (Show, Eq) - -instance Arbitrary Instruction where - arbitrary :: Gen Instruction - arbitrary = Gen.oneof $ - [ pure Increment - , pure Decrement - , pure MoveLeft - , pure MoveRight - , pure ReadByte - , pure PutByte - , Loop <$> reduceSize 8 arbitrary - ] - where - reduceSize d g = Gen.sized $ \ s -> Gen.resize (s `div` d) g - --- >>> Gen.generate (Gen.resize 30 arbitrary) :: IO [Instruction] --- [MoveLeft,Decrement,PutByte,Decrement,Decrement,Increment,ReadByte,MoveLeft,Increment,Loop [],MoveRight,Increment,Increment,Loop [],MoveLeft,Loop [],MoveRight,ReadByte,ReadByte,MoveLeft,Decrement,MoveRight,MoveLeft,Loop [PutByte,Increment,Loop []],Decrement] diff --git a/src/Language/Brainfuck/Instruction/Compressed.hs b/src/Language/Brainfuck/Instruction/Compressed.hs index bf28a1d..c57224f 100644 --- a/src/Language/Brainfuck/Instruction/Compressed.hs +++ b/src/Language/Brainfuck/Instruction/Compressed.hs @@ -1,19 +1,13 @@ {-# LANGUAGE ImportQualifiedPost #-} -{-# LANGUAGE InstanceSigs #-} -module Language.Brainfuck.Instruction.Compressed ( CompressedInstruction(..), compress, uncompress ) where +module Language.Brainfuck.Instruction.Compressed ( CompressedInstruction(..), compress ) where import Data.Bifunctor ( Bifunctor(first) ) import Data.Vector ( Vector ) import Data.Word ( Word8 ) import Numeric.Natural ( Natural ) -import Test.QuickCheck.Gen (Gen) -import Test.QuickCheck.Arbitrary (Arbitrary(arbitrary)) -import Test.QuickCheck.Instances.Natural () import Data.Vector qualified as Vector -import Test.QuickCheck.Gen qualified as Gen - import Language.Brainfuck.Instruction ( Instruction ) import Language.Brainfuck.Instruction qualified as Instruction @@ -27,20 +21,6 @@ data CompressedInstruction | Loop (Vector CompressedInstruction) deriving (Show, Eq) -instance Arbitrary CompressedInstruction where - arbitrary :: Gen CompressedInstruction - arbitrary = Gen.oneof - [ Add <$> arbitrary - , Subtract <$> arbitrary - , MoveRight <$> arbitrary - , MoveLeft <$> arbitrary - , pure ReadByte - , pure PutByte - , Loop <$> resize (`div` 8) arbitrary - ] - where - resize f x = Gen.sized $ \ s -> Gen.resize (f s) x - compress :: Vector Instruction -> Vector CompressedInstruction compress instructions = Vector.fromList (go instructions) where @@ -71,18 +51,3 @@ compress instructions = Vector.fromList (go instructions) -- >>> compress . Vector.fromList $ replicate 300 Instruction.MoveRight -- [MoveRight 300] -uncompress :: Vector CompressedInstruction -> Vector Instruction -uncompress = Vector.concatMap uncompressSingle - where - uncompressSingle instruction = let - repeated x times = Vector.replicate (fromIntegral times) x - - in case instruction of - Add times -> repeated Instruction.Increment times - Subtract times -> repeated Instruction.Decrement times - MoveRight times -> repeated Instruction.MoveRight times - MoveLeft times -> repeated Instruction.MoveLeft times - PutByte -> Vector.singleton Instruction.PutByte - ReadByte -> Vector.singleton Instruction.ReadByte - Loop body -> Vector.singleton $ Instruction.Loop (uncompress body) - diff --git a/src/Language/Brainfuck/Instruction/Extended.hs b/src/Language/Brainfuck/Instruction/Extended.hs index 5fb434c..e3b8d9d 100644 --- a/src/Language/Brainfuck/Instruction/Extended.hs +++ b/src/Language/Brainfuck/Instruction/Extended.hs @@ -1,16 +1,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE PatternSynonyms #-} -{-# LANGUAGE StrictData #-} module Language.Brainfuck.Instruction.Extended (Operation(..), Interaction(..), ExtendedInstruction(Modify, Move, Interact, Jump), pattern IfNonZero, pattern WithOffset, mkIfNonZero, mkWithOffset, translationSize, parse) where - import Data.Word (Word8) -import Data.Vector (Vector) -import Numeric.Natural (Natural) - import Language.Brainfuck.Instruction.Compressed (CompressedInstruction) - +import Data.Vector (Vector) import qualified Data.Vector as Vector import qualified Language.Brainfuck.Instruction.Compressed as CompressedInstruction +import Numeric.Natural (Natural) data Operation = Add @@ -22,7 +18,7 @@ data Interaction | Write deriving (Show) -pattern WithOffset :: Integer -> ExtendedInstruction -> ExtendedInstruction +pattern WithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction pattern WithOffset offset embedded <- AtOffset offset embedded where WithOffset offset embedded = mkWithOffset offset embedded @@ -33,7 +29,7 @@ pattern IfNonZero instruction <- WhenNonZero instruction IfNonZero instruction = mkIfNonZero instruction data ExtendedInstruction - = AtOffset Integer ExtendedInstruction -- invariant, WithOffset may not nest itself + = AtOffset Int ExtendedInstruction -- invariant, WithOffset may not nest itself | WhenNonZero ExtendedInstruction -- invariant, IfNonZero may not nest itself | Modify Operation Word8 | Move Integer @@ -46,7 +42,7 @@ mkIfNonZero = \case WhenNonZero i -> WhenNonZero i instruction -> WhenNonZero instruction -mkWithOffset :: Integer -> ExtendedInstruction -> ExtendedInstruction +mkWithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction mkWithOffset offset = \case AtOffset offset' i -> AtOffset (offset + offset') i instruction -> AtOffset offset instruction @@ -96,3 +92,4 @@ translationSize = Vector.sum . Vector.map instructionTranslationSize -- -- >>> parse [CompressedInstruction.Add 5, CompressedInstruction.Loop [CompressedInstruction.Loop [CompressedInstruction.ReadByte], CompressedInstruction.PutByte]] -- [Modify Add 5,Jump 4,Jump 1,Interact Read,WhenNonZero (Jump (-2)),Interact Write,WhenNonZero (Jump (-5))] + diff --git a/test/Arbitrary/InvalidBrainfuckText.hs b/test/Arbitrary/InvalidBrainfuckText.hs deleted file mode 100644 index 42b97f1..0000000 --- a/test/Arbitrary/InvalidBrainfuckText.hs +++ /dev/null @@ -1,26 +0,0 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE DerivingStrategies #-} -module Arbitrary.InvalidBrainfuckText (InvalidBrainfuckText(..)) where - -import Data.Text (Text) -import Test.QuickCheck.Gen (Gen) -import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary)) - -import qualified Data.Text as Text -import qualified Test.QuickCheck.Gen as Gen -import qualified Arbitrary.ValidBrainfuckText as ValidBrainfuckText - -newtype InvalidBrainfuckText = InvalidBrainfuckText { get :: Text } - deriving stock Show - -instance Arbitrary InvalidBrainfuckText where - arbitrary :: Gen InvalidBrainfuckText - arbitrary = do - validText <- ValidBrainfuckText.get <$> arbitrary - - index <- Gen.choose (0, Text.length validText) - badBrace <- Gen.oneof $ map pure "[]" - let (prefix, suffix) = Text.splitAt index validText - - pure . InvalidBrainfuckText $ Text.concat [prefix, Text.singleton badBrace, suffix] - diff --git a/test/Arbitrary/ValidBrainfuckText.hs b/test/Arbitrary/ValidBrainfuckText.hs deleted file mode 100644 index c5a0505..0000000 --- a/test/Arbitrary/ValidBrainfuckText.hs +++ /dev/null @@ -1,48 +0,0 @@ -{-# LANGUAGE InstanceSigs #-} -{-# LANGUAGE DerivingStrategies #-} -module Arbitrary.ValidBrainfuckText (ValidBrainfuckText(..)) where -import Data.Text (Text) -import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary)) -import Test.QuickCheck.Gen (Gen, sized, frequency, oneof, resize) -import Data.Coerce (coerce) - -import qualified Data.Text as Text - -newtype ValidBrainfuckText = ValidBrainfuckText { get :: Text } - deriving stock Show - -instance Arbitrary ValidBrainfuckText where - arbitrary :: Gen ValidBrainfuckText - arbitrary = coerce . fmap Text.pack $ character [] - where - character rest = do - body <- frequency - [ (1, comment) - , (9, operator) - ] - - sized $ \ size -> frequency - [ (1 , pure body) - , (size, character body) - ] - - where - operator = let - - simpleOperator = oneof $ map (pure . (:rest)) "+-<>,." - loopOperator = fmap ('[':) . sized $ \ s -> resize (s `div` 8) (character (']':rest)) - - in frequency - [ (3, simpleOperator) - , (1, loopOperator) - ] - - comment = do - commentChar <- oneof $ map pure "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" - pure $ commentChar : rest - --- >>> import Test.QuickCheck.Gen (generate) --- >>> generate $ (arbitrary :: Gen ValidBrainfuckText) --- ValidBrainfuckText {get = "<[><]>[>],>+,[.-K.]+.>[<],z[p[[<]]+<],<[+]+[P[+][[e]]+,]+,.[-][[<],>>++]+"} - - diff --git a/test/Spec.hs b/test/Spec.hs index 449530c..cd4753f 100644 --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,40 +1,2 @@ -{-# LANGUAGE TemplateHaskell #-} - -import Data.Vector (Vector) - -import Test.QuickCheck.All (quickCheckAll) -import System.Exit (exitFailure, exitSuccess) - -import Language.Brainfuck.Instruction (Instruction) - -import qualified Data.Either as Either -import qualified Language.Brainfuck as Brainfuck -import qualified Arbitrary.ValidBrainfuckText as ValidBrainfuckText -import qualified Arbitrary.InvalidBrainfuckText as InValidBrainfuckText -import qualified Language.Brainfuck.Instruction.Compressed as CompressedInstruction - --- | ValidBrainfuckText will produce a text with comments, it must be parsed correctly -prop_acceptValidTexts :: ValidBrainfuckText.ValidBrainfuckText -> Bool -prop_acceptValidTexts = Either.isRight . Brainfuck.parse . ValidBrainfuckText.get - --- | InvalidBrainfuckText will insert unbalanced brackets, they must be rejected -prop_rejectInvalidTexts :: InValidBrainfuckText.InvalidBrainfuckText -> Bool -prop_rejectInvalidTexts = Either.isLeft . Brainfuck.parse . InValidBrainfuckText.get - --- | Does rendering and parsing a vector of instructions yield the exact same result? -prop_renderParseInverse :: Vector Instruction -> Bool -prop_renderParseInverse source = Right source == (Brainfuck.parse . Brainfuck.render $ source) - --- | Compressing and Uncompressing should be inverse. The opposite must not be true, since `compress $ replicate 300 Increment` is `Add 44` -prop_CompressUncompressInverse :: Vector Instruction -> Bool -prop_CompressUncompressInverse source = source == (CompressedInstruction.uncompress . CompressedInstruction.compress) source - -return [] -- template haskell guard -runQuickCheck :: IO Bool -runQuickCheck = $quickCheckAll - main :: IO () -main = do - quickCheckGood <- runQuickCheck - - if quickCheckGood then exitSuccess else exitFailure +main = putStrLn "Test suite not yet implemented"