patrick/FicroKanSharp
1
0
Fork 0
mirror of https://github.com/Smaug123/FicroKanSharp synced 2025-10-21 18:58:39 +00:00
Code Issues Packages Projects Releases Wiki Activity

Split into an untyped core and a typed layer (#1)

Browse Source
This commit is contained in:
Patrick Stevens
2021-12-26 16:24:05 +00:00
committed by GitHub
parent c462042dd2
commit b407409584
13 changed files with 745 additions and 242 deletions
Download Patch File Download Diff File Expand all files Collapse all files

206
FicroKanSharp.Test/Arithmetic.fs
View File

@@ -6,23 +6,20 @@ open Xunit
module Arithmetic =
type Nat = Nat
[<Fact>]
let ``Arithmetic example`` () =
let zero : Term<Nat> = Term.Symbol ("zero", [])
let ``Arithmetic example, untyped`` () =
let zero : Term = Term.Symbol ("zero", [])
let succ (x : Term<Nat>) : Term<Nat> =
Term.Symbol ("succ", [ TypedTerm.make x ])
let succ (x : Term) : Term = Term.Symbol ("succ", [ x ])
let rec ofInt (n : int) : Term<Nat> =
let rec ofInt (n : int) : Term =
if n = 0 then
zero
else
succ (ofInt (n - 1))
// "pluso x y z" is "x + y == z".
let rec pluso (x : Term<Nat>) (y : Term<Nat>) (z : Term<Nat>) : Goal =
let rec pluso (x : Term) (y : Term) (z : Term) : Goal =
let succCase =
Goal.callFresh (fun n ->
let n = Term.Variable n
@@ -41,49 +38,206 @@ module Arithmetic =
Goal.disj zeroCase succCase
Goal.evaluate (Goal.callFresh (fun z -> Goal.equiv<Nat> (Term.Variable z) (Term.Variable z))) State.empty
Goal.evaluate (Goal.callFresh (fun z -> Goal.equiv (Term.Variable z) (Term.Variable z)))
|> Stream.toList
|> shouldEqual [ Map.empty ]
// Evaluate 1 + 1
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 1) (ofInt 1) (Term.Variable z))) State.empty
Goal.evaluate (pluso (ofInt 2) (ofInt 2) (ofInt 4))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.make (succ (Term.Variable (VariableCount 2)))
VariableCount 1, TypedTerm.make (ofInt 0)
VariableCount 2, TypedTerm.make (ofInt 1)
VariableCount 0, ofInt 1
VariableCount 1, ofInt 3
VariableCount 3, zero
VariableCount 4, ofInt 2
]
)
// Evaluate 1 + 1
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 1) (ofInt 1) (Term.Variable z)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, succ (Term.Variable (VariableCount 2))
VariableCount 1, ofInt 0
VariableCount 2, ofInt 1
]
)
// Evaluate 2 + 2
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 2) (ofInt 2) (Term.Variable z))) State.empty
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 2) (ofInt 2) (Term.Variable z)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.make (succ (Term.Variable (VariableCount 2)))
VariableCount 1, TypedTerm.make (ofInt 1)
VariableCount 2, TypedTerm.make (succ (Term.Variable (VariableCount 4)))
VariableCount 3, TypedTerm.make zero
VariableCount 4, TypedTerm.make (ofInt 2)
VariableCount 0, succ (Term.Variable (VariableCount 2))
VariableCount 1, ofInt 1
VariableCount 2, succ (Term.Variable (VariableCount 5))
VariableCount 4, zero
VariableCount 5, ofInt 2
]
)
// Find n such that n + n = 4
Goal.evaluate (Goal.callFresh (fun z -> pluso (Term.Variable z) (Term.Variable z) (ofInt 4))) State.empty
Goal.evaluate (Goal.callFresh (fun z -> pluso (Term.Variable z) (Term.Variable z) (ofInt 4)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.make (succ (Term.Variable (VariableCount 1)))
VariableCount 1, TypedTerm.make (succ (Term.Variable (VariableCount 3)))
VariableCount 2, TypedTerm.make (ofInt 3)
VariableCount 3, TypedTerm.make zero
VariableCount 4, TypedTerm.make (ofInt 2)
VariableCount 0, succ (Term.Variable (VariableCount 1))
VariableCount 1, succ (Term.Variable (VariableCount 4))
VariableCount 2, ofInt 3
VariableCount 4, zero
VariableCount 5, ofInt 2
]
)
type Nat =
| Zero
| Succ of TypedTerm<Nat>
[<Fact>]
let ``Arithmetic example, typed`` () =
let rec ofInt (n : int) : TypedTerm<Nat> =
if n = 0 then
Nat.Zero |> TypedTerm.literal
else
Nat.Succ (ofInt (n - 1)) |> TypedTerm.literal
let succ (n : TypedTerm<Nat>) = Nat.Succ n |> TypedTerm.literal
let zero = Nat.Zero |> TypedTerm.literal
let rec numeralo (x : TypedTerm<Nat>) : Goal =
Goal.disj
(TypedTerm.Goal.equiv x (TypedTerm.literal Nat.Zero))
(TypedTerm.Goal.callFresh (fun y ->
Goal.conj (Goal.delay (fun () -> numeralo y)) (TypedTerm.Goal.equiv x (succ y))
))
// By the power of microKanren, let some numerals be manifested!
Goal.evaluate (TypedTerm.Goal.callFresh numeralo)
|> Stream.take 4
|> shouldEqual
[
Map.ofList
[
VariableCount 0, TypedTerm.literal Nat.Zero |> TypedTerm.compile
]
Map.ofList
[
VariableCount 0,
TypedTerm.literal (Nat.Succ (TypedTerm.variable (VariableCount 1)))
|> TypedTerm.compile
VariableCount 1, TypedTerm.literal Nat.Zero |> TypedTerm.compile
]
Map.ofList
[
VariableCount 0,
TypedTerm.literal (Nat.Succ (TypedTerm.variable (VariableCount 1)))
|> TypedTerm.compile
VariableCount 1,
TypedTerm.literal (Nat.Succ (TypedTerm.variable (VariableCount 3)))
|> TypedTerm.compile
VariableCount 3, TypedTerm.literal Nat.Zero |> TypedTerm.compile
]
Map.ofList
[
VariableCount 0,
TypedTerm.literal (Nat.Succ (TypedTerm.variable (VariableCount 1)))
|> TypedTerm.compile
VariableCount 1,
TypedTerm.literal (Nat.Succ (TypedTerm.variable (VariableCount 3)))
|> TypedTerm.compile
VariableCount 3,
TypedTerm.literal (Nat.Succ (TypedTerm.variable (VariableCount 5)))
|> TypedTerm.compile
VariableCount 5, TypedTerm.literal Nat.Zero |> TypedTerm.compile
]
]
// "pluso x y z" is "x + y == z".
let rec pluso (x : TypedTerm<Nat>) (y : TypedTerm<Nat>) (z : TypedTerm<Nat>) : Goal =
let z = z |> TypedTerm.compile
let succCase =
Goal.callFresh (fun n ->
let n = TypedTerm.variable n
Goal.callFresh (fun m ->
let m = TypedTerm.variable m
Goal.conj
(Goal.equiv (TypedTerm.compile x) (TypedTerm.compile (succ n)))
(Goal.conj (Goal.equiv z (succ m |> TypedTerm.compile)) (Goal.delay (fun () -> pluso n y m)))
)
)
let zeroCase =
Goal.conj
(Goal.equiv (TypedTerm.compile x) (TypedTerm.compile zero))
(Goal.equiv (TypedTerm.compile y) z)
Goal.disj zeroCase succCase
Goal.evaluate (pluso (ofInt 2) (ofInt 2) (ofInt 4))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, (ofInt 1 |> TypedTerm.compile)
VariableCount 1, (ofInt 3 |> TypedTerm.compile)
VariableCount 3, TypedTerm.compile zero
VariableCount 4, (ofInt 2 |> TypedTerm.compile)
]
)
// Evaluate 1 + 1
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 1) (ofInt 1) (TypedTerm.variable z)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 2)))
VariableCount 1, TypedTerm.compile (ofInt 0)
VariableCount 2, TypedTerm.compile (ofInt 1)
]
)
// Evaluate 2 + 2
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 2) (ofInt 2) (TypedTerm.variable z)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 2)))
VariableCount 1, TypedTerm.compile (ofInt 1)
VariableCount 2, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 5)))
VariableCount 4, TypedTerm.compile zero
VariableCount 5, TypedTerm.compile (ofInt 2)
]
)
// Find n such that n + n = 4
Goal.evaluate (Goal.callFresh (fun z -> pluso (TypedTerm.variable z) (TypedTerm.variable z) (ofInt 4)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 1)))
VariableCount 1, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 4)))
VariableCount 2, TypedTerm.compile (ofInt 3)
VariableCount 4, TypedTerm.compile zero
VariableCount 5, TypedTerm.compile (ofInt 2)
]
)

