diff --git a/ConsumePlugin/FSharpForFunAndProfitCata.fs b/ConsumePlugin/FSharpForFunAndProfitCata.fs index 1120bc3..121e66e 100644 --- a/ConsumePlugin/FSharpForFunAndProfitCata.fs +++ b/ConsumePlugin/FSharpForFunAndProfitCata.fs @@ -61,3 +61,8 @@ and ConsCase = Head : int Tail : MyList } + +[] +type MyList2 = + | Nil + | Cons of int * MyList2 diff --git a/ConsumePlugin/GeneratedFileSystem.fs b/ConsumePlugin/GeneratedFileSystem.fs index 3106c20..a35c45d 100644 --- a/ConsumePlugin/GeneratedFileSystem.fs +++ b/ConsumePlugin/GeneratedFileSystem.fs @@ -206,3 +206,56 @@ module MyListCata = 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 +[] +module MyList2Cata = + [] + type private Instruction = + | Process__MyList2 of MyList2 + | MyList2_Cons of int + + let private loop (cata : MyList2Cata<_>) (instructions : ResizeArray) = + 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 diff --git a/WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestMyList2.fs b/WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestMyList2.fs new file mode 100644 index 0000000..e7f94db --- /dev/null +++ b/WoofWare.Myriad.Plugins.Test/TestCataGenerator/TestMyList2.fs @@ -0,0 +1,26 @@ +namespace WoofWare.Myriad.Plugins.Test + +open NUnit.Framework +open FsCheck +open FsUnitTyped +open ConsumePlugin + +[] +module TestMyList2 = + + let idCata : MyList2Cata<_> = + { + MyList2 = + { new MyList2CataCase<_> with + member _.Nil = MyList2.Nil + + member _.Cons head tail = MyList2.Cons (head, tail) + } + + } + + [] + let ``Cata works`` () = + let property (x : MyList2) = MyList2Cata.runMyList2 idCata x = x + + Check.QuickThrowOnFailure property diff --git a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj index b1433c7..6866b31 100644 --- a/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj +++ b/WoofWare.Myriad.Plugins.Test/WoofWare.Myriad.Plugins.Test.fsproj @@ -26,6 +26,7 @@ + diff --git a/WoofWare.Myriad.Plugins/CataGenerator.fs b/WoofWare.Myriad.Plugins/CataGenerator.fs index f737010..ac5df31 100644 --- a/WoofWare.Myriad.Plugins/CataGenerator.fs +++ b/WoofWare.Myriad.Plugins/CataGenerator.fs @@ -285,7 +285,7 @@ module internal CataGenerator = (fields : AdtNode list) : CataUnionBasicField list = - let rec go (prefix : string) (name : Ident option) (ty : SynType) = + let rec go (prefix : string) (name : Ident option) (ty : SynType) : CataUnionBasicField = let stripped = SynType.stripOptionalParen ty match stripped with