I already did a lot of things

src/Language/Brainfuck/Instruction/Extended.hs

@@ -0,0 +1,95 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE PatternSynonyms #-}
+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 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
+  | Subtract
+  deriving (Show)
+
+data Interaction
+  = Read
+  | Write
+  deriving (Show)
+
+pattern WithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction
+pattern WithOffset offset embedded <- AtOffset offset embedded
+  where
+    WithOffset offset embedded = mkWithOffset offset embedded
+
+pattern IfNonZero :: ExtendedInstruction -> ExtendedInstruction
+pattern IfNonZero instruction <- WhenNonZero instruction
+  where
+    IfNonZero instruction = mkIfNonZero instruction
+
+data ExtendedInstruction
+  = AtOffset Int ExtendedInstruction -- invariant, WithOffset may not nest itself
+  | WhenNonZero ExtendedInstruction -- invariant, IfNonZero may not nest itself
+  | Modify Operation Word8
+  | Move Integer
+  | Interact Interaction
+  | Jump Integer
+  deriving (Show)
+
+mkIfNonZero :: ExtendedInstruction -> ExtendedInstruction
+mkIfNonZero = \case
+  WhenNonZero i -> WhenNonZero i
+  instruction -> WhenNonZero instruction
+
+mkWithOffset :: Int -> ExtendedInstruction -> ExtendedInstruction
+mkWithOffset offset = \case
+  AtOffset offset' i -> AtOffset (offset + offset') i
+  instruction -> AtOffset offset instruction
+
+-- >>> mkWithOffset 15 $ mkWithOffset (-3) $ Interact Read
+-- AtOffset 12 (Interact Read)
+
+parse :: Vector CompressedInstruction -> Vector ExtendedInstruction
+parse = Vector.fromList . Vector.foldr prependTranslation []
+
+prependTranslation :: CompressedInstruction -> [ExtendedInstruction] -> [ExtendedInstruction]
+prependTranslation instruction rest = let
+  addSingle = (:rest)
+  in case instruction of
+    CompressedInstruction.Add       i    -> addSingle $ Modify Add i
+    CompressedInstruction.Subtract  i    -> addSingle $ Modify Subtract i
+    CompressedInstruction.MoveRight n    -> addSingle $ Move $ toInteger n
+    CompressedInstruction.MoveLeft  n    -> addSingle $ Move $ toInteger (-n)
+    CompressedInstruction.ReadByte       -> addSingle $ Interact Read
+    CompressedInstruction.PutByte        -> addSingle $ Interact Write
+    CompressedInstruction.Loop      body -> let
+      bodySize = translationSize body
+      backJump = IfNonZero $ Jump $ -(toInteger bodySize + 1)
+      forwardJump = Jump $ toInteger bodySize
+
+      in forwardJump : Vector.foldr prependTranslation (backJump : rest) body
+
+translationSize :: Vector CompressedInstruction -> Natural
+translationSize = Vector.sum . Vector.map instructionTranslationSize
+  where
+    instructionTranslationSize = \case
+     CompressedInstruction.Add       _    -> 1
+     CompressedInstruction.Subtract  _    -> 1
+     CompressedInstruction.MoveRight _    -> 1
+     CompressedInstruction.MoveLeft  _    -> 1
+     CompressedInstruction.ReadByte       -> 1
+     CompressedInstruction.PutByte        -> 1
+     CompressedInstruction.Loop      body -> let
+      skipLoopSize = 1
+      repeatLoopSize = 1
+      bodySize = translationSize body
+      in skipLoopSize + repeatLoopSize + bodySize
+
+-- >>> :set -XOverloadedLists
+-- >>> parse [CompressedInstruction.Add 5]
+-- [Modify Add 5]
+--
+-- >>> 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))]
+