mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-30 08:08:59 +00:00
First pass at handling generics in cata
This commit is contained in:
@@ -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
|
||||
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user