Skip to content

Evaluate traverse left to right #418

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 15 commits into from
Feb 23, 2021
25 changes: 18 additions & 7 deletions src/FSharpPlus/Control/Traversable.fs
Original file line number Diff line number Diff line change
Expand Up @@ -81,8 +81,8 @@ type Traverse =
static member inline Traverse (t: option<_>, f, [<Optional>]_output: 'R, [<Optional>]_impl: Traverse) : 'R = match t with Some x -> Map.Invoke Some (f x) | _ -> result None

static member inline Traverse (t:Map<_,_> , f, [<Optional>]_output: 'R, [<Optional>]_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>``, [<Optional>]_output: '``Functor<Result<'U,'Error>>``, [<Optional>]_impl: Traverse) : '``Functor<Result<'U,'Error>>`` =
match t with
Expand All @@ -95,13 +95,24 @@ type Traverse =
| Choice2Of2 e -> Return.Invoke (Choice<'U,'Error>.Choice2Of2 e)

static member inline Traverse (t:list<_> ,f , [<Optional>]_output: 'R, [<Optional>]_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
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 , [<Optional>]_output: 'R, [<Optional>]_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 cons x y = Array.append [|x|] y
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)
Expand Down
8 changes: 8 additions & 0 deletions tests/FSharpPlus.Tests/General.fs
Original file line number Diff line number Diff line change
Expand Up @@ -1261,6 +1261,14 @@ module Traversable =
let _ = Seq.sequence [ZipList [1]; ZipList []; ZipList (seq {failwith "sholdn't get here"})] |> toList
()

[<Test>]
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"]


[<Test>]
let traversableForNonPrimitive () =
let nel = nelist { Some 1 }
Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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 }
Expand Down