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

26 Feb 2019

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

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

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

Li-yao Xia