3
FicroKanSharp.Test/FicroKanSharp.Test.fsproj
View File

@@ -7,6 +7,9 @@
<ItemGroup>
<Compile Include="TestExamples.fs" />
<Compile Include="Arithmetic.fs" />
<None Include="NotWorking.fs" />
<Compile Include="Geometry.fs" />
<Compile Include="Recursive.fs" />
</ItemGroup>
<ItemGroup>

116
FicroKanSharp.Test/Geometry.fs Normal file
View File

@@ -0,0 +1,116 @@
namespace FicroKanSharp.Test
// Taken from http://www.let.rug.nl/bos/lpn//lpnpage.php?pagetype=html&pageid=lpn-htmlse5
open FsUnitTyped
open FicroKanSharp
open Xunit
module Geometry =
type Point<'a> = Point of TypedTerm<'a> * TypedTerm<'a>
type Line<'a> = Line of TypedTerm<Point<'a>> * TypedTerm<Point<'a>>
let verticalo<'a when 'a : equality> (line : TypedTerm<Line<'a>>) : Goal =
fun x ->
fun y ->
fun z ->
Line (TypedTerm<Point<'a>>.Literal (Point (x, y)), TypedTerm.Literal (Point (x, z)))
|> TypedTerm.Literal
|> TypedTerm.Goal.equiv line
|> TypedTerm.Goal.callFresh
|> TypedTerm.Goal.callFresh
|> TypedTerm.Goal.callFresh
let horizontalo<'a when 'a : equality> (line : TypedTerm<Line<'a>>) : Goal =
fun x ->
fun y ->
fun z ->
Line (TypedTerm<Point<'a>>.Literal (Point (x, y)), TypedTerm.Literal (Point (z, y)))
|> TypedTerm.Literal
|> TypedTerm.Goal.equiv line
|> TypedTerm.Goal.callFresh
|> TypedTerm.Goal.callFresh
|> TypedTerm.Goal.callFresh
[<Fact>]
let ``Geometry example from Learn Prolog Now`` () =
Line (
TypedTerm.Literal (Point (TypedTerm.Literal 1, TypedTerm.Literal 1)),
TypedTerm.Literal (Point (TypedTerm.Literal 1, TypedTerm.Literal 3))
)
|> TypedTerm.Literal
|> verticalo
|> Goal.evaluate
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (TypedTerm.Literal 1)
VariableCount 1, TypedTerm.compile (TypedTerm.Literal 1)
VariableCount 2, TypedTerm.compile (TypedTerm.Literal 3)
]
)
(Line (
TypedTerm.Literal (Point (TypedTerm.Literal 1, TypedTerm.Literal 1)),
TypedTerm.Literal (Point (TypedTerm.Literal 3, TypedTerm.Literal 2))
))
|> TypedTerm.Literal
|> verticalo
|> Goal.evaluate
|> Stream.toList
|> shouldEqual []
Goal.callFresh (fun y ->
Line (
TypedTerm.Literal (Point (TypedTerm.Literal 1, TypedTerm.Literal 1)),
TypedTerm.Literal (Point (TypedTerm.Literal 2, TypedTerm.variable y))
)
|> TypedTerm.Literal
|> horizontalo
)
|> Goal.evaluate
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
// There is y such that (1,1) = (2, y), and it is 1.
VariableCount 0, TypedTerm.compile (TypedTerm.Literal 1)
// There is x,y,z such that (x,y) = (z,y) where (x,y) = (1,1) and (z,y) = (2, y)
// and they are 1, 1, and 2.
VariableCount 1, TypedTerm.compile (TypedTerm.Literal 1)
VariableCount 2, TypedTerm.compile (TypedTerm.Literal 1)
VariableCount 3, TypedTerm.compile (TypedTerm.Literal 2)
]
)
Goal.callFresh (fun y ->
Line (TypedTerm.Literal (Point (TypedTerm.Literal 2, TypedTerm.Literal 3)), TypedTerm.variable y)
|> TypedTerm.Literal
|> horizontalo
)
|> Goal.evaluate
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
// There is a point p such that (2,3) -> p is horizontal.
// It is (x3, x2).
VariableCount 0,
TypedTerm.compile (
TypedTerm.Literal (
Point (TypedTerm.variable (VariableCount 3), TypedTerm.variable (VariableCount 2))
)
)
// This is the x-coordinate, which doesn't reify in the final answer.
VariableCount 1, TypedTerm.compile (TypedTerm.Literal 2)
// x2 is 3.
VariableCount 2, TypedTerm.compile (TypedTerm.Literal 3)
// Notice that x3 is not constrained.
]
)

