generics-sop equivalent of everywhere/mkT?

Previous Topic Next Topic
 
classic Classic list List threaded Threaded
4 messages Options
Reply | Threaded
Open this post in threaded view
|

generics-sop equivalent of everywhere/mkT?

scooter.phd@gmail.com
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.
Reply | Threaded
Open this post in threaded view
|

Re: generics-sop equivalent of everywhere/mkT?

scooter.phd@gmail.com
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 <[hidden email]> 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.
Reply | Threaded
Open this post in threaded view
|

Re: generics-sop equivalent of everywhere/mkT?

scooter.phd@gmail.com
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 <[hidden email]> 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 <[hidden email]> 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.
Reply | Threaded
Open this post in threaded view
|

Re: generics-sop equivalent of everywhere/mkT?

Li-yao Xia-2
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 <[hidden email]> 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 <[hidden email]>
>> 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.
>
_______________________________________________
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.