patrick/FicroKanSharp
1
0
Fork 0
mirror of https://github.com/Smaug123/FicroKanSharp synced 2025-10-05 03:28:41 +00:00
Code Issues Packages Projects Releases Wiki Activity

Update Fantomas (#5)

Browse Source
This commit is contained in:
Patrick Stevens
2023-06-17 19:41:15 +01:00
committed by GitHub
parent 7dd8f0dce4
commit 995c3efe4e
10 changed files with 51 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
.config/dotnet-tools.json
View File

@@ -2,11 +2,11 @@
"version": 1,
"isRoot": true,
"tools": {
"fantomas-tool": {
"version": "4.6.0",
"fantomas": {
"version": "6.0.5",
"commands": [
"fantomas"
]
}
}
}
}

8
.editorconfig
View File

@@ -7,8 +7,12 @@ fsharp_space_before_colon=true
fsharp_space_before_semicolon=true
fsharp_multiline_block_brackets_on_same_column=true
fsharp_newline_between_type_definition_and_members=true
fsharp_keep_indent_in_branch=true
fsharp_experimental_keep_indent_in_branch=true
fsharp_align_function_signature_to_indentation=true
fsharp_alternative_long_member_definitions=true
fsharp_disable_elmish_syntax=true
fsharp_multiline_bracket_style=aligned
fsharp_multi_line_lambda_closing_newline=true
fsharp_max_value_binding_width=80
fsharp_max_record_width=0
max_line_length=120
end_of_line=lf

2
.github/workflows/dotnet-core.yaml vendored
View File

@@ -26,4 +26,4 @@ jobs:
- name: Install Fantomas
run: dotnet tool restore
- name: Run Fantomas
run: dotnet tool run fantomas --check -r .
run: dotnet tool run fantomas --check .

9
FicroKanSharp.Test/Arithmetic.fs
View File

@@ -13,10 +13,7 @@ module Arithmetic =
let succ (x : Term) : Term = Term.Symbol ("succ", [ x ])
let rec ofInt (n : int) : Term =
if n = 0 then
zero
else
succ (ofInt (n - 1))
if n = 0 then zero else succ (ofInt (n - 1))
// "pluso x y z" is "x + y == z".
let rec pluso (x : Term) (y : Term) (z : Term) : Goal =
@@ -125,7 +122,9 @@ module Arithmetic =
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)))
(Goal.conj
(Goal.equiv z (succ m |> TypedTerm.compile))
(Goal.delay (fun () -> pluso n y m)))
)
)

8
FicroKanSharp.Test/Recursive.fs
View File

@@ -101,11 +101,7 @@ module Recursive =
|> shouldEqual (
Map.ofList
[
VariableCount 0,
TypedTerm.literal (Human "bridget")
|> TypedTerm.compile
VariableCount 1,
TypedTerm.literal (Human "caroline")
|> TypedTerm.compile
VariableCount 0, TypedTerm.literal (Human "bridget") |> TypedTerm.compile
VariableCount 1, TypedTerm.literal (Human "caroline") |> TypedTerm.compile
]
)

50
FicroKanSharp.Test/TestExamples.fs
View File

@@ -58,12 +58,7 @@ module TestThing =
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Symbol (5, [])
]
s |> Map.toList |> shouldEqual [ Variable.VariableCount 0, Term.Symbol (5, []) ]
match Stream.peel rest with
| None -> ()
@@ -78,18 +73,9 @@ module TestThing =
|> Stream.take 3
|> shouldEqual
[
Map.ofList
[
Variable.VariableCount 0, Term.Symbol (5, [])
]
Map.ofList
[
Variable.VariableCount 0, Term.Symbol (5, [])
]
Map.ofList
[
Variable.VariableCount 0, Term.Symbol (5, [])
]
Map.ofList [ Variable.VariableCount 0, Term.Symbol (5, []) ]
Map.ofList [ Variable.VariableCount 0, Term.Symbol (5, []) ]
Map.ofList [ Variable.VariableCount 0, Term.Symbol (5, []) ]
]
[<Fact>]
@@ -108,45 +94,25 @@ module TestThing =
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Symbol (5, [])
]
s |> Map.toList |> shouldEqual [ Variable.VariableCount 0, Term.Symbol (5, []) ]
match Stream.peel rest with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Symbol (6, [])
]
s |> Map.toList |> shouldEqual [ Variable.VariableCount 0, Term.Symbol (6, []) ]
match Stream.peel rest with
| None -> failwith "oh no"
| Some (s, rest) ->
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Symbol (5, [])
]
s |> Map.toList |> shouldEqual [ Variable.VariableCount 0, Term.Symbol (5, []) ]
match Stream.peel rest with
| None -> failwith "oh no"
| Some (s, _rest) ->
s
|> Map.toList
|> shouldEqual
[
Variable.VariableCount 0, Term.Symbol (6, [])
]
s |> Map.toList |> shouldEqual [ Variable.VariableCount 0, Term.Symbol (6, []) ]
/// This arose because x0 unified to x1, x1 unified to 1, but x0 didn't get reduced to 1 by `walk`.
[<Fact>]

