Skip to content

Commit a6d3eb1

Browse files
committed
Merge branch 'master' into v1.6
2 parents 1f474b4 + 39c9cb4 commit a6d3eb1

File tree

5 files changed

+124
-72
lines changed

5 files changed

+124
-72
lines changed

src/FSharpPlus/Data/DList.fs

+100-68
Original file line numberDiff line numberDiff line change
@@ -1,19 +1,19 @@
11
namespace FSharpPlus.Data
22

3+
open System
34
open System.Collections.Generic
45
open System.ComponentModel
6+
open FSharp.Core.CompilerServices
57
open FSharpPlus
68

79
// DList from FSharpx.Collections
810
//This implementation adds an additional parameter to allow O(1) retrieval of the list length.
911

10-
1112
type DListData<'T> =
1213
| Nil
1314
| Unit of 'T
1415
| Join of DListData<'T> * DListData<'T>
1516

16-
1717
/// DList is an ordered linear structure implementing the List signature (head, tail, cons),
1818
/// end-insertion (add), and O(1) append. Ordering is by insertion history.
1919
/// DList is an implementation of [John Hughes' append list](http://dl.acm.org/citation.cfm?id=8475).
@@ -25,11 +25,11 @@ type DList<'T> (length: int, data: DListData<'T>) =
2525

2626
static member ofSeq (s: seq<'T>) =
2727
DList (Seq.fold (fun (i, state) x ->
28-
(i+1,
28+
(i + 1,
2929
match state with
30-
| Nil -> Unit x
31-
| Unit _ -> Join (state, Unit x)
32-
| Join(_,_) -> Join (state, Unit x))) (0, Nil) s)
30+
| Nil -> Unit x
31+
| Unit _ -> Join (state, Unit x)
32+
| Join(_, _) -> Join (state, Unit x))) (0, Nil) s)
3333

3434
override this.GetHashCode () =
3535
match hashCode with
@@ -42,34 +42,23 @@ type DList<'T> (length: int, data: DListData<'T>) =
4242
| Some hash -> hash
4343

4444
override this.Equals other =
45-
#if FABLE_COMPILER
46-
let y = other :?> DList<'T>
47-
if this.Length <> y.Length then false
48-
else
49-
if hash this <> hash y then false
50-
else Seq.forall2 Unchecked.equals this y
51-
#else
5245
match other with
53-
| :? DList<'T> as y ->
54-
if this.Length <> y.Length then false
55-
else
56-
if this.GetHashCode () <> y.GetHashCode () then false
57-
else Seq.forall2 Unchecked.equals this y
46+
| :? DList<'T> as y -> (this :> IEquatable<DList<'T>>).Equals y
5847
| _ -> false
59-
#endif
6048

6149
/// O(1). Returns the count of elememts.
6250
member _.Length = length
6351

