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

Format

Browse Source
This commit is contained in:
Smaug123
2021-12-24 20:00:02 +00:00
parent dc4ac9d9f1
commit 200f94b72d
3 changed files with 72 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
FicroKanSharp.Test/TestExamples.fs
View File

@@ -11,9 +11,14 @@ module TestThing =
let aAndB =
Goal.conj
(Goal.callFresh (fun x -> Goal.equiv (Term.Variable x) (Term.Literal 7)))
(Goal.callFresh (fun x -> Goal.disj (Goal.equiv (Term.Variable x) (Term.Literal 5)) (Goal.equiv (Term.Variable x) (Term.Literal 6))))
(Goal.callFresh (fun x ->
Goal.disj
(Goal.equiv (Term.Variable x) (Term.Literal 5))
(Goal.equiv (Term.Variable x) (Term.Literal 6))
))
let u = Goal.evaluate aAndB State.empty
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
@@ -48,13 +53,17 @@ module TestThing =
(Goal.callFresh (fun x -> Goal.equiv (Term.Variable x) (Term.Literal 5)))
let u = Goal.evaluate aAndB State.empty
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 5]
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
]
match Stream.peel rest with
| None -> ()
@@ -65,14 +74,19 @@ module TestThing =
let rec fives (x : Variable) =
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Literal 5)) (Goal.delay (fun () -> fives x)))
let u = Goal.evaluate (Goal.callFresh fives) State.empty
let u =
Goal.evaluate (Goal.callFresh fives) State.empty
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 5]
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
]
match Stream.peel rest with
| None -> failwith "oh no"
@@ -80,33 +94,45 @@ module TestThing =
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 5]
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
]
match Stream.peel rest with
| None -> failwith "oh no"
| Some (s, _rest) ->
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 5]
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 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)))
let rec sixes (x : Variable) =
(Goal.disj (Goal.equiv (Term.Variable x) (Term.Literal 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
match u |> Stream.peel with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 5]
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
]
match Stream.peel rest with
| None -> failwith "oh no"
@@ -114,7 +140,10 @@ module TestThing =
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 6]
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 6
]
match Stream.peel rest with
| None -> failwith "oh no"
@@ -122,12 +151,18 @@ module TestThing =
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 5]
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 5
]
match Stream.peel rest with
| None -> failwith "oh no"
| Some (s, _rest) ->
s
|> Map.toList
|> shouldEqual [Variable.VariableCount 0, Term.Literal 6]
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Literal 6
]

4
FicroKanSharp/AssemblyInfo.fs
View File

@@ -2,5 +2,5 @@ module AssemblyInfo
open System.Runtime.CompilerServices
[<assembly: InternalsVisibleTo("FicroKanSharp.Test")>]
do()
[<assembly : InternalsVisibleTo("FicroKanSharp.Test")>]
do ()

56
FicroKanSharp/Domain.fs
View File

@@ -1,6 +1,6 @@
namespace FicroKanSharp
type Variable = internal | VariableCount of int
type Variable = internal VariableCount of int
[<RequireQualifiedAccess>]
module private Variable =
@@ -41,8 +41,7 @@ module State =
[<RequireQualifiedAccess>]
module Stream =
let mzero : Stream =
Stream.Empty
let mzero : Stream = Stream.Empty
let rec mplus (s1 : Stream) (s2 : Stream) : Stream =
match s1 with
@@ -54,8 +53,7 @@ module Stream =
match s with
| Stream.Empty -> mzero
| Stream.Procedure s -> Stream.Procedure (fun () -> bind (s ()) g)
| Stream.Nonempty (fst, rest) ->
mplus (g fst) (bind rest g)
| Stream.Nonempty (fst, rest) -> mplus (g fst) (bind rest g)
let rec peel (s : Stream) : (Map<Variable, Term> * Stream) option =
match s with
@@ -65,19 +63,15 @@ module Stream =
[<RequireQualifiedAccess>]
module Goal =
let callFresh (f : Variable -> Goal) =
Goal.Fresh f
let callFresh (f : Variable -> Goal) = Goal.Fresh f
let delay g = Goal.Delay g
let disj (goal1 : Goal) (goal2 : Goal) : Goal =
Goal.Disj (goal1, goal2)
let disj (goal1 : Goal) (goal2 : Goal) : Goal = Goal.Disj (goal1, goal2)
let conj (goal1 : Goal) (goal2 : Goal) : Goal =
Goal.Conj (goal1, goal2)
let conj (goal1 : Goal) (goal2 : Goal) : Goal = Goal.Conj (goal1, goal2)
let equiv (term1 : Term) (term2 : Term) : Goal =
Goal.Equiv (term1, term2)
let equiv (term1 : Term) (term2 : Term) : Goal = Goal.Equiv (term1, term2)
let walk (u : Term) (s : State) : Term =
match u with
@@ -97,19 +91,10 @@ module Goal =
let v = walk v s
match u, v with
| Term.Variable u, Term.Variable v when u = v ->
s
|> Some
| Term.Variable u, v ->
extend u v s
|> Some
| u, Term.Variable v ->
extend v u s
|> Some
| Term.Literal u, Term.Literal v ->
if u = v then
Some s
else None
| Term.Variable u, Term.Variable v when u = v -> s |> Some
| Term.Variable u, v -> extend u v s |> Some
| u, Term.Variable v -> extend v u s |> Some
| Term.Literal u, Term.Literal v -> if u = v then Some s else None
let rec evaluate (goal : Goal) (state : State) : Stream =
match goal with
@@ -118,14 +103,15 @@ module Goal =
//(if s (unit `(, s . , (cdr s/c))) mzero))))
match unify u v state with
| None -> Stream.mzero
| Some unification ->
Stream.Nonempty (unification, Stream.mzero)
| Some unification -> Stream.Nonempty (unification, Stream.mzero)
| Goal.Fresh goal ->
let newVar = state.VariableCounter
evaluate (goal newVar) { state with VariableCounter = Variable.incr state.VariableCounter }
| Goal.Disj (goal1, goal2) ->
Stream.mplus (evaluate goal1 state) (evaluate goal2 state)
| Goal.Conj (goal1, goal2) ->
Stream.bind (evaluate goal1 state) (evaluate goal2)
| Goal.Delay g ->
Stream.Procedure (fun () -> evaluate (g ()) state)
evaluate
(goal newVar)
{ state with
VariableCounter = Variable.incr state.VariableCounter
}
| Goal.Disj (goal1, goal2) -> Stream.mplus (evaluate goal1 state) (evaluate goal2 state)
| Goal.Conj (goal1, goal2) -> Stream.bind (evaluate goal1 state) (evaluate goal2)
| Goal.Delay g -> Stream.Procedure (fun () -> evaluate (g ()) state)