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 libraries.

V/R

-scooter

{-# 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?
where
    printIns accum ins = accum |> T.concat ([mnemonic, gFormatOperands] <*> [ins])

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

    -- Generics.SOP: Fairly straightforward
    gFormatOperands {-elt-} =
      T.intercalate ", " . hcollapse . hcmap disOperandProxy (mapIK formatOperand) . from {-elt-}
      where
        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@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