soyuz-0.0.0: DCPU16/Assembler.hs

-- | Assembler.
--
-- Works with "DCPU16.Instructions". Does no optimizations, just converts
-- labels to direct addresses and produces machine code.
--
-- Needs to be extended to support relative addressing. Extending labels to do
-- arithmetic: @sub pc,this-loop@ is a necessary step. I see this as more of an
-- optimization problem, since these kinds of rewrites would be neat to perform
-- automatically...
--
-- We'll see which direction it gets approached from.
module DCPU16.Assembler 
    ( assemble
    -- * Utility
    , labelAddrs
    ) where
import DCPU16.Instructions
import DCPU16.Instructions.Size
import Data.Word (Word16)
import Data.Vector (Vector)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B
import qualified Data.Vector as V
import Data.Generics.Uniplate.Data
import qualified Data.Map as M
import Data.Map (Map)
import Data.Serialize

-- | Turn labels into direct addresses, and output machine code.
assemble :: Vector Instruction -> ByteString
assemble = B.concat . V.toList . V.map (runPut . put) . labelsToAddrs


-- | Build address lookup table for label definitions.
labelAddrs :: Vector Instruction -> Map ByteString Word16
labelAddrs = snd . V.foldl f (0,M.empty) where
    f (addr,map) i = (addr',map') where
        addr' = addr + size i
        map' = case i of
            (Label s) -> M.insert s addr map
            _ -> map

-- | Replace every reference to a label with an address.
--
-- Strips comments and label definitions as well, assuming they won't be needed.
labelsToAddrs :: Vector Instruction -> Vector Instruction
labelsToAddrs is = 
    let is' =  V.filter (not . isComment) is
        lut = labelAddrs is'
    in  V.map (remap lut) . V.filter (not . isLabel) $ is'
  where
    isComment (Comment _ _) = True
    isComment _ = False
    isLabel (Label _) = True
    isLabel _ = False
    remap lut = transformBi f where
        f (LabelAddr s) = case M.lookup s lut of
            Just addr -> Const addr
            Nothing -> error $ "Undefined label: "++show s
        f x = x