Fungi-1.0: Ip.hs

module Ip (
    Ip
  , mkIp

  , getId
  , getPos
  , getDelta
  , getSs
  , isAlive
  , getStorageOffset
  , getSemantics

  , testMode
  , addMode
  , removeMode
  , toggleMode

  , killIp
  , reverseIp
  , setPos
  , setDelta
  , setSs
  , setStorageOffset

  ) where

import Control.Monad.State.Strict

import Data.Deque
import Data.I
import Data.Map (Map)
import Data.Set (Set)
import qualified Data.Set as Set
import Data.Stack
import Data.Vector

import Text.PrettyShow

import Mode
import Semantics

-----------------------------------------------------------

type Instruction env i = StateT (env i) IO

data Ip env i = Ip {
    getId :: i
  , getPos :: Vector i
  , getDelta :: Vector i
  , getSs :: Stack (Deque i)
  , isAlive :: Bool
  , getStorageOffset :: !(Vector i)
  , getSemantics :: Semantics env i
  , modes :: Set Mode
  }

instance (PrettyShow i) => PrettyShow (Ip env i) where
  pshow ip = concat [ []
    , "(IP"
    , " "
    , "id=" ++ pshow (getId ip)
    , " "
    , "pos=" ++ pshow (getPos ip)
    , " "
    , "delta=" ++ pshow (getDelta ip)
    , " "
    , "modes=" ++ pshow (Set.toList $ modes ip)
    , ")"
    ]

mkIp :: (I i) => Int -> i -> Map i (Instruction env i ()) -> Ip env i
mkIp dim ident baseSemantics = Ip {
    getId = ident
  , getPos = takeV dim 0
  , getDelta = takeV dim (1 `cons` 0)
  , getSs = mkStack1 mkDeque
  , isAlive = True
  , getStorageOffset = takeV dim 0
  , getSemantics = mkSemantics baseSemantics
  , modes = Set.empty
  }

testMode :: Mode -> Ip env i -> Bool
testMode mode = Set.member mode . modes

addMode :: Mode -> Ip env i -> Ip env i
addMode mode ip = ip { modes = Set.insert mode $ modes ip }

removeMode :: Mode -> Ip env i -> Ip env i
removeMode mode ip = ip { modes = Set.delete mode $ modes ip }

toggleMode :: Mode -> Ip env i -> Ip env i
toggleMode mode ip = if testMode mode ip
  then removeMode mode ip
  else addMode mode ip

killIp :: Ip env i -> Ip env i
killIp ip = ip { isAlive = False }

reverseIp :: (Num i) => Ip env i -> Ip env i
reverseIp ip = ip { getDelta = negate . getDelta $ ip }

setPos :: (Num i) => Vector i -> Ip env i -> Ip env i
setPos pos ip = ip { getPos = pos }

setDelta :: (Num i) => Vector i -> Ip env i -> Ip env i
setDelta delta ip = ip { getDelta = delta }

setSs :: Stack (Deque i) -> Ip env i -> Ip env i
setSs s ip = ip { getSs = s }

setStorageOffset :: Vector i -> Ip env i -> Ip env i
setStorageOffset v ip = ip { getStorageOffset = v }