10
FicroKanSharp.Test/TypedArithmetic.fs
View File

@@ -26,12 +26,7 @@ module TypedArithmetic =
if t2 = 0 then
None
else
unify
(TypedTerm.compile t1)
(Pure (t2 - 1)
|> TypedTerm.literal
|> TypedTerm.compile)
state
unify (TypedTerm.compile t1) (Pure (t2 - 1) |> TypedTerm.literal |> TypedTerm.compile) state
| Pure t1, Succ t2 ->
if t1 = 0 then
None
@@ -69,7 +64,8 @@ module TypedArithmetic =
TypedTerm.Goal.callFresh (fun n ->
Goal.conj
(TypedTerm.Goal.equiv x (succ n))
(TypedTerm.Goal.callFresh (fun ny -> Goal.conj (Goal.delay (fun () -> timeso n y ny)) (pluso y ny z)
(TypedTerm.Goal.callFresh (fun ny ->
Goal.conj (Goal.delay (fun () -> timeso n y ny)) (pluso y ny z)
))
)

8
FicroKanSharp/Domain.fs
View File

@@ -16,10 +16,7 @@ type Term =
override this.ToString () =
match this with
| Symbol (name, args) ->
let s =
args
|> List.map (sprintf "%O")
|> String.concat ", "
let s = args |> List.map (sprintf "%O") |> String.concat ", "
$"{name}[{s}]"
| Variable (VariableCount v) -> $"x{v}"
@@ -38,8 +35,7 @@ type Goal =
if variableCount > 4 then
"<exists x: ...>"
else
$"exists x{variableCount}: ({(g (VariableCount variableCount))
.ToString (variableCount + 1)})"
$"exists x{variableCount}: ({(g (VariableCount variableCount)).ToString (variableCount + 1)})"
| Conj (g1, g2) -> sprintf "((%s) AND (%s))" (g1.ToString variableCount) (g2.ToString variableCount)
| Disj (g1, g2) -> sprintf "((%s) OR (%s))" (g1.ToString variableCount) (g2.ToString variableCount)
| Equiv (g1, g2) -> sprintf "(%O) == (%O)" g1 g2

20
FicroKanSharp/Goal.fs
View File

@@ -86,8 +86,7 @@ module Goal =
None
else
//(unify : Term -> Term -> bool option)
if unifyMethod.ReturnParameter.ParameterType
<> typeof<State option> then
if unifyMethod.ReturnParameter.ParameterType <> typeof<State option> then
failwith
$"Incorrect unify return parameter should have been Option<State>: {unifyMethod.ReturnParameter.ParameterType}"
@@ -125,17 +124,7 @@ module Goal =
failwith $"Wrong parameters on Unify method of type {ty.Name}: {wrongParams}"
let result =
unifyMethod.Invoke (
name1,
[|
unify
name1
args1
name2
args2
state
|]
)
unifyMethod.Invoke (name1, [| unify ; name1 ; args1 ; name2 ; args2 ; state |])
|> unbox<State option>
result
@@ -155,8 +144,7 @@ module Goal =
name1.GetType ()
|> fun ty ->
if FSharpType.IsUnion ty then
if FSharpType.GetUnionCases ty
|> Array.forall (fun i -> i.GetFields().Length = 0) then
if FSharpType.GetUnionCases ty |> Array.forall (fun i -> i.GetFields().Length = 0) then
// reference enum
ty
else
@@ -178,8 +166,6 @@ module Goal =
else
customUnification ty name1 args1 name2 args2 s
| _, _ -> None
let rec private evaluate' (debug : bool) (goal : Goal) (state : State) : Stream =
if debug then
let varState =

49
FicroKanSharp/Typed.fs
View File

