mirror of
https://github.com/Smaug123/WoofWare.Myriad
synced 2025-10-12 23:48:42 +00:00
Absolute bare-bones support for generics in cata (#101)
This commit is contained in:
@@ -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
|
||||
|
Reference in New Issue
Block a user