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

[Scott Michel]

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