64-
// O(n). FoldBack walks the DList using constant stack space. Implementation is from Norman Ramsey.
52+
// O(2n). FoldBack walks the DList using constant stack space. Implementation is from Norman Ramsey.
6553
// Called a "fold" in the article processes the linear representation from right to left
6654
// and so is more appropriately implemented under the foldBack signature
6755
// See http://stackoverflow.com/questions/5324623/functional-o1-append-and-on-iteration-from-first-element-list-data-structure/5334068#5334068
68-
static member foldBack (f: 'T -> 'State -> 'State) (l: DList<'T>) (state: 'State) =
56+
static member foldBack (f: 'T -> 'State -> 'State) (l: DList<'T>) (state: 'State) =
57+
let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt f
6958
let rec walk lefts l xs =
7059
match l with
7160
| Nil -> finish lefts xs
72-
| Unit x -> finish lefts <| f x xs
61+
| Unit x -> finish lefts <| f.Invoke (x, xs)
7362
| Join (x, y) -> walk (x::lefts) y xs
7463
and finish lefts xs =
7564
match lefts with
@@ -78,37 +67,35 @@ type DList<'T> (length: int, data: DListData<'T>) =
7867
walk [] l.dc state
7968

8069
// making only a small adjustment to Ramsey's algorithm we get a left to right fold
81-
static member fold (f: 'State -> 'T -> 'State) (state: 'State) (l: DList<'T>) =
82-
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt f
70+
static member fold (f: 'State -> 'T -> 'State) (state: 'State) (l: DList<'T>) =
71+
let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt f
8372
let rec walk rights l xs =
8473
match l with
85-
| Nil -> finish rights xs
86-
| Unit x -> finish rights <| f.Invoke (xs, x)
87-
| Join(x,y) -> walk (y::rights) x xs
74+
| Nil -> finish rights xs
75+
| Unit x -> finish rights <| f.Invoke (xs, x)
76+
| Join (x, y) -> walk (y::rights) x xs
8877
and finish rights xs =
8978
match rights with
9079
| [] -> xs
9180
| t::ts -> walk ts t xs
9281
walk [] l.dc state
9382

94-
static member private tryFindi (f: (int -> 'T -> bool)) (l: DList<'T>) =
95-
let f = OptimizedClosures.FSharpFunc<_,_,_>.Adapt f
83+
static member private tryFindi (f: (int -> 'T -> bool)) (l: DList<'T>) =
84+
let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt f
9685
let rec walk rights l i =
9786
match l with
98-
| Nil -> finish rights i
99-
| Unit x ->
100-
if f.Invoke (i, x) then
101-
Some x
102-
else
103-
finish rights (i+1)
104-
| Join(x,y) -> walk (y::rights) x i
87+
| Nil -> finish rights i
88+
| Unit x ->
89+
if f.Invoke (i, x) then Some x
90+
else finish rights (i + 1)
91+
| Join (x, y) -> walk (y::rights) x i
10592
and finish rights xs =
10693
match rights with
10794
| [] -> None
10895
| t::ts -> walk ts t xs
10996
walk [] l.dc 0
11097
static member private findi (f: (int -> 'T -> bool)) (l: DList<'T>) =
111-
match DList.tryFindi f l with | Some v ->v | None -> raise (System.Collections.Generic.KeyNotFoundException ())
98+
match DList.tryFindi f l with Some v -> v | None -> raise (KeyNotFoundException ())
11299

113100
static member append (left, right) =
114101
match left, right with
@@ -161,59 +148,59 @@ type DList<'T> (length: int, data: DListData<'T>) =
161148
member this.TryTail =
162149
let rec step (xs: DListData<'T>) (acc: DListData<'T>) =
163150
match xs with
164-
| Nil -> acc | Unit _ -> acc
165-
| Join (x, y) -> step x (DList<'T>.append (y, acc))
151+
| Nil | Unit _ -> acc
152+
| Join (x, y) -> step x (DList<'T>.append (y, acc))
166153
if this.IsEmpty then None
167154
else Some (DList (length - 1, step data Nil))
168155

169156
/// O(log n). Returns the first element and tail.
170-
member this.Uncons = (DList<'T>.head data, this.Tail)
157+
member this.Uncons = DList<'T>.head data, this.Tail
171158

172159
/// O(log n). Returns option first element and tail.
173160
member this.TryUncons =
174161
match DList<'T>.tryHead data with
175162
| Some x -> Some (x, this.Tail)
176163
| None -> None
177164

178-
member s.Item with get (index: int) =
179-
let withIndex i _ = (i = index)
180-
if index < 0 || index >= s.Length then raise (System.IndexOutOfRangeException ())
181-
DList.findi withIndex s
165+
member s.Item
166+
with get (index: int) =
167+
let withIndex i _ = (i = index)
168+
if index < 0 || index >= s.Length then raise (IndexOutOfRangeException ())
169+
DList.findi withIndex s
182170

183171
member _.toSeq () =
184172
//adaptation of right-hand side of Norman Ramsey's "fold"
185173
let rec walk rights l = seq {
186174
match l with
187175
| Nil ->
188176
match rights with
189-
| [] -> ()
177+
| [] -> ()
190178
| t::ts -> yield! walk ts t
191179
| Unit x ->
192180
yield x
193181
match rights with
194182
| [] -> ()
195183
| t::ts -> yield! walk ts t
196-
| Join (x, y) -> yield! walk (y::rights) x}
197-
184+
| Join (x, y) -> yield! walk (y::rights) x }
198185
(walk [] data).GetEnumerator ()
199186

200-
interface IEnumerable<'T> with
201-
member s.GetEnumerator () = s.toSeq ()
202-
203-
interface IReadOnlyCollection<'T> with
204-
member s.Count = s.Length
187+
interface IEquatable<DList<'T>> with
188+
member this.Equals(y: DList<'T>) =
189+
if this.Length <> y.Length then false
190+
elif this.GetHashCode () <> y.GetHashCode () then false
191+
else Seq.forall2 Unchecked.equals this y
205192

206193
interface IReadOnlyList<'T> with
207194
member s.Item with get index = s.Item index
208-
209-
interface System.Collections.IEnumerable with
210-
override s.GetEnumerator () = (s.toSeq () :> System.Collections.IEnumerator)
195+
member s.Count = s.Length
196+
member s.GetEnumerator () = s.toSeq ()
197+
member s.GetEnumerator () = s.toSeq () :> System.Collections.IEnumerator
211198

212199

213-
[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
200+
[<RequireQualifiedAccess>]
214201
module DList =
215202
/// O(1). Returns a new DList of two lists.
216-
let append left right = DList<'T>.appendLists(left, right)
203+
let append left right = DList<'T>.appendLists (left, right)
217204

218205
/// O(1). Returns a new DList with the element added to the beginning.
219206
let cons hd (l: DList<'T>) =
@@ -225,8 +212,7 @@ module DList =
225212
[<GeneralizableValue>]
226213
let empty<'T> : DList<'T> = DList(0, Nil)
227214

228-
/// O(n). Fold walks the DList using constant stack space. Implementation is from Norman Ramsey.
229-
/// See http://stackoverflow.com/questions/5324623/functional-o1-append-and-on-iteration-from-first-element-list-data-structure/5334068#5334068
215+
/// Fold walks the DList using constant stack space.
230216
let foldBack (f: 'T -> 'State -> 'State) (l: DList<'T>) (state: 'State) = DList<'T>.foldBack f l state
231217

232218
let fold (f: 'State -> 'T -> 'State) (state: 'State) (l: DList<'T>) = DList<'T>.fold f state l
@@ -261,18 +247,64 @@ module DList =
261247
/// O(log n). Returns option first element and tail.
262248
let inline tryUncons (l: DList<'T>) = l.TryUncons
263249

264-
/// O(n). Returns a DList of the seq.
250+
/// Returns a DList of the seq.
265251
let ofSeq s = DList<'T>.ofSeq s
266252

267-
/// O(n). Returns a list of the DList elements.
268-
let inline toList l = foldBack List.cons l []
269-
270-
/// O(n). Returns a seq of the DList elements.
253+
/// Iterates over each element of the list.
254+
let iter action (source: DList<'T>) =
255+
let rec walk rights = function
256+
| Nil ->
257+
match rights with
258+
| [] -> ()
259+
| t::ts -> walk ts t
260+
| Unit x ->
261+
action x
262+
match rights with
263+
| [] -> ()
264+
| t::ts -> walk ts t
265+
| Join (x, y) -> walk (y::rights) x
266+
walk [] source.dc
267+
268+
/// Returns a list of the DList elements.
269+
let toList (source: DList<'T>) =
270+
#if FABLE_COMPILER
271+
DList<'T>.foldBack List.cons source []
272+
#else
273+
let mutable coll = new ListCollector<_> ()
274+
iter (fun x -> coll.Add x) source
275+
coll.Close ()
276+
#endif
277+
278+
/// Returns an array of the DList elements.
279+
let toArray (source: DList<'T>) =
280+
#if FABLE_COMPILER
281+
source :> seq<'T> |> Seq.toArray
282+
#else
283+
let mutable coll = new ArrayCollector<_> ()
284+
iter (fun x -> coll.Add x) source
285+
coll.Close ()
286+
#endif
287+
288+
/// Returns a seq of the DList elements.
271289
let inline toSeq (l: DList<'T>) = l :> seq<'T>
272290

291+
let pairwise (source: DList<'T>) =
292+
let (|Cons|Nil|) (l: DList<'T>) = match l.TryUncons with Some (a, b) -> Cons (a, b) | None -> Nil
293+
let rec pairWiseDListData cons lastvalue = function
294+
| Nil -> cons
295+
| Cons (x, Nil) -> Join (cons, Unit (lastvalue, x))
296+
| Cons (x, rest) -> pairWiseDListData (Join (cons, Unit (lastvalue, x))) x rest
297+
let dlistData =
298+
match source with
299+
| Nil | Cons (_, Nil) -> Nil
300+
| Cons (x, (Cons (y, rest))) -> pairWiseDListData (Unit (x, y)) y rest
301+
match source.Length with
302+
| 0 -> DList (0, Nil)
303+
| _ -> DList (source.Length - 1, dlistData)
304+
273305
// additions to fit F#+ :
274306
let inline map f (x: DList<_>) = DList.foldBack (cons << f ) x empty
275-
let concat x = DList.fold append empty x
307+
let concat x = DList.fold append empty x
276308
let inline ap f x = concat <| map (fun y -> map ((|>) y) f) x
277309
let inline bind m k = DList.foldBack (append << k) empty m
278310

@@ -283,13 +315,13 @@ type DList<'T> with
283315
static member (<|>) (x: DList<_>, y: DList<_>) = DList.append x y
284316

285317
[<EditorBrowsable(EditorBrowsableState.Never)>]
286-
static member ToSeq x = DList.toSeq x
318+
static member ToSeq x = DList.toSeq x
287319

288320
[<EditorBrowsable(EditorBrowsableState.Never)>]
289321
static member ToList x = DList.toList x
290322

291323
[<EditorBrowsable(EditorBrowsableState.Never)>]
292-
static member OfSeq x = DList.ofSeq x
324+
static member OfSeq x = DList.ofSeq x
293325

294326
[<EditorBrowsable(EditorBrowsableState.Never)>]
295327
static member Fold (x, f, z) = DList.fold f x z
@@ -301,4 +333,4 @@ type DList<'T> with
301333
static member Map (x, f) = DList.map f x
302334

303335
static member (<*>) (f, x) = DList.ap f x
304-
static member (>>=) (x, f) = DList.bind x f
336+
static member (>>=) (x, f) = DList.bind x f

src/FSharpPlus/Extensions/Array.fs

+1-1
Original file line numberDiff line numberDiff line change
@@ -55,7 +55,7 @@ module Array =
5555
let lenx, leny, lenz = Array.length list1, Array.length list2, Array.length list3
5656
let combinedFirstTwo = Array.init (lenx * leny) (fun i -> let (d, r) = Math.DivRem (i, leny) in (list1.[d], list2.[r]))
5757

58-
Array.init (lenx * leny * lenz) (fun i -> let (d, r) = Math.DivRem (i, leny) in combinedFirstTwo.[d], list3.[r])
58+
Array.init (lenx * leny * lenz) (fun i -> let (d, r) = Math.DivRem (i, lenz) in combinedFirstTwo.[d], list3.[r])
5959
|> Array.map (fun x -> mapping (fst (fst x)) (snd (fst x)) (snd x))
6060

6161
/// Concatenates all elements, using the specified separator between each element.

src/FSharpPlus/Extensions/List.fs

+3-3
Original file line numberDiff line numberDiff line change
@@ -76,12 +76,12 @@ module List =
7676
/// <param name="x3">Third list.</param>
7777
///
7878
/// <returns>List with values returned from mapping function.</returns>
79-
let lift3 f x1 x2 x3 =
80-
#if !FABLE_COMPILER || FABLE_COMPILER_3 || NET45 || FABLE_COMPILER_4
79+
let lift3 (f: 'T1 -> 'T2 -> 'T3 -> 'U) (x1: list<'T1>) (x2: list<'T2>) (x3: list<'T3>) =
80+
#if FABLE_COMPILER || NET45
8181
List.allPairs x2 x3
8282
|> List.allPairs x1
8383
|> List.map (fun x -> (fst (snd x), snd (snd x), fst x))
84-
|> List.map (fun (x, y, z) -> f x y z)
84+
|> List.map (fun (x, y, z) -> f z x y)
8585
#else
8686
let mutable coll = ListCollector<'U> ()
8787
x1 |> List.iter (fun x1 ->

src/FSharpPlus/Operators.fs

+13
Original file line numberDiff line numberDiff line change
@@ -144,6 +144,19 @@ module Operators =
144144
/// <category index="1">Functor</category>
145145
let inline (|>>) (x: '``Functor<'T>``) (f: 'T->'U) : '``Functor<'U>`` = Map.Invoke f x
146146

147+
/// <summary>
148+
/// Lifts a function into two Functors.
149+
/// To be used in pipe-forward style expressions
150+
/// </summary>
151+
/// <category index="1">Functor</category>
152+
let inline (|>>>) (x: '``Functor1<Functor2<'T>>``) (f: 'T -> 'U) : '``Functor1<Functor2<'U>>`` = (Map.Invoke >> Map.Invoke) f x
153+
154+
/// <summary>
155+
/// Lifts a function into two Functors.
156+
/// </summary>
157+
/// <category index="1">Functor</category>
158+
let inline (<<<|) (f: 'T -> 'U) (x: '``Functor1<Functor2<'T>>``) : '``Functor1<Functor2<'U>`` = (Map.Invoke >> Map.Invoke) f x
159+
147160
/// <summary>
148161
/// Like map but ignoring the results.
149162
/// </summary>

tests/FSharpPlus.Tests/General.fs

+7
Original file line numberDiff line numberDiff line change
@@ -396,6 +396,13 @@ module Functor =
396396
Assert.IsInstanceOf<Option<Async<int>>> (Some testVal10)
397397
areEqual 2 (testVal10 |> Async.RunSynchronously)
398398

399+
[<Test>]
400+
let mapSquared () =
401+
let x =
402+
[Some 1; Some 2]
403+
|>>> string
404+
Assert.AreEqual ([Some "1"; Some "2"], x)
405+
399406
[<Test>]
400407
let unzip () =
401408
let testVal = unzip {Head = (1, 'a'); Tail = [(2, 'b');(3, 'b')]}

0 commit comments

Comments
 (0)