patrick/WoofWare.Myriad
1
0
Fork 0
mirror of https://github.com/Smaug123/WoofWare.Myriad synced 2025-10-30 08:08:59 +00:00
Code Issues Packages Projects Releases Wiki Activity

Generics support

Browse Source
This commit is contained in:
Smaug123
2024-02-19 00:53:06 +00:00
parent 030d8ffa12
commit f2922a37a4
10 changed files with 175 additions and 87 deletions
Download Patch File Download Diff File Expand all files Collapse all files

16
ConsumePlugin/Catamorphism.fs
View File

@@ -11,12 +11,12 @@ type PairOpKind =
| ThenDoSeq
[<CreateCatamorphism "TreeCata">]
type Tree<'a> =
| Const of Const<'a>
| Pair of Tree<'a> * Tree<'a> * PairOpKind
| Sequential of Tree<'a> list
| Builder of Tree<'a> * TreeBuilder<'a>
type Tree<'a, 'b> =
| Const of Const<'a> * 'b
| Pair of Tree<'a, 'b> * Tree<'a, 'b> * PairOpKind
| Sequential of Tree<'a, 'b> list
| Builder of Tree<'a, 'b> * TreeBuilder<'b, 'a>
and TreeBuilder<'a> =
| Child of TreeBuilder<'a>
| Parent of Tree<'a>
and TreeBuilder<'b, 'a> =
| Child of TreeBuilder<'b, 'a>
| Parent of Tree<'a, 'b>

32
ConsumePlugin/GeneratedCatamorphism.fs
View File

@@ -12,16 +12,16 @@ namespace ConsumePlugin
open WoofWare.Myriad.Plugins
/// Description of how to combine cases during a fold
type TreeBuilderCataCase<'a, 'TreeBuilder, 'Tree> =
type TreeBuilderCataCase<'b, 'a, 'TreeBuilder, 'Tree> =
/// How to operate on the Child case
abstract Child : 'TreeBuilder -> 'TreeBuilder
/// How to operate on the Parent case
abstract Parent : 'Tree -> 'TreeBuilder
/// Description of how to combine cases during a fold
type TreeCataCase<'a, 'TreeBuilder, 'Tree> =
type TreeCataCase<'a, 'b, 'TreeBuilder, 'Tree> =
/// How to operate on the Const case
abstract Const : Const<'a> -> 'Tree
abstract Const : Const<'a> -> 'b -> 'Tree
/// How to operate on the Pair case
abstract Pair : 'Tree -> 'Tree -> PairOpKind -> 'Tree
/// How to operate on the Sequential case
@@ -30,30 +30,30 @@ type TreeCataCase<'a, 'TreeBuilder, 'Tree> =
abstract Builder : 'Tree -> 'TreeBuilder -> 'Tree
/// Specifies how to perform a fold (catamorphism) over the type Tree and its friends.
type TreeCata<'a, 'a, 'TreeBuilder, 'Tree> =
type TreeCata<'b, 'a, 'TreeBuilder, 'Tree> =
{
/// How to perform a fold (catamorphism) over the type TreeBuilder
TreeBuilder : TreeBuilderCataCase<'a, 'TreeBuilder, 'Tree>
TreeBuilder : TreeBuilderCataCase<'b, 'a, 'TreeBuilder, 'Tree>
/// How to perform a fold (catamorphism) over the type Tree
Tree : TreeCataCase<'a, 'TreeBuilder, 'Tree>
Tree : TreeCataCase<'a, 'b, 'TreeBuilder, 'Tree>
}
/// Methods to perform a catamorphism over the type Tree
[<RequireQualifiedAccess>]
module TreeCata =
[<RequireQualifiedAccess>]
type private Instruction<'a, 'a> =
| Process__TreeBuilder of TreeBuilder<'a>
| Process__Tree of Tree<'a>
type private Instruction<'b, 'a> =
| Process__TreeBuilder of TreeBuilder<'b, 'a>
| Process__Tree of Tree<'a, 'b>
| TreeBuilder_Child
| TreeBuilder_Parent
| Tree_Pair of PairOpKind
| Tree_Sequential of int
| Tree_Builder
let private loop (cata : TreeCata<_, _, _, _>) (instructions : ResizeArray<Instruction<_, _>>) =
let treeStack = ResizeArray ()
let treeBuilderStack = ResizeArray ()
let private loop (cata : TreeCata<'b, 'a, 'TreeBuilder, 'Tree>) (instructions : ResizeArray<Instruction<'b, 'a>>) =
let treeStack = ResizeArray<'Tree> ()
let treeBuilderStack = ResizeArray<'TreeBuilder> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
@@ -70,7 +70,7 @@ module TreeCata =
instructions.Add (Instruction.Process__Tree arg0_0)
| Instruction.Process__Tree x ->
match x with
| Tree.Const (arg0_0) -> cata.Tree.Const arg0_0 |> treeStack.Add
| Tree.Const (arg0_0, arg1_0) -> cata.Tree.Const arg0_0 arg1_0 |> treeStack.Add
| Tree.Pair (arg0_0, arg1_0, arg2_0) ->
instructions.Add (Instruction.Tree_Pair (arg2_0))
instructions.Add (Instruction.Process__Tree arg0_0)
@@ -121,8 +121,8 @@ module TreeCata =
/// Execute the catamorphism.
let runTreeBuilder
(cata : TreeCata<'a, 'a, 'TreeBuilderRet, 'TreeRet>)
(x : TreeBuilder<'a, 'a>)
(cata : TreeCata<'b, 'a, 'TreeBuilderRet, 'TreeRet>)
(x : TreeBuilder<'b, 'a>)
: 'TreeBuilderRet
=
let instructions = ResizeArray ()
@@ -131,7 +131,7 @@ module TreeCata =
Seq.exactlyOne treeBuilderRetStack
/// Execute the catamorphism.
let runTree (cata : TreeCata<'a, 'a, 'TreeBuilderRet, 'TreeRet>) (x : Tree<'a, 'a>) : 'TreeRet =
let runTree (cata : TreeCata<'b, 'a, 'TreeBuilderRet, 'TreeRet>) (x : Tree<'a, 'b>) : 'TreeRet =
let instructions = ResizeArray ()
instructions.Add (Instruction.Process__Tree x)
let treeBuilderRetStack, treeRetStack = loop cata instructions

8
ConsumePlugin/GeneratedFileSystem.fs
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]

8
ConsumePlugin/ListCata.fs
View File

@@ -33,8 +33,8 @@ module MyListCata =
| Process__MyList of MyList<'a>
| MyList_Cons of 'a
let private loop (cata : MyListCata<_, _>) (instructions : ResizeArray<Instruction<_>>) =
let myListStack = ResizeArray ()
let private loop (cata : MyListCata<'a, 'MyList>) (instructions : ResizeArray<Instruction<'a>>) =
let myListStack = ResizeArray<'MyList> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]
@@ -89,8 +89,8 @@ module MyList2Cata =
| Process__MyList2 of MyList2<'a>
| MyList2_Cons of 'a
let private loop (cata : MyList2Cata<_, _>) (instructions : ResizeArray<Instruction<_>>) =
let myList2Stack = ResizeArray ()
let private loop (cata : MyList2Cata<'a, 'MyList2>) (instructions : ResizeArray<Instruction<'a>>) =
let myList2Stack = ResizeArray<'MyList2> ()
while instructions.Count > 0 do
let currentInstruction = instructions.[instructions.Count - 1]