Question

是否有generics-sop模仿SYB的everywhere / mkT行为的例子？

我要尝试执行的操作（但未成功完成）是将everywhere (mkT fixupSymbol)中的main替换为等效的Generics.SOP构造，即使用{{1 }}递归到产品Generics.SOP中，并用(I (AbsAddr value))代替。

我可以将符号表传递给(I (SymAddr label))，从而污染gformatOperands签名。这似乎不是最理想的。

如果没有formatOperands，输出将如下所示：

fixupSymbol

将地址解析为符号标签：

LD   B, 0x0000
LD   C, 0x1234
CALL 0x4567

减少代码版本：

gensop % stack ghci
Using main module: 1. Package `gensop' component exe:gensop with main-is file: <...>/Main.hs
gensop-0.1: configure (exe)
Configuring gensop-0.1...
gensop-0.1: initial-build-steps (exe)
Configuring GHCi with the following packages: gensop
GHCi, version 8.6.3: http://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Main             ( <...>/Main.hs, interpreted )
*Main> main
LD   B, 0x0000
LD   C, label1
CALL label2
*Main>

{-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DeriveDataTypeable #-} module Main where import Data.Data import Data.Foldable (foldl) 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]文件：

gensop.cabal

Answer 1

generics-sop不提供等效的递归遍历方案，例如这些功能。如果您需要在该库中处理递归，则可能的解决方案是实现它们。虽然，在SOP中定义这样的功能会带来一些困难，因为它对数据的核心通用视图无法将递归节点与叶区分开。可以使用封闭类型系列（CTF）和某些类型类的机器来管理此设置中的递归。封闭式系列允许您：

实施类型安全的强制类型转换，这是定义mkT所必需的，
解决递归和非递归节点的情况-不同类型类的实例，否则将重叠。（另外的选择正在使用pragma来处理重叠的实例，这是GHC的一项最新功能；但是，在 Haskell社区，因此该解决方案通常被认为是不需要的。）

在未发表的论文“使用封闭类型族在通用编程中处理递归”中已经描述了使用CTF来处理递归，该案例使用generics-sop库作为案例研究；它提供了在SOP中定义递归方案的示例。

SYB的everywhere支持相互递归的数据类型族。以下实现允许将它们指定为类型级别列表。

{-# LANGUAGE DeriveGeneric, TypeFamilies, DataKinds,
             TypeApplications, ScopedTypeVariables, MultiParamTypeClasses,
             ConstraintKinds, FlexibleContexts, AllowAmbiguousTypes,
             FlexibleInstances, UndecidableInstances,
             UndecidableSuperClasses, TypeOperators, RankNTypes #-}

import Generics.SOP
import Generics.SOP.NS

import GHC.Exts (Constraint)
import Data.Type.Equality

type family Equal a x :: Bool where
  Equal a a = 'True
  Equal _ _ = 'False

class DecideEq (eq :: Bool) (a :: *) (b :: *) where
  decideEq :: Maybe (b :~: a)
instance a ~ b => DecideEq True a b where
  decideEq = Just Refl
instance DecideEq False a b where
  decideEq = Nothing

type ProofCast a b = DecideEq (Equal a b) a b

castEq :: forall a b. ProofCast a b => b -> Maybe a
castEq t = (\d -> castWith d t) <$> decideEq @(Equal a b)

type Transform a b = (Generic a, Generic b, ProofCast a b, ProofCast b a)

mkT :: Transform a b => (a -> a) -> b -> b
mkT f x = maybe x id $ castEq =<< f <$> castEq x

type family In (a :: *) (fam :: [*]) :: Bool where
    In a   ([a] ': fam) = 'True
    In [a] (a   ': fam) = 'True
    In a   (a   ': fam) = 'True
    In a   (_   ': fam) = In a fam
    In _   '[]          = 'False

class CaseEverywhere' (inFam :: Bool) (c :: * -> Constraint)
                      (fam :: [*]) (x :: *) (y :: *) where
  caseEverywhere' :: (forall b . c b => b -> b) -> I x -> I y

instance c x => CaseEverywhere' 'False c fam x x where
  caseEverywhere' f = I . f . unI
instance (c x, Everywhere x c fam) => CaseEverywhere' 'True c fam x x where
  caseEverywhere' f = I . f . everywhere @fam @c f . unI

class    CaseEverywhere' (In x fam) c fam x y => CaseEverywhere c fam x y
instance CaseEverywhere' (In x fam) c fam x y => CaseEverywhere c fam x y

caseEverywhere :: forall c fam x y . CaseEverywhere c fam x y
               => (forall b . c b => b -> b) -> I x -> I y
caseEverywhere = caseEverywhere' @(In x fam) @c @fam

type Everywhere a c fam =
  (Generic a, AllZip2 (CaseEverywhere c fam) (Code a) (Code a))

everywhere :: forall fam c a . Everywhere a c fam
           => (forall b . c b => b -> b) -> a -> a
everywhere f = to . everywhere_SOP . from
  where
    everywhere_SOP = trans_SOP (Proxy @(CaseEverywhere c fam)) $
                               caseEverywhere @c @fam f

用法首先，可以使用一个来自SYB论文的小规模示例对此进行检验。与SYB的everywhere相比，已实现的基于SOP的T还带有两个类型参数，并通过显式类型应用程序传递。第一个将一组相互递归的数据类型指定为类型列表。遍历仅将那些类型在该列表中指定的节点视为递归。需要第二个参数来为编译器提供“证明”对象以进行类型转换。 Transform约束的data Company = C [Dept] data Dept = D Name Manager [SubUnit] data SubUnit = PU Employee | DU Dept data Employee = E Person Salary data Person = P Name Address data Salary = S Float type Manager = Employee type Name = String type Address = String class Transform a b => T a b instance Transform a b => T a b type CompanyF = '[Company, Dept, SubUnit, Employee] increase :: Float -> Company -> Company increase k = everywhere @CompanyF @(T Salary) (mkT (incS k)) incS :: Float -> Salary -> Salary incS k (Sal s) = Sal (s * (1 + k))同义词用于允许其部分应用。

everywhere

已定义的mkT / Generic函数可以在您的代码中使用，但是会丢失某些everywhere实例。要将insnSeq应用于Generic (Seq Z80instruction)，您需要一个Data.Sequence实例。然而，您无法获得它，因为fmap模块不会导出其内部表示。可能的解决方法是将{-# LANGUAGE TypeApplications #-} ... type Z80 = '[SymAbsAddr, Z80reg8, Z80instruction, OperLD] main :: IO() main = mapM_ T.putStrLn (foldl printIns Seq.empty $ fmap (everywhere @Z80 @(T SymAbsAddr) (mkT fixupSymbol)) insnSeq)应用于序列。现在，您可以编写：

Generic

您应该为该遍历的所有类型的节点（递归和非递归）提供Generic实例。因此，接下来，这需要Word8，Word16和Text的{{1}}实例。尽管Generic Text实例可以通过deriveGeneric生成，但其他实例则不能，因为它们具有特殊的GHC表示形式。因此，您必须手动进行操作；这个定义很简单：

$(deriveGeneric ''Text)

instance Generic Word8 where
  type Code Word8 = '[ '[Word8]]
  from x                        = SOP (Z (I x :* Nil))
  to   (SOP ((Z (I x :* Nil)))) = x

instance Generic Word16 where
  type Code Word16 = '[ '[Word16]]
  from x                        = SOP (Z (I x :* Nil))
  to   (SOP ((Z (I x :* Nil)))) = x

此代码是样板，但是最新的GHC扩展名DerivingVia可以很好地简化此过程，从而减少了第二个定义。希望可以通过独立派生的方式来改进此有用的功能，因此可以改为：

deriving via Word8 instance Generic Word16

整个代码现在运行良好，main产生了预期的结果。

等同于无处不在/ mkT（替代产品）的Generics.SOP

1 个答案: