Generics support

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

View File

@@ -8,17 +8,17 @@ open FsCheck
[<TestFixture>]
module TestCataGenerator =
let idCata : TreeCata<_, _> =
let idCata<'a, 'b> : TreeCata<'a, 'b, _, _> =
{
Tree =
{ new TreeCataCase<_, _> with
member _.Const x = Const x
{ new TreeCataCase<_, _, _, _> with
member _.Const x y = Const (x, y)
member _.Pair x y z = Pair (x, y, z)
member _.Sequential xs = Sequential xs
member _.Builder x b = Builder (x, b)
}
TreeBuilder =
{ new TreeBuilderCataCase<_, _> with
{ new TreeBuilderCataCase<_, _, _, _> with
member _.Child x = Child x
member _.Parent x = Parent x
}
@@ -27,7 +27,7 @@ module TestCataGenerator =
[<Test>]
let ``Example`` () =
let x =
Tree.Pair (Tree.Const (Const.Int 0), Tree.Const (Const.String ""), PairOpKind.ThenDoSeq)
Tree.Pair (Tree.Const (Const.Verbatim 0, "hi"), Tree.Const (Const.String "", "bye"), PairOpKind.ThenDoSeq)
TreeCata.runTree idCata x |> shouldEqual x
@@ -36,7 +36,7 @@ module TestCataGenerator =
let ``Cata works`` () =
let builderCases = ref 0
let property (x : Tree) =
let property (x : Tree<int, string>) =
match x with
| Tree.Builder _ -> Interlocked.Increment builderCases |> ignore
| _ -> ()

View File

@@ -21,7 +21,6 @@ module TestMyList =
Tail = tail
}
}
}
[<Test>]

View File

@@ -14,9 +14,8 @@ module TestMyList2 =
{ new MyList2CataCase<'a, _> with
member _.Nil = MyList2.Nil
member _.Cons head tail = MyList2.Cons (head, tail)
member _.Cons (head : 'a) (tail : MyList2<'a>) = MyList2.Cons (head, tail)
}
}
[<Test>]