@@ -12,8 +12,8 @@ type TypedTerm<'a> =
type private TermConstructor =
{
Literal : obj [] -> obj
Term : obj [] -> obj
Literal : obj[] -> obj
Term : obj[] -> obj
}
type private FSharpUnionCase =
@@ -21,8 +21,8 @@ type private FSharpUnionCase =
Name : string
/// The PropertyInfo for the field, and the Literal case constructor of the TypedTerm
/// if it is one
Fields : (PropertyInfo * Option<TermConstructor>) []
Constructor : obj [] -> obj
Fields : (PropertyInfo * Option<TermConstructor>)[]
Constructor : obj[] -> obj
}
[<NoComparison ; CustomEquality>]
@@ -37,9 +37,7 @@ type internal TypeName<'a when 'a : equality> =
override this.Equals (other : obj) : bool =
match other with
| :? TypeName<'a> as other ->
this.UserType = other.UserType
&& this.FieldValue = other.FieldValue
| :? TypeName<'a> as other -> this.UserType = other.UserType && this.FieldValue = other.FieldValue
| _ -> false
override this.GetHashCode () = hash (this.UserType, this.FieldValue)
@@ -50,9 +48,7 @@ type internal TypeName<'a when 'a : equality> =
| Some (cases, tagDiscriminator) ->
if t1.FieldValue.GetType () = typeof<string> then
let case =
cases
|> Array.find (fun case -> case.Name = unbox<string> t1.FieldValue)
let case = cases |> Array.find (fun case -> case.Name = unbox<string> t1.FieldValue)
args
|> List.mapi (fun i term ->
@@ -65,11 +61,10 @@ type internal TypeName<'a when 'a : equality> =
.GetType()
.GetMethod(
"Unbox",
BindingFlags.Public
||| BindingFlags.NonPublic
||| BindingFlags.Instance
BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Instance
)
.MakeGenericMethod typeof<obj>
.MakeGenericMethod
typeof<obj>
let unboxed = mi.Invoke (name, [||]) |> unbox<TypeName<obj>>
@@ -110,8 +105,7 @@ type internal TypeName<'a when 'a : equality> =
None
else
if unifyMethod.ReturnParameter.ParameterType
<> typeof<State option> then
if unifyMethod.ReturnParameter.ParameterType <> typeof<State option> then
failwith
$"Incorrect unify return parameter should have been Option<State>: {unifyMethod.ReturnParameter.ParameterType}"
@@ -169,24 +163,23 @@ module TypedTerm =
let literal<'a> (t : 'a) : TypedTerm<'a> = TypedTerm.Literal t
let resolveGeneric (t : Type) : Type =
if t.IsGenericType then
t.GetGenericTypeDefinition ()
else
t
if t.IsGenericType then t.GetGenericTypeDefinition () else t
let rec private toUntypedLiteral' (ty : Type) : obj -> Term =
if ty = typeof<Variable> then
fun t -> Term.Variable (unbox t)
elif FSharpType.IsUnion ty then
let toTermList (o : obj []) : Term list =
let toTermList (o : obj[]) : Term list =
o
|> List.ofArray
|> List.map (fun (o : obj) ->
let ty = o.GetType ()
if ty.BaseType.IsGenericType
&& ty.BaseType.GetGenericTypeDefinition () = typedefof<TypedTerm<obj>>.GetGenericTypeDefinition
() then
if
ty.BaseType.IsGenericType
&& ty.BaseType.GetGenericTypeDefinition () = typedefof<TypedTerm<obj>>
.GetGenericTypeDefinition ()
then
o |> compileUntyped ty.GenericTypeArguments.[0]
else
toUntypedLiteral o
@@ -208,8 +201,7 @@ module TypedTerm =
let ty = pi.PropertyType
let isTypedTerm =
ty.IsGenericType
&& ty.GetGenericTypeDefinition () = typedefof<TypedTerm<obj>>
ty.IsGenericType && ty.GetGenericTypeDefinition () = typedefof<TypedTerm<obj>>
let constructor =
if isTypedTerm then
@@ -240,10 +232,7 @@ module TypedTerm =
fun t ->
let case = cases.[precomputed t]
let values =
case.Fields
|> Array.map (fun (pi, _) -> pi.GetValue t)
|> toTermList
let values = case.Fields |> Array.map (fun (pi, _) -> pi.GetValue t) |> toTermList
Term.Symbol (
{