收集某種類型的構造函數的參數

Question

對this後續問題，假設我有兩個t1和t2的某個代數數據類型的術語，並且檢查到t1和t2的構造函數是相同的。也就是說，（非正式），T1 = F（S）和t2 = G（T），我已經檢查了F = G。現在，我想計算

map f (zip S T) 

假設S和T是名單參數。這個天真的代碼會要求S中的所有東西都是單一類型的，但一般情況並非如此。

在這一點上，我只是好奇，如果有辦法做到這一點。看起來像構造函數的套件將是一個更簡單的解決方案。我想寫一個泛型類型，但我只需要它的某種特定類型。

---

編輯：我對這個問題的描述不太對。我使用的類型是一樣的東西

data Term v = F (Term v) (Term v) 
      | G (Term v) 
      | C 
      | Var v 

對於Term v類型的零個或多個參數（如(F x y, F z w)），我想申請到他們每個人的功能，並收集結果的列表構造函數：[f (x,z), f (y,w)]，我想忽略這些變量。

我假設Term v類型是Unifiable v，它有一個方法isVar，它挑選出我的類型中的哪些項是變量。但是鑑於類型可以具有任意參數的構造函數，所以我不確定我首先可以得到什麼概括性。我需要類似於那裏有一個特定的Var構造函數，以及所有其他構造函數的形式爲F [Term v]，或者這樣的，我不知道我需要保證什麼約束。

---

編輯：更具體地說，我試圖定義一個函數（在假哈斯克爾）

match :: (Variable v) => Term v -> Term v -> Maybe [(v, Term v)] 
match t1 t2 = case t1 of 
    Var v -> Just (check v t2) 
    f xs -> case t2 of 
    Var v -> Just (check t1 v) 
    g ys -> if f == g then flatten(map match (zip (xs,ys))) 
       else Nothing 

當然，你不能使用的情況下那樣，這種假設每個構造（除了Var）以一個列表作爲它的參數。

Answer 1

下面是通用編程的one-liner庫的外觀。有一些樣板可以封裝在某個地方，也許只有一行。

的zipWithA說對match'遞歸調用已鍵入forall s. Typeable s => s -> s -> ZeroA Unifier s，其中ZeroA一定適用函子的參數。理想情況下，我們希望s等於Term，但one-liner需要一個可處理泛型類型的所有字段的函數（您可以選擇一個必須適用於所有字段的約束）;我們使用Typeable（通過withType）過濾出無效的情況。

main.hs：

{-# LANGUAGE DeriveGeneric, TypeApplications #-} 

import Data.Typeable (Typeable) 
import Generics.OneLiner (zipWithA) 
import GHC.Generics (Generic) 

import MyLibrary -- Some setup that should probably go in a library 

-- Some arbitrary syntax 
type V = Int 
data Term = Var V | C | UnOp Term | BinOp Term Term 
    deriving (Show, Generic) 

type Unifier = [(Int, Term)] 

match :: Term -> Term -> Maybe Unifier 
match t1 t2 = unZeroA (match' t1 t2) 

-- ZeroA is a wrapper around the applicative functor Const 
match' :: Term -> Term -> ZeroA Unifier Term 
match' (Var v1) t2 = write (v1, t2) 
match' t1 (Var v2) = write (v2, t1) 
match' t1 t2 = zipWithA @Typeable f t1 t2 
    where 
    f :: Typeable s => s -> s -> ZeroA Unifier s 
    f s1 s2 = withType @Term s1 (match' s1 s2) 

main = do 
    print (match (BinOp (Var 0) (UnOp (UnOp (Var 1)))) 
       (BinOp C  (UnOp (Var 4)))) 
    -- Just [(0,C),(4,UnOp (Var 1))] 
    print (match (BinOp C C) (UnOp C)) 
    -- Nothing 

MyLibrary.hs：

{-# LANGUAGE AllowAmbiguousTypes, DeriveGeneric, FlexibleInstances, GADTs, RankNTypes, ScopedTypeVariables, TypeOperators #-} 

module MyLibrary where 

import Control.Applicative (Alternative(..), Const(..)) 
import Data.Typeable (Typeable, eqT, (:~:)(..)) 

-- Add an absorbing element to any Monoid b 
newtype Zero b = Zero { unZero :: Maybe b } 

nil :: Zero b 
nil = Zero Nothing 

toZero :: b -> Zero b 
toZero b = Zero (Just b) 

instance Monoid b => Monoid (Zero b) where 
    mempty = Zero (Just mempty) 
    Zero Nothing `mappend` _   = nil 
    _   `mappend` Zero Nothing = nil 
    Zero a  `mappend` Zero b  = Zero (a `mappend` b) -- reusing the Maybe Monoid. 

-- Every monoid induces an Applicative functor via Const. 
type ZeroA b = Const (Zero b) 

unZeroA :: ZeroA b a -> Maybe b 
unZeroA = unZero . getConst 

-- A writer-like action. 
write :: b -> ZeroA [b] a 
write b = Const (toZero [b]) 

-- A monoid with an absorbing element induces an Alternative functor 
instance Monoid b => Alternative (ZeroA b) where 
    empty = Const nil 
    Const (Zero Nothing) <|> y = y 
    x <|> _ = x 

-- Typeable helper 

-- withType @t x (body x): 
-- the body may assume that the type of x is equal to t. 
-- 
-- If that is actually the case, then 
-- withType @t x (body x) = body x 
-- otherwise 
-- withType @t x (body x) = empty 
withType 
    :: forall t s f a 
    . (Typeable s, Typeable t, Alternative f) 
    => s -> ((t ~ s) => f a) -> f a 
withType _ body = case eqT :: Maybe (s :~: t) of 
    Nothing -> empty 
    Just Refl -> body