commit 4132a7b3f73402a2829e344e129b7ce2643f967f Author: Smaug123 Date: Sat May 2 12:57:03 2020 +0100 Initial commit diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..cf13761 --- /dev/null +++ b/.gitignore @@ -0,0 +1,7 @@ +bin/ +obj/ +/packages/ +riderModule.iml +/_ReSharper.Caches/ +.idea/ +Vector.sln.DotSettings.user diff --git a/Vector.Test/UnitTest1.fs b/Vector.Test/UnitTest1.fs new file mode 100644 index 0000000..6414771 --- /dev/null +++ b/Vector.Test/UnitTest1.fs @@ -0,0 +1,66 @@ +namespace Vector.Test + +open Vector +open NUnit.Framework +open FsUnitTyped + +[] +module TestVector = + [] + let example1 () = + let v1 = + Vector.empty + |> Vector.cons 3 + |> Vector.cons 5 + |> Vector.cons 6 + v1 |> Vector.toList |> shouldEqual [6 ; 5 ; 3] + + let v2 = Vector.empty |> Vector.cons "hi" |> Vector.cons "bye" + v2 |> Vector.toList |> shouldEqual ["bye" ; "hi"] + + match Vector.empty with + | Empty () -> failwith "" + //| Vec (a, b) -> failwith "" -- doesn't compile + + match v1 with + | Vec (a , b) -> + a |> shouldEqual 6 + b |> Vector.toList |> shouldEqual [5 ; 3] + + let v1 = + Vector.empty + |> Vector.cons 3 + |> Vector.cons 5 + |> Vector.cons 6 + + let twice = Vector.append v1 v1 + let otherTwice = + Vector.empty + |> Vector.cons 3 + |> Vector.cons 5 + |> Vector.cons 6 + |> Vector.cons 3 + |> Vector.cons 5 + |> Vector.cons 6 + + twice |> Vector.toList + |> shouldEqual (otherTwice |> Vector.toList) + + twice + |> Vector.cast + |> Vector.cast>, _, _> + |> Vector.cast>>>, _, _> + |> Vector.cast + |> shouldEqual otherTwice + + [] + let foo () = + let v1 = Vector.empty |> Vector.cons 1 + let twice = Vector.append v1 v1 + let twiceAgain = Vector.empty |> Vector.cons 1 |> Vector.cons 1 + + twice + |> Vector.cast + |> Vector.cast + |> shouldEqual twiceAgain + diff --git a/Vector.Test/Vector.Test.fsproj b/Vector.Test/Vector.Test.fsproj new file mode 100644 index 0000000..6941849 --- /dev/null +++ b/Vector.Test/Vector.Test.fsproj @@ -0,0 +1,25 @@ + + + + netcoreapp3.1 + + false + false + + + + + + + + + + + + + + + + + + diff --git a/Vector.sln b/Vector.sln new file mode 100644 index 0000000..2fc61ac --- /dev/null +++ b/Vector.sln @@ -0,0 +1,22 @@ + +Microsoft Visual Studio Solution File, Format Version 12.00 +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Vector", "Vector\Vector.fsproj", "{02FD0C06-3231-4381-9FCD-91149836F0FB}" +EndProject +Project("{F2A71F9B-5D33-465A-A702-920D77279786}") = "Vector.Test", "Vector.Test\Vector.Test.fsproj", "{27DA29C8-088E-4AEE-8195-982AF9C412E9}" +EndProject +Global + GlobalSection(SolutionConfigurationPlatforms) = preSolution + Debug|Any CPU = Debug|Any CPU + Release|Any CPU = Release|Any CPU + EndGlobalSection + GlobalSection(ProjectConfigurationPlatforms) = postSolution + {02FD0C06-3231-4381-9FCD-91149836F0FB}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {02FD0C06-3231-4381-9FCD-91149836F0FB}.Debug|Any CPU.Build.0 = Debug|Any CPU + {02FD0C06-3231-4381-9FCD-91149836F0FB}.Release|Any CPU.ActiveCfg = Release|Any CPU + {02FD0C06-3231-4381-9FCD-91149836F0FB}.Release|Any CPU.Build.0 = Release|Any CPU + {27DA29C8-088E-4AEE-8195-982AF9C412E9}.Debug|Any CPU.ActiveCfg = Debug|Any CPU + {27DA29C8-088E-4AEE-8195-982AF9C412E9}.Debug|Any CPU.Build.0 = Debug|Any CPU + {27DA29C8-088E-4AEE-8195-982AF9C412E9}.Release|Any CPU.ActiveCfg = Release|Any CPU + {27DA29C8-088E-4AEE-8195-982AF9C412E9}.Release|Any CPU.Build.0 = Release|Any CPU + EndGlobalSection +EndGlobal diff --git a/Vector/Vector.fs b/Vector/Vector.fs new file mode 100644 index 0000000..d366c0c --- /dev/null +++ b/Vector/Vector.fs @@ -0,0 +1,88 @@ +namespace Vector + +type Z = + private + | Z + static member computed (a : Z) : Z = a + +type S<'a> = + private + | S + static member inline refine< ^n1, ^n2 when (^n1 or ^n2) : (static member refine : ^n1 -> ^n2)> (_ : S<'n1>) : S<'n2> = Unchecked.defaultof<_> + static member inline computed< ^n1 when ^n1 : (static member computed : ^n1 -> ^n1)> (_ : S<'n1>) : S<'n1> = Unchecked.defaultof<_> + +type Add<'a, 'b> = + private + | Add + static member inline refine (_ : Add< Z, Z>) : Z = Unchecked.defaultof<_> + static member inline refine< ^n1, ^n2> (_ : Add< S< ^n1>, S< ^n2>>) : S>> = Unchecked.defaultof<_> + static member inline refine< ^n1, ^n2 when (^n1 or ^n2) : (static member refine : ^n1 -> ^n2) and ^n1 : (static member computed : ^n1 -> ^n2)> (_ : Add< Z, ^n1>) : ^n2 = Unchecked.defaultof<_> + static member inline refine< ^n1, ^n2 when (^n1 or ^n2) : (static member refine : ^n1 -> ^n2) and ^n1 : (static member computed : ^n1 -> ^n2)> (_ : Add< ^n1, Z>) : ^n2 = Unchecked.defaultof<_> + +type Vector<'a, 'len> = + { + Elements : 'a list + } + +type VectorCrateEvaluator<'a, 'ret> = abstract Eval<'n> : Vector<'a, 'n> -> 'ret +type VectorCrate<'a> = abstract Apply<'ret> : VectorCrateEvaluator<'a, 'ret> -> 'ret + +[] +module VectorCrate = + let make<'a, 'n> (v : Vector<'a, 'n>) : VectorCrate<'a> = + { new VectorCrate<'a> with + member __.Apply e = e.Eval v + } + +[] +module Vector = + let empty<'a> : Vector<'a, Z> = { Elements = [] } + + let cons<'a, 'n> (x : 'a) (v : Vector<'a, 'n>) : Vector<'a, S<'n>> = + { + Elements = x :: v.Elements + } + + let toList<'a, 'n> (v : Vector<'a, 'n>) : 'a list = v.Elements + + let rec ofList<'a> (v : List<'a>) : VectorCrate<'a> = + match v with + | [] -> VectorCrate.make empty + | x :: xs -> + { new VectorCrate<'a> with + member __.Apply e = + (ofList xs).Apply + { new VectorCrateEvaluator<_,_> with + member __.Eval v = + e.Eval (cons x v) + } + } + + let append<'a, 'n1, 'n2> (v1 : Vector<'a, 'n1>) (v2 : Vector<'a, 'n2>) : Vector<'a, Add<'n1, 'n2>> = + { Elements = List.append v1.Elements v2.Elements } + + let fold<'a, 's, 'n> (f : 's -> 'a -> 's) (s : 's) (v : Vector<'a, 'n>) = + List.fold f s v.Elements + + let zip<'a, 'b, 'n> (v1 : Vector<'a, 'n>) (v2 : Vector<'b, 'n>) : Vector<'a * 'b, 'n> = + { + Elements = List.zip v1.Elements v2.Elements + } + + let map<'a, 'b, 'n> (f : 'a -> 'b) (v : Vector<'a, 'n>) : Vector<'b, 'n> = + { + Elements = List.map f v.Elements + } + + let head<'a, 'n> (v : Vector<'a, S<'n>>) : 'a = v.Elements.[0] + let tail<'a, 'n> (v : Vector<'a, S<'n>>) : Vector<'a, 'n> = { Elements = List.tail v.Elements } + let unsafeCast<'a, 'n, 'm> (a : Vector<'a, 'n>) : Vector<'a, 'm> = { Elements = a.Elements } + + let inline cast< ^n2, ^n1, 'a when (^n1 or ^n2) : (static member refine : ^n1 -> ^n2)> (a : Vector<'a, ^n1>) : Vector<'a, ^n2> = unsafeCast a + +[] +module Patterns = + let (|Vec|) (v : Vector<'a, S<'n>>) : 'a * Vector<'a, 'n> = + List.head v.Elements, { Elements = List.tail v.Elements } + + let (|Empty|) (_ : Vector<'a, Z>) = () \ No newline at end of file diff --git a/Vector/Vector.fsproj b/Vector/Vector.fsproj new file mode 100644 index 0000000..9eede08 --- /dev/null +++ b/Vector/Vector.fsproj @@ -0,0 +1,11 @@ + + + + netcoreapp3.1 + + + + + + +