Building again

package.yaml

@@ -56,6 +56,7 @@ dependencies:
 - containers
 - filepath
 - megaparsec
+- mtl
 - string-interpolate
 - vector
 

src/TIS100/Parser/AsmParser.hs

@@ -1,7 +1,6 @@
 module TIS100.Parser.AsmParser where
 
 import Control.Monad (void)
-import Data.Graph (Tree (Node))
 import Data.IntMap qualified as IM
 import Debug.Trace (trace, traceM)
 import TIS100.Errors (TISError (..), TISErrorCode (..), TISErrorOr)
@@ -32,10 +31,10 @@ data LabelOrInstruction
   | JRO RegisterOrConstant
   deriving (Eq, Show)
 
-newtype NodeAsmSource = NodeAsmSource [LabelOrInstruction]
+newtype TileAsmSource = TileAsmSource [LabelOrInstruction]
   deriving (Eq, Show)
 
-type AsmSource = IM.IntMap NodeAsmSource
+type AsmSource = IM.IntMap TileAsmSource
 
 parseLabel :: Parser String
 parseLabel = some alphaNumChar
@@ -138,23 +137,23 @@ parseInstruction = try parseNOP <|> try parseMOV <|> try parseSWP <|> try parseS
 parseLabelOrInstruction :: Parser LabelOrInstruction
 parseLabelOrInstruction = try parseLabelDef <|> try parseInstruction
 
-parseNodeAsm :: Parser (Int, NodeAsmSource)
-parseNodeAsm = do
+parseTileAsm :: Parser (Int, TileAsmSource)
+parseTileAsm = do
   char '@'
   n <- parseInt
   space
