<div dir="ltr"><div dir="ltr"><div>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.<br></div><div><br></div><div><br></div><div>V/R</div><div>-scooter<br></div><div><br></div><div><div style="margin-left:40px"><span style="font-family:monospace,monospace">{-# LANGUAGE DataKinds            #-}<br>{-# LANGUAGE TypeFamilies         #-}<br>{-# LANGUAGE TemplateHaskell      #-}<br>{-# LANGUAGE DeriveDataTypeable #-}<br><br>module Main where<br><br>import Data.Data<br>import Data.Foldable (foldl)<br>import Data.Int<br>import Data.Word (Word8, Word16)<br>import Data.Text (Text)<br>import qualified Data.Text as T<br>import qualified <a href="http://Data.Text.IO">Data.Text.IO</a> as T<br>import Text.Printf<br>import Generics.SOP<br>import <a href="http://Generics.SOP.TH">Generics.SOP.TH</a> (deriveGeneric)<br>import Data.Generics.Aliases (mkT)<br>import Data.Generics.Schemes (everywhere)<br>import Data.HashMap.Strict (HashMap)<br>import qualified Data.HashMap.Strict as H<br>import Data.Sequence (Seq, (><), (|>))<br>import qualified Data.Sequence as Seq<br><br><br>type Z80addr = Word16<br>type Z80word = Word8<br><br>class Z80operand x where<br>  formatOperand :: x -> Text<br><br>main :: IO()<br>main = mapM_ T.putStrLn (foldl printIns Seq.empty $ everywhere (mkT fixupSymbol) insnSeq)<br>-- -------------------------------------------------^ Does this have a Generics.SOP equivalent?<br>  where<br>    printIns accum ins = accum |> T.concat ([mnemonic, gFormatOperands] <*> [ins])<br><br>    mnemonic (LD _)   = "LD   "<br>    mnemonic (CALL _) = "CALL "<br><br>    -- Generics.SOP: Fairly straightforward<br>    gFormatOperands {-elt-} =<br>      T.intercalate ", " . hcollapse . hcmap disOperandProxy (mapIK formatOperand) . from {-elt-}<br>      where<br>        disOperandProxy = Proxy :: Proxy Z80operand<br><br>    -- Translate an absolute address, generally hidden inside an instruction operand, into a symbolic address<br>    -- if present in the symbol table.<br>    fixupSymbol addr@(AbsAddr absAddr) = maybe addr SymAddr (absAddr `H.lookup` symtab)<br>    fixupSymbol other                  = other<br><br>    insnSeq :: Seq Z80instruction<br>    insnSeq = Seq.singleton (LD (Reg8Imm B 0x0))<br>              |> (LD (Reg8Indirect C (AbsAddr 0x1234)))<br>              |> (CALL (AbsAddr 0x4567))<br><br>    symtab :: HashMap Z80addr Text<br>    symtab = H.fromList [ (0x1234, "label1"), (0x4567, "label2")]<br><br>-- | Symbolic and absolute addresses. Absolute addresses can be translated into symbolic<br>-- labels.<br>data SymAbsAddr  = AbsAddr Z80addr | SymAddr Text<br>  deriving (Eq, Ord, Typeable, Data)<br><br>data Z80reg8 = A | B | C<br>  deriving (Eq, Ord, Typeable, Data)<br><br>-- | Cut down version of the Z80 instruction set<br>data Z80instruction = LD OperLD | CALL SymAbsAddr<br>  deriving (Eq, Ord, Typeable, Data)<br><br>-- | Load operands<br>data OperLD = Reg8Imm Z80reg8 Z80word | Reg8Indirect Z80reg8 SymAbsAddr<br>  deriving (Eq, Ord, Typeable, Data)<br><br>$(deriveGeneric ''SymAbsAddr)<br>$(deriveGeneric ''Z80reg8)<br>$(deriveGeneric ''Z80instruction)<br>$(deriveGeneric ''OperLD)<br><br>instance Z80operand Z80word where<br>  formatOperand word = T.pack $ printf "0x%04x" word<br><br>instance Z80operand SymAbsAddr where<br>  formatOperand (AbsAddr addr)  = T.pack $ printf "0x04x" addr<br>  formatOperand (SymAddr label) = label<br><br>instance Z80operand Z80reg8 where<br>  formatOperand A = "A"<br>  formatOperand B = "B"<br>  formatOperand C = "C"<br><br>instance Z80operand OperLD where<br>  formatOperand (Reg8Imm reg imm) = T.concat [formatOperand reg, ", ", formatOperand imm]<br>  formatOperand (Reg8Indirect reg addr) = T.concat [formatOperand reg, ", ", formatOperand addr]<br></span></div><br></div></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Sun, Feb 24, 2019 at 10:07 PM Scott Michel <<a href="mailto:scooter.phd@gmail.com">scooter.phd@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"><div dir="ltr"><div>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".</div><div><br></div><div>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.<br></div><div> <br></div><div><br></div><div>-scooter<br></div></div>
</blockquote></div>