First pass at handling generics in cata

This commit is contained in:
Smaug123
2024-02-18 18:33:23 +00:00
parent 3209372b5b
commit dff2431bc8
6 changed files with 344 additions and 212 deletions

View File

@@ -8,10 +8,10 @@ open ConsumePlugin
[<TestFixture>]
module TestMyList =
let idCata : MyListCata<_> =
let idCata<'a> : MyListCata<'a, _> =
{
MyList =
{ new MyListCataCase<_> with
{ new MyListCataCase<'a, _> with
member _.Nil = MyList.Nil
member _.Cons head tail =
@@ -26,31 +26,28 @@ module TestMyList =
[<Test>]
let ``Cata works`` () =
let property (x : MyList) = MyListCata.runMyList idCata x = x
let property (x : MyList<int>) = MyListCata.runMyList idCata x = x
Check.QuickThrowOnFailure property
let toListCata =
let toListCata<'a> =
{
MyList =
{ new MyListCataCase<int list> with
{ new MyListCataCase<'a, 'a list> with
member _.Nil = []
member _.Cons (head : int) (tail : int list) = head :: tail
member _.Cons (head : 'a) (tail : 'a list) = head :: tail
}
}
let toListViaCata (l : MyList) : int list = MyListCata.runMyList toListCata l
let toListViaCata<'a> (l : MyList<'a>) : 'a list = MyListCata.runMyList toListCata l
[<Test>]
let ``Example of a fold converting to a new data structure`` () =
let rec toListNaive (l : MyList) : int list =
let rec toListNaive (l : MyList<int>) : int list =
match l with
| MyList.Nil -> []
| MyList.Cons {
Head = head
Tail = tail
} -> head :: toListNaive tail
| MyList.Cons consCell -> consCell.Head :: toListNaive consCell.Tail
Check.QuickThrowOnFailure (fun l -> toListNaive l = toListViaCata l)
@@ -62,20 +59,20 @@ module TestMyList =
let sumCata =
{
MyList =
{ new MyListCataCase<int64> with
{ new MyListCataCase<int, int64> with
member _.Nil = baseCase
member _.Cons (head : int) (tail : int64) = atLeaf head tail
}
}
let viaCata (l : MyList) : int64 = MyListCata.runMyList sumCata l
let viaCata (l : MyList<int>) : int64 = MyListCata.runMyList sumCata l
let viaFold (l : MyList) : int64 =
let viaFold (l : MyList<int>) : int64 =
// choose your favourite "to list" method - here I use the cata
// but that could have been done naively
(toListViaCata l, baseCase)
||> List.foldBack (fun elt state -> atLeaf elt state)
let property (l : MyList) = viaCata l = viaFold l
let property (l : MyList<int>) = viaCata l = viaFold l
Check.QuickThrowOnFailure property

View File

@@ -8,10 +8,10 @@ open ConsumePlugin
[<TestFixture>]
module TestMyList2 =
let idCata : MyList2Cata<_> =
let idCata<'a> : MyList2Cata<'a, _> =
{
MyList2 =
{ new MyList2CataCase<_> with
{ new MyList2CataCase<'a, _> with
member _.Nil = MyList2.Nil
member _.Cons head tail = MyList2.Cons (head, tail)
@@ -21,6 +21,6 @@ module TestMyList2 =
[<Test>]
let ``Cata works`` () =
let property (x : MyList2) = MyList2Cata.runMyList2 idCata x = x
let property (x : MyList2<int>) = MyList2Cata.runMyList2 idCata x = x
Check.QuickThrowOnFailure property