Implement subphase5 and complete phase1To2

The program is now able to read simple asm programs and convert them to
a MimaState.

src/Mima/Asm/Phase2.hs

@@ -2,9 +2,19 @@ module Mima.Asm.Phase2
   ( phase1To2
   ) where
 
-import qualified Mima.Asm.Phase1 as P1
+import qualified Mima.Asm.Phase1           as P1
+import           Mima.Asm.Phase2.Subphase1
+import           Mima.Asm.Phase2.Subphase2
+import           Mima.Asm.Phase2.Subphase3
+import           Mima.Asm.Phase2.Subphase4
+import           Mima.Asm.Phase2.Subphase5
 import           Mima.Asm.Weed
-import qualified Mima.Vm.State   as Vm
+import qualified Mima.Vm.State             as Vm
 
 phase1To2 :: P1.Phase1 s -> Weed (WeedError s) Vm.MimaState
-phase1To2 = error "to be implemented"
+phase1To2 phase1 = do
+  s1 <- subphase1 phase1
+  s2 <- subphase2 s1
+  (s3, labelMap, _) <- subphase3 s2
+  s4 <- subphase4 labelMap s3
+  subphase5 s4

src/Mima/Asm/Phase2/Subphase5.hs

@@ -0,0 +1,48 @@
+{-# LANGUAGE DataKinds #-}
+
+module Mima.Asm.Phase2.Subphase5
+  ( subphase5
+  ) where
+
+import           Control.Monad.Trans.State
+import           Data.Void
+
+import           Mima.Asm.Phase2.Types
+import           Mima.Asm.Weed
+import qualified Mima.Vm.Memory            as Vm
+import qualified Mima.Vm.State             as Vm
+import qualified Mima.Vm.Word              as Vm
+
+type StateS5 = Vm.MimaState
+
+type WeedS5 s = StateT StateS5 (Weed (WeedError s))
+
+wordToVmWord :: MimaWord 'S4 s -> Vm.MimaWord
+wordToVmWord (WordLocation addr) = fromIntegral addr
+wordToVmWord (WordRaw word)      = word
+
+addRegister :: RegisterDirective 'S4 s -> WeedS5 s ()
+addRegister (RegIar _ loc)  = modify $ \s5 -> s5{Vm.msIar = loc}
+addRegister (RegAcc _ word) = modify $ \s5 -> s5{Vm.msAcc = wordToVmWord word}
+addRegister (RegRa  _ loc)  = modify $ \s5 -> s5{Vm.msRa = loc}
+addRegister (RegSp  _ loc)  = modify $ \s5 -> s5{Vm.msSp = loc}
+addRegister (RegFp  _ loc)  = modify $ \s5 -> s5{Vm.msFp = loc}
+
+addToMemory :: Vm.MimaAddress -> Vm.MimaWord -> WeedS5 s ()
+addToMemory addr word = do
+  s5 <- get
+  let mem = Vm.msMemory s5
+  put s5{Vm.msMemory = Vm.writeAt addr word mem}
+
+updateToken :: AsmToken 'S4 s -> WeedS5 s ()
+updateToken (TokenOrg _ v)         = absurd v
+updateToken (TokenLabel _ _ v)     = absurd v
+updateToken (TokenMeta _ _ v)      = absurd v
+updateToken (TokenLit _ addr word) = addToMemory addr (wordToVmWord word)
+updateToken (TokenInstr _ _ v)     = absurd v
+updateToken (TokenReg _ _ reg)     = addRegister reg
+
+subphase5 :: Phase2 'S4 s -> Weed (WeedError s) Vm.MimaState
+subphase5 phase2 = execStateT (traverse updateToken phase2) initialS
+  where
+    initialS = Vm.basicState (Vm.mapToMemory mempty)