124
FicroKanSharp.Test/NotWorking.fs Normal file
View File

@@ -0,0 +1,124 @@
namespace FicroKanSharp.Test
open FicroKanSharp
open Xunit
open FsUnitTyped
module NotWorking =
type Int =
| Pure of int
| Succ of TypedTerm<Int>
[<Fact>]
let ``Arithmetic example using literals`` () =
let zero = TypedTerm.literal (Int.Pure 0)
let succ (x : TypedTerm<Int>) : TypedTerm<Int> =
match x with
// Little efficiency saving
| TypedTerm.Literal (Int.Pure x) -> TypedTerm.Literal (x + 1 |> Int.Pure)
| _ -> TypedTerm.Literal (Int.Succ x)
let rec ofInt (n : int) : TypedTerm<Int> = Int.Pure n |> TypedTerm.Literal
let rec equal (x : Int) (y : Int) : Goal =
match x, y with
| Int.Pure x, Int.Pure y ->
if x = y then
Goal.always
else
Goal.never
| Int.Succ x, Int.Succ y -> equal x y
| TypedTerm.Literal (Int.Pure x), TypedTerm.Literal (Int.Succ y) ->
Goal.delay (fun () -> equal (TypedTerm.Literal (Int.Pure (x - 1))) y)
| TypedTerm.Literal (Int.Succ x), TypedTerm.Literal (Int.Pure y) ->
Goal.delay (fun () -> equal x (TypedTerm.Literal (Int.Pure (y - 1))))
// "pluso x y z" is "x + y == z".
let rec pluso (x : TypedTerm<Int>) (y : TypedTerm<Int>) (z : TypedTerm<Int>) : Goal =
let succCase =
TypedTerm.Goal.callFresh (fun n ->
TypedTerm.Goal.callFresh (fun m ->
Goal.conj (equal x (succ n)) (Goal.conj (equal z (succ m)) (Goal.delay (fun () -> pluso n y m)))
)
)
let zeroCase = Goal.conj (equal x zero) (equal y z)
Goal.disj zeroCase succCase
Goal.callFresh (fun n ->
let n = TypedTerm.variable n // should be 1
Goal.callFresh (fun m ->
let m = TypedTerm.variable m // should be 3
let delayed =
Goal.callFresh (fun a ->
let a = TypedTerm.variable a // should be 0
Goal.callFresh (fun b ->
let b = TypedTerm.variable b // should be 2
Goal.conj
(equal n (succ a))
(Goal.conj (equal m (succ b)) (Goal.conj (equal a zero) (equal (ofInt 2) b)))
)
)
Goal.conj (equal (ofInt 2) (succ n)) (Goal.conj (equal (ofInt 4) (succ m)) delayed)
)
)
|> Goal.evaluate
//Goal.evaluate (pluso (ofInt 2) (ofInt 2) (ofInt 4))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual Map.empty
Goal.evaluate (pluso (ofInt 2) (ofInt 2) (ofInt 5))
|> Stream.toList
|> printfn "%O"
// Evaluate 1 + 1
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 1) (ofInt 1) (TypedTerm.variable z)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 2)))
VariableCount 1, TypedTerm.compile (ofInt 0)
VariableCount 2, TypedTerm.compile (ofInt 1)
]
)
// Evaluate 2 + 2
Goal.evaluate (Goal.callFresh (fun z -> pluso (ofInt 2) (ofInt 2) (TypedTerm.variable z)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 2)))
VariableCount 1, TypedTerm.compile (ofInt 1)
VariableCount 2, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 4)))
VariableCount 3, TypedTerm.compile zero
VariableCount 4, TypedTerm.compile (ofInt 2)
]
)
// Find n such that n + n = 4
Goal.evaluate (Goal.callFresh (fun z -> pluso (TypedTerm.variable z) (TypedTerm.variable z) (ofInt 4)))
|> Stream.toList
|> List.exactlyOne
|> shouldEqual (
Map.ofList
[
VariableCount 0, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 1)))
VariableCount 1, TypedTerm.compile (succ (TypedTerm.variable (VariableCount 3)))
VariableCount 2, TypedTerm.compile (ofInt 3)
VariableCount 3, TypedTerm.compile zero
VariableCount 4, TypedTerm.compile (ofInt 2)
]
)

