<div dir="ltr"><div dir="ltr"><div>The corresponding gensop.cabal:</div><div><br></div><div><div style="margin-left:40px"><span style="font-family:monospace,monospace">cabal-version: >= 1.12</span><br><span style="font-family:monospace,monospace">name: gensop</span><br><span style="font-family:monospace,monospace">version: 0.1</span><br><span style="font-family:monospace,monospace">build-type: Simple</span><br><span style="font-family:monospace,monospace">description: No description.</span><br><span style="font-family:monospace,monospace">license: GPL-3</span><br><span style="font-family:monospace,monospace"></span><br><span style="font-family:monospace,monospace">executable gensop</span><br><span style="font-family:monospace,monospace"> default-language: Haskell2010</span><br><span style="font-family:monospace,monospace"> main-is: Main.hs</span><br><span style="font-family:monospace,monospace"> build-depends:</span><br><span style="font-family:monospace,monospace"> base,</span><br><span style="font-family:monospace,monospace"> containers,</span><br><span style="font-family:monospace,monospace"> bytestring,</span><br><span style="font-family:monospace,monospace"> generics-sop,</span><br><span style="font-family:monospace,monospace"> syb,</span><br><span style="font-family:monospace,monospace"> text,</span><br><span style="font-family:monospace,monospace"> unordered-containers</span><br><span style="font-family:monospace,monospace"></span><br><span style="font-family:monospace,monospace"> default-extensions:</span><br><span style="font-family:monospace,monospace"> OverloadedStrings,</span><br><span style="font-family:monospace,monospace"> FlexibleInstances</span><br><span style="font-family:monospace,monospace"></span><br><span style="font-family:monospace,monospace"> ghc-options: -Wall</span><br></div><div style="margin-left:40px"><span style="font-family:monospace,monospace"></span></div><br></div></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Mon, Feb 25, 2019 at 4:51 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 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" target="_blank">Data.Text.IO</a> as T<br>import Text.Printf<br>import Generics.SOP<br>import <a href="http://Generics.SOP.TH" target="_blank">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" target="_blank">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>
</blockquote></div>