Refactoring to use new ConenctTile implementation. Need to resolve po…

…tential existence of invalid states

src/TIS100/Sim/CPU.hs

@@ -10,6 +10,7 @@ import TIS100.Errors (TISError (..), TISErrorCode (TISParseError), TISErrorOr)
 import TIS100.Parser.AsmParser qualified as AP
 import TIS100.Parser.Config qualified as C
 import TIS100.Tiles.Base qualified as Tiles
+import TIS100.Tiles.ConnectedTile (ConnectedTile (..))
 import TIS100.Tiles.Inactive qualified as Inactive
 import TIS100.Tiles.T21 qualified as T21
 import TIS100.Tiles.T30 qualified as T30
@@ -18,10 +19,23 @@ import Text.Read (Lexeme (String))
 data Tile = T21' T21.T21 | T30' T30.T30 | Inactive' Inactive.InactiveTile
   deriving (Eq, Show)
 
+-- instance ConnectedTile Tile where
+--   readValueFrom (T21' t) = (T21' t', v) where (t', v) = readVelueFrom t
+--   readValueFrom (T30' t) = (T30' t', v) where (t', v) = readVelueFrom t
+--   readValueFrom (Inactive' t) = (Inactive' t', v) where (t', v) = readVelueFrom t
+
+--   writeValueTo (T21' t) = T21' $ writeValueTo t
+--   writeValueTo (T30' t) = T30' $ writeValueTo t
+--   writeValueTo (Inactive' t) = Inactive' $ writeValueTo t
+
+--   step (T21' t) = T21' $ step t
+--   step (T30' t) = T30' $ step t
+--   step (Inactive' t) = Inactive' $ step t
+
 data PositionedTile = PositionedTile
   { pos :: (Int, Int)
   , index :: Int
-  , tile :: Tile
+  , tile :: ConnectedTile
   }
   deriving (Show)
 
@@ -49,9 +63,9 @@ createInitialCPUState cfg asm =
   createTile i tileType =
     let pos = i `divMod` C.cols cfg
      in case tileType of
-          C.Conpute -> PositionedTile pos i . T21' . T21.createTileState <$> getTileAsm i
-          C.Stack -> Right $ PositionedTile pos i $ T30' $ T30.T30 []
-          C.Disabled -> Right $ PositionedTile pos i $ Inactive' $ Inactive.InactiveTile
+          C.Conpute -> PositionedTile pos i . ConnectedTile . T21.createTileState <$> getTileAsm i
+          C.Stack -> Right $ PositionedTile pos i $ ConnectedTile $ T30.T30 []
+          C.Disabled -> Right $ PositionedTile pos i $ ConnectedTile $ Inactive.InactiveTile
 
   getTileAsm :: Int -> TISErrorOr T21.TileProgram
   getTileAsm i = case IM.lookup i asm of
@@ -95,9 +109,9 @@ createInitialCPUState cfg asm =
     resolveReg :: AP.Register -> T21.RegisterOrPort
     resolveReg AP.ACC = T21.Register T21.ACC
     resolveReg AP.NIL = T21.Register T21.NIL
-    resolveReg AP.LEFT = T21.Port T21.LEFT
-    resolveReg AP.RIGHT = T21.Port T21.RIGHT
-    resolveReg AP.UP = T21.Port T21.UP
-    resolveReg AP.DOWN = T21.Port T21.DOWN
-    resolveReg AP.ANY = T21.Port T21.ANY
-    resolveReg AP.LAST = T21.Port T21.LAST
+    resolveReg AP.LEFT = T21.Port Tiles.LEFT
+    resolveReg AP.RIGHT = T21.Port Tiles.RIGHT
+    resolveReg AP.UP = T21.Port Tiles.UP
+    resolveReg AP.DOWN = T21.Port Tiles.DOWN
+    resolveReg AP.ANY = T21.Port Tiles.ANY
+    resolveReg AP.LAST = T21.Port Tiles.LAST

src/TIS100/Sim/Run.hs

@@ -1,15 +1,17 @@
 module TIS100.Sim.Run where
 
-import Data.Maybe (fromMaybe)
 import Control.Monad (foldM)
 import Control.Monad.ST
+import Data.Maybe (fromJust, fromMaybe)
 import Data.Vector qualified as MV
 import Data.Vector qualified as V
 import Data.Vector.Mutable qualified as MV
 import Foreign qualified as V
 import TIS100.Parser.Config (IODef)
 import TIS100.Parser.Config qualified as CFG
 import TIS100.Sim.CPU qualified as CPU
+import TIS100.Tiles.Base qualified as Tiles
+import TIS100.Tiles.ConnectedTile (ConnectedTile (..), IsConnectedTile (..))
 import TIS100.Tiles.Inactive qualified as Inactive
 import TIS100.Tiles.T21 qualified as T21
 import TIS100.Tiles.T30 qualified as T30
@@ -22,6 +24,7 @@ data SimState = SimState
   deriving (Show)
 
 type RWTileVector = MV.MVector RealWorld CPU.PositionedTile
+
 {-
 class (Show t) => IsConnectedTile t where
   processTileComm :: t -> (Int, Int) -> (Int, Int) -> (RWTileVector, IODef, IODef) -> IO (RWTileVector, IODef, IODef)
@@ -69,6 +72,44 @@ processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles) ins outs) =
   processTileComm' (tiles, ins, outs) i = do
     ptile <- MV.read tiles i
     let tile = CPU.tile ptile
+    let (r, c) = CPU.pos ptile
+
+    case getRunState tile of
+      Tiles.WaitingOnRead p -> do
+        if r == 0
+          then return (tiles, ins, outs)
+          else do
+            let o = getOtherTile i p
+            optile <- MV.read tiles o
+            let otile = CPU.tile optile
+            let op = Tiles.getOppositePort p
+            if readable otile op
+              then do
+                let (tile', val) = readValueFrom tile p
+                let otile' = writeValueTo otile op $ fromJust val
+                MV.write tiles i $ ptile{CPU.tile = tile'}
+                MV.write tiles o $ optile{CPU.tile = otile'}
+                return (tiles, ins, outs)
+              else return (tiles, ins, outs)
+      Tiles.WaitingOnWrite p -> do
+        if r == rows - 1
+          then return (tiles, ins, outs)
+          else do
+            let o = getOtherTile i p
+            optile <- MV.read tiles o
+            let otile = CPU.tile optile
+            let op = Tiles.getOppositePort p
+            if writable otile op
+              then do
+                let (otile', val) = readValueFrom otile op
+                let tile' = writeValueTo tile p $ fromJust val
+                MV.write tiles i $ ptile{CPU.tile = tile'}
+                MV.write tiles o $ optile{CPU.tile = otile'}
+                return (tiles, ins, outs)
+              else return (tiles, ins, outs)
+      _ -> return (tiles, ins, outs)
+
+  {-
     case tile of
       CPU.T21' t -> processT21Comm i (tiles, ins, outs)
 
@@ -96,15 +137,16 @@ processComm (SimState (CPU.CPUState (CPU.CPUConfig rows cols) tiles) ins outs) =
                 MV.write tiles o otile
                 return (tiles, ins, outs)
               else return (tiles, ins, outs)
+      -}
 
-  getOtherTile :: Int -> T21.Port' -> Int
+  getOtherTile :: Int -> Tiles.Port' -> Int
   getOtherTile i p = case p of
-    T21.LEFT -> i - 1
-    T21.RIGHT -> i + 1
-    T21.UP -> i - cols
-    T21.DOWN -> i + cols
-    T21.ANY -> i
-    T21.LAST -> i
-           
+    Tiles.LEFT -> i - 1
+    Tiles.RIGHT -> i + 1
+    Tiles.UP -> i - cols
+    Tiles.DOWN -> i + cols
+    Tiles.ANY -> i
+    Tiles.LAST -> i
+
 processTiles :: SimState -> IO SimState
 processTiles = _

src/TIS100/Tiles/Base.hs

@@ -17,5 +17,19 @@ instance Num Value where
   signum (Value a) = Value $ signum a
   fromInteger = Value . clamp . fromInteger
 
+data RunState
+  = Ready
+  | WaitingOnRead Port'
+  | WaitingOnWrite Port'
+  deriving (Eq, Show)
+
 data Port' = ANY | LAST | LEFT | RIGHT | UP | DOWN
   deriving (Eq, Show)
+
+getOppositePort :: Port' -> Port'
+getOppositePort ANY = ANY
+getOppositePort LAST = LAST
+getOppositePort LEFT = RIGHT
+getOppositePort RIGHT = LEFT
+getOppositePort UP = DOWN
+getOppositePort DOWN = UP

src/TIS100/Tiles/ConnectedTile.hs

@@ -1,8 +1,41 @@
 module TIS100.Tiles.ConnectedTile where
 
 import TIS100.Tiles.Base (Port', Value)
+import TIS100.Tiles.Base qualified as Tiles
+
+class (Show t) => IsConnectedTile t where
+  getRunState :: t -> Tiles.RunState
+  setRunState :: t -> Tiles.RunState -> t
+
+  readable :: t -> Port' -> Bool
+  writable :: t -> Port' -> Bool
+
+  isWaitingOnRead :: t -> Maybe Port'
+  isWaitingOnWrite :: t -> Maybe Port'
 
-class ConnectedTile t where
   readValueFrom :: t -> Port' -> (t, Maybe Value)
   writeValueTo :: t -> Port' -> Value -> t
-  step :: t -> t
+
+  step :: t -> t
+
+data ConnectedTile
+  = forall t.
+    (IsConnectedTile t) =>
+    ConnectedTile t
+
+instance Show ConnectedTile where
+  show (ConnectedTile t) = show t
+
+instance IsConnectedTile ConnectedTile where
+  getRunState (ConnectedTile t) = getRunState t
+  setRunState (ConnectedTile t) rs = ConnectedTile $ setRunState t rs
+
+  readable (ConnectedTile t) p = readable t p
+  writable (ConnectedTile t) p = writable t p
+
+  isWaitingOnRead (ConnectedTile t) = isWaitingOnRead t
+  isWaitingOnWrite (ConnectedTile t) = isWaitingOnWrite t
+
+  readValueFrom (ConnectedTile t) p = (ConnectedTile t', v) where (t', v) = readValueFrom t p
+
+  writeValueTo (ConnectedTile t) p v = ConnectedTile $ writeValueTo t p v

src/TIS100/Tiles/Inactive.hs

@@ -1,11 +1,22 @@
 module TIS100.Tiles.Inactive where
 
-import TIS100.Tiles.ConnectedTile (ConnectedTile (..))
+import TIS100.Tiles.Base qualified as Tiles
+import TIS100.Tiles.ConnectedTile (ConnectedTile (..), IsConnectedTile (..))
 
 data InactiveTile = InactiveTile
   deriving (Eq, Show)
 
-instance ConnectedTile InactiveTile where
+instance IsConnectedTile InactiveTile where
+  getRunState _ = Tiles.Ready
+  setRunState _ _ = InactiveTile
+
+  readable _ _ = False
+  writable _ _ = False
+
+  isWaitingOnRead _ = Just Tiles.ANY
+  isWaitingOnWrite _ = Just Tiles.ANY
+
   readValueFrom t _ = (t, Nothing)
   writeValueTo t _ _ = t
+
   step = id

src/TIS100/Tiles/T21.hs

@@ -1,8 +1,9 @@
 module TIS100.Tiles.T21 where
 
+import Data.Maybe (isJust, isNothing)
 import TIS100.Parser.AsmParser (LabelOrInstruction (NOP))
-import TIS100.Tiles.Base (Port' (..), Value (..))
-import TIS100.Tiles.ConnectedTile (ConnectedTile (..))
+import TIS100.Tiles.Base (Port' (..), RunState (..), Value (..))
+import TIS100.Tiles.ConnectedTile (ConnectedTile (..), IsConnectedTile (..))
 import Prelude hiding (last)
 
 data Register' = ACC | NIL
@@ -36,12 +37,6 @@ data Instruction
 
 type TileProgram = [Instruction]
 
-data RunState
-  = Ready
-  | WaitingOnRead Port'
-  | WaitingOnWrite Port'
-  deriving (Eq, Show)
-
 data TileState = TileState
   { acc :: Value
   , bak :: Value
@@ -85,14 +80,6 @@ getTileRunState = runState . tileState
 setTileRunState :: T21 -> RunState -> T21
 setTileRunState tile rs = tile{tileState = (tileState tile){runState = rs}}
 
-getOppositePort :: Port' -> Port'
-getOppositePort ANY = ANY
-getOppositePort LAST = LAST
-getOppositePort LEFT = RIGHT
-getOppositePort RIGHT = LEFT
-getOppositePort UP = DOWN
-getOppositePort DOWN = UP
-
 getPortVal :: Port' -> T21 -> Maybe Value
 -- getPortVal ANY t = getPortVal (last t) t
 -- getPortVal LAST t = getPortVal (last t) t
@@ -117,7 +104,34 @@ clearPortVal RIGHT v t = t{tileState = (tileState t){right = Nothing}}
 clearPortVal UP v t = t{tileState = (tileState t){up = Nothing}}
 clearPortVal DOWN v t = t{tileState = (tileState t){down = Nothing}}
 
-instance ConnectedTile T21 where
+instance IsConnectedTile T21 where
+  getRunState = getTileRunState
+  setRunState = setTileRunState
+
+  readable t p = case p of
+    ANY -> True
+    LAST -> True
+    LEFT -> isJust $ left $ tileState t
+    RIGHT -> isJust $ right $ tileState t
+    UP -> isJust $ up $ tileState t
+    DOWN -> isJust $ down $ tileState t
+
+  writable t p = case p of
+    ANY -> True
+    LAST -> True
+    LEFT -> isNothing $ left $ tileState t
+    RIGHT -> isNothing $ right $ tileState t
+    UP -> isNothing $ up $ tileState t
+    DOWN -> isNothing $ down $ tileState t
+
+  isWaitingOnRead t = case getTileRunState t of
+    WaitingOnRead p -> Just p
+    _ -> Nothing
+
+  isWaitingOnWrite t = case getTileRunState t of
+    WaitingOnWrite p -> Just p
+    _ -> Nothing
+
   readValueFrom t p = (t, getPortVal p t)
   writeValueTo t p v = setPortVal p v t
   step t = t

src/TIS100/Tiles/T30.hs

@@ -1,13 +1,24 @@
 module TIS100.Tiles.T30 where
 
-import TIS100.Tiles.Base (Value (..))
-import TIS100.Tiles.ConnectedTile (ConnectedTile (..))
+import TIS100.Tiles.Base qualified as Tiles
+import TIS100.Tiles.ConnectedTile (ConnectedTile (..), IsConnectedTile (..))
 
-newtype T30 = T30 [Value]
+newtype T30 = T30 [Tiles.Value]
   deriving (Eq, Show)
 
-instance ConnectedTile T30 where
+instance IsConnectedTile T30 where
+  getRunState _ = Tiles.Ready
+  setRunState t _ = t
+
+  readable (T30 []) _ = False
+  readable _ _ = True
+  writable _ _ = True
+
+  isWaitingOnRead _ = Just Tiles.ANY
+  isWaitingOnWrite _ = Just Tiles.ANY
+
   readValueFrom (T30 []) _ = (T30 [], Nothing)
   readValueFrom (T30 (v : vs)) _ = (T30 vs, Just v)
   writeValueTo (T30 vs) _ v = T30 (vs ++ [v])
-  step = id
+
+  step = id