117
FicroKanSharp.Test/Recursive.fs Normal file
View File

@@ -0,0 +1,117 @@
namespace FicroKanSharp.Test
open Xunit
open FsUnitTyped
open FicroKanSharp
module Recursive =
type Entity =
| Mosquito
| Frog
| Stork
| Blood of TypedTerm<Entity>
| Name of TypedTerm<string>
[<Fact>]
let ``Recursive definitions, example 1`` () : unit =
let justAte (t1 : TypedTerm<Entity>) (t2 : TypedTerm<Entity>) : Goal =
Goal.disj
(Goal.conj
(TypedTerm.Goal.equiv t1 (TypedTerm.literal Entity.Mosquito))
(TypedTerm.Goal.equiv
t2
(TypedTerm.Literal (Entity.Blood (TypedTerm.literal (Entity.Name (TypedTerm.literal "john")))))))
(Goal.disj
(Goal.conj
(TypedTerm.Goal.equiv t1 (TypedTerm.literal Entity.Frog))
(TypedTerm.Goal.equiv t2 (TypedTerm.literal Entity.Mosquito)))
(Goal.conj
(TypedTerm.Goal.equiv t1 (TypedTerm.literal Entity.Stork))
(TypedTerm.Goal.equiv t2 (TypedTerm.literal Entity.Frog))))
let rec isDigesting (t1 : TypedTerm<Entity>) (t2 : TypedTerm<Entity>) : Goal =
Goal.disj
(justAte t1 t2)
(TypedTerm.Goal.callFresh (fun z ->
Goal.delay (fun () -> Goal.conj (isDigesting t1 z) (isDigesting z t2))
))
let stream =
isDigesting (TypedTerm.literal Entity.Stork) (TypedTerm.literal Entity.Mosquito)
|> Goal.evaluate
let fst, _ = stream |> Stream.peel |> Option.get
fst
|> shouldEqual (
Map.ofList
[
// The stork is digesting the mosquito, via the frog which the stork just ate.
VariableCount 0, TypedTerm.Literal Entity.Frog |> TypedTerm.compile
]
)
// There is no second element of the stream, but FicroKanSharp will search
// forever without realising this.
// It will forever try to find z such that `isDigesting Stork z` and `isDigesting z Mosquito`.
type Human = Human of string
[<Fact>]
let ``Recursive definitions, example 2`` () : unit =
let children =
[
"anne", "bridget"
"bridget", "caroline"
"caroline", "donna"
"donna", "emily"
]
|> List.map (fun (parent, child) -> TypedTerm.literal (Human parent), TypedTerm.literal (Human child))
let child (t1 : TypedTerm<Human>) (t2 : TypedTerm<Human>) : Goal =
children
|> List.fold
(fun state (parent, child) ->
Goal.conj (TypedTerm.Goal.equiv parent t1) (TypedTerm.Goal.equiv t2 child)
|> Goal.disj state
)
Goal.never
let rec descend (t1 : TypedTerm<Human>) (t2 : TypedTerm<Human>) : Goal =
Goal.disj
(child t1 t2)
(TypedTerm.Goal.callFresh (fun z -> Goal.conj (child t1 z) (Goal.delay (fun () -> descend z t2))))
let emptyStream =
child (TypedTerm.literal (Human "anne")) (TypedTerm.literal (Human "donna"))
|> Goal.evaluate
|> Stream.peel
match emptyStream with
| None -> ()
| Some s -> failwith $"{s}"
child (TypedTerm.literal (Human "anne")) (TypedTerm.literal (Human "bridget"))
|> Goal.evaluate
|> Stream.peel
|> Option.get
|> fst
|> shouldEqual (Map.ofList [])
descend (TypedTerm.literal (Human "anne")) (TypedTerm.literal (Human "donna"))
|> Goal.evaluate
|> Stream.peel
|> Option.get
|> fst
|> shouldEqual (
Map.ofList
[
VariableCount 0,
TypedTerm.literal (Human "bridget")
|> TypedTerm.compile
VariableCount 2,
TypedTerm.literal (Human "caroline")
|> TypedTerm.compile
]
)

