src/Language/Brainfuck.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DerivingStrategies #-}
 {-# LANGUAGE LambdaCase #-}
 module Language.Brainfuck (parse, ParseFailure, render) where
@@ -15,11 +16,10 @@ import Data.Vector.Mutable qualified as MutableVector
 
 import Language.Brainfuck.Instruction ( Instruction(..) )
 import qualified Data.List as List
-import Numeric.Natural (Natural)
 
 data ParseFailure
-  = UnexpectedClosingBracket Natural -- closing bracket position
-  | UnmatchedOpenBracket Natural -- opening bracket position
+  = UnexpectedClosingBracket Int -- closing bracket position
+  | UnmatchedOpenBracket Int -- opening bracket position
   deriving stock (Show, Eq)
 
 -- | Convert a Text to a list of instructions, discard all comments.
@@ -30,51 +30,48 @@ parse :: Text -> Either ParseFailure (Vector Instruction)
 parse text = runST $ do
   collectorVector <- MutableVector.new (Text.length text)
 
-  result <- parseBlock text collectorVector 0
+  result <- go text collectorVector 0
 
   pure $ case result of
 
     Right (instructions, rest) -> case rest of
       Text.Empty -> Right instructions
-      _ -> Left (UnexpectedClosingBracket . fromIntegral $ Text.length text - Text.length rest)
+      _ -> Left (UnexpectedClosingBracket $ Text.length text - Text.length rest)
 
     Left failure -> Left failure
 
   where
 
-    -- | Parses the supplied text until the next closing bracket., the closing bracket will be returned in the rest.
-    --
-    -- Assumes the vector has enough space to hold all the instructions. Assumes all elements until the Int index have already been initialized.
-    parseBlock :: Text -> MVector s Instruction -> Int -> ST s (Either ParseFailure (Vector Instruction, Text))
-    parseBlock Text.Empty instructions index = do
+    go :: Text -> MVector s Instruction -> Int -> ST s (Either ParseFailure (Vector Instruction, Text))
+    go (Text.Empty  ) instructions index = do
       let populatedSlice = MutableVector.take index instructions
       frozen <- Vector.force <$!> Vector.freeze populatedSlice
       pure . Right $ (frozen, Text.empty)
-    parseBlock t@(c Text.:< cs) instructions index = let
+    go t@(c Text.:< cs) instructions index = let
+      
+      recognizeInstruction i cont = do
+        MutableVector.write instructions index i
+        go cont instructions (succ index)
 
-              recognizeInstruction i cont = do
-                MutableVector.write instructions index i
-                parseBlock cont instructions (succ index)
-
-              in case c of
-                '+' -> recognizeInstruction Increment cs
-                '-' -> recognizeInstruction Decrement cs
-                '>' -> recognizeInstruction MoveRight cs
-                '<' -> recognizeInstruction MoveLeft  cs
-                ',' -> recognizeInstruction ReadByte  cs
-                '.' -> recognizeInstruction PutByte   cs
-                ']' -> do
-                  let populatedSlice = MutableVector.take index instructions
-                  frozen <- Vector.force <$!> Vector.freeze populatedSlice
-                  pure $ Right (frozen, t)
-                '[' -> do
-                  innerVector <- MutableVector.new (Text.length cs)
-                  innerResult <- parseBlock cs innerVector 0
-                  case innerResult of
-                    Right (body, ']' Text.:< rest) -> recognizeInstruction (Loop body) rest
-                    Right _ -> pure $ Left (UnmatchedOpenBracket . fromIntegral $ Text.length text - Text.length t)
-                    _ -> pure innerResult
-                _   -> parseBlock cs instructions index
+      in case c of
+        '+' -> recognizeInstruction Increment cs
+        '-' -> recognizeInstruction Decrement cs
+        '>' -> recognizeInstruction MoveRight cs
+        '<' -> recognizeInstruction MoveLeft  cs
+        ',' -> recognizeInstruction ReadByte  cs
+        '.' -> recognizeInstruction PutByte   cs
+        ']' -> do
+          let populatedSlice = MutableVector.take index instructions
+          frozen <- Vector.force <$!> Vector.freeze populatedSlice
+          pure $ Right (frozen, t)
+        '[' -> do
+          innerVector <- MutableVector.new (Text.length cs)
+          innerResult <- go cs innerVector 0
+          case innerResult of
+            Right (body, ']' Text.:< rest) -> recognizeInstruction (Loop body) rest
+            Right _ -> pure $ Left (UnmatchedOpenBracket $ Text.length text - Text.length t)
+            _ -> pure innerResult
+        _   -> go cs instructions index
 
 
 -- >>> parse $ Text.pack "<<>>,,..<,.>"
@@ -103,7 +100,6 @@ render = Text.concat . List.map renderSingle . Vector.toList
 
 -- >>> import Test.QuickCheck.Instances.Vector ()
 -- >>> import Test.QuickCheck.Arbitrary (arbitrary)
--- >>> import Test.QuickCheck.Gen as Gen
 -- >>> render <$> Gen.generate arbitrary
--- "-<,.<<,>++.[]<+>.<.-,"
+-- "<,<>,<,."
 

stack.yaml

@@ -18,7 +18,6 @@
 # snapshot: ./custom-snapshot.yaml
 # snapshot: https://example.com/snapshots/2024-01-01.yaml
 snapshot: nightly-2025-06-16
-compiler: ghc-9.12.1
 
 # User packages to be built.
 # Various formats can be used as shown in the example below.