Có thể lấy được các nguyên tắc đệ quy một cách tổng quát không?

Question

Trong Idris, có một số máy móc ma thuật để tự động tạo (phụ thuộc) loại bỏ cho các loại do người dùng xác định. Tôi tự hỏi nếu nó có thể làm điều gì đó (có lẽ ít phụ thuộc) với các loại Haskell. Ví dụ, cho

data Foo a = No | Yes a | Perhaps (Foo a) 

Tôi muốn tạo

foo :: b -> (a -> b) -> (b -> b) -> Foo a -> b 
foo b _ _ No = b 
foo _ f _ (Yes a) = f a 
foo b f g (Perhaps c) = g (foo b f g x) 

tôi khá yếu về chức năng polyvariadic và Generics, vì vậy tôi có thể sử dụng một chút giúp đỡ bắt đầu.

Answer 1

Đây là bắt đầu thực hiện việc này bằng cách sử dụng GHC Generics. Thêm một số mã để liên kết lại các (:+:) sẽ làm cho điều này đẹp hơn. Cần thêm một vài trường hợp nữa và điều này có thể có vấn đề về ergonomic.

EDIT: Bah, tôi trở nên lười biếng và quay trở lại một nhóm dữ liệu để được tiêm cho công văn bình đẳng của tôi. Điều này làm thay đổi giao diện. Tôi nghi ngờ với đủ trickery, và/hoặc sử dụng gia đình loại tiêm này có thể được thực hiện mà không có một gia đình dữ liệu hoặc trường hợp chồng chéo.

