Skip to content

Commit

Permalink
Prevent allocations
Browse files Browse the repository at this point in the history
  • Loading branch information
alfonsogarciacaro authored and ncave committed Dec 24, 2020
1 parent d1f260c commit c8b4943
Showing 1 changed file with 84 additions and 60 deletions.
144 changes: 84 additions & 60 deletions src/fable-library/List.fs
Original file line number Diff line number Diff line change
Expand Up @@ -12,24 +12,31 @@ module SR =
let listsHadDifferentLengths = "The lists had different lengths."
let notEnoughElements = "The input sequence has an insufficient number of elements."

[<Emit("new Array($0)")>]
let private allocate (i: int): ResizeArray<'T> = jsNative

// [<Struct>]
[<CustomEquality; CustomComparison>]
// [<CustomEquality; CustomComparison>]
// [<CompiledName("FSharpList`1")>]
type ResizeList<'T> =
{ Count: int; Values: ResizeArray<'T> }
type ResizeList<'T>(count, values) =
member _.Count: int = count
member _.Values: ResizeArray<'T> = values

member inline internal xs.Add(x: 'T) =
member internal xs.Add(x: 'T) =
let values =
if xs.Count = xs.Values.Count
then xs.Values
else xs.Values.GetRange(0, xs.Count)
values.Add(x)
{ Count = values.Count; Values = values }
ResizeList<'T>.NewList(values)

member inline internal xs.Reverse() =
let values = xs.Values.GetRange(0, xs.Count)
values.Reverse()
{ Count = values.Count; Values = values }
member internal xs.Reverse() =
let values = allocate xs.Count
let mutable j = 0
for i = xs.Count - 1 downto 0 do
values.[j] <- xs.Values.[i]
j <- j + 1
ResizeList<'T>.NewList(values)

// This is a destructive internal optimization that
// can only be performed on newly constructed lists.
Expand All @@ -38,30 +45,31 @@ type ResizeList<'T> =
xs

static member inline Singleton(x: 'T) =
let values = ResizeArray<'T>()
values.Add(x)
{ Count = 1; Values = values }
ResizeList<'T>.NewList(ResizeArray [|x|])

static member inline NewList (values: ResizeArray<'T>) =
{ Count = values.Count; Values = values }
ResizeList(values.Count, values)

static member inline Empty =
{ Count = 0; Values = ResizeArray<'T>() }
static member inline NewList (count, values) =
ResizeList(count, values)

static member inline Empty: ResizeList<'T> =
ResizeList<'T>.NewList(ResizeArray())

static member inline Cons (x: 'T, xs: 'T list) = xs.Add(x)

member inline xs.IsEmpty = xs.Count <= 0

member inline xs.Length = xs.Count

member inline xs.Head =
member xs.Head =
if xs.Count > 0
then xs.Values.[xs.Count - 1]
else invalidArg "list" SR.inputListWasEmpty

member inline xs.Tail =
member xs.Tail =
if xs.Count > 0
then { Count = xs.Count - 1; Values = xs.Values }
then ResizeList<'T>.NewList(xs.Count - 1, xs.Values)
else invalidArg "list" SR.inputListWasEmpty

member inline xs.Item with get (index: int) =
Expand Down Expand Up @@ -117,7 +125,7 @@ and 'T list = ResizeList<'T>

let inline indexNotFound() = raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt))

let newList values = ResizeList.NewList (values)
let newList values = ResizeList<'T>.NewList (values)

let empty () = ResizeList.Empty

Expand Down Expand Up @@ -170,22 +178,24 @@ let foldBack (folder: 'T -> 'acc -> 'acc) (xs: 'T list) (state: 'acc) =
let reverse (xs: 'a list) =
xs.Reverse()

let inline reverseInPlace (xs: 'a list) =
xs.ReverseInPlace()
let ofResizeArrayInPlace (xs: ResizeArray<'a>) =
xs.Reverse()
ResizeList.NewList xs

let toSeq (xs: 'a list): 'a seq =
xs :> System.Collections.Generic.IEnumerable<'a>

let ofSeq (xs: 'a seq): 'a list =
// Seq.fold (fun acc x -> cons x acc) ResizeList.Empty xs
// |> reverseInPlace
// |> ofResizeArrayInPlace
let values = ResizeArray(xs)
values.Reverse()
values |> newList

let concat (lists: seq<'a list>) =
Seq.fold (fold (fun acc x -> cons x acc)) ResizeList.Empty lists
|> reverseInPlace
(ResizeArray(), lists)
||> Seq.fold (fold (fun acc x -> acc.Add(x); acc))
|> ofResizeArrayInPlace

let fold2 f (state: 'acc) (xs: 'a list) (ys: 'b list) =
Seq.fold2 f state xs ys
Expand All @@ -196,9 +206,9 @@ let foldBack2 f (xs: 'a list) (ys: 'b list) (state: 'acc) =
let unfold (gen: 'acc -> ('T * 'acc) option) (state: 'acc) =
let rec loop st acc =
match gen st with
| None -> reverseInPlace acc
| Some (x, st) -> loop st (cons x acc)
loop state ResizeList.Empty
| None -> ofResizeArrayInPlace acc
| Some (x, st) -> acc.Add(x); loop st acc
loop state (ResizeArray())

let scan f (state: 'acc) (xs: 'a list) =
Seq.scan f state xs |> ofSeq
Expand All @@ -207,21 +217,24 @@ let scanBack f (xs: 'a list) (state: 'acc) =
Seq.scanBack f xs state |> ofSeq

let append (xs: 'a list) (ys: 'a list) =
// foldBack cons xs ys
let mutable acc = ys
for i = xs.Length - 1 downto 0 do
acc <- cons xs.[i] acc
acc
let ylen = ys.Count
let values = allocate (xs.Count + ys.Count)
for i = xs.Count - 1 downto 0 do
values.[i + ylen] <- xs.Values.[i]
for i = ys.Count - 1 downto 0 do
values.[i] <- ys.Values.[i]
ResizeList<'a>.NewList(values)

let collect (f: 'a -> 'b list) (xs: 'a list) =
Seq.collect f xs |> ofSeq

let mapIndexed (f: int -> 'a -> 'b) (xs: 'a list) =
let rec loop i acc =
if i < xs.Length
then loop (i + 1) (cons (f i xs.[i]) acc)
else reverseInPlace acc
loop 0 ResizeList.Empty
let values = allocate xs.Count
let mutable j = 0
for i = xs.Count - 1 downto 0 do
values.[i] <- f j xs.Values.[i]
j <- j + 1
ResizeList<'b>.NewList(values)

let map (f: 'a -> 'b) (xs: 'a list) =
mapIndexed (fun _i x -> f x) xs
Expand All @@ -239,11 +252,12 @@ let map3 f xs ys zs =
Seq.map3 f xs ys zs |> ofSeq

let mapFold (f: 'S -> 'T -> 'R * 'S) s xs =
let folder (nxs, fs) x =
let folder (nxs: ResizeArray<_>, fs) x =
let nx, fs = f fs x
cons nx nxs, fs
let nxs, s = fold folder (ResizeList.Empty, s) xs
reverseInPlace nxs, s
nxs.Add(nx)
nxs, fs
let nxs, s = fold folder (ResizeArray(), s) xs
ofResizeArrayInPlace nxs, s

let mapFoldBack (f: 'T -> 'S -> 'R * 'S) xs s =
mapFold (fun s v -> f v s) s (reverse xs)
Expand All @@ -261,10 +275,10 @@ let iterateIndexed2 f xs ys =
fold2 (fun i x y -> f i x y; i + 1) 0 xs ys |> ignore

let ofArrayWithTail (xs: 'T[]) (tail: 'T list) =
let mutable res = tail
let values = tail.Values
for i = xs.Length - 1 downto 0 do
res <- cons xs.[i] res
res
values.Add(xs.[i])
newList values

// let ofArray (xs: 'T[]) =
// ofArrayWithTail xs ResizeList.Empty
Expand Down Expand Up @@ -359,23 +373,26 @@ let tryItem index (xs: 'a list) =
else None

let filter f xs =
fold (fun acc x ->
(ResizeArray(), xs)
||> fold (fun acc x ->
if f x
then cons x acc
else acc) ResizeList.Empty xs
|> reverseInPlace
then acc.Add(x); acc
else acc)
|> ofResizeArrayInPlace

// TODO: Optimize this
let partition f xs =
fold (fun (lacc, racc) x ->
if f x then cons x lacc, racc
else lacc, cons x racc) (ResizeList.Empty, ResizeList.Empty) (reverse xs)

let choose f xs =
fold (fun acc x ->
(ResizeArray(), xs)
||> fold (fun acc x ->
match f x with
| Some y -> cons y acc
| None -> acc) ResizeList.Empty xs
|> reverseInPlace
| Some y -> acc.Add(y); acc
| None -> acc)
|> ofResizeArrayInPlace

let contains (value: 'T) (xs: 'T list) ([<Inject>] eq: System.Collections.Generic.IEqualityComparer<'T>) =
tryFindIndex (fun v -> eq.Equals (value, v)) xs |> Option.isSome
Expand All @@ -387,10 +404,12 @@ let except (itemsToExclude: seq<'t>) (xs: 't list) ([<Inject>] eq: System.Collec
xs |> filter cached.Add

let initialize n f =
let mutable res = ResizeList.Empty
for i = 0 to n - 1 do
res <- cons (f i) res
res |> reverseInPlace
let mutable j = 0
let values = allocate n
for i = n - 1 downto 0 do
values.[i] <- f j
j <- j + 1
values |> newList

let replicate n x =
initialize n (fun _ -> x)
Expand Down Expand Up @@ -418,6 +437,7 @@ let rec exists2 f xs ys =
| x, y when x = y -> f (head xs) (head ys) || exists2 f (tail xs) (tail ys)
| _ -> invalidArg "list2" SR.listsHadDifferentLengths

// TODO: Optimize this
let unzip xs =
foldBack (fun (x, y) (lacc, racc) -> cons x lacc, cons y racc) xs (ResizeList.Empty, ResizeList.Empty)

Expand All @@ -433,7 +453,7 @@ let zip3 xs ys zs =
let sortWith (comparison: 'T -> 'T -> int) (xs: 'T list): 'T list =
let values = ResizeArray(xs)
values.Sort(System.Comparison<_>(comparison)) // should be a stable sort in JS
values |> newList |> reverseInPlace
values |> ofResizeArrayInPlace

let sort (xs: 'T list) ([<Inject>] comparer: System.Collections.Generic.IComparer<'T>): 'T list =
sortWith (fun x y -> comparer.Compare(x, y)) xs
Expand Down Expand Up @@ -505,8 +525,11 @@ let getSlice (startIndex: int option) (endIndex: int option) (xs: 'T list) =
let startIndex = if startIndex < 0 then 0 else startIndex
let endIndex = if endIndex >= xs.Length then xs.Length - 1 else endIndex
// take (endIndex - startIndex + 1) (skip startIndex xs)
let values = ResizeArray(endIndex - startIndex + 1)
for i = endIndex downto startIndex do values.Add(xs.[i])
let values = allocate (endIndex - startIndex + 1)
let mutable j = 0
for i = endIndex downto startIndex do
values.[j] <- xs.[i]
j <- j + 1
values |> newList

let splitAt index (xs: 'T list) =
Expand All @@ -527,6 +550,7 @@ let exactlyOne (xs: 'T list) =
| 0 -> invalidArg "list" SR.inputSequenceEmpty
| _ -> invalidArg "list" SR.inputSequenceTooLong

// TODO: Optimize this
let groupBy (projection: 'T -> 'Key) (xs: 'T list)([<Inject>] eq: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T list) list =
let dict = System.Collections.Generic.Dictionary<'Key, 'T list>(eq)
let mutable keys = ResizeList.Empty
Expand All @@ -539,7 +563,7 @@ let groupBy (projection: 'T -> 'Key) (xs: 'T list)([<Inject>] eq: System.Collect
dict.Add(key, cons v ResizeList.Empty)
keys <- cons key keys )
let mutable result = ResizeList.Empty
keys |> iterate (fun key -> result <- cons (key, reverseInPlace dict.[key]) result)
keys |> iterate (fun key -> result <- cons (key, dict.[key].ReverseInPlace()) result)
result

let countBy (projection: 'T -> 'Key) (xs: 'T list)([<Inject>] eq: System.Collections.Generic.IEqualityComparer<'Key>) =
Expand Down

0 comments on commit c8b4943

Please sign in to comment.