Collecting the arguments of a constructor for some type

Question

A followup question to this , suppose I have two terms t1 and t2 of some algebraic datatype, and I have checked that the constructor for t1 and t2 are the same. That is, (informally), t1 = F(S) and t2 = G(T), and I've checked that F = G. Now I want to compute

map f (zip S T)

assuming S and T are lists of arguments. This naive code would require that everything in S is of some singular type though, which isn't going to be true in general.

At this point I'm just curious if there is a way to do this. It seems like casing over the constructors is going to be a much simpler solution. I would like to write this for a generic type, but I only need it for some specific type.

---

Edit: My specification of the problem wasn't quite right. The type I'm using is something like

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

For constructors with zero or more arguments of type Term v (like (F xy, F zw) ), I want to apply a function to each of them and collect a list of results: [f (x,z), f (y,w)] , and I want to ignore the variables.

I'm assuming the type Term v is of some class Unifiable v which has a method isVar which picks out which terms of my type are variables. But given that types can have constructors with arbitrary arguments, I'm not sure in what generality I could have for this in the first place. I'd need something like for there to be a specific Var constructor, and all other constructors to be of the form F [Term v] , or some such, and I'm not sure what constraints I would need to guarantee that.

---

Edit: More specifically, I'm trying to define a function (in fake haskell)

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

Of course, you can't use case like that, and this assumes every constructor (except Var) takes a list as its argument.

Answer 1

Here's how it would look like with the one-liner library for generic programming. There is a bit of boilerplate that could be packaged up somewhere, one-liner perhaps.

The argument of zipWithA that makes the recursive call to match' has type forall s. Typeable s => s -> s -> ZeroA Unifier s forall s. Typeable s => s -> s -> ZeroA Unifier s , where ZeroA is a certain applicative functor. Ideally, we would like s to be equal to Term , but one-liner expects a function that can handle all fields of the generic type (you get to choose a constraint that must hold for all of them); we use Typeable (via withType ) to filter out the invalid cases.

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