Skip to content

Commit

Permalink
Evaluate traverse left to right (#418)
Browse files Browse the repository at this point in the history
  • Loading branch information
Rafał Gwoździński authored Feb 23, 2021
1 parent 4dbb62e commit 9ce1279
Show file tree
Hide file tree
Showing 3 changed files with 34 additions and 7 deletions.
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

0 comments on commit 9ce1279

Please sign in to comment.