From 5bde2183d08d2ad71eac9de9d842edfd36dfae31 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Mon, 20 Jul 2020 16:38:47 -0700 Subject: [PATCH] Optimized List module --- src/Fable.Transforms/Fable2Babel.fs | 16 +- src/fable-library/Array.fs | 11 +- src/fable-library/List.fs | 555 +++++++++--------- src/fable-library/Types.ts | 226 +++---- .../test/bench-compiler/package.json | 2 + tests/Main/ListTests.fs | 19 +- 6 files changed, 414 insertions(+), 415 deletions(-) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 1babfbffb5..9e9ba380bd 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -373,7 +373,7 @@ module Util = makeNativeTypeAnnotation com ctx [genArg] "Array" and makeListTypeAnnotation com ctx genArg = - makeImportTypeAnnotation com ctx [genArg] "Types" "List" + makeImportTypeAnnotation com ctx [genArg] "List" "List" and makeUnionTypeAnnotation com ctx genArgs = List.map (typeAnnotation com ctx) genArgs @@ -808,12 +808,12 @@ module Util = | Fable.NewTuple vals -> makeTypedArray com ctx Fable.Any (Fable.ArrayValues vals) // Optimization for bundle size: compile list literals as List.ofArray | Replacements.ListLiteral(exprs, t) -> - [|List.rev exprs |> makeArray com ctx|] |> coreLibConstructorCall com ctx "Types" "List" + [|List.rev exprs |> makeArray com ctx|] |> coreLibCall com ctx r "List" "newList" | Fable.NewList (headAndTail, _) -> match headAndTail with - | None -> coreLibConstructorCall com ctx "Types" "List" [||] + | None -> coreLibCall com ctx r "List" "newList" [||] | Some(TransformExpr com ctx head, TransformExpr com ctx tail) -> - callFunction r (get None tail "add") [head] + coreLibCall com ctx r "List" "cons" [|head; tail|] | Fable.NewOption (value, t) -> match value with | Some (TransformExpr com ctx e) -> @@ -1053,8 +1053,8 @@ module Util = let expr = com.TransformAsExpr(ctx, fableExpr) match getKind with | Fable.ExprGet(TransformExpr com ctx prop) -> getExpr range expr prop - | Fable.ListHead -> get range expr "head" - | Fable.ListTail -> get range expr "tail" + | Fable.ListHead -> coreLibCall com ctx range "List" "head" [|expr|] + | Fable.ListTail -> coreLibCall com ctx range "List" "tail" [|expr|] | Fable.FieldGet(fieldName,_,_) -> let expr = match fableExpr with @@ -1150,7 +1150,7 @@ module Util = | Fable.FunctionType _ -> jsTypeof "function" expr | Fable.Array _ | Fable.Tuple _ -> coreLibCall com ctx None "Util" "isArrayLike" [|com.TransformAsExpr(ctx, expr)|] - | Fable.List _ -> jsInstanceof (coreValue com ctx "Types" "List") expr + | Fable.List _ -> jsInstanceof (coreValue com ctx "List" "List") expr | Replacements.Builtin kind -> match kind with | Replacements.BclGuid -> jsTypeof "string" expr @@ -1211,7 +1211,7 @@ module Util = let op = if nonEmpty then BinaryUnequal else BinaryEqual upcast BinaryExpression(op, com.TransformAsExpr(ctx, expr), NullLiteral(), ?loc=range) | Fable.ListTest nonEmpty -> - let expr = get range (com.TransformAsExpr(ctx, expr)) "isEmpty" + let expr = coreLibCall com ctx range "List" "isEmpty" [|com.TransformAsExpr(ctx, expr)|] if nonEmpty then upcast UnaryExpression(UnaryNot, expr, ?loc=range) else expr | Fable.UnionCaseTest(uci, ent) -> diff --git a/src/fable-library/Array.fs b/src/fable-library/Array.fs index 5710ffd995..8909faf584 100644 --- a/src/fable-library/Array.fs +++ b/src/fable-library/Array.fs @@ -123,7 +123,6 @@ module Helpers = open Helpers let private indexNotFoundMsg = "An index satisfying the predicate was not found in the collection." -let inline indexNotFound() = failwith indexNotFoundMsg // Pay attention when benchmarking to append and filter functions below // if implementing via native JS array .concat() and .filter() do not fall behind due to js-native transitions. @@ -478,7 +477,7 @@ let partition (f: 'T -> bool) (source: 'T[]) ([] cons: IArrayCons<'T>) = let find (predicate: 'T -> bool) (array: 'T[]): 'T = match findImpl predicate array with | Some res -> res - | None -> indexNotFound() + | None -> failwith indexNotFoundMsg let tryFind (predicate: 'T -> bool) (array: 'T[]): 'T option = findImpl predicate array @@ -486,7 +485,7 @@ let tryFind (predicate: 'T -> bool) (array: 'T[]): 'T option = let findIndex (predicate: 'T -> bool) (array: 'T[]): int = match findIndexImpl predicate array with | index when index > -1 -> index - | _ -> indexNotFound() + | _ -> failwith indexNotFoundMsg let tryFindIndex (predicate: 'T -> bool) (array: 'T[]): int option = match findIndexImpl predicate array with @@ -496,7 +495,7 @@ let tryFindIndex (predicate: 'T -> bool) (array: 'T[]): int option = let pick chooser (array: _[]) = let rec loop i = if i >= array.Length then - indexNotFound() + failwith indexNotFoundMsg else match chooser array.[i] with | None -> loop(i+1) @@ -513,7 +512,7 @@ let tryPick chooser (array: _[]) = let findBack predicate (array: _[]) = let rec loop i = - if i < 0 then indexNotFound() + if i < 0 then failwith indexNotFoundMsg elif predicate array.[i] then array.[i] else loop (i - 1) loop (array.Length - 1) @@ -534,7 +533,7 @@ let findLastIndex predicate (array: _[]) = let findIndexBack predicate (array: _[]) = let rec loop i = - if i < 0 then indexNotFound() + if i < 0 then failwith indexNotFoundMsg elif predicate array.[i] then i else loop (i - 1) loop (array.Length - 1) diff --git a/src/fable-library/List.fs b/src/fable-library/List.fs index 9d1d7d14b2..46083e6ba7 100644 --- a/src/fable-library/List.fs +++ b/src/fable-library/List.fs @@ -6,105 +6,141 @@ module List open System.Collections.Generic open Fable.Core -let head = function - | x::_ -> x - | _ -> failwith "List was empty" - -let tryHead = function - | x::_ -> Some x - | _ -> None - -let tail = function - | _::xs -> xs - | _ -> failwith "List was empty" - -let rec last = function - | [] -> failwith "List was empty" - | [x] -> x - | _::xs -> last xs - -let rec tryLast = function - | [] -> None - | [x] -> Some x - | _::xs -> tryLast xs +let msgListWasEmpty = "List was empty" +let msgListNoMatch = "List did not contain any matching elements" + +type List<'T> = + { Count: int; Values: ResizeArray<'T> } + static member Empty = + { Count = 0; Values = ResizeArray<'T>() } + override xs.ToString() = + let values = xs.Values.GetRange(0, xs.Count) + values.Reverse() + "[" + System.String.Join("; ", values) + "]" + interface IEnumerable<'T> with + member xs.GetEnumerator(): IEnumerator<'T> = + let elems = seq { for i = xs.Count - 1 downto 0 do yield xs.Values.[i] } + elems.GetEnumerator() + interface System.Collections.IEnumerable with + member this.GetEnumerator(): System.Collections.IEnumerator = + ((this :> IEnumerable<'T>).GetEnumerator() :> System.Collections.IEnumerator) + +type 'T list = List<'T> + +type List<'T> with + member xs.Length = xs.Count + member xs.Head = if xs.Count > 0 then xs.Values.[xs.Count - 1] else failwith msgListWasEmpty + member xs.Tail = if xs.Count > 0 then { Count = xs.Count - 1; Values = xs.Values } else failwith msgListWasEmpty + member xs.IsEmpty = xs.Count <= 0 + member xs.Item with get(index) = xs.Values.[xs.Count - index - 1] + +let newList (values: ResizeArray<'T>) = { Count = values.Count; Values = values } + +let length xs = xs.Count + +let empty () = List.Empty + +let isEmpty (xs: 'T list) = xs.Count <= 0 + +let cons (x: 'T) (xs: 'T list) = + let values = + if xs.Count = xs.Values.Count + then xs.Values + else xs.Values.GetRange(0, xs.Count) + values.Add(x) + newList values + +let copy (xs: 'T list) = + newList <| xs.Values.GetRange(0, xs.Count) + +let singleton x = + cons x List.Empty + +let head (xs: 'T list) = + if xs.Count > 0 + then xs.Values.[xs.Count - 1] + else failwith msgListWasEmpty + +let tryHead (xs: 'T list) = + if xs.Count > 0 + then Some xs.Values.[xs.Count - 1] + else None + +let tail (xs: 'T list) = + if xs.Count > 0 + then { Count = xs.Count - 1; Values = xs.Values } + else failwith msgListWasEmpty + +let last (xs: 'T list) = + if xs.Count > 0 + then xs.Values.[0] + else failwith msgListWasEmpty + +let tryLast (xs: 'T list) = + if xs.Count > 0 + then Some xs.Values.[0] + else None let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = if obj.ReferenceEquals(xs, ys) then 0 else - let rec loop xs ys = - match xs, ys with - | [], [] -> 0 - | [], _ -> -1 - | _, [] -> 1 - | x::xs, y::ys -> - match comparer x y with - | 0 -> loop xs ys - | res -> res - loop xs ys - -let rec foldIndexedAux f i acc = function - | [] -> acc - | x::xs -> foldIndexedAux f (i+1) (f i acc x) xs - -let foldIndexed<'a,'acc> f (state: 'acc) (xs: 'a list) = - foldIndexedAux f 0 state xs - -let rec fold<'a,'acc> f (state: 'acc) (xs: 'a list) = - match xs with - | [] -> state - | h::t -> fold f (f state h) t - -let reverse xs = - fold (fun acc x -> x::acc) [] xs - -let foldBack<'a,'acc> f (xs: 'a list) (state: 'acc) = - fold (fun acc x -> f x acc) state (reverse xs) + + if isEmpty xs then + if isEmpty ys then 0 else -1 + elif isEmpty ys then + 1 + else + let mutable i = xs.Count - 1 + let mutable result = 0 + if xs.Count > ys.Count then 1 + elif xs.Count < ys.Count then -1 + else + while i >= 0 && result = 0 do + result <- comparer xs.Values.[i] ys.Values.[i] + i <- i - 1 + result + +let fold (folder: 'acc -> 'T -> 'acc) (state: 'acc) (xs: 'T list) = + let mutable acc = state + for i = xs.Count - 1 downto 0 do + acc <- folder acc xs.Values.[i] + acc + +let foldBack (folder: 'T -> 'acc -> 'acc) (xs: 'T list) (state: 'acc) = + let mutable acc = state + for i = 0 to xs.Count - 1 do + acc <- folder xs.Values.[i] acc + acc + +let reverse (xs: 'a list) = + fold (fun acc x -> cons x acc) List.Empty xs let toSeq (xs: 'a list): 'a seq = Seq.map id xs let ofSeq (xs: 'a seq): 'a list = - Seq.fold (fun acc x -> x::acc) [] xs + Seq.fold (fun acc x -> cons x acc) List.Empty xs |> reverse let concat (lists: seq<'a list>) = - Seq.fold (fold (fun acc x -> x::acc)) [] lists + Seq.fold (fold (fun acc x -> cons x acc)) List.Empty lists |> reverse -let rec foldIndexed2Aux f i acc bs cs = - match bs, cs with - | [], [] -> acc - | x::xs, y::ys -> foldIndexed2Aux f (i+1) (f i acc x y) xs ys - | _ -> invalidOp "Lists had different lengths" - -let foldIndexed2<'a, 'b, 'acc> f (state: 'acc) (xs: 'a list) (ys: 'b list) = - foldIndexed2Aux f 0 state xs ys - let fold2<'a, 'b, 'acc> f (state: 'acc) (xs: 'a list) (ys: 'b list) = Seq.fold2 f state xs ys let foldBack2<'a, 'b, 'acc> f (xs: 'a list) (ys: 'b list) (state: 'acc) = Seq.foldBack2 f xs ys state -let unfold f state = - let rec unfoldInner acc state = - match f state with - | None -> reverse acc - | Some (x,state) -> unfoldInner (x::acc) state - unfoldInner [] state - -let rec foldIndexed3Aux f i acc bs cs ds = - match bs, cs, ds with - | [], [], [] -> acc - | x::xs, y::ys, z::zs -> foldIndexed3Aux f (i+1) (f i acc x y z) xs ys zs - | _ -> invalidOp "Lists had different lengths" - -let foldIndexed3<'a, 'b, 'c, 'acc> f (seed: 'acc) (xs: 'a list) (ys: 'b list) (zs: 'c list) = - foldIndexed3Aux f 0 seed xs ys zs - -let fold3<'a, 'b, 'c, 'acc> f (state: 'acc) (xs: 'a list) (ys: 'b list) (zs: 'c list) = - foldIndexed3 (fun _ acc x y z -> f acc x y z) state xs ys zs +let unfold (gen: 'acc -> ('T * 'acc) option) (state: 'acc) = + let values = ResizeArray<_>() + let rec loop acc = + match gen acc with + | None -> () + | Some (x, st) -> values.Add(x); loop st + loop state + newList values let scan<'a, 'acc> f (state: 'acc) (xs: 'a list) = Seq.scan f state xs |> ofSeq @@ -112,47 +148,43 @@ let scan<'a, 'acc> f (state: 'acc) (xs: 'a list) = let scanBack<'a, 'acc> f (xs: 'a list) (state: 'acc) = Seq.scanBack f xs state |> ofSeq -let length xs = - fold (fun acc _ -> acc + 1) 0 xs - -let append xs ys = - fold (fun acc x -> x::acc) ys (reverse xs) +let append (xs: 'a list) (ys: 'a list) = + Seq.append xs ys |> ofSeq let collect (f: 'a -> 'b list) (xs: 'a list) = Seq.collect f xs |> ofSeq -let map f xs = - fold (fun acc x -> f x::acc) [] xs - |> reverse +let map f (xs: 'a list) = + let values = ResizeArray<_>(xs.Count) + for i = xs.Count - 1 downto 0 do + values.Add(f xs.Values.[i]) + values.Reverse() + newList values -let mapIndexed f xs = - foldIndexed (fun i acc x -> f i x::acc) [] xs - |> reverse +let mapIndexed f (xs: 'a list) = + let values = ResizeArray<_>(xs.Count) + for i = xs.Count - 1 downto 0 do + values.Add(f (xs.Count - i - 1) xs.Values.[i]) + values.Reverse() + newList values -let indexed xs = - mapIndexed (fun i x -> (i,x)) xs +let indexed (xs: 'a list) = + mapIndexed (fun i x -> (i, x)) xs let map2 f xs ys = - fold2 (fun acc x y -> f x y::acc) [] xs ys - |> reverse + Seq.map2 f xs ys |> ofSeq let mapIndexed2 f xs ys = - foldIndexed2 (fun i acc x y -> f i x y:: acc) [] xs ys - |> reverse + Seq.mapi2 f xs ys |> ofSeq let map3 f xs ys zs = - fold3 (fun acc x y z -> f x y z::acc) [] xs ys zs - |> reverse - -let mapIndexed3 f xs ys zs = - foldIndexed3 (fun i acc x y z -> f i x y z:: acc) [] xs ys zs - |> reverse + Seq.map3 f xs ys zs |> ofSeq let mapFold (f: 'S -> 'T -> 'R * 'S) s xs = let foldFn (nxs, fs) x = let nx, fs = f fs x - nx::nxs, fs - let nxs, s = fold foldFn ([], s) xs + cons nx nxs, fs + let nxs, s = fold foldFn (List.Empty, s) xs reverse nxs, s let mapFoldBack (f: 'T -> 'S -> 'R * 'S) xs s = @@ -165,132 +197,137 @@ let iterate2 f xs ys = fold2 (fun () x y -> f x y) () xs ys let iterateIndexed f xs = - foldIndexed (fun i () x -> f i x) () xs + fold (fun i x -> f i x; i + 1) 0 xs |> ignore let iterateIndexed2 f xs ys = - foldIndexed2 (fun i () x y -> f i x y) () xs ys + fold2 (fun i x y -> f i x y; i + 1) 0 xs ys |> ignore let ofArray (xs: IList<'T>) = - // Array.foldBack (fun x acc -> x::acc) xs [] - let mutable res = [] + let values = ResizeArray<_>(xs.Count) for i = xs.Count - 1 downto 0 do - res <- xs.[i]::res - res - -let empty<'a> : 'a list = [] - -let isEmpty = function - | [] -> true - | _ -> false - -let rec tryPickIndexedAux f i = function - | [] -> None - | x::xs -> - let result = f i x - match result with - | Some _ -> result - | None -> tryPickIndexedAux f (i+1) xs - -let tryPickIndexed f xs = - tryPickIndexedAux f 0 xs + values.Add(xs.[i]) + newList values + +let tryPickIndexed (f: int -> 'a -> 'b option) xs = + let rec loop i = + let res = f (xs.Count - i - 1) xs.Values.[i] + match res with + | Some _ -> res + | None -> if i > 0 then loop (i - 1) else None + if xs.Count > 0 then loop (xs.Count - 1) else None + +let tryPickIndexedBack (f: int -> 'a -> 'b option) xs = + let rec loop i = + let res = f (xs.Count - i - 1) xs.Values.[i] + match res with + | Some _ -> res + | None -> if i < xs.Count - 1 then loop (i + 1) else None + if xs.Count > 0 then loop 0 else None let tryPick f xs = tryPickIndexed (fun _ x -> f x) xs let pick f xs = match tryPick f xs with - | None -> invalidOp "List did not contain any matching elements" + | None -> invalidOp msgListNoMatch | Some x -> x let tryFindIndexed f xs = tryPickIndexed (fun i x -> if f i x then Some x else None) xs -let tryFind f xs = - tryPickIndexed (fun _ x -> if f x then Some x else None) xs +let tryFindIndexedBack f xs = + tryPickIndexedBack (fun i x -> if f i x then Some x else None) xs let findIndexed f xs = match tryFindIndexed f xs with - | None -> invalidOp "List did not contain any matching elements" + | None -> invalidOp msgListNoMatch + | Some x -> x + +let findIndexedBack f xs = + match tryFindIndexedBack f xs with + | None -> invalidOp msgListNoMatch | Some x -> x let find f xs = findIndexed (fun _ x -> f x) xs let findBack f xs = - xs |> reverse |> find f + findIndexedBack (fun _ x -> f x) xs + +let tryFind f xs = + tryPickIndexed (fun _ x -> if f x then Some x else None) xs let tryFindBack f xs = - xs |> reverse |> tryFind f + tryPickIndexedBack (fun _ x -> if f x then Some x else None) xs let tryFindIndex f xs: int option = tryPickIndexed (fun i x -> if f x then Some i else None) xs let tryFindIndexBack f xs: int option = - List.toArray xs - |> Array.tryFindIndexBack f + tryPickIndexedBack (fun i x -> if f x then Some i else None) xs let findIndex f xs: int = match tryFindIndex f xs with - | None -> invalidOp "List did not contain any matching elements" + | None -> invalidOp msgListNoMatch | Some x -> x let findIndexBack f xs: int = - List.toArray xs - |> Array.findIndexBack f + match tryFindIndexBack f xs with + | None -> invalidOp msgListNoMatch + | Some x -> x let item n xs = - findIndexed (fun i _ -> n = i) xs + if n < 0 || n >= xs.Count + then failwith "Index out of range" + else xs.Values.[xs.Count - n - 1] let tryItem n xs = - tryFindIndexed (fun i _ -> n = i) xs + if n < 0 || n >= xs.Count + then None + else Some xs.Values.[xs.Count - n - 1] let filter f xs = fold (fun acc x -> - if f x then x::acc - else acc) [] xs |> reverse + if f x then cons x acc + else acc) List.Empty xs |> reverse let partition f xs = fold (fun (lacc, racc) x -> - if f x then x::lacc, racc - else lacc,x::racc) ([],[]) (reverse xs) + if f x then cons x lacc, racc + else lacc, cons x racc) (List.Empty, List.Empty) (reverse xs) let choose f xs = fold (fun acc x -> match f x with - | Some y -> y:: acc - | None -> acc) [] xs |> reverse - -let contains<'T> (value: 'T) (list: 'T list) ([] eq: IEqualityComparer<'T>) = - let rec loop xs = - match xs with - | [] -> false - | v::rest -> - if eq.Equals (value, v) - then true - else loop rest - loop list - -let except (itemsToExclude: seq<'t>) (array: 't list) ([] eq: IEqualityComparer<'t>): 't list = - if isEmpty array then array + | Some y -> cons y acc + | None -> acc) List.Empty xs |> reverse + +let contains<'T> (value: 'T) (xs: 'T list) ([] eq: IEqualityComparer<'T>) = + tryFindIndex (fun v -> eq.Equals (value, v)) xs |> Option.isSome + +let except (itemsToExclude: seq<'t>) (xs: 't list) ([] eq: IEqualityComparer<'t>): 't list = + if isEmpty xs then xs else let cached = HashSet(itemsToExclude, eq) - array |> filter cached.Add + xs |> filter cached.Add -let initialize n f = - let mutable xs = [] - for i = 0 to n-1 do xs <- (f i)::xs - reverse xs +let initialize (n: int) f = + let values = ResizeArray<_>(n) + for i = 0 to n - 1 do + values.Add(f i) + values.Reverse() + newList values let replicate n x = initialize n (fun _ -> x) -let reduce f = function - | [] -> invalidOp "List was empty" - | h::t -> fold f h t +let reduce f (xs: 't list) = + if isEmpty xs then invalidOp msgListWasEmpty + else fold f (head xs) (tail xs) -let reduceBack f = function - | [] -> invalidOp "List was empty" - | h::t -> foldBack f t h +let reduceBack f (xs: 't list) = + if isEmpty xs then invalidOp msgListWasEmpty + else foldBack f (tail xs) (head xs) let forAll f xs = fold (fun acc x -> acc && f x) true xs @@ -298,21 +335,20 @@ let forAll f xs = let forAll2 f xs ys = fold2 (fun acc x y -> acc && f x y) true xs ys -let rec exists f = function - | [] -> false - | x::xs -> f x || exists f xs +let exists f xs = + tryFindIndex f xs |> Option.isSome -let rec exists2 f bs cs = - match bs, cs with - | [], [] -> false - | x::xs, y::ys -> f x y || exists2 f xs ys +let rec exists2 f xs ys = + match length xs, length ys with + | 0, 0 -> false + | x, y when x = y -> f (head xs) (head ys) || exists2 f (tail xs) (tail ys) | _ -> invalidOp "Lists had different lengths" let unzip xs = - foldBack (fun (x, y) (lacc, racc) -> x::lacc, y::racc) xs ([],[]) + foldBack (fun (x, y) (lacc, racc) -> cons x lacc, cons y racc) xs (List.Empty, List.Empty) let unzip3 xs = - foldBack (fun (x, y, z) (lacc, macc, racc) -> x::lacc, y::macc, z::racc) xs ([],[],[]) + foldBack (fun (x, y, z) (lacc, macc, racc) -> cons x lacc, cons y macc, cons z racc) xs (List.Empty, List.Empty, List.Empty) let zip xs ys = map2 (fun x y -> x, y) xs ys @@ -320,20 +356,23 @@ let zip xs ys = let zip3 xs ys zs = map3 (fun x y z -> x, y, z) xs ys zs +let sortWith (comparison: 'T -> 'T -> int) (xs: 'T list): 'T list = + let sorted = copy xs + let reverse_comparison x y = (comparison x y) * -1 + sorted.Values.Sort(System.Comparison<_>(reverse_comparison)) + sorted + let sort (xs: 'T list) ([] comparer: IComparer<'T>): 'T list = - Array.sortInPlaceWith (fun x y -> comparer.Compare(x, y)) (List.toArray xs) |> ofArray + sortWith (fun x y -> comparer.Compare(x, y)) xs let sortBy (projection: 'a -> 'b) (xs: 'a list) ([] comparer: IComparer<'b>): 'a list = - Array.sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y)) (List.toArray xs) |> ofArray + sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs let sortDescending (xs: 'T list) ([] comparer: IComparer<'T>): 'T list = - Array.sortInPlaceWith (fun x y -> comparer.Compare(x, y) * -1) (List.toArray xs) |> ofArray + sortWith (fun x y -> comparer.Compare(x, y) * -1) xs let sortByDescending (projection: 'a -> 'b) (xs: 'a list) ([] comparer: IComparer<'b>): 'a list = - Array.sortInPlaceWith (fun x y -> comparer.Compare(projection x, projection y) * -1) (List.toArray xs) |> ofArray - -let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list): 'T list = - Array.sortInPlaceWith comparer (List.toArray xs) |> ofArray + sortWith (fun x y -> comparer.Compare(projection x, projection y) * -1) xs let sum (xs: 'T list) ([] adder: IGenericAdder<'T>): 'T = fold (fun acc x -> adder.Add(acc, x)) (adder.GetZero()) xs @@ -361,92 +400,43 @@ let averageBy (f: 'T -> 'T2) (xs: 'T list) ([] averager: IGenericAverage let total = fold (fun acc x -> averager.Add(acc, f x)) (averager.GetZero()) xs averager.DivideByInt(total, length xs) -let permute f xs = - xs - |> List.toArray +let permute f (xs: 'T list) = + Array.ofSeq xs Array.DynamicArrayCons |> Array.permute f |> ofArray let chunkBySize (chunkSize: int) (xs: 'T list): 'T list list = - xs - |> List.toArray + Array.ofSeq xs Array.DynamicArrayCons |> Array.chunkBySize chunkSize |> ofArray |> map ofArray -let skip i xs = - let rec skipInner i xs = - match i, xs with - | 0, _ -> xs - | _, [] -> failwith "The input sequence has an insufficient number of elements." - | _, _::xs -> skipInner (i - 1) xs - match i, xs with - | i, _ when i < 0 -> failwith "The input must be non-negative." - | 0, _ -> xs - | 1, _::xs -> xs - | i, xs -> skipInner i xs - -let rec skipWhile predicate xs = - match xs with - | h::t when predicate h -> skipWhile predicate t - | _ -> xs - -// TODO: Is there a more efficient algorithm? -let rec takeSplitAux error i acc xs = - match i, xs with - | 0, _ -> reverse acc, xs - | _, [] -> - if error then - failwith "The input sequence has an insufficient number of elements." - else - reverse acc, xs - | _, x::xs -> takeSplitAux error (i - 1) (x::acc) xs +let skip i (xs: 'T list) = + Seq.skip i xs |> ofSeq -let take i xs = - match i, xs with - | i, _ when i < 0 -> failwith "The input must be non-negative." - | 0, _ -> [] - | 1, x::_ -> [x] - | i, xs -> takeSplitAux true i [] xs |> fst - -let rec takeWhile predicate (xs: 'T list) = - match xs with - | [] -> xs - | x::([] as nil) -> if predicate x then xs else nil - | x::xs -> - if not (predicate x) then [] - else x::(takeWhile predicate xs) +let skipWhile predicate (xs: 'T list) = + Seq.skipWhile predicate xs |> ofSeq -let truncate i xs = - match i, xs with - | i, _ when i < 0 -> failwith "The input must be non-negative." - | 0, _ -> [] - | 1, x::_ -> [x] - | i, xs -> takeSplitAux false i [] xs |> fst +let take i xs = + Seq.take i xs |> ofSeq -let splitAt i xs = - match i, xs with - | i, _ when i < 0 -> failwith "The input must be non-negative." - | 0, _ -> [],xs - | 1, x::xs -> [x],xs - | i, xs -> takeSplitAux true i [] xs +let takeWhile predicate (xs: 'T list) = + Seq.takeWhile predicate xs |> ofSeq -let outOfRange() = failwith "Index out of range" +let truncate i xs = + Seq.truncate i xs |> ofSeq let slice (lower: int option) (upper: int option) (xs: 'T list) = let lower = defaultArg lower 0 - let hasUpper = Option.isSome upper - if lower < 0 then outOfRange() - elif hasUpper && upper.Value < lower then [] - else - let mutable lastIndex = -1 - let res = - ([], xs) ||> foldIndexed (fun i acc x -> - lastIndex <- i - if lower <= i && (not hasUpper || i <= upper.Value) then x::acc - else acc) - if lower > (lastIndex + 1) || (hasUpper && upper.Value > lastIndex) then outOfRange() - reverse res + let upper = defaultArg upper (xs.Count - 1) + if lower < 0 || upper >= xs.Count then failwith "Index out of range" + elif upper < lower then List.Empty + else newList <| xs.Values.GetRange(xs.Count - 1 - upper, upper - lower + 1) + +let splitAt i (xs: 'T list) = + if i < 0 then invalidArg "index" LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + if i > xs.Count then invalidArg "index" "The input sequence has an insufficient number of elements." + take i xs, skip i xs let distinctBy (projection: 'T -> 'Key) (xs: 'T list) ([] eq: IEqualityComparer<'Key>) = let hashSet = HashSet<'Key>(eq) @@ -456,29 +446,29 @@ let distinct (xs: 'T list) ([] eq: IEqualityComparer<'T>) = distinctBy id xs eq let exactlyOne (xs: 'T list) = - match xs with - | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString - | [x] -> x - | x1::x2::xs -> invalidArg "list" "Input list too long" + match xs.Count with + | 1 -> head xs + | 0 -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + | _ -> invalidArg "list" "Input list too long" let groupBy (projection: 'T -> 'Key) (xs: 'T list)([] eq: IEqualityComparer<'Key>): ('Key * 'T list) list = let dict = Dictionary<'Key, 'T list>(eq) - let mutable keys = [] + let mutable keys = List.Empty xs |> iterate (fun v -> let key = projection v match dict.TryGetValue(key) with | true, prev -> - dict.[key] <- v::prev + dict.[key] <- cons v prev | false, _ -> - dict.Add(key, [v]) - keys <- key::keys ) - let mutable result = [] - keys |> iterate (fun key -> result <- (key, reverse dict.[key]) :: result) + dict.Add(key, cons v List.Empty) + keys <- cons key keys ) + let mutable result = List.Empty + keys |> iterate (fun key -> result <- cons (key, reverse dict.[key]) result) result let countBy (projection: 'T -> 'Key) (xs: 'T list)([] eq: IEqualityComparer<'Key>) = let dict = Dictionary<'Key, int>(eq) - let mutable keys = [] + let mutable keys = List.Empty xs |> iterate (fun v -> let key = projection v match dict.TryGetValue(key) with @@ -486,29 +476,24 @@ let countBy (projection: 'T -> 'Key) (xs: 'T list)([] eq: IEqualityCompa dict.[key] <- prev + 1 | false, _ -> dict.[key] <- 1 - keys <- key::keys ) - let mutable result = [] - keys |> iterate (fun key -> result <- (key, dict.[key]) :: result) + keys <- cons key keys ) + let mutable result = List.Empty + keys |> iterate (fun key -> result <- cons (key, dict.[key]) result) result -let where predicate source = - filter predicate source +let where predicate (xs: 'T list) = + filter predicate xs + +let pairwise (xs: 'T list) = + Seq.pairwise xs |> ofSeq -let pairwise source = - Seq.pairwise source +let windowed (windowSize: int) (xs: 'T list): 'T list list = + Seq.windowed windowSize xs |> ofSeq + |> map ofArray -let windowed (windowSize: int) (source: 'T list): 'T list list = - if windowSize <= 0 then - failwith "windowSize must be positive" - let mutable res = [] - for i = length source downto windowSize do - res <- (slice (Some(i-windowSize)) (Some(i-1)) source) :: res - res - -let splitInto (chunks: int) (source: 'T list): 'T list list = - source - |> List.toArray +let splitInto (chunks: int) (xs: 'T list): 'T list list = + Array.ofSeq xs Array.DynamicArrayCons |> Array.splitInto chunks |> ofArray |> map ofArray diff --git a/src/fable-library/Types.ts b/src/fable-library/Types.ts index 977388dc4f..40155a2df3 100644 --- a/src/fable-library/Types.ts +++ b/src/fable-library/Types.ts @@ -47,131 +47,131 @@ export class SystemObject implements IEquatable { } } -function compareList(self: List, other: List) { - if (self === other) { - return 0; - } else { - if (other == null) { - return -1; - } - const selfLen = self.length; - const otherLen = other.length; - const minLen = Math.min(selfLen, otherLen); - for (let i = 0; i < minLen; i++) { - const res = compare(self.item(i), other.item(i)); - if (res !== 0) { return res; } - } - return selfLen > otherLen ? 1 : (selfLen < otherLen ? -1 : 0); - } -} +// function compareList(self: List, other: List) { +// if (self === other) { +// return 0; +// } else { +// if (other == null) { +// return -1; +// } +// const selfLen = self.length; +// const otherLen = other.length; +// const minLen = Math.min(selfLen, otherLen); +// for (let i = 0; i < minLen; i++) { +// const res = compare(self.item(i), other.item(i)); +// if (res !== 0) { return res; } +// } +// return selfLen > otherLen ? 1 : (selfLen < otherLen ? -1 : 0); +// } +// } -/** - * F# list is represented in runtime by an optimized type that uses a stack (a reverted JS array) - * to store the values, so we can a have a big list represented by a single object (plus the stack). - * It also allows for optimizations in the List module. - */ -export class List implements IEquatable>, IComparable>, Iterable { - public vals: T[]; - public idx: number; - public _tail: List | undefined; - - constructor(vals?: T[], idx?: number) { - this.vals = vals ?? []; - this.idx = idx ?? this.vals.length - 1; - } +// /** +// * F# list is represented in runtime by an optimized type that uses a stack (a reverted JS array) +// * to store the values, so we can a have a big list represented by a single object (plus the stack). +// * It also allows for optimizations in the List module. +// */ +// export class List implements IEquatable>, IComparable>, Iterable { +// public vals: T[]; +// public idx: number; +// public _tail: List | undefined; + +// constructor(vals?: T[], idx?: number) { +// this.vals = vals ?? []; +// this.idx = idx ?? this.vals.length - 1; +// } - add(item: T): List { - // If this points to the last index of the stack, push the new value into it. - // Otherwise, this becomes an "actual" tail. - if (this.vals.length === this.idx + 1) { - this.vals.push(item); - return new List(this.vals); - } else { - const li = new List([item]); - li._tail = this; - return li; - } - } - - /** Unsafe, check length before calling it */ - public item(i: number): T | undefined { - let rev_i = this.idx - i; - if (rev_i >= 0) { - return this.vals[rev_i]; - } else if (this._tail) { - return this._tail.item(rev_i * -1 - 1); - } - return undefined; - } +// add(item: T): List { +// // If this points to the last index of the stack, push the new value into it. +// // Otherwise, this becomes an "actual" tail. +// if (this.vals.length === this.idx + 1) { +// this.vals.push(item); +// return new List(this.vals); +// } else { +// const li = new List([item]); +// li._tail = this; +// return li; +// } +// } + +// /** Unsafe, check length before calling it */ +// public item(i: number): T | undefined { +// const rev_i = this.idx - i; +// if (rev_i >= 0) { +// return this.vals[rev_i]; +// } else if (this._tail) { +// return this._tail.item(rev_i * -1 - 1); +// } +// return undefined; +// } - /** Unsafe, check isEmpty before calling it */ - public get head(): T | undefined { - return this.vals[this.idx]; - } +// /** Unsafe, check isEmpty before calling it */ +// public get head(): T | undefined { +// return this.vals[this.idx]; +// } - public get tail(): List | undefined { - if (this.idx === 0 && this._tail) { - return this._tail; - } else if (this.idx >= 0) { - return new List(this.vals, this.idx - 1); - } - return undefined; - } +// public get tail(): List | undefined { +// if (this.idx === 0 && this._tail) { +// return this._tail; +// } else if (this.idx >= 0) { +// return new List(this.vals, this.idx - 1); +// } +// return undefined; +// } - public get isEmpty() { - return this.idx < 0; - } +// public get isEmpty() { +// return this.idx < 0; +// } - public get length(): number { - return this.idx + 1 + (this._tail?.length ?? 0); - } +// public get length(): number { +// return this.idx + 1 + (this._tail?.length ?? 0); +// } - public toString() { - return "[" + Array.from(this).join("; ") + "]"; - } +// public toString() { +// return "[" + Array.from(this).join("; ") + "]"; +// } - public toJSON() { - return Array.from(this); - } +// public toJSON() { +// return Array.from(this); +// } - public [Symbol.iterator](): Iterator { - let curIdx = this.idx; - let li: List = this; - return { - next: (): IteratorResult => { - if (curIdx < 0) { - if (li._tail) { - li = li._tail; - curIdx = li.idx; - } else { - return { done: true, value: undefined }; - } - } - return { done: false, value: li.vals[curIdx--] }; - } - }; - } +// public [Symbol.iterator](): Iterator { +// let curIdx = this.idx; +// let li: List = this; +// return { +// next: (): IteratorResult => { +// if (curIdx < 0) { +// if (li._tail) { +// li = li._tail; +// curIdx = li.idx; +// } else { +// return { done: true, value: undefined }; +// } +// } +// return { done: false, value: li.vals[curIdx--] }; +// } +// }; +// } - public GetHashCode() { - if (this.idx < 0) { - return 0; - } else { - const hashes: number[] = new Array(this.idx + 1); - for (let i = this.idx; i >= 0; i--) { - hashes[i] = structuralHash(this.vals[i]); - } - return combineHashCodes(hashes); - } - } +// public GetHashCode() { +// if (this.idx < 0) { +// return 0; +// } else { +// const hashes: number[] = new Array(this.idx + 1); +// for (let i = this.idx; i >= 0; i--) { +// hashes[i] = structuralHash(this.vals[i]); +// } +// return combineHashCodes(hashes); +// } +// } - public Equals(other: List): boolean { - return compareList(this, other) === 0; - } +// public Equals(other: List): boolean { +// return compareList(this, other) === 0; +// } - public CompareTo(other: List): number { - return compareList(this, other); - } -} +// public CompareTo(other: List): number { +// return compareList(this, other); +// } +// } export class Union extends SystemObject implements IComparable { public tag: number; diff --git a/src/fable-standalone/test/bench-compiler/package.json b/src/fable-standalone/test/bench-compiler/package.json index b13e897170..02f4a7d9f6 100644 --- a/src/fable-standalone/test/bench-compiler/package.json +++ b/src/fable-standalone/test/bench-compiler/package.json @@ -34,7 +34,9 @@ "tsc-lib-init": "npm run tsc -- --init --target es2020 --module es2020 --allowJs", "tsc-lib": "npm run tsc -- -p ./out-lib --outDir ./out-lib-js", + "build-test-node": "node out-node/app.js ../../../../../fable-test/fable-test.fsproj out-test && npm run build-test-transform", "build-test-node-ts": "node out-node/app.js ../../../../../fable-test/fable-test.fsproj out-test --classTypes --typescript && npm run build-test-transform -- --typescript", + "build-test-dotnet": "dotnet run -c Release ../../../../../fable-test/fable-test.fsproj out-test && npm run build-test-transform", "build-test-dotnet-ts": "dotnet run -c Release ../../../../../fable-test/fable-test.fsproj out-test --classTypes --typescript && npm run build-test-transform -- --typescript", "build-test-dotnet-opt": "dotnet run -c Release ../../../../../fable-test/fable-test.fsproj out-test --optimize-fcs && npm run build-test-transform", "build-test-transform": "node transform ../../../../../fable-test/fable-test.fsproj out-test ../../../../build/fable-library", diff --git a/tests/Main/ListTests.fs b/tests/Main/ListTests.fs index 30d0534d95..d679a1acfd 100644 --- a/tests/Main/ListTests.fs +++ b/tests/Main/ListTests.fs @@ -42,13 +42,26 @@ module List = let tests = testList "Lists" [ - // TODO: Empty lists may be represented as null, make sure they don't conflict with None testCase "Some [] works" <| fun () -> let xs: int list option = Some [] let ys: int list option = None Option.isSome xs |> equal true Option.isNone ys |> equal true + testCase "List equality works" <| fun () -> + let xs = [1;2;3] + let ys = [1;2;3] + let zs = [1;4;3] + xs = ys |> equal true + xs = zs |> equal false + + testCase "List comparison works" <| fun () -> + let xs = [1;2;3] + let ys = [1;2;3] + let zs = [1;4;3] + xs < ys |> equal false + xs < zs |> equal true + testCase "Pattern matching with lists works" <| fun () -> match [] with [] -> true | _ -> false |> equal true @@ -302,9 +315,9 @@ let tests = |> List.sum |> equal 9 testCase "List.rev works" <| fun () -> - let xs = [1; 2] + let xs = [1; 2; 3] let ys = xs |> List.rev - equal 2 ys.Head + equal 3 ys.Head testCase "List.scan works" <| fun () -> let xs = [1; 2; 3; 4]