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

[Scott Michel]

The corresponding gensop.cabal:

cabal-version:  >= 1.12
name:           gensop
version:        0.1
build-type:     Simple
description:    No description.
license:        GPL-3

executable gensop
  default-language:     Haskell2010
  main-is: Main.hs
  build-depends:
    base,
    containers,
    bytestring,
    generics-sop,
    syb,
    text,
    unordered-containers

  default-extensions:
    OverloadedStrings,
    FlexibleInstances

  ghc-options: -Wall


On Mon, Feb 25, 2019 at 4:51 PM Scott Michel <scooter.phd at gmail.com> wrote:

> 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/f6ab8996/attachment.html>