From c9a6aa29e54e7e37f35d0ab846a03452ab503878 Mon Sep 17 00:00:00 2001 From: ncave <777696+ncave@users.noreply.github.com> Date: Thu, 1 Oct 2020 07:11:35 -0700 Subject: [PATCH] Array-based List type --- src/Fable.Transforms/Fable2Babel.fs | 35 +- src/Fable.Transforms/Replacements.fs | 29 +- src/fable-library/List.fs | 729 +++++++++++++++------------ src/fable-library/Map.fs | 4 +- src/fable-library/Types.ts | 47 -- 5 files changed, 426 insertions(+), 418 deletions(-) diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 31bb59d6a1..2c724bc5e3 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -426,7 +426,7 @@ module Annotation = makeNativeTypeAnnotation com ctx [genArg] "Array" let makeListTypeAnnotation com ctx genArg = - makeImportTypeAnnotation com ctx [genArg] "Types" "List" + makeImportTypeAnnotation com ctx [genArg] "List" "List" let makeUnionTypeAnnotation com ctx genArgs = List.map (typeAnnotation com ctx) genArgs @@ -647,12 +647,6 @@ module Util = | [] -> expr | m::ms -> get None expr m |> getParts ms - let makeList com ctx r headAndTail = - match headAndTail with - | None -> [||] - | Some(TransformExpr com ctx head, TransformExpr com ctx tail) -> [|head; tail|] - |> libConsCall com ctx r "Types" "List" - let makeArray (com: IBabelCompiler) ctx exprs = List.mapToArray (fun e -> com.TransformAsExpr(ctx, e)) exprs |> ArrayExpression :> Expression @@ -902,12 +896,17 @@ module Util = | Fable.NewTuple vals -> makeArray com ctx vals // Optimization for bundle size: compile list literals as List.ofArray | Replacements.ListLiteral(exprs, t) -> - match exprs with - | [] -> makeList com ctx r None - | [expr] -> Some(expr, Fable.Value(Fable.NewList (None,t), None)) |> makeList com ctx r - | exprs -> [|makeArray com ctx exprs|] |> libCall com ctx r "List" "ofArray" + [|List.rev exprs |> makeArray com ctx|] + |> libCall com ctx r "List" "newList" + // match exprs with + // | [] -> libCall com ctx r "List" "empty" [||] + // | [TransformExpr com ctx expr] -> libCall com ctx r "List" "singleton" [|expr|] + // | exprs -> [|makeArray com ctx exprs|] |> libCall com ctx r "List" "ofArray" | Fable.NewList (headAndTail, _) -> - makeList com ctx r headAndTail + match headAndTail with + | None -> libCall com ctx r "List" "empty" [||] + | Some(TransformExpr com ctx head, TransformExpr com ctx tail) -> + libCall com ctx r "List" "cons" [|head; tail|] | Fable.NewOption (value, t) -> match value with | Some (TransformExpr com ctx e) -> @@ -1162,10 +1161,12 @@ module Util = | Fable.FieldKey field -> get range expr field.Name | Fable.ListHead -> - get range (com.TransformAsExpr(ctx, fableExpr)) "head" + // get range (com.TransformAsExpr(ctx, fableExpr)) "head" + libCall com ctx range "List" "head" [|com.TransformAsExpr(ctx, fableExpr)|] | Fable.ListTail -> - get range (com.TransformAsExpr(ctx, fableExpr)) "tail" + // get range (com.TransformAsExpr(ctx, fableExpr)) "tail" + libCall com ctx range "List" "tail" [|com.TransformAsExpr(ctx, fableExpr)|] | Fable.TupleIndex index -> match fableExpr with @@ -1233,9 +1234,9 @@ 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 = com.TransformAsExpr(ctx, expr) - let op = if nonEmpty then BinaryUnequal else BinaryEqual - upcast BinaryExpression(op, get None expr "tail", NullLiteral(), ?loc=range) + // let expr = get range (com.TransformAsExpr(ctx, expr)) "IsEmpty" + let expr = libCall com ctx range "List" "isEmpty" [|com.TransformAsExpr(ctx, expr)|] + if nonEmpty then upcast UnaryExpression(UnaryNot, expr, ?loc=range) else expr | Fable.UnionCaseTest tag -> let expected = ofInt tag let actual = com.TransformAsExpr(ctx, expr) |> getUnionExprTag None diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index 0776fc817c..8e384f995e 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1783,29 +1783,26 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex Helper.LibCall(com, "Array", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some let lists (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = + let meth = Naming.removeGetSetPrefix i.CompiledName |> Naming.lowerFirst match i.CompiledName, thisArg, args with - // Use methods for Head and Tail (instead of Get(ListHead) for example) to check for empty lists - | ReplaceName - [ "get_Head", "head" - "get_Tail", "tail" - "get_Item", "item" - "get_Length", "length" - "GetSlice", "slice" ] methName, Some x, _ -> - let args = match args with [ExprType Unit] -> [x] | args -> args @ [x] - Helper.LibCall(com, "List", methName, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "get_IsEmpty", Some x, _ -> Test(x, ListTest false, r) |> Some - | "get_Empty", None, _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Cons", None, [h;t] -> NewList(Some(h,t), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + | ("get_Head" | "get_Tail" | "get_IsEmpty" | "get_Length"), Some x, _ -> + Helper.LibCall(com, "List", meth, t, [x], i.SignatureArgTypes, ?loc=r) |> Some + // get r t x meth |> Some + | ("get_Item" | "GetSlice"), Some x, _ -> + Helper.LibCall(com, "List", meth, t, args @ [x], i.SignatureArgTypes, ?loc=r) |> Some + | ("get_Empty" | "Cons"), None, _ -> + Helper.LibCall(com, "List", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("GetHashCode" | "Equals" | "CompareTo"), Some callee, _ -> Helper.InstanceCall(callee, i.CompiledName, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Expr option) (args: Expr list) = match i.CompiledName, args with - | "IsEmpty", [x] -> Test(x, ListTest false, r) |> Some - | "Empty", _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some - | "Singleton", [x] -> - NewList(Some(x, Value(NewList(None, t), None)), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + // | ("Head" | "Tail" | "IsEmpty") as meth, [x] -> get r t x (Naming.lowerFirst meth) |> Some + // | "IsEmpty", [x] -> Test(x, ListTest false, r) |> Some + // | "Empty", _ -> NewList(None, (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some + // | "Singleton", [x] -> + // NewList(Some(x, Value(NewList(None, t), None)), (genArg com ctx r 0 i.GenericArgs)) |> makeValue r |> Some // Use a cast to give it better chances of optimization (e.g. converting list // literals to arrays) after the beta reduction pass | "ToSeq", [x] -> toSeq t x |> Some diff --git a/src/fable-library/List.fs b/src/fable-library/List.fs index 9d1d7d14b2..763ee122a2 100644 --- a/src/fable-library/List.fs +++ b/src/fable-library/List.fs @@ -1,159 +1,249 @@ module List -// Disables warn:1204 raised by use of LanguagePrimitives.ErrorStrings.* -#nowarn "1204" - -open System.Collections.Generic open Fable.Core -let head = function - | x::_ -> x - | _ -> failwith "List was empty" +module SR = + let indexOutOfBounds = "The index was outside the range of elements in the list." + let inputListWasEmpty = "List was empty" + let inputMustBeNonNegative = "The input must be non-negative." + let inputSequenceEmpty = "The input sequence was empty." + let inputSequenceTooLong = "The input sequence contains more than one element." + let keyNotFoundAlt = "An index satisfying the predicate was not found in the collection." + let listsHadDifferentLengths = "The lists had different lengths." + let notEnoughElements = "The input sequence has an insufficient number of elements." + +// [] +[] +// [] +type ResizeList<'T> = + { Count: int; Values: ResizeArray<'T> } + + member inline 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 } + + member inline internal xs.Reverse() = + let values = xs.Values.GetRange(0, xs.Count) + values.Reverse() + { Count = values.Count; Values = values } + + // This is a destructive internal optimization that + // can only be performed on newly constructed lists. + member inline internal xs.ReverseInPlace() = + xs.Values.Reverse() + xs + + static member inline Singleton(x: 'T) = + let values = ResizeArray<'T>() + values.Add(x) + { Count = 1; Values = values } + + static member inline NewList (values: ResizeArray<'T>) = + { Count = values.Count; Values = values } + + static member inline Empty = + { Count = 0; Values = ResizeArray<'T>() } + + 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 = + if xs.Count > 0 + then xs.Values.[xs.Count - 1] + else invalidArg "list" SR.inputListWasEmpty + + member inline xs.Tail = + if xs.Count > 0 + then { Count = xs.Count - 1; Values = xs.Values } + else invalidArg "list" SR.inputListWasEmpty + + member inline xs.Item with get (index: int) = + xs.Values.[xs.Count - 1 - index] + + override xs.ToString() = + "[" + System.String.Join("; ", xs) + "]" + + override xs.Equals(other: obj) = + if obj.ReferenceEquals(xs, other) + then true + else + let ys = other :?> 'T list + if xs.Length <> ys.Length then false + else Seq.forall2 Unchecked.equals xs ys + + override xs.GetHashCode() = + let inline combineHash i x y = (x <<< 1) + y + 631 * i + let len = min (xs.Length - 1) 18 // limit the hash count + let mutable h = 0 + for i = 0 to len do + h <- combineHash i h (Unchecked.hash xs.[i]) + h + + interface System.IComparable with + member xs.CompareTo(other: obj) = + Seq.compareWith Unchecked.compare xs (other :?> 'T list) + + interface System.Collections.Generic.IEnumerable<'T> with + member xs.GetEnumerator(): System.Collections.Generic.IEnumerator<'T> = + new ListEnumerator<'T>(xs) :> System.Collections.Generic.IEnumerator<'T> + + interface System.Collections.IEnumerable with + member xs.GetEnumerator(): System.Collections.IEnumerator = + ((xs :> System.Collections.Generic.IEnumerable<'T>).GetEnumerator() :> System.Collections.IEnumerator) + +and ListEnumerator<'T>(xs: 'T list) = + let mutable i = -1 + interface System.Collections.Generic.IEnumerator<'T> with + member __.Current = xs.[i] + interface System.Collections.IEnumerator with + member __.Current = box (xs.[i]) + member __.MoveNext() = i <- i + 1; i < xs.Length + member __.Reset() = i <- -1 + interface System.IDisposable with + member __.Dispose() = () + +and 'T list = ResizeList<'T> + +// [] +// [] +// module List = + +let inline indexNotFound() = raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) + +let newList values = ResizeList.NewList (values) + +let empty () = ResizeList.Empty + +let cons (x: 'T) (xs: 'T list) = ResizeList.Cons (x, xs) + +let singleton (x: 'T) = ResizeList.Singleton (x) -let tryHead = function - | x::_ -> Some x - | _ -> None +let isEmpty (xs: 'T list) = xs.IsEmpty -let tail = function - | _::xs -> xs - | _ -> failwith "List was empty" +let length (xs: 'T list) = xs.Length -let rec last = function - | [] -> failwith "List was empty" - | [x] -> x - | _::xs -> last xs +let head (xs: 'T list) = xs.Head -let rec tryLast = function - | [] -> None - | [x] -> Some x - | _::xs -> tryLast xs +let tryHead (xs: 'T list) = + if xs.Length > 0 + then Some xs.[0] + else None + +let tail (xs: 'T list) = xs.Tail + +let (|Cons|Nil|) xs = + if isEmpty xs then Nil + else Cons (head xs, tail xs) + +let last (xs: 'T list) = + if xs.Length > 0 + then xs.[xs.Length - 1] + else invalidArg "list" SR.inputListWasEmpty + +let tryLast (xs: 'T list) = + if xs.Length > 0 + then Some xs.[xs.Length - 1] + 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) + Seq.compareWith comparer xs ys + +let fold (folder: 'acc -> 'T -> 'acc) (state: 'acc) (xs: 'T list) = + let mutable acc = state + for i = 0 to xs.Length - 1 do + acc <- folder acc xs.[i] + acc + +let foldBack (folder: 'T -> 'acc -> 'acc) (xs: 'T list) (state: 'acc) = + let mutable acc = state + for i = xs.Length - 1 downto 0 do + acc <- folder xs.[i] acc + acc + +let reverse (xs: 'a list) = + xs.Reverse() + +let inline reverseInPlace (xs: 'a list) = + xs.ReverseInPlace() let toSeq (xs: 'a list): 'a seq = - Seq.map id xs + xs :> System.Collections.Generic.IEnumerable<'a> let ofSeq (xs: 'a seq): 'a list = - Seq.fold (fun acc x -> x::acc) [] xs - |> reverse + // Seq.fold (fun acc x -> cons x acc) ResizeList.Empty xs + // |> reverseInPlace + let values = ResizeArray(xs) + values.Reverse() + values |> newList let concat (lists: seq<'a list>) = - Seq.fold (fold (fun acc x -> x::acc)) [] 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 + Seq.fold (fold (fun acc x -> cons x acc)) ResizeList.Empty lists + |> reverseInPlace -let fold2<'a, 'b, 'acc> f (state: 'acc) (xs: 'a list) (ys: 'b list) = +let fold2 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) = +let foldBack2 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 rec loop st acc = + match gen st with + | None -> reverseInPlace acc + | Some (x, st) -> loop st (cons x acc) + loop state ResizeList.Empty -let scan<'a, 'acc> f (state: 'acc) (xs: 'a list) = +let scan f (state: 'acc) (xs: 'a list) = Seq.scan f state xs |> ofSeq -let scanBack<'a, 'acc> f (xs: 'a list) (state: 'acc) = +let scanBack 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) = + // foldBack cons xs ys + let mutable acc = ys + for i = xs.Length - 1 downto 0 do + acc <- cons xs.[i] acc + acc 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 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 mapIndexed f xs = - foldIndexed (fun i acc x -> f i x::acc) [] xs - |> reverse +let map (f: 'a -> 'b) (xs: 'a list) = + mapIndexed (fun _i x -> f x) xs -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 folder (nxs, fs) x = let nx, fs = f fs x - nx::nxs, fs - let nxs, s = fold foldFn ([], s) xs - reverse nxs, s + cons nx nxs, fs + let nxs, s = fold folder (ResizeList.Empty, s) xs + reverseInPlace nxs, s let mapFoldBack (f: 'T -> 'S -> 'R * 'S) xs s = mapFold (fun s v -> f v s) s (reverse xs) @@ -165,132 +255,144 @@ 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 - -let ofArray (xs: IList<'T>) = - // Array.foldBack (fun x acc -> x::acc) xs [] - let mutable res = [] - 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 + fold2 (fun i x y -> f i x y; i + 1) 0 xs ys |> ignore + +let ofArray (xs: 'T[]) = + // let mutable res = ResizeList.Empty + // for i = xs.Length - 1 downto 0 do + // res <- cons xs.[i] res + // res + let values = ResizeArray(xs.Length) + let lastIndex = xs.Length - 1 + for i = lastIndex downto 0 do + values.[lastIndex - i] <- xs.[i] + values |> newList + +let tryPickIndexed (f: int -> 'a -> 'b option) (xs: 'a list) = + let rec loop i = + let res = f i xs.[i] + match res with + | Some _ -> res + | None -> if i < xs.Length - 1 then loop (i + 1) else None + if xs.Length > 0 then loop 0 else None + +let tryPickIndexedBack (f: int -> 'a -> 'b option) (xs: 'a list) = + let rec loop i = + let res = f i xs.[i] + match res with + | Some _ -> res + | None -> if i > 0 then loop (i - 1) else None + if xs.Length > 0 then loop (xs.Length - 1) 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 -> indexNotFound() | 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 -> indexNotFound() + | Some x -> x + +let findIndexedBack f xs = + match tryFindIndexedBack f xs with + | None -> indexNotFound() | 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 -> indexNotFound() | Some x -> x let findIndexBack f xs: int = - List.toArray xs - |> Array.findIndexBack f + match tryFindIndexBack f xs with + | None -> indexNotFound() + | Some x -> x -let item n xs = - findIndexed (fun i _ -> n = i) xs +let item index (xs: 'a list) = + if index >= 0 && index < xs.Length + then xs.[index] + else invalidArg "index" SR.indexOutOfBounds -let tryItem n xs = - tryFindIndexed (fun i _ -> n = i) xs +let tryItem index (xs: 'a list) = + if index >= 0 && index < xs.Length + then Some xs.[index] + else None 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) ResizeList.Empty xs + |> reverseInPlace 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) (ResizeList.Empty, ResizeList.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) ResizeList.Empty xs + |> reverseInPlace + +let contains (value: 'T) (xs: 'T list) ([] eq: System.Collections.Generic.IEqualityComparer<'T>) = + tryFindIndex (fun v -> eq.Equals (value, v)) xs |> Option.isSome + +let except (itemsToExclude: seq<'t>) (xs: 't list) ([] eq: System.Collections.Generic.IEqualityComparer<'t>): 't list = + if isEmpty xs then xs else - let cached = HashSet(itemsToExclude, eq) - array |> filter cached.Add + let cached = System.Collections.Generic.HashSet(itemsToExclude, eq) + 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 mutable res = ResizeList.Empty + for i = 0 to n - 1 do + res <- cons (f i) res + res |> reverseInPlace 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 invalidArg "list" SR.inputListWasEmpty + 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 invalidArg "list" SR.inputListWasEmpty + else foldBack f (tail xs) (head xs) let forAll f xs = fold (fun acc x -> acc && f x) true xs @@ -298,21 +400,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 - | _ -> invalidOp "Lists had different lengths" +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) + | _ -> invalidArg "list2" SR.listsHadDifferentLengths 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 (ResizeList.Empty, ResizeList.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 (ResizeList.Empty, ResizeList.Empty, ResizeList.Empty) let zip xs ys = map2 (fun x y -> x, y) xs ys @@ -320,20 +421,22 @@ let zip xs ys = let zip3 xs ys zs = map3 (fun x y z -> x, y, z) xs ys zs -let sort (xs: 'T list) ([] comparer: IComparer<'T>): 'T list = - Array.sortInPlaceWith (fun x y -> comparer.Compare(x, y)) (List.toArray xs) |> ofArray +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 -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 +let sort (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'T>): 'T list = + sortWith (fun x y -> comparer.Compare(x, 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 +let sortBy (projection: 'a -> 'b) (xs: 'a list) ([] comparer: System.Collections.Generic.IComparer<'b>): 'a list = + sortWith (fun x y -> comparer.Compare(projection x, projection y)) 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 sortDescending (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'T>): 'T list = + sortWith (fun x y -> comparer.Compare(x, y) * -1) xs -let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list): 'T list = - Array.sortInPlaceWith comparer (List.toArray xs) |> ofArray +let sortByDescending (projection: 'a -> 'b) (xs: 'a list) ([] comparer: System.Collections.Generic.IComparer<'b>): 'a list = + 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 @@ -341,16 +444,16 @@ let sum (xs: 'T list) ([] adder: IGenericAdder<'T>): 'T = let sumBy (f: 'T -> 'T2) (xs: 'T list) ([] adder: IGenericAdder<'T2>): 'T2 = fold (fun acc x -> adder.Add(acc, f x)) (adder.GetZero()) xs -let maxBy (projection: 'a -> 'b) (xs: 'a list) ([] comparer: IComparer<'b>): 'a = +let maxBy (projection: 'a -> 'b) (xs: 'a list) ([] comparer: System.Collections.Generic.IComparer<'b>): 'a = reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then y else x) xs -let max (li:'a list) ([] comparer: IComparer<'a>): 'a = +let max (li:'a list) ([] comparer: System.Collections.Generic.IComparer<'a>): 'a = reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) li -let minBy (projection: 'a -> 'b) (xs: 'a list) ([] comparer: IComparer<'b>): 'a = +let minBy (projection: 'a -> 'b) (xs: 'a list) ([] comparer: System.Collections.Generic.IComparer<'b>): 'a = reduce (fun x y -> if comparer.Compare(projection y, projection x) > 0 then x else y) xs -let min (xs: 'a list) ([] comparer: IComparer<'a>): 'a = +let min (xs: 'a list) ([] comparer: System.Collections.Generic.IComparer<'a>): 'a = reduce (fun x y -> if comparer.Compare(y, x) > 0 then x else y) xs let average (xs: 'T list) ([] averager: IGenericAverager<'T>): 'T = @@ -361,124 +464,78 @@ 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 - |> Array.permute f - |> ofArray +let permute f (xs: 'T list) = + Seq.permute f xs |> ofSeq let chunkBySize (chunkSize: int) (xs: 'T list): 'T list list = - xs - |> List.toArray - |> 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 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 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 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 outOfRange() = failwith "Index out of range" - -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 [] + Seq.chunkBySize chunkSize xs + |> Seq.map ofArray + |> ofSeq + +let skip count (xs: 'T list) = + Seq.skip count xs |> ofSeq + +let skipWhile predicate (xs: 'T list) = + Seq.skipWhile predicate xs |> ofSeq + +let take count xs = + Seq.take count xs |> ofSeq + +let takeWhile predicate (xs: 'T list) = + Seq.takeWhile predicate xs |> ofSeq + +let truncate count xs = + Seq.truncate count xs |> ofSeq + +let getSlice (startIndex: int option) (endIndex: int option) (xs: 'T list) = + let startIndex = defaultArg startIndex 0 + let endIndex = defaultArg endIndex (xs.Length - 1) + if startIndex > endIndex then + ResizeList.Empty 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 distinctBy (projection: 'T -> 'Key) (xs: 'T list) ([] eq: IEqualityComparer<'Key>) = - let hashSet = HashSet<'Key>(eq) + 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]) + values |> newList + +let splitAt index (xs: 'T list) = + if index < 0 then invalidArg "index" SR.inputMustBeNonNegative + if index > xs.Length then invalidArg "index" SR.notEnoughElements + take index xs, skip index xs + +let distinctBy (projection: 'T -> 'Key) (xs: 'T list) ([] eq: System.Collections.Generic.IEqualityComparer<'Key>) = + let hashSet = System.Collections.Generic.HashSet<'Key>(eq) xs |> filter (projection >> hashSet.Add) -let distinct (xs: 'T list) ([] eq: IEqualityComparer<'T>) = +let distinct (xs: 'T list) ([] eq: System.Collections.Generic.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" - -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 = [] + match xs.Length with + | 1 -> head xs + | 0 -> invalidArg "list" SR.inputSequenceEmpty + | _ -> invalidArg "list" SR.inputSequenceTooLong + +let groupBy (projection: 'T -> 'Key) (xs: 'T list)([] 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 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 ResizeList.Empty) + keys <- cons key keys ) + let mutable result = ResizeList.Empty + keys |> iterate (fun key -> result <- cons (key, reverseInPlace 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 countBy (projection: 'T -> 'Key) (xs: 'T list)([] eq: System.Collections.Generic.IEqualityComparer<'Key>) = + let dict = System.Collections.Generic.Dictionary<'Key, int>(eq) + let mutable keys = ResizeList.Empty xs |> iterate (fun v -> let key = projection v match dict.TryGetValue(key) with @@ -486,35 +543,35 @@ 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 = ResizeList.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 source = - Seq.pairwise source +let pairwise (xs: 'T list) = + Seq.pairwise xs |> ofSeq + +let windowed (windowSize: int) (xs: 'T list): 'T list list = + Seq.windowed windowSize xs + |> Seq.map ofArray |> ofSeq -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 - |> Array.splitInto chunks - |> ofArray - |> map ofArray +let splitInto (chunks: int) (xs: 'T list): 'T list list = + Seq.splitInto chunks xs + |> Seq.map ofArray + |> ofSeq let transpose (lists: seq<'T list>): 'T list list = - lists - |> Seq.transpose + Seq.transpose lists |> Seq.map ofSeq |> ofSeq + +// let rev = reverse +// let init = initialize +// let iter = iterate +// let iter2 = iterate2 +// let iteri = iterateIndexed +// let iteri2 = iterateIndexed2 diff --git a/src/fable-library/Map.fs b/src/fable-library/Map.fs index 5e99b70e19..9d590a1db0 100644 --- a/src/fable-library/Map.fs +++ b/src/fable-library/Map.fs @@ -412,7 +412,7 @@ module MapTree = let ofSeq comparer (c : seq<'Key * 'T>) = match c with | :? array<'Key * 'T> as xs -> ofArray comparer xs - | :? list<'Key * 'T> as xs -> ofList comparer xs + // | :? list<'Key * 'T> as xs -> ofList comparer xs | _ -> use ie = c.GetEnumerator() mkFromEnumerator comparer empty ie @@ -841,7 +841,7 @@ let tryFindKey predicate (table : Map<_, _>) = // [] let ofList (elements: ('Key * 'Value) list) = - Map<_, _>.ofList elements + Map<_, _>.Create elements // [] let ofSeq elements = diff --git a/src/fable-library/Types.ts b/src/fable-library/Types.ts index 6cf3875475..0a00ac2954 100644 --- a/src/fable-library/Types.ts +++ b/src/fable-library/Types.ts @@ -34,53 +34,6 @@ export function toString(x: any, callStack = 0): string { return String(x); } -function compareList(self: List, other: List): number { - if (self === other) { - return 0; - } else { - if (other == null) { - return -1; - } - while (self.tail != null) { - if (other.tail == null) { return 1; } - const res = compare(self.head, other.head); - if (res !== 0) { return res; } - self = self.tail; - other = other.tail; - } - return other.tail == null ? 0 : -1; - } -} - -export class List implements IEquatable>, IComparable>, Iterable { - public head: T; - public tail?: List; - - constructor(head?: T, tail?: List) { - this.head = head as T; - this.tail = tail; - } - - public [Symbol.iterator](): Iterator { - let cur: List | undefined = this; - return { - next: (): IteratorResult => { - const value = cur?.head as T; - const done = cur?.tail == null; - cur = cur?.tail; - return { done, value }; - }, - }; - } - - public toJSON() { return Array.from(this); } - public toString() { return this.ToString(); } - public ToString() { return seqToString(this); } - public GetHashCode() { return combineHashCodes(Array.from(this).map(structuralHash)); } - public Equals(other: List): boolean { return compareList(this, other) === 0; } - public CompareTo(other: List): number { return compareList(this, other); } -} - export abstract class Union implements IEquatable, IComparable { public tag!: number; public fields!: any[];