diff --git a/src/Language/Brainfuck.hs b/src/Language/Brainfuck.hs index 040ef7e..0681be7 100644 --- a/src/Language/Brainfuck.hs +++ b/src/Language/Brainfuck.hs @@ -30,7 +30,7 @@ parse :: Text -> Either ParseFailure (Vector Instruction) parse text = runST $ do collectorVector <- MutableVector.new (Text.length text) - result <- go text collectorVector 0 + result <- parseBlock text collectorVector 0 pure $ case result of @@ -42,36 +42,39 @@ parse text = runST $ do where - go :: Text -> MVector s Instruction -> Int -> ST s (Either ParseFailure (Vector Instruction, Text)) - go Text.Empty instructions index = do + -- | 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 let populatedSlice = MutableVector.take index instructions frozen <- Vector.force <$!> Vector.freeze populatedSlice pure . Right $ (frozen, Text.empty) - go t@(c Text.:< cs) instructions index = let + parseBlock 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 <- go 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 - _ -> go 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 <- 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 -- >>> parse $ Text.pack "<<>>,,..<,.>"