Absolute bare-bones support for generics in cata (#101)

This commit is contained in:
Patrick Stevens
2024-02-19 00:57:14 +00:00
committed by GitHub
parent 3209372b5b
commit 7b49505064
13 changed files with 648 additions and 372 deletions

View File

@@ -33,8 +33,8 @@ module FileSystemItemCata =
| Process__FileSystemItem of FileSystemItem
| FileSystemItem_Directory of string * int * int
let private loop (cata : FileSystemCata<_>) (instructions : ResizeArray<Instruction>) =
let fileSystemItemStack = ResizeArray ()
let private loop (cata : FileSystemCata<'FileSystemItem>) (instructions : ResizeArray<Instruction>) =
let fileSystemItemStack = ResizeArray<'FileSystemItem> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
@@ -108,8 +108,8 @@ module GiftCata =
| Gift_Boxed
| Gift_WithACard of string
let private loop (cata : GiftCata<_>) (instructions : ResizeArray<Instruction>) =
let giftStack = ResizeArray ()
let private loop (cata : GiftCata<'Gift>) (instructions : ResizeArray<Instruction>) =
let giftStack = ResizeArray<'Gift> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
@@ -150,112 +150,3 @@ module GiftCata =
instructions.Add (Instruction.Process__Gift x)
let giftRetStack = loop cata instructions
Seq.exactlyOne giftRetStack
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type MyListCataCase<'MyList> =
/// How to operate on the Nil case
abstract Nil : 'MyList
/// How to operate on the Cons case
abstract Cons : head : int -> tail : 'MyList -> 'MyList
/// Specifies how to perform a fold (catamorphism) over the type MyList and its friends.
type MyListCata<'MyList> =
{
/// How to perform a fold (catamorphism) over the type MyList
MyList : MyListCataCase<'MyList>
}
/// Methods to perform a catamorphism over the type MyList
[<RequireQualifiedAccess>]
module MyListCata =
[<RequireQualifiedAccess>]
type private Instruction =
| Process__MyList of MyList
| MyList_Cons of int
let private loop (cata : MyListCata<_>) (instructions : ResizeArray<Instruction>) =
let myListStack = ResizeArray ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__MyList x ->
match x with
| MyList.Nil -> cata.MyList.Nil |> myListStack.Add
| MyList.Cons ({
Head = head
Tail = tail
}) ->
instructions.Add (Instruction.MyList_Cons (head))
instructions.Add (Instruction.Process__MyList tail)
| Instruction.MyList_Cons (head) ->
let tail = myListStack.[myListStack.Count - 1]
myListStack.RemoveAt (myListStack.Count - 1)
cata.MyList.Cons head tail |> myListStack.Add
myListStack
/// Execute the catamorphism.
let runMyList (cata : MyListCata<'MyListRet>) (x : MyList) : 'MyListRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__MyList x)
let myListRetStack = loop cata instructions
Seq.exactlyOne myListRetStack
namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type MyList2CataCase<'MyList2> =
/// How to operate on the Nil case
abstract Nil : 'MyList2
/// How to operate on the Cons case
abstract Cons : int -> 'MyList2 -> 'MyList2
/// Specifies how to perform a fold (catamorphism) over the type MyList2 and its friends.
type MyList2Cata<'MyList2> =
{
/// How to perform a fold (catamorphism) over the type MyList2
MyList2 : MyList2CataCase<'MyList2>
}
/// Methods to perform a catamorphism over the type MyList2
[<RequireQualifiedAccess>]
module MyList2Cata =
[<RequireQualifiedAccess>]
type private Instruction =
| Process__MyList2 of MyList2
| MyList2_Cons of int
let private loop (cata : MyList2Cata<_>) (instructions : ResizeArray<Instruction>) =
let myList2Stack = ResizeArray ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
instructions.RemoveAt (instructions.Count - 1)
match currentInstruction with
| Instruction.Process__MyList2 x ->
match x with
| MyList2.Nil -> cata.MyList2.Nil |> myList2Stack.Add
| MyList2.Cons (arg0_0, arg1_0) ->
instructions.Add (Instruction.MyList2_Cons (arg0_0))
instructions.Add (Instruction.Process__MyList2 arg1_0)
| Instruction.MyList2_Cons (arg0_0) ->
let arg1_0 = myList2Stack.[myList2Stack.Count - 1]
myList2Stack.RemoveAt (myList2Stack.Count - 1)
cata.MyList2.Cons arg0_0 arg1_0 |> myList2Stack.Add
myList2Stack
/// Execute the catamorphism.
let runMyList2 (cata : MyList2Cata<'MyList2Ret>) (x : MyList2) : 'MyList2Ret =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__MyList2 x)
let myList2RetStack = loop cata instructions
Seq.exactlyOne myList2RetStack