SSA usage caching

module Main
  ( main
  ) where

import Control.Monad (forM_)
import Control.Monad.State (State, runState)
import Data.Map (Map)

import qualified Control.Monad.State.Class as State
import qualified Data.Map as Map

newtype InstructionID = InstructionID Int deriving (Eq, Ord, Show)

data Instruction
  = ConstInstruction Int
  | IncrementInstruction InstructionID
  deriving (Show)

operands :: Instruction -> [InstructionID]
operands (ConstInstruction _) = []
operands (IncrementInstruction operand) = [operand]

type SSA = State (Int, [(InstructionID, Instruction)], Map InstructionID [InstructionID])

freshInstructionID :: SSA InstructionID
freshInstructionID = do
  id <- State.gets $ \(next, _, _) -> next
  State.modify $ \(next, is, us) -> (next + 1, is, us)
  pure $ InstructionID id

appendInstruction :: Instruction -> SSA InstructionID
appendInstruction instruction = do
  id <- freshInstructionID
  State.modify $ \(next, is, us) -> (next, is ++ [(id, instruction)], us)
  forM_ (operands instruction) $ \operand -> do
    let alter Nothing   = Just [id]
        alter (Just os) = Just $ id : os
    State.modify $ \(next, is, us) -> (next, is, Map.alter alter operand us)
  pure id

main :: IO ()
main = print . flip runState (0, [], Map.empty) $ do
  a <- appendInstruction $ ConstInstruction 42
  b <- appendInstruction $ IncrementInstruction a
  pure b