57
FicroKanSharp.Test/TestExamples.fs
View File

@@ -10,26 +10,25 @@ module TestThing =
let ``Example from the docs`` () : unit =
let aAndB =
Goal.conj
(Goal.callFresh (fun x -> Goal.equiv (Term.Variable x) (Term.Literal 7)))
(Goal.callFresh (fun x -> Goal.equiv (Term.Variable x) (Term.Symbol (7, []))))
(Goal.callFresh (fun x ->
Goal.disj
(Goal.equiv (Term.Variable x) (Term.Literal 5))
(Goal.equiv (Term.Variable x) (Term.Literal 6))
(Goal.equiv (Term.Variable x) (Term.Symbol (5, [])))
(Goal.equiv (Term.Variable x) (Term.Symbol (6, [])))
))
let u = Goal.evaluate aAndB State.empty
let u = Goal.evaluate aAndB
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 7
Variable.VariableCount 1, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (7, [])
Variable.VariableCount 1, Term.Symbol (5, [])
]
match rest |> Stream.peel with
@@ -37,12 +36,11 @@ module TestThing =
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 7
Variable.VariableCount 1, Term.Literal 6
Variable.VariableCount 0, Term.Symbol (7, [])
Variable.VariableCount 1, Term.Symbol (6, [])
]
match rest |> Stream.peel with
@@ -52,20 +50,19 @@ module TestThing =
[<Fact>]
let ``Another example`` () =
let aAndB =
(Goal.callFresh (fun x -> Goal.equiv (Term.Variable x) (Term.Literal 5)))
(Goal.callFresh (fun x -> Goal.equiv (Term.Variable x) (Term.Symbol (5, []))))
let u = Goal.evaluate aAndB State.empty
let u = Goal.evaluate aAndB
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (5, [])
]
match Stream.peel rest with
@@ -75,21 +72,19 @@ module TestThing =
[<Fact>]
let ``Recursive example`` () =
let rec fives (x : Variable) =
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Literal 5)) (Goal.delay (fun () -> fives x)))
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Symbol (5, []))) (Goal.delay (fun () -> fives x)))
let u =
Goal.evaluate (Goal.callFresh fives) State.empty
let u = Goal.evaluate (Goal.callFresh fives)
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (5, [])
]
match Stream.peel rest with
@@ -97,11 +92,10 @@ module TestThing =
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (5, [])
]
match Stream.peel rest with
@@ -109,36 +103,34 @@ module TestThing =
| Some (s, _rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (5, [])
]
[<Fact>]
let ``Another recursive example`` () =
let rec fives (x : Variable) =
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Literal 5)) (Goal.delay (fun () -> fives x)))
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Symbol (5, []))) (Goal.delay (fun () -> fives x)))
let rec sixes (x : Variable) =
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Literal 6)) (Goal.delay (fun () -> sixes x)))
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Symbol (6, []))) (Goal.delay (fun () -> sixes x)))
let fivesAndSixes =
Goal.callFresh (fun x -> Goal.disj (fives x) (sixes x))
let u = Goal.evaluate fivesAndSixes State.empty
let u = Goal.evaluate fivesAndSixes
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (5, [])
]
match Stream.peel rest with
@@ -146,11 +138,10 @@ module TestThing =
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 6
Variable.VariableCount 0, Term.Symbol (6, [])
]
match Stream.peel rest with
@@ -158,11 +149,10 @@ module TestThing =
| Some (s, rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
Variable.VariableCount 0, Term.Symbol (5, [])
]
match Stream.peel rest with
@@ -170,9 +160,8 @@ module TestThing =
| Some (s, _rest) ->
s
|> Map.map (fun _ -> TypedTerm.force<int>)
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 6
Variable.VariableCount 0, Term.Symbol (6, [])
]