-  labelsOrInstructions <- sepEndBy (try parseLabelOrInstruction') $ try endOfNodeProgram
-  return (n, NodeAsmSource labelsOrInstructions)
+  labelsOrInstructions <- sepEndBy (try parseLabelOrInstruction') $ try endOfTileProgram
+  return (n, TileAsmSource labelsOrInstructions)
  where
   parseLabelOrInstruction' = do
     li <- parseLabelOrInstruction
     void space <|> eof
     return li
-  endOfNodeProgram = void space <|> void (char '@') <|> eof
+  endOfTileProgram = void space <|> void (char '@') <|> eof
 
 parseAllAsm :: AsmSource -> Parser AsmSource
-parseAllAsm nodeSources = do
-  sources <- sepBy parseNodeAsm space
+parseAllAsm tileSources = do
+  sources <- sepBy parseTileAsm space
   return $ IM.fromList sources
 
 parseAsm :: String -> TISErrorOr AsmSource

src/TIS100/Parser/Config.hs

@@ -2,7 +2,7 @@ module TIS100.Parser.Config where
 
 import Data.IntMap qualified as IM
 
-data NodeType = Conpute | Stack | Disabled
+data TileType = Conpute | Stack | Disabled
   deriving (Eq, Show)
 
 data IOSource = StdIO | List [Int] | File FilePath
@@ -13,7 +13,7 @@ type IODef = IM.IntMap IOSource
 data Config = Config
   { rows :: Int
   , cols :: Int
-  , nodes :: [[NodeType]]
+  , tiles :: [[TileType]]
   , inputs :: IODef
   , outputs :: IODef
   }

src/TIS100/Parser/ConfigParser.hs

@@ -8,7 +8,7 @@ import GHC.IO.Handle (hGetContents)
 import System.FilePath (takeDirectory, (</>))
 import System.IO (stdin)
 import TIS100.Errors (TISError (..), TISErrorCode (TISParseError), TISErrorOr)
-import TIS100.Parser.Config (Config (..), IODef, IOSource (..), NodeType (..))
+import TIS100.Parser.Config (Config (..), IODef, IOSource (..), TileType (..))
 import TIS100.Parser.Base (Parser, parseInt, parseToken)
 import Text.Megaparsec (MonadParsec (eof, takeWhile1P, try), Parsec, anySingleBut, count, manyTill, oneOf, parse, some, (<|>))
 import Text.Megaparsec.Char (char, printChar, space, spaceChar, string)
@@ -23,14 +23,14 @@ parseIntList = do
     space
     return n
 
-parseRow :: Int -> Parser [NodeType]
+parseRow :: Int -> Parser [TileType]
 parseRow n = do
   nodes <- count n $ oneOf ['C', 'S', 'D']
-  return $ map parseNodeType nodes
+  return $ map parseTileType nodes
  where
-  parseNodeType 'C' = Conpute
-  parseNodeType 'S' = Stack
-  parseNodeType 'D' = Disabled
+  parseTileType 'C' = Conpute
+  parseTileType 'S' = Stack
+  parseTileType 'D' = Disabled
 
 parseIOSource :: Parser IOSource
 parseIOSource = do
@@ -75,13 +75,13 @@ cfgParser = do
   space
   cols <- parseInt
   space
-  nodes <- replicateM rows $ do
-    nodesRow <- parseRow cols
+  tiles <- replicateM rows $ do
+    tilesRow <- parseRow cols
     space
-    return nodesRow
+    return tilesRow
   space
   (inputs, outputs) <- parseIODefs IM.empty IM.empty
-  return $ Config rows cols nodes inputs outputs
+  return $ Config rows cols tiles inputs outputs
 
 parseConfig :: String -> TISErrorOr Config
 parseConfig cfgSrc = case parse cfgParser "tis100cfg" cfgSrc of

src/TIS100/Sim/CPU.hs

@@ -1,44 +1,61 @@
 module TIS100.Sim.CPU where
 
-import Data.Vector.Mutable
+import Data.Vector qualified as V
+import Data.Vector.Mutable qualified as MV
 import TIS100.Parser.AsmParser (AsmSource)
-import TIS100.Parser.Config
+import TIS100.Parser.Config qualified as C
 import TIS100.Sim.ConnectedTile (ConnectedTile (..))
-import TIS100.Tiles.T21 (T21 (..))
-import TIS100.Tiles.T30 (T30 (..))
+import TIS100.Tiles.T21 qualified as T21
+import TIS100.Tiles.T30 qualified as T30
+
+-- data TileType = Undefined | T21 | T30
+--   deriving (Eq, Show)
 
 data Tile = Tile
   { pos :: (Int, Int)
-  , node :: ConnectedTile
+  , -- , typ :: TileType
+    connTile :: ConnectedTile
   }
 
--- deriving (Eq, Show)
-
-data CPUState m = CPUState
+data CPUState = CPUState
   { rows :: Int
   , cols :: Int
-  , tiles :: MVector m Tile
+  , tiles :: V.Vector Tile
   }
 
--- deriving (Eq, Show)
+createInitialCPUState :: C.Config -> AsmSource -> CPUState
+createInitialCPUState cfg asm =
+  let rows = C.rows cfg
+      cols = C.cols cfg
+      numTiles = rows * cols
+      tileTypes = concat $ C.tiles cfg
+   in CPUState rows cols $ V.fromList $ zipWith createTile [0 ..] tileTypes
+ where
+  createTile :: Int -> C.TileType -> Tile
+  createTile i tileType =
+    let pos = i `divMod` C.cols cfg
+     in case tileType of
+          C.Conpute -> Tile pos $ ConnectedTile $ T21.createTileState []
+          C.Stack -> Tile pos $ ConnectedTile $ T30.T30 []
+          C.Disabled -> Tile pos $ ConnectedTile $ T21.createTileState []
 
 {-
-createInitialState :: (Monad m) => Config -> AsmSource -> m (CPUState m)
+
+createInitialState :: (Monad m) => C.Config -> AsmSource -> m (CPUState (m ()))
 createInitialState cfg asm = do
-  let rows = rows cfg
-  let cols = cols cfg
-  let nodesTypes = nodes cfg
+  let rows = C.rows cfg
+  let cols = C.cols cfg
+  let numTiles = rows * cols
+  let tileTypes = concat $ C.tiles cfg
 
-  mapM createNodeRow nodesTypes
+  tileVector <- MV.generate numTiles $ createTile tileTypes
+  return $ CPUState rows cols tileVector
  where
-  createNodeRow :: (Monad m) => [NodeType] -> m (NodeRow m)
-  createNodeRow nodeTypes' = do
-    mapM createNode nodeTypes'
-
-  createNode :: (Monad m) => NodeType -> m Node
-  createNode nodeType = do
-    case nodeType of
-      Conpute -> return $ Node21 $ T21 asm
-      Stack -> return $ Node30 $ T30
-      Disabled -> return InactiveNode
+  createTile :: [C.TileType] -> Int -> Tile
+  createTile tileTypes i =
+    let tileType = tileTypes !! i
+     in case tileType of
+          C.Conpute -> Tile (0, 0) $ ConnectedTile $ T21
+          C.Stack -> Tile (0, 0) $ ConnectedTile $ T30
+          C.Disabled -> Tile (0, 0) $ ConnectedTile $ T21
 -}

src/TIS100/Sim/ConnectedTile.hs

@@ -1,8 +1,15 @@
 module TIS100.Sim.ConnectedTile where
 
+import TIS100.Tiles.T21
+import TIS100.Tiles.T30
+
 class IsConnectedTile t
 
 data ConnectedTile
   = forall t.
     (IsConnectedTile t) =>
     ConnectedTile t
+
+instance IsConnectedTile T21
+
+instance IsConnectedTile T30