[Haskell-cafe] generics-sop equivalent of everywhere/mkT?

Scott Michel scooter.phd at gmail.com
Tue Feb 26 00:51:58 UTC 2019

Here's the cut down code. I'd like to replace the "everywhere (mkT
fixupSymbol)" in the main with an equivalent Generics.SOP construction,
which effectively recurses into the product to replace/transform the
AbsAddr with a SymAddr if the hash table lookup succeeds. While I don't
object to SYB, it seems awkward to "mix and match" the two generic


{-# LANGUAGE DataKinds            #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE TemplateHaskell      #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Main where

import Data.Data
import Data.Foldable (foldl)
import Data.Int
import Data.Word (Word8, Word16)
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Text.Printf
import Generics.SOP
import Generics.SOP.TH (deriveGeneric)
import Data.Generics.Aliases (mkT)
import Data.Generics.Schemes (everywhere)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as H
import Data.Sequence (Seq, (><), (|>))
import qualified Data.Sequence as Seq

type Z80addr = Word16
type Z80word = Word8

class Z80operand x where
  formatOperand :: x -> Text

main :: IO()
main = mapM_ T.putStrLn (foldl printIns Seq.empty $ everywhere (mkT
fixupSymbol) insnSeq)
-- -------------------------------------------------^ Does this have a
Generics.SOP equivalent?
    printIns accum ins = accum |> T.concat ([mnemonic, gFormatOperands] <*>

    mnemonic (LD _)   = "LD   "
    mnemonic (CALL _) = "CALL "

    -- Generics.SOP: Fairly straightforward
    gFormatOperands {-elt-} =
      T.intercalate ", " . hcollapse . hcmap disOperandProxy (mapIK
formatOperand) . from {-elt-}
        disOperandProxy = Proxy :: Proxy Z80operand

    -- Translate an absolute address, generally hidden inside an
instruction operand, into a symbolic address
    -- if present in the symbol table.
    fixupSymbol addr@(AbsAddr absAddr) = maybe addr SymAddr (absAddr
`H.lookup` symtab)
    fixupSymbol other                  = other

    insnSeq :: Seq Z80instruction
    insnSeq = Seq.singleton (LD (Reg8Imm B 0x0))
              |> (LD (Reg8Indirect C (AbsAddr 0x1234)))
              |> (CALL (AbsAddr 0x4567))

    symtab :: HashMap Z80addr Text
    symtab = H.fromList [ (0x1234, "label1"), (0x4567, "label2")]

-- | Symbolic and absolute addresses. Absolute addresses can be translated
into symbolic
-- labels.
data SymAbsAddr  = AbsAddr Z80addr | SymAddr Text
  deriving (Eq, Ord, Typeable, Data)

data Z80reg8 = A | B | C
  deriving (Eq, Ord, Typeable, Data)

-- | Cut down version of the Z80 instruction set
data Z80instruction = LD OperLD | CALL SymAbsAddr
  deriving (Eq, Ord, Typeable, Data)

-- | Load operands
data OperLD = Reg8Imm Z80reg8 Z80word | Reg8Indirect Z80reg8 SymAbsAddr
  deriving (Eq, Ord, Typeable, Data)

$(deriveGeneric ''SymAbsAddr)
$(deriveGeneric ''Z80reg8)
$(deriveGeneric ''Z80instruction)
$(deriveGeneric ''OperLD)

instance Z80operand Z80word where
  formatOperand word = T.pack $ printf "0x%04x" word

instance Z80operand SymAbsAddr where
  formatOperand (AbsAddr addr)  = T.pack $ printf "0x04x" addr
  formatOperand (SymAddr label) = label

instance Z80operand Z80reg8 where
  formatOperand A = "A"
  formatOperand B = "B"
  formatOperand C = "C"

instance Z80operand OperLD where
  formatOperand (Reg8Imm reg imm) = T.concat [formatOperand reg, ", ",
formatOperand imm]
  formatOperand (Reg8Indirect reg addr) = T.concat [formatOperand reg, ",
", formatOperand addr]

On Sun, Feb 24, 2019 at 10:07 PM Scott Michel <scooter.phd at gmail.com> wrote:

> Before I cut down my code to a test case, are there any examples of a
> generics-sop equivalent of syb's everywhere/mkT? What's the way to operate
> on a product, replace the "I" argument with a compatible argument and walk
> back through the isomorphism, i.e. "to $ <something> $ from".
> I'm hacking on a Z80 system emulator (TRS-80 Model I system, more
> specifically). There are a couple of places where it'd be smoother in the
> disassembler to transform the disassembled instruction sequence (converting
> addresses to labels) before output. Consequently, cutting down code to an
> example is a bit painful -- examples would help.
> -scooter
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20190225/3e0214da/attachment.html>

More information about the Haskell-Cafe mailing list