{-# LANGUAGE DeriveGeneriC#-} 
{-# LANGUAGE EmptyDataDecls #-} 
{-# LANGUAGE TypeFamilies #-} 
{-# LANGUAGE TypeOperators #-} 
{-# LANGUAGE FlexibleInstances #-} 
{-# LANGUAGE FlexibleContexts #-} 
{-# LANGUAGE MultiParamTypeClasses #-} 
{-# LANGUAGE UndecidableInstances #-} 
module Main where 
import Data.Function (fix) 
import GHC.Generics 

data Foo a = No | Yes | Perhaps (Foo a) | Extra a Int Bool 
    deriving (Show, Generic1) 

data Bar a = Bar (Maybe a) 
    deriving (Show, Generic1) 

gcata :: (GCata (f a) (Rep1 f a), Generic1 f) => Alg (f a) (Rep1 f a) r -> f a -> r 
gcata f = fix(\w -> gcata' w f . from1) 

ex' :: Show a => Foo a -> String 
ex' = gcata (("No","Yes"),(\(Rec s) -> "Perhaps ("++s++")", \a i b -> "Extra ("++show a++") ("++show i++") ("++show b++")")) 

ex1 = ex' (Perhaps (Perhaps Yes) :: Foo Int) 
ex2 = ex' (Perhaps (Perhaps (Extra 'a' 2 True)) :: Foo Char) 

ex3 :: Foo a -> Foo a 
ex3 = gcata ((No, Yes), (Perhaps . unRec, Extra)) 

ex4 = gcata (\(K m) -> show m) (Bar (Just 3)) 

class GCata rec f where 
    type Alg (rec :: *) (f :: *) (r :: *) :: * 
    gcata' :: (rec -> r) -> Alg rec f r -> f -> r 

instance (GCata rec (f p)) => GCata rec (M1 i c f p) where 
    type Alg rec (M1 i c f p) r = Alg rec (f p) r 
    gcata' w f (M1 x) = gcata' w f x 

instance (GCata rec (f p), GCata rec (g p)) => GCata rec ((f :+: g) p) where 
    type Alg rec ((f :+: g) p) r = (Alg rec (f p) r, Alg rec (g p) r) 
    gcata' w (l,_) (L1 x) = gcata' w l x 
    gcata' w (_,r) (R1 x) = gcata' w r x 

instance GCata rec (U1 p) where 
    type Alg rec (U1 p) r = r 
    gcata' _ f U1 = f 

instance (Project rec (f p), GCata rec (g p)) => GCata rec ((f :*: g) p) where 
    type Alg rec ((f :*: g) p) r = Prj rec (f p) r -> Alg rec (g p) r 
    gcata' w f (x :*: y) = gcata' w (f (prj w x)) y 

class Project rec f where 
    type Prj (rec :: *) (f :: *) (r :: *) :: * 
    prj :: (rec -> r) -> f -> Prj rec f r 

instance (Project rec (f p)) => Project rec (M1 i c f p) where 
    type Prj rec (M1 i c f p) r = Prj rec (f p) r 
    prj w (M1 x) = prj w x 

instance Project rec (K1 i c p) where 
    type Prj rec (K1 i c p) r = c 
    prj _ (K1 x) = x 

instance (RecIfEq (TEq rec (f p)) rec (f p)) => Project rec (Rec1 f p) where 
    type Prj rec (Rec1 f p) r = Tgt (TEq rec (f p)) rec (f p) r 
    prj w (Rec1 x) = recIfEq w x 

instance Project rec (Par1 p) where 
    type Prj rec (Par1 p) r = p 
    prj _ (Par1 x) = x 

instance GCata rec (K1 i c p) where 
    type Alg rec (K1 i c p) r = c -> r 
    gcata' _ f (K1 x) = f x 

instance GCata rec (Par1 p) where 
    type Alg rec (Par1 p) r = p -> r 
    gcata' _ f (Par1 x) = f x 

instance (Project rec (Rec1 f p)) => GCata rec (Rec1 f p) where 
    type Alg rec (Rec1 f p) r = Prj rec (Rec1 f p) r -> r 
    gcata' w f = f . prj w 

data HTrue; data HFalse 

type family TEq x y where 
    TEq x x = HTrue 
    TEq x y = HFalse 

class RecIfEq b rec t where 
    data Tgt b rec t r :: * 
    recIfEq :: (rec -> r) -> t -> Tgt b rec t r 

instance RecIfEq HTrue rec rec where 
    newtype Tgt HTrue rec rec r = Rec { unRec :: r } 
    recIfEq w = Rec . w 

instance RecIfEq HFalse rec t where 
    newtype Tgt HFalse rec t r = K { unK :: t } 
    recIfEq _ = K 

Answer 2

Như pigworker nhận xét trong các ý kiến ​​câu hỏi, bằng cách sử dụng mặc định Generic đại diện đưa đến xấu sắc tuyệt vời, vì chúng tôi không có thông tin trước về đệ quy trong loại của chúng ta, và chúng ta phải đào ra lần xuất hiện đệ quy bằng cách kiểm tra bằng tay đối với loại bình đẳng. Tôi muốn trình bày ở đây các giải pháp thay thế với đệ quy kiểu đại số f rõ ràng. Để làm được điều này, chúng tôi cần một phương án thay thế chung là Rep. Đáng buồn thay, điều này có nghĩa là chúng ta không thể dễ dàng gõ vào GHC.Generics, nhưng tôi hy vọng điều này sẽ được chỉnh sửa dù sao.

Trong giải pháp đầu tiên của tôi, tôi hướng đến một bản trình bày càng đơn giản càng tốt trong các khả năng GHC hiện tại. Giải pháp thứ hai là một phiên bản TypeApplication-heavy GHC 8 dựa trên các loại phức tạp hơn.

Bắt đầu như bình thường:

{-# language 
    TypeOperators, DataKinds, PolyKinds, 
    RankNTypes, EmptyCase, ScopedTypeVariables, 
    DeriveFunctor, StandaloneDeriving, GADTs, 
    TypeFamilies, FlexibleContexts, FlexibleInstances #-} 

đại diện chung của tôi là một fixpoint của một tổng-of-sản phẩm. Nó hơi mở rộng mô hình cơ bản của generics-sop, cũng là một tổng sản phẩm nhưng không phải là functorial và do đó không được trang bị cho các thuật toán đệ quy. Tôi nghĩ rằng SOP là một đại diện thực tế tốt hơn nhiều so với các loại lồng nhau tùy ý; bạn có thể tìm các đối số mở rộng về lý do tại sao đây là trường hợp trong số paper. Tóm lại, SOP loại bỏ thông tin làm tổ không cần thiết và cho phép chúng tôi tách riêng siêu dữ liệu khỏi dữ liệu cơ bản.

Nhưng trước bất cứ điều gì khác, chúng ta nên quyết định mã cho các loại chung. Trong vanilla GHC.Generics không có loại mã được xác định rõ ràng, vì các nhà xây dựng kiểu tổng, sản phẩm, v.v. tạo thành một ngữ pháp cấp loại đặc biệt và chúng tôi có thể gửi chúng bằng các lớp loại. Chúng tôi tuân thủ chặt chẽ hơn với các bản trình bày thông thường trong các generics được đánh máy phụ thuộc và sử dụng các mã, giải thích và chức năng rõ ràng. Mã của chúng tôi phải là loại:

[[Maybe *]] 

Danh sách bên ngoài mã hóa tổng số hàm tạo, với mỗi mã bên trong một hàm tạo. A Just * chỉ là trường hàm tạo, trong khi Nothing biểu thị trường đệ quy. Ví dụ: mã số [Int] là ['[], [Just Int, Nothing]].

type Rep a = Fix (SOP (Code a)) 

class Generic a where 
    type Code a :: [[Maybe *]] 
    to :: a -> Rep a 
    from :: Rep a -> a 

data NP (ts :: [Maybe *]) (k :: *) where 
    Nil :: NP '[] k 
    (:>) :: t -> NP ts k -> NP (Just t ': ts) k 
    Rec :: k -> NP ts k -> NP (Nothing ': ts) k 
infixr 5 :> 

data SOP (code :: [[Maybe *]]) (k :: *) where 
    Z :: NP ts k -> SOP (ts ': code) k 
    S :: SOP code k -> SOP (ts ': code) k 

Lưu ý rằng NP có các hàm tạo khác nhau cho các trường đệ quy và không đệ quy. Điều này khá quan trọng, bởi vì chúng tôi muốn các mã được phản ánh rõ ràng trong các chỉ mục loại. Nói cách khác, chúng tôi muốn NP cũng hoạt động như một singleton cho [Maybe *] (mặc dù chúng tôi vẫn tham số trong * vì lý do chính đáng).

Chúng tôi sử dụng thông số k trong các định nghĩa để lại một lỗ để đệ quy. Chúng tôi thiết lập đệ quy như thường lệ, bỏ rơi Functor trường để GHC:

deriving instance Functor (SOP code) 
deriving instance Functor (NP code) 

newtype Fix f = In {out :: f (Fix f)} 

cata :: Functor f => (f a -> a) -> Fix f -> a 
cata phi = go where go = phi . fmap go . out 

Chúng tôi có hai gia đình loại:

type family CurryNP (ts :: [Maybe *]) (r :: *) :: * where 
    CurryNP '[]    r = r 
    CurryNP (Just t ': ts) r = t -> CurryNP ts r 
    CurryNP (Nothing ': ts) r = r -> CurryNP ts r 

type family Alg (code :: [[Maybe *]]) (r :: *) :: * where 
    Alg '[]   r =() 
    Alg (ts ': tss) r = (CurryNP ts r, Alg tss r) 

CurryNP ts r món cà ri NP ts với kết quả loại r, và nó cũng cắm trong r trong các lần xuất hiện đệ quy.

Alg code r tính loại đại số trên SOP code r. Nó tuples cùng các eliminators cho các nhà xây dựng cá nhân. Ở đây, chúng tôi sử dụng các bộ dữ liệu lồng nhau thuần túy, nhưng tất nhiên là HList -s cũng sẽ phù hợp. Chúng tôi cũng có thể sử dụng lại NP tại đây dưới dạng HList, nhưng tôi thấy rằng quá kludgy.

Tất cả những gì còn lại là thực hiện các chức năng:

uncurryNP :: CurryNP ts a -> NP ts a -> a 
uncurryNP f Nil  = f 
uncurryNP f (x :> xs) = uncurryNP (f x) xs 
uncurryNP f (Rec k xs) = uncurryNP (f k) xs 

algSOP :: Alg code a -> SOP code a -> a 
algSOP fs (Z np) = uncurryNP (fst fs) np 
algSOP fs (S sop) = algSOP (snd fs) sop 

gcata :: Generic a => Alg (Code a) r -> a -> r 
gcata f = cata (algSOP f) . to 

Điểm mấu chốt ở đây là chúng ta phải chuyển đổi các eliminators cà ri trong Alg thành một "phù hợp" SOP code a -> a đại số, vì đó là hình thức mà có thể được sử dụng trực tiếp trong cata.

Hãy xác định một số đường và các trường hợp:

(<:) :: a -> b -> (a, b) 
(<:) = (,) 
infixr 5 <: 

instance Generic (Fix (SOP code)) where 
    type Code (Fix (SOP code)) = code 
    to = id 
    from = id 

instance Generic [a] where 
    type Code [a] = ['[], [Just a, Nothing]] 
    to = foldr (\x xs -> In (S (Z (x :> Rec xs Nil)))) (In (Z Nil)) 
    from = gcata ([] <: (:) <:()) -- note the use of "Generic (Rep [a])" 

Ví dụ:

> gcata (0 <: (+) <:()) [0..10] 
55 

Full code.

---

Tuy nhiên, nó sẽ đẹp hơn nếu chúng ta đã tách lạng bộ và không có sử dụng HList -s hoặc bộ lưu trữ để loại bỏ các bộ triệt tiêu. Cách thuận tiện nhất là có cùng thứ tự các đối số như trong các thư viện chuẩn, chẳng hạn như foldr hoặc maybe. Trong trường hợp này, kiểu trả về của gcata được cung cấp bởi một họ loại tính toán từ mã chung của một loại.

type family CurryNP (ts :: [Maybe *]) (r :: *) :: * where 
    CurryNP '[]    r = r 
    CurryNP (Just t ': ts) r = t -> CurryNP ts r 
    CurryNP (Nothing ': ts) r = r -> CurryNP ts r 

type family Fold' code a r where 
    Fold' '[]   a r = r 
    Fold' (ts ': tss) a r = CurryNP ts a -> Fold' tss a r 

type Fold a r = Fold' (Code a) r (a -> r) 

gcata :: forall a r. Generic a => Fold a r 

Điều này gcata rất cao (đầy đủ) mơ hồ. Chúng tôi cần một trong hai ứng dụng rõ ràng hoặc Proxy và tôi đã chọn ứng dụng cũ, phụ thuộc vào sự phụ thuộc vào GHC 8. Tuy nhiên, khi chúng tôi cung cấp một loại a, loại quả giảm, và chúng ta có thể dễ dàng cà ri:

> :t gcata @[_] 
gcata @[_] :: Generic [t] => r -> (t -> r -> r) -> [t] -> r 
> :t gcata @[_] 0 
gcata @[_] 0 :: Num t1 => (t -> t1 -> t1) -> [t] -> t1 
> gcata @[_] 0 (+) [0..10] 
55 

tôi đã sử dụng trên một loại chữ ký phần trong [_].Chúng tôi cũng có thể tạo một cách viết tắt cho điều này:

gcata1 :: forall f a r. Generic (f a) => Fold (f a) r 
gcata1 = gcata @(f a) @r 

Có thể được sử dụng làm gcata1 @[].

Tôi không muốn xây dựng chi tiết implementation of the above gcata tại đây. Nó không dài hơn nhiều so với phiên bản đơn giản, nhưng việc thực hiện gcata là khá lông (xấu hổ, nó chịu trách nhiệm cho câu trả lời bị trì hoãn của tôi). Ngay bây giờ tôi không thể giải thích nó rất tốt, kể từ khi tôi viết nó với Agda viện trợ, đòi hỏi rất nhiều tìm kiếm tự động và loại tetris.

Answer 3

Như đã nói trong các nhận xét và các câu trả lời khác, tốt nhất là bắt đầu từ một đại diện chung có quyền truy cập vào các vị trí đệ quy.

Một thư viện làm việc với một đại diện như là multirec (khác là compdata):

{-# LANGUAGE TemplateHaskell #-} 
{-# LANGUAGE GADTs, TypeFamilies, MultiParamTypeClasses, RankNTypes #-} 
module FooFold where 

import Generics.MultiRec.FoldAlgK 
import Generics.MultiRec.TH 

data Foo a = No | Yes a | Perhaps (Foo a) 

data FooF :: * -> * -> * where 
    Foo :: FooF a (Foo a) 

deriveAll ''FooF 

foldFoo :: (r, (a -> r, r -> r)) -> Foo a -> r 
foldFoo phi = fold (const phi) Foo 

Module FoldAlgK cung cấp một lần với một kiểu kết quả duy nhất và tính kiểu đại số như một cặp lồng nhau. Nó sẽ là tương đối dễ dàng để thêm cà ri đó. Có một số biến thể khác do thư viện cung cấp.