From 77e3f2e3c151b30d834184f5a8701898771bc6aa Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Thu, 7 Jan 2021 11:15:32 +0100 Subject: [PATCH 01/15] Traverse lists evaluating left to right --- src/FSharpPlus/Control/Traversable.fs | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 0f728439c..819994dc7 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -95,8 +95,15 @@ type Traverse = | Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e) static member inline Traverse (t:list<_> ,f , []_output: 'R, []_impl: Traverse) : 'R = - let cons_f x ys = Map.Invoke List.cons (f x) <*> ys - List.foldBack cons_f t (result []) + let rec loop acc = function + | [] -> acc + | x::xs -> let v = f x + if v |> IsLeftZero.Invoke |> not + then loop (v::acc) xs + else v::acc + let cons_f x xs = Map.Invoke List.cons xs <*> x + loop [] t + |> fun x -> List.fold cons_f (result []) x static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = let cons x y = Array.append [|x|] y From 7bf3827361153ac2a5616d3341e4a97f6f315a86 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Fri, 8 Jan 2021 10:30:05 +0100 Subject: [PATCH 02/15] Traverse arrays left-to-right --- src/FSharpPlus/Control/Traversable.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 819994dc7..8c10417a6 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -106,9 +106,8 @@ type Traverse = |> fun x -> List.fold cons_f (result []) x static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = - let cons x y = Array.append [|x|] y - let cons_f x ys = Map.Invoke cons (f x) <*> ys - Array.foldBack cons_f t (result [||]) + let mapped = Seq.map f t + Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, Array.ofSeq) static member inline Invoke (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Traverse : _*_*_*_ -> _) b, f, c, a) From d2c53de415b656765ae5373afde1a3aeac3a4879 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Fri, 8 Jan 2021 15:59:30 +0100 Subject: [PATCH 03/15] Traverse map left to right --- src/FSharpPlus/Control/Traversable.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 8c10417a6..e749fce5c 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -81,8 +81,9 @@ type Traverse = static member inline Traverse (t: option<_>, f, []_output: 'R, []_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None static member inline Traverse (t:Map<_,_> , f, []_output: 'R, []_impl: Traverse) : 'R = - let insert_f k x ys = Map.Invoke (Map.add k) (f x) <*> ys - Map.foldBack insert_f t (result Map.empty) + let insert_f m k v = Map.Invoke (Map.add k) v <*> m + Map.mapValues f t + |> Map.fold insert_f (result Map.empty) static member inline Traverse (t: Result<'T,'Error>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Traverse) : '``Functor>`` = match t with From 5f516ac8f86bb0ceba3e8ca64d4a82465fd87bc1 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Fri, 8 Jan 2021 16:19:32 +0100 Subject: [PATCH 04/15] Simplify list traversal --- src/FSharpPlus/Control/Traversable.fs | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index e749fce5c..6a9ea426b 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -96,15 +96,8 @@ type Traverse = | Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e) static member inline Traverse (t:list<_> ,f , []_output: 'R, []_impl: Traverse) : 'R = - let rec loop acc = function - | [] -> acc - | x::xs -> let v = f x - if v |> IsLeftZero.Invoke |> not - then loop (v::acc) xs - else v::acc - let cons_f x xs = Map.Invoke List.cons xs <*> x - loop [] t - |> fun x -> List.fold cons_f (result []) x + let mapped = List.map f t + Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, id) static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = let mapped = Seq.map f t From 578d5e418691c00e012b5178e323174ba73ca8f1 Mon Sep 17 00:00:00 2001 From: Rafal Gwozdzinski Date: Fri, 8 Jan 2021 16:24:20 +0100 Subject: [PATCH 05/15] Remove unused Traverse overloads --- src/FSharpPlus/Control/Traversable.fs | 10 ---------- 1 file changed, 10 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 6a9ea426b..29fa32358 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -38,16 +38,6 @@ type Traverse = static member inline Traverse (t: Id<_>, f, []_output: 'R, []_impl: Default3) = Map.Invoke Id.create (f (Id.run t)) - static member inline Traverse (t: _ seq, f, []_output: 'R, []_impl: Default3) = - let cons x y = seq {yield x; yield! y} - let cons_f x ys = Map.Invoke (cons: 'a->seq<_>->seq<_>) (f x) <*> ys - Seq.foldBack cons_f t (result Seq.empty) - - static member inline Traverse (t: _ NonEmptySeq, f, []_output: 'R, []_impl: Default3) = - let cons x y = seq {yield x; yield! y} - let cons_f x ys = Map.Invoke (cons: 'a->seq<_>->seq<_>) (f x) <*> ys - Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (result Seq.empty)) - static member inline Traverse (t: seq<'T>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = let mapped = Seq.map f t Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq) : '``Functor>`` From af58e3155484d6833647cac6d3df76fd852cc202 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 18:30:30 +0100 Subject: [PATCH 06/15] Try remove optimization --- src/FSharpPlus/Control/Traversable.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 29fa32358..e9ccd0324 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -87,7 +87,7 @@ type Traverse = static member inline Traverse (t:list<_> ,f , []_output: 'R, []_impl: Traverse) : 'R = let mapped = List.map f t - Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, id) + Sequence.ForInfiniteSequences (mapped, (fun _ -> true), id) static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = let mapped = Seq.map f t From b074005e4a53d78adf2cc7bf8124a206d036be81 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 18:45:11 +0100 Subject: [PATCH 07/15] Revert #578d5e41 --- src/FSharpPlus/Control/Traversable.fs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index e9ccd0324..223e5036f 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -38,6 +38,16 @@ type Traverse = static member inline Traverse (t: Id<_>, f, []_output: 'R, []_impl: Default3) = Map.Invoke Id.create (f (Id.run t)) + static member inline Traverse (t: _ seq, f, []_output: 'R, []_impl: Default3) = + let cons x y = seq {yield x; yield! y} + let cons_f x ys = Map.Invoke (cons: 'a->seq<_>->seq<_>) (f x) <*> ys + Seq.foldBack cons_f t (result Seq.empty) + + static member inline Traverse (t: _ NonEmptySeq, f, []_output: 'R, []_impl: Default3) = + let cons x y = seq {yield x; yield! y} + let cons_f x ys = Map.Invoke (cons: 'a->seq<_>->seq<_>) (f x) <*> ys + Map.Invoke NonEmptySeq.ofSeq (Seq.foldBack cons_f t (result Seq.empty)) + static member inline Traverse (t: seq<'T>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Default2) = let mapped = Seq.map f t Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, List.toSeq) : '``Functor>`` From f5292398e1e7d98cedbe1e6cc242b9171dae1ec8 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 18:53:18 +0100 Subject: [PATCH 08/15] Remove 2nd optimization --- src/FSharpPlus/Control/Traversable.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 223e5036f..2113284bf 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -101,7 +101,7 @@ type Traverse = static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = let mapped = Seq.map f t - Sequence.ForInfiniteSequences (mapped, IsLeftZero.Invoke, Array.ofSeq) + Sequence.ForInfiniteSequences (mapped, (fun _ -> true), Array.ofSeq) static member inline Invoke (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Traverse : _*_*_*_ -> _) b, f, c, a) From 9a1962361cea9708606fd3e3177a429d469047ff Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 19:52:28 +0100 Subject: [PATCH 09/15] Revert Map --- src/FSharpPlus/Control/Traversable.fs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 2113284bf..6154aebb3 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -81,9 +81,8 @@ type Traverse = static member inline Traverse (t: option<_>, f, []_output: 'R, []_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None static member inline Traverse (t:Map<_,_> , f, []_output: 'R, []_impl: Traverse) : 'R = - let insert_f m k v = Map.Invoke (Map.add k) v <*> m - Map.mapValues f t - |> Map.fold insert_f (result Map.empty) + let insert_f k x ys = Map.Invoke (Map.add k) (f x) <*> ys let insert_f m k v = Map.Invoke (Map.add k) v <*> m + Map.foldBack insert_f t (result Map.empty) static member inline Traverse (t: Result<'T,'Error>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Traverse) : '``Functor>`` = match t with From 5136030f7def662bfc57e38c3341184262d8dd02 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 19:54:55 +0100 Subject: [PATCH 10/15] fix previous --- src/FSharpPlus/Control/Traversable.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 6154aebb3..e5428b09f 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -81,7 +81,7 @@ type Traverse = static member inline Traverse (t: option<_>, f, []_output: 'R, []_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None static member inline Traverse (t:Map<_,_> , f, []_output: 'R, []_impl: Traverse) : 'R = - let insert_f k x ys = Map.Invoke (Map.add k) (f x) <*> ys let insert_f m k v = Map.Invoke (Map.add k) v <*> m + let insert_f k x ys = Map.Invoke (Map.add k) (f x) <*> ys Map.foldBack insert_f t (result Map.empty) static member inline Traverse (t: Result<'T,'Error>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Traverse) : '``Functor>`` = From 4a635887331b7c273bd65487ebf4421df7627de9 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 20:12:15 +0100 Subject: [PATCH 11/15] Revert Array --- src/FSharpPlus/Control/Traversable.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index e5428b09f..b32a3b6e5 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -99,8 +99,9 @@ type Traverse = Sequence.ForInfiniteSequences (mapped, (fun _ -> true), id) static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = - let mapped = Seq.map f t - Sequence.ForInfiniteSequences (mapped, (fun _ -> true), Array.ofSeq) + let cons x y = Array.append [|x|] y + let cons_f x ys = Map.Invoke cons (f x) <*> ys + Array.foldBack cons_f t (result [||]) static member inline Invoke (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Traverse : _*_*_*_ -> _) b, f, c, a) From 7d5e75b697f9cddf4ed8bff50724e6fba78ea1b4 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Sun, 21 Feb 2021 20:28:04 +0100 Subject: [PATCH 12/15] Back to first commit, without optimization --- src/FSharpPlus/Control/Traversable.fs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index b32a3b6e5..879c03929 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -95,8 +95,13 @@ type Traverse = | Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e) static member inline Traverse (t:list<_> ,f , []_output: 'R, []_impl: Traverse) : 'R = - let mapped = List.map f t - Sequence.ForInfiniteSequences (mapped, (fun _ -> true), id) + let rec loop acc = function + | [] -> acc + | x::xs -> + let v = f x + loop (v::acc) xs + let cons_f x xs = Map.Invoke List.cons xs <*> x + List.fold cons_f (result []) (loop [] t) static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = let cons x y = Array.append [|x|] y From e0b1bbb10fbe0568b2f909f4d5005bcfe68cf91a Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 22 Feb 2021 06:53:46 +0100 Subject: [PATCH 13/15] Restore fix for Map --- src/FSharpPlus/Control/Traversable.fs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 879c03929..0e43892ae 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -81,8 +81,8 @@ type Traverse = static member inline Traverse (t: option<_>, f, []_output: 'R, []_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None static member inline Traverse (t:Map<_,_> , f, []_output: 'R, []_impl: Traverse) : 'R = - let insert_f k x ys = Map.Invoke (Map.add k) (f x) <*> ys - Map.foldBack insert_f t (result Map.empty) + let insert_f m k v = Map.Invoke (Map.add k) v <*> m + Map.fold insert_f (result Map.empty) (Map.mapValues f t) static member inline Traverse (t: Result<'T,'Error>, f: 'T->'``Functor<'U>``, []_output: '``Functor>``, []_impl: Traverse) : '``Functor>`` = match t with From 82d4c2fbb48919f1c51e80618aa34ddc2da73831 Mon Sep 17 00:00:00 2001 From: Gustavo Leon <1261319+gusty@users.noreply.github.com> Date: Mon, 22 Feb 2021 08:08:23 +0100 Subject: [PATCH 14/15] Restore array but as self contained --- src/FSharpPlus/Control/Traversable.fs | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/src/FSharpPlus/Control/Traversable.fs b/src/FSharpPlus/Control/Traversable.fs index 0e43892ae..a48b6c509 100644 --- a/src/FSharpPlus/Control/Traversable.fs +++ b/src/FSharpPlus/Control/Traversable.fs @@ -105,8 +105,14 @@ type Traverse = static member inline Traverse (t:_ [] ,f , []_output: 'R, []_impl: Traverse) : 'R = let cons x y = Array.append [|x|] y - let cons_f x ys = Map.Invoke cons (f x) <*> ys - Array.foldBack cons_f t (result [||]) + let rec loop acc = function + | [||] -> acc + | xxs -> + let x, xs = Array.head xxs, Array.tail xxs + let v = f x + loop (cons v acc) xs + let cons_f x xs = Map.Invoke cons xs <*> x + Array.fold cons_f (result [||]) (loop [||] t) static member inline Invoke (f: 'T->'``Functor<'U>``) (t: '``Traversable<'T>``) : '``Functor<'Traversable<'U>>`` = let inline call_3 (a: ^a, b: ^b, c: ^c, f) = ((^a or ^b or ^c) : (static member Traverse : _*_*_*_ -> _) b, f, c, a) From 9766da89b93a343b682ecdab2dfbdcb03024f66b Mon Sep 17 00:00:00 2001 From: Oskar Gewalli Date: Mon, 22 Feb 2021 20:36:11 +0100 Subject: [PATCH 15/15] +Traversable order tests --- tests/FSharpPlus.Tests/General.fs | 8 ++++++++ .../FSharpTests/General/Traversable.fs | 8 ++++++++ 2 files changed, 16 insertions(+) diff --git a/tests/FSharpPlus.Tests/General.fs b/tests/FSharpPlus.Tests/General.fs index 57322bb03..80a2c2cfb 100644 --- a/tests/FSharpPlus.Tests/General.fs +++ b/tests/FSharpPlus.Tests/General.fs @@ -1261,6 +1261,14 @@ module Traversable = let _ = Seq.sequence [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList () + [] + let traverse_Order () = + SideEffects.reset() + let mapper v = SideEffects.add <| sprintf "mapping %d" v + let _ = traverse (Option.map mapper) [Some 1; Some 2] + SideEffects.are ["mapping 1"; "mapping 2"] + + [] let traversableForNonPrimitive () = let nel = nelist { Some 1 } diff --git a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs index 6749ffebd..52da97e16 100644 --- a/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs +++ b/tests/FSharpPlusFable.Tests/FSharpTests/General/Traversable.fs @@ -92,6 +92,14 @@ let traversable = testList "Traversable" [ #endif #if !FABLE_COMPILER || FABLE_COMPILER_3 + testList "traverse_Order" [ + testCase "nelist" (fun () -> + SideEffects.reset() + let mapper v = SideEffects.add <| sprintf "mapping %d" v + let _ = traverse (Option.map mapper) [Some 1; Some 2] + SideEffects.are ["mapping 1"; "mapping 2"] + )] + testList "traversableForNonPrimitive" [ testCase "nelist" (fun () -> let nel = nelist { Some 1 }