spiking out a data model

src/TuringHS/Interpreter.hs

@@ -2,10 +2,55 @@ module TuringHS.Interpreter where
 
 import TuringHS.Operator
 
-data TuringMachine = TuringMachne {}
+interpret :: [Operator] -> m (TuringMachine n)
+interpret ops = do
+  return $ loadMachine ops
 
-instance Show TuringMachine where
+loadMachine :: [Operator] -> TuringMachine n
-  show _ = "TuringMachine is empty!"
+loadMachine ops =
+  TuringMachine
+    { machineOperators = loadOperators ops,
+      machineTape = blankTape
+    }
 
-interpret :: [Operator] -> m TuringMachine
+data TuringMachine n = TuringMachine
-interpret = undefined
+  { machineOperators :: OperatorDeck,
+    machineTape :: InfiniteTape n
+  }
+
+instance (Show n) => Show (TuringMachine n) where
+  show tm = "TuringMachine(operator=" ++ show (peekOperator $ machineOperators tm) ++ ", tape=" ++ show (peekTape $ machineTape tm) ++ ")"
+
+data OperatorDeck = OperatorDeck [Operator] [Operator]
+
+loadOperators :: [Operator] -> OperatorDeck
+loadOperators ops = OperatorDeck ops []
+
+peekOperator :: OperatorDeck -> Maybe Operator
+peekOperator (OperatorDeck (x : _) _) = Just x
+peekOperator _ = Nothing
+
+incrementOperator :: OperatorDeck -> Maybe OperatorDeck
+incrementOperator (OperatorDeck (x : front) back) = Just $ OperatorDeck front (x : back)
+incrementOperator _ = Nothing
+
+decrementOperator :: OperatorDeck -> Maybe OperatorDeck
+decrementOperator (OperatorDeck front (x : back)) = Just $ OperatorDeck (x : front) back
+decrementOperator _ = Nothing
+
+data InfiniteTape n = InfiniteTape [n] [n]
+
+blankTape :: InfiniteTape n
+blankTape = InfiniteTape [] []
+
+readTape :: (Bounded n) => InfiniteTape n -> n
+readTape (InfiniteTape (x : _) _) = x
+readTape _ = minBound
+
+incrementTape :: (Bounded n) => InfiniteTape n -> InfiniteTape n
+incrementTape (InfiniteTape (x : front) back) = InfiniteTape front (x : back)
+incrementTape (InfiniteTape [] back) = InfiniteTape [minBound] back
+
+decrementTape :: (Bounded n) => InfiniteTape n -> InfiniteTape n
+decrementTape (InfiniteTape front (x : back)) = InfiniteTape (x : front) back
+decrementTape (InfiniteTape front []) = InfiniteTape front [minBound]