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

[Li-yao Xia]

I don't know about generics-sop examples, but the `types` traversal in 
generic-lens comes close. That could be a source of inspiration if 
you're considering implementing such deep traversals with SOP.

http://hackage.haskell.org/package/generic-lens-1.1.0.0/docs/Data-Generics-Product-Types.html

Li-yao

On 2/25/19 8:36 PM, Scott Michel wrote:
> 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
>>>
>>
> 
> 
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>