diff --git a/src/Fable.Cli/CHANGELOG.md b/src/Fable.Cli/CHANGELOG.md index 99cbcb5a2e..5c16ea29fc 100644 --- a/src/Fable.Cli/CHANGELOG.md +++ b/src/Fable.Cli/CHANGELOG.md @@ -17,6 +17,8 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 #### Python * [GH-3645](https://github.com/fable-compiler/Fable/pull/3645) Add `TimeSpan.Parse` and `TimeSpan.TryParse` support to Python (by @MangelMaxime) +* [GH-3649](https://github.com/fable-compiler/Fable/issues/3649) Fixes for `List.sortBy` (by @dbrattli) +* [GH-3638](https://github.com/fable-compiler/Fable/issues/3638) Fixes for `Array.sort` and `Array.sortDescending` (by @dbrattli) ## 4.7.0 - 2023-12-06 diff --git a/src/Fable.Transforms/Python/Fable2Python.fs b/src/Fable.Transforms/Python/Fable2Python.fs index e06bd9838f..f2c459f1e9 100644 --- a/src/Fable.Transforms/Python/Fable2Python.fs +++ b/src/Fable.Transforms/Python/Fable2Python.fs @@ -967,14 +967,14 @@ module Annotation = stdlibModuleTypeHint com ctx - "typing" + "collections.abc" "Callable" (argTypes @ [ returnType ]) | Fable.DelegateType(argTypes, returnType) -> stdlibModuleTypeHint com ctx - "typing" + "collections.abc" "Callable" (argTypes @ [ returnType ]) | Fable.Option(genArg, _) -> @@ -1247,7 +1247,8 @@ module Annotation = any ] - stdlibModuleAnnotation com ctx "typing" "Callable" genArgs, stmts + stdlibModuleAnnotation com ctx "collections.abc" "Callable" genArgs, + stmts | _ -> let ent = com.GetEntity(entRef) // printfn "DeclaredType: %A" ent.FullName diff --git a/src/Fable.Transforms/Python/Replacements.fs b/src/Fable.Transforms/Python/Replacements.fs index d403384386..10a406f0fa 100644 --- a/src/Fable.Transforms/Python/Replacements.fs +++ b/src/Fable.Transforms/Python/Replacements.fs @@ -3346,14 +3346,6 @@ let arrayModule (Helper.GlobalCall("len", t, [ ar ], [ t ], ?loc = r)) (makeIntConst 0) |> Some - - | "SortInPlaceWith", args -> - let args, thisArg = List.splitLast args - let argTypes = List.take (List.length args) i.SignatureArgTypes - let meth = "sort" - - Helper.InstanceCall(thisArg, meth, t, args, argTypes, ?loc = r) |> Some - | Patterns.DicContains nativeArrayFunctions meth, _ -> let args, thisArg = List.splitLast args let argTypes = List.take (List.length args) i.SignatureArgTypes diff --git a/src/fable-library-py/fable_library/Array.fs b/src/fable-library-py/fable_library/Array.fs new file mode 100644 index 0000000000..df7dbce41a --- /dev/null +++ b/src/fable-library-py/fable_library/Array.fs @@ -0,0 +1,1405 @@ +module ArrayModule + +// Disables warn:1204 raised by use of LanguagePrimitives.ErrorStrings.* +#nowarn "1204" + +open System.Collections.Generic +open Fable.Core +open Fable.Core.JsInterop + +open Native +open Native.Helpers + +let private indexNotFound () = + failwith + "An index satisfying the predicate was not found in the collection." + +let private differentLengths () = failwith "Arrays had different lengths" + +// 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. + +// Don't use native JS Array.prototype.concat as it doesn't work with typed arrays +let append + (array1: 'T[]) + (array2: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = + let len1 = array1.Length + let len2 = array2.Length + let newArray = allocateArrayFromCons cons (len1 + len2) + + for i = 0 to len1 - 1 do + newArray.[i] <- array1.[i] + + for i = 0 to len2 - 1 do + newArray.[i + len1] <- array2.[i] + + newArray + +let filter (predicate: 'T -> bool) (array: 'T[]) = filterImpl predicate array + +// intentionally returns target instead of unit +let fill (target: 'T[]) (targetIndex: int) (count: int) (value: 'T) : 'T[] = + fillImpl target value targetIndex count + +let getSubArray (array: 'T[]) (start: int) (count: int) : 'T[] = + subArrayImpl array start count + +let last (array: 'T[]) = + if array.Length = 0 then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + + array.[array.Length - 1] + +let tryLast (array: 'T[]) = + if array.Length = 0 then + None + else + Some array.[array.Length - 1] + +let mapIndexed + (f: int -> 'T -> 'U) + (source: 'T[]) + ([] cons: Cons<'U>) + : 'U[] + = + let len = source.Length + let target = allocateArrayFromCons cons len + + for i = 0 to (len - 1) do + target.[i] <- f i source.[i] + + target + +let map + (f: 'T -> 'U) + (source: 'T[]) + ([] cons: Cons<'U>) + : 'U[] + = + let len = source.Length + let target = allocateArrayFromCons cons len + + for i = 0 to (len - 1) do + target.[i] <- f source.[i] + + target + +let mapIndexed2 + (f: int -> 'T1 -> 'T2 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length then + failwith "Arrays had different lengths" + + let result = allocateArrayFromCons cons source1.Length + + for i = 0 to source1.Length - 1 do + result.[i] <- f i source1.[i] source2.[i] + + result + +let map2 + (f: 'T1 -> 'T2 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length then + failwith "Arrays had different lengths" + + let result = allocateArrayFromCons cons source1.Length + + for i = 0 to source1.Length - 1 do + result.[i] <- f source1.[i] source2.[i] + + result + +let mapIndexed3 + (f: int -> 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + failwith "Arrays had different lengths" + + let result = allocateArrayFromCons cons source1.Length + + for i = 0 to source1.Length - 1 do + result.[i] <- f i source1.[i] source2.[i] source3.[i] + + result + +let map3 + (f: 'T1 -> 'T2 -> 'T3 -> 'U) + (source1: 'T1[]) + (source2: 'T2[]) + (source3: 'T3[]) + ([] cons: Cons<'U>) + : 'U[] + = + if source1.Length <> source2.Length || source2.Length <> source3.Length then + failwith "Arrays had different lengths" + + let result = allocateArrayFromCons cons source1.Length + + for i = 0 to source1.Length - 1 do + result.[i] <- f source1.[i] source2.[i] source3.[i] + + result + +let mapFold<'T, 'State, 'Result> + (mapping: 'State -> 'T -> 'Result * 'State) + state + (array: 'T[]) + ([] cons: Cons<'Result>) + = + match array.Length with + | 0 -> [||], state + | len -> + let mutable acc = state + let res = allocateArrayFromCons cons len + + for i = 0 to array.Length - 1 do + let h, s = mapping acc array.[i] + res.[i] <- h + acc <- s + + res, acc + +let mapFoldBack<'T, 'State, 'Result> + (mapping: 'T -> 'State -> 'Result * 'State) + (array: 'T[]) + state + ([] cons: Cons<'Result>) + = + match array.Length with + | 0 -> [||], state + | len -> + let mutable acc = state + let res = allocateArrayFromCons cons len + + for i = array.Length - 1 downto 0 do + let h, s = mapping array.[i] acc + res.[i] <- h + acc <- s + + res, acc + +let indexed (source: 'T[]) = + let len = source.Length + let target = allocateArray len + + for i = 0 to (len - 1) do + target.[i] <- i, source.[i] + + target + +let truncate (count: int) (array: 'T[]) : 'T[] = + let count = max 0 count + subArrayImpl array 0 count + +let concat + (arrays: 'T[] seq) + ([] cons: Cons<'T>) + : 'T[] + = + let arrays = + if isDynamicArrayImpl arrays then + arrays :?> 'T[][] // avoid extra copy + else + arrayFrom arrays + + match arrays.Length with + | 0 -> allocateArrayFromCons cons 0 + | 1 -> arrays.[0] + | _ -> + let mutable totalIdx = 0 + let mutable totalLength = 0 + + for arr in arrays do + totalLength <- totalLength + arr.Length + + let result = allocateArrayFromCons cons totalLength + + for arr in arrays do + for j = 0 to (arr.Length - 1) do + result.[totalIdx] <- arr.[j] + totalIdx <- totalIdx + 1 + + result + +let collect + (mapping: 'T -> 'U[]) + (array: 'T[]) + ([] cons: Cons<'U>) + : 'U[] + = + let mapped = map mapping array Unchecked.defaultof<_> + concat mapped cons +// collectImpl mapping array // flatMap not widely available yet + +let where predicate (array: _[]) = filterImpl predicate array + +let indexOf<'T> + (array: 'T[]) + (item: 'T) + (start: int option) + (count: int option) + ([] eq: IEqualityComparer<'T>) + = + let start = defaultArg start 0 + + let end' = + count + |> Option.map (fun c -> start + c) + |> Option.defaultValue array.Length + + let rec loop i = + if i >= end' then + -1 + else if eq.Equals(item, array.[i]) then + i + else + loop (i + 1) + + loop start + +let contains<'T> + (value: 'T) + (array: 'T[]) + ([] eq: IEqualityComparer<'T>) + = + indexOf array value None None eq >= 0 + +let empty cons = allocateArrayFromCons cons 0 + +let singleton value ([] cons: Cons<'T>) = + let ar = allocateArrayFromCons cons 1 + ar.[0] <- value + ar + +let initialize count initializer ([] cons: Cons<'T>) = + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + + let result = allocateArrayFromCons cons count + + for i = 0 to count - 1 do + result.[i] <- initializer i + + result + +let pairwise (array: 'T[]) = + if array.Length < 2 then + [||] + else + let count = array.Length - 1 + let result = allocateArray count + + for i = 0 to count - 1 do + result.[i] <- array.[i], array.[i + 1] + + result + +let replicate count initial ([] cons: Cons<'T>) = + // Shorthand version: = initialize count (fun _ -> initial) + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + + let result: 'T array = allocateArrayFromCons cons count + + for i = 0 to result.Length - 1 do + result.[i] <- initial + + result + +let copy (array: 'T[]) = + // if isTypedArrayImpl array then + // let res = allocateArrayFrom array array.Length + // for i = 0 to array.Length-1 do + // res.[i] <- array.[i] + // res + // else + copyImpl array + +let copyTo + (source: 'T[]) + (sourceIndex: int) + (target: 'T[]) + (targetIndex: int) + (count: int) + = + // TODO: Check array lengths + System.Array.Copy(source, sourceIndex, target, targetIndex, count) + +let reverse (array: 'T[]) = + // if isTypedArrayImpl array then + // let res = allocateArrayFrom array array.Length + // let mutable j = array.Length-1 + // for i = 0 to array.Length-1 do + // res.[j] <- array.[i] + // j <- j - 1 + // res + // else + copyImpl array |> reverseImpl + +let scan<'T, 'State> + folder + (state: 'State) + (array: 'T[]) + ([] cons: Cons<'State>) + = + let res = allocateArrayFromCons cons (array.Length + 1) + res.[0] <- state + + for i = 0 to array.Length - 1 do + res.[i + 1] <- folder res.[i] array.[i] + + res + +let scanBack<'T, 'State> + folder + (array: 'T[]) + (state: 'State) + ([] cons: Cons<'State>) + = + let res = allocateArrayFromCons cons (array.Length + 1) + res.[array.Length] <- state + + for i = array.Length - 1 downto 0 do + res.[i] <- folder array.[i] res.[i + 1] + + res + +let skip count (array: 'T[]) ([] cons: Cons<'T>) = + if count > array.Length then + invalidArg "count" "count is greater than array length" + + if count = array.Length then + allocateArrayFromCons cons 0 + else + let count = + if count < 0 then + 0 + else + count + + skipImpl array count + +let skipWhile + predicate + (array: 'T[]) + ([] cons: Cons<'T>) + = + let mutable count = 0 + + while count < array.Length && predicate array.[count] do + count <- count + 1 + + if count = array.Length then + allocateArrayFromCons cons 0 + else + skipImpl array count + +let take count (array: 'T[]) ([] cons: Cons<'T>) = + if count < 0 then + invalidArg + "count" + LanguagePrimitives.ErrorStrings.InputMustBeNonNegativeString + + if count > array.Length then + invalidArg "count" "count is greater than array length" + + if count = 0 then + allocateArrayFromCons cons 0 + else + subArrayImpl array 0 count + +let takeWhile + predicate + (array: 'T[]) + ([] cons: Cons<'T>) + = + let mutable count = 0 + + while count < array.Length && predicate array.[count] do + count <- count + 1 + + if count = 0 then + allocateArrayFromCons cons 0 + else + subArrayImpl array 0 count + +let addInPlace (x: 'T) (array: 'T[]) = + // if isTypedArrayImpl array then invalidArg "array" "Typed arrays not supported" + pushImpl array x |> ignore + +let addRangeInPlace (range: seq<'T>) (array: 'T[]) = + // if isTypedArrayImpl array then invalidArg "array" "Typed arrays not supported" + for x in range do + addInPlace x array + +let insertRangeInPlace index (range: seq<'T>) (array: 'T[]) = + // if isTypedArrayImpl array then invalidArg "array" "Typed arrays not supported" + let mutable i = index + + for x in range do + insertImpl array i x |> ignore + i <- i + 1 + +let removeInPlace + (item: 'T) + (array: 'T[]) + ([] eq: IEqualityComparer<'T>) + = + let i = indexOf array item None None eq + + if i > -1 then + spliceImpl array i 1 |> ignore + true + else + false + +let removeAllInPlace predicate (array: 'T[]) = + let rec countRemoveAll count = + let i = findIndexImpl predicate array + + if i > -1 then + spliceImpl array i 1 |> ignore + countRemoveAll count + 1 + else + count + + countRemoveAll 0 + +let partition + (f: 'T -> bool) + (source: 'T[]) + ([] cons: Cons<'T>) + = + let len = source.Length + let res1 = allocateArrayFromCons cons len + let res2 = allocateArrayFromCons cons len + let mutable iTrue = 0 + let mutable iFalse = 0 + + for i = 0 to len - 1 do + if f source.[i] then + res1.[iTrue] <- source.[i] + iTrue <- iTrue + 1 + else + res2.[iFalse] <- source.[i] + iFalse <- iFalse + 1 + + res1 |> truncate iTrue, res2 |> truncate iFalse + +let find (predicate: 'T -> bool) (array: 'T[]) : 'T = + match findImpl predicate array with + | Some res -> res + | None -> indexNotFound () + +let tryFind (predicate: 'T -> bool) (array: 'T[]) : 'T option = + findImpl predicate array + +let findIndex (predicate: 'T -> bool) (array: 'T[]) : int = + match findIndexImpl predicate array with + | index when index > -1 -> index + | _ -> + indexNotFound () + -1 + +let tryFindIndex (predicate: 'T -> bool) (array: 'T[]) : int option = + match findIndexImpl predicate array with + | index when index > -1 -> Some index + | _ -> None + +let pick chooser (array: _[]) = + let rec loop i = + if i >= array.Length then + indexNotFound () + else + match chooser array.[i] with + | None -> loop (i + 1) + | Some res -> res + + loop 0 + +let tryPick chooser (array: _[]) = + let rec loop i = + if i >= array.Length then + None + else + match chooser array.[i] with + | None -> loop (i + 1) + | res -> res + + loop 0 + +let findBack predicate (array: _[]) = + let rec loop i = + if i < 0 then + indexNotFound () + elif predicate array.[i] then + array.[i] + else + loop (i - 1) + + loop (array.Length - 1) + +let tryFindBack predicate (array: _[]) = + let rec loop i = + if i < 0 then + None + elif predicate array.[i] then + Some array.[i] + else + loop (i - 1) + + loop (array.Length - 1) + +let findLastIndex predicate (array: _[]) = + let rec loop i = + if i < 0 then + -1 + elif predicate array.[i] then + i + else + loop (i - 1) + + loop (array.Length - 1) + +let findIndexBack predicate (array: _[]) = + let rec loop i = + if i < 0 then + indexNotFound () + -1 + elif predicate array.[i] then + i + else + loop (i - 1) + + loop (array.Length - 1) + +let tryFindIndexBack predicate (array: _[]) = + let rec loop i = + if i < 0 then + None + elif predicate array.[i] then + Some i + else + loop (i - 1) + + loop (array.Length - 1) + +let choose + (chooser: 'T -> 'U option) + (array: 'T[]) + ([] cons: Cons<'U>) + = + let res: 'U[] = [||] + + for i = 0 to array.Length - 1 do + match chooser array.[i] with + | None -> () + | Some y -> pushImpl res y |> ignore + + match box cons with + | null -> res // avoid extra copy + | _ -> map id res cons + +let foldIndexed<'T, 'State> folder (state: 'State) (array: 'T[]) = + // if isTypedArrayImpl array then + // let mutable acc = state + // for i = 0 to array.Length - 1 do + // acc <- folder i acc array.[i] + // acc + // else + foldIndexedImpl (fun acc x i -> folder i acc x) state array + +let fold<'T, 'State> folder (state: 'State) (array: 'T[]) = + // if isTypedArrayImpl array then + // let mutable acc = state + // for i = 0 to array.Length - 1 do + // acc <- folder acc array.[i] + // acc + // else + foldImpl folder state array + +let iterate action (array: 'T[]) = + for i = 0 to array.Length - 1 do + action array.[i] + +let iterateIndexed action (array: 'T[]) = + for i = 0 to array.Length - 1 do + action i array.[i] + +let iterate2 action (array1: 'T1[]) (array2: 'T2[]) = + if array1.Length <> array2.Length then + differentLengths () + + for i = 0 to array1.Length - 1 do + action array1.[i] array2.[i] + +let iterateIndexed2 action (array1: 'T1[]) (array2: 'T2[]) = + if array1.Length <> array2.Length then + differentLengths () + + for i = 0 to array1.Length - 1 do + action i array1.[i] array2.[i] + +let isEmpty (array: 'T[]) = array.Length = 0 + +let forAll predicate (array: 'T[]) = + // if isTypedArrayImpl array then + // let mutable i = 0 + // let mutable result = true + // while i < array.Length && result do + // result <- predicate array.[i] + // i <- i + 1 + // result + // else + forAllImpl predicate array + +let permute f (array: 'T[]) = + let size = array.Length + let res = copyImpl array + let checkFlags = allocateArray size + + iterateIndexed + (fun i x -> + let j = f i + + if j < 0 || j >= size then + invalidOp "Not a valid permutation" + + res.[j] <- x + checkFlags.[j] <- 1 + ) + array + + let isValid = checkFlags |> forAllImpl ((=) 1) + + if not isValid then + invalidOp "Not a valid permutation" + + res + +let setSlice + (target: 'T[]) + (lower: int option) + (upper: int option) + (source: 'T[]) + = + let lower = defaultArg lower 0 + let upper = defaultArg upper -1 + + let length = + (if upper >= 0 then + upper + else + target.Length - 1) + - lower + // can't cast to TypedArray, so can't use TypedArray-specific methods + // if isTypedArrayImpl target && source.Length <= length then + // typedArraySetImpl target source lower + // else + for i = 0 to length do + target.[i + lower] <- source.[i] + +let sortInPlaceBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : unit + = + sortInPlaceWithImpl + (fun x y -> comparer.Compare(projection x, projection y)) + xs + +let sortInPlace (xs: 'T[]) ([] comparer: IComparer<'T>) = + sortInPlaceWithImpl (fun x y -> comparer.Compare(x, y)) xs + +let sortInPlaceWith (comparer: 'T -> 'T -> int) (xs: 'T[]) = + sortInPlaceWithImpl comparer xs + xs + +let sort (xs: 'T[]) ([] comparer: IComparer<'T>) : 'T[] = + sortWithImpl (fun x y -> comparer.Compare(x, y)) (xs) + +let sortBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a[] + = + sortWithImpl (fun x y -> comparer.Compare(projection x, projection y)) xs + +let sortDescending (xs: 'T[]) ([] comparer: IComparer<'T>) : 'T[] = + sortWithImpl (fun x y -> comparer.Compare(x, y) * -1) xs + +let sortByDescending + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a[] + = + sortWithImpl + (fun x y -> comparer.Compare(projection x, projection y) * -1) + xs + +let sortWith (comparer: 'T -> 'T -> int) (xs: 'T[]) : 'T[] = + sortWithImpl comparer xs + +let allPairs (xs: 'T1[]) (ys: 'T2[]) : ('T1 * 'T2)[] = + let len1 = xs.Length + let len2 = ys.Length + let res = allocateArray (len1 * len2) + + for i = 0 to xs.Length - 1 do + for j = 0 to ys.Length - 1 do + res.[i * len2 + j] <- (xs.[i], ys.[j]) + + res + +let unfold<'T, 'State> + (generator: 'State -> ('T * 'State) option) + (state: 'State) + : 'T[] + = + let res: 'T[] = [||] + + let rec loop state = + match generator state with + | None -> () + | Some(x, s) -> + pushImpl res x |> ignore + loop s + + loop state + res + +// TODO: We should pass Cons<'T> here (and unzip3) but 'a and 'b may differ +let unzip (array: _[]) = + let len = array.Length + let res1 = allocateArray len + let res2 = allocateArray len + + iterateIndexed + (fun i (item1, item2) -> + res1.[i] <- item1 + res2.[i] <- item2 + ) + array + + res1, res2 + +let unzip3 (array: _[]) = + let len = array.Length + let res1 = allocateArray len + let res2 = allocateArray len + let res3 = allocateArray len + + iterateIndexed + (fun i (item1, item2, item3) -> + res1.[i] <- item1 + res2.[i] <- item2 + res3.[i] <- item3 + ) + array + + res1, res2, res3 + +let zip (array1: 'T[]) (array2: 'U[]) = + // Shorthand version: map2 (fun x y -> x, y) array1 array2 + if array1.Length <> array2.Length then + differentLengths () + + let result = allocateArray array1.Length + + for i = 0 to array1.Length - 1 do + result.[i] <- array1.[i], array2.[i] + + result + +let zip3 (array1: 'T[]) (array2: 'U[]) (array3: 'V[]) = + // Shorthand version: map3 (fun x y z -> x, y, z) array1 array2 array3 + if array1.Length <> array2.Length || array2.Length <> array3.Length then + differentLengths () + + let result = allocateArray array1.Length + + for i = 0 to array1.Length - 1 do + result.[i] <- array1.[i], array2.[i], array3.[i] + + result + +let chunkBySize (chunkSize: int) (array: 'T[]) : 'T[][] = + if chunkSize < 1 then + invalidArg "size" "The input must be positive." + + if array.Length = 0 then + [| [||] |] + else + let result: 'T[][] = [||] + // add each chunk to the result + for x = 0 to int ( + System.Math.Ceiling( + float (array.Length) / float (chunkSize) + ) + ) + - 1 do + let start = x * chunkSize + let slice = subArrayImpl array start chunkSize + pushImpl result slice |> ignore + + result + +let splitAt (index: int) (array: 'T[]) : 'T[] * 'T[] = + if index < 0 || index > array.Length then + invalidArg "index" SR.indexOutOfBounds + + subArrayImpl array 0 index, skipImpl array index + +// Note that, though it's not consistent with `compare` operator, +// Array.compareWith doesn't compare first the length, see #2961 +let compareWith (comparer: 'T -> 'T -> int) (source1: 'T[]) (source2: 'T[]) = + if isNull source1 then + if isNull source2 then + 0 + else + -1 + elif isNull source2 then + 1 + else + let len1 = source1.Length + let len2 = source2.Length + + let len = + if len1 < len2 then + len1 + else + len2 + + let mutable i = 0 + let mutable res = 0 + + while res = 0 && i < len do + res <- comparer source1.[i] source2.[i] + i <- i + 1 + + if res <> 0 then + res + elif len1 > len2 then + 1 + elif len1 < len2 then + -1 + else + 0 + +let compareTo (comparer: 'T -> 'T -> int) (source1: 'T[]) (source2: 'T[]) = + if isNull source1 then + if isNull source2 then + 0 + else + -1 + elif isNull source2 then + 1 + else + let len1 = source1.Length + let len2 = source2.Length + + if len1 > len2 then + 1 + elif len1 < len2 then + -1 + else + let mutable i = 0 + let mutable res = 0 + + while res = 0 && i < len1 do + res <- comparer source1.[i] source2.[i] + i <- i + 1 + + res + +let equalsWith (equals: 'T -> 'T -> bool) (array1: 'T[]) (array2: 'T[]) = + if isNull array1 then + if isNull array2 then + true + else + false + elif isNull array2 then + false + else + let mutable i = 0 + let mutable result = true + let length1 = array1.Length + let length2 = array2.Length + + if length1 > length2 then + false + elif length1 < length2 then + false + else + while i < length1 && result do + result <- equals array1.[i] array2.[i] + i <- i + 1 + + result + +let exactlyOne (array: 'T[]) = + if array.Length = 1 then + array.[0] + elif array.Length = 0 then + invalidArg + "array" + LanguagePrimitives.ErrorStrings.InputSequenceEmptyString + else + invalidArg "array" "Input array too long" + +let tryExactlyOne (array: 'T[]) = + if array.Length = 1 then + Some(array.[0]) + else + None + +let head (array: 'T[]) = + if array.Length = 0 then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + else + array.[0] + +let tryHead (array: 'T[]) = + if array.Length = 0 then + None + else + Some array.[0] + +let tail (array: 'T[]) = + if array.Length = 0 then + invalidArg "array" "Not enough elements" + + skipImpl array 1 + +let item index (array: _[]) = array.[index] + +let tryItem index (array: 'T[]) = + if index < 0 || index >= array.Length then + None + else + Some array.[index] + +let foldBackIndexed<'T, 'State> folder (array: 'T[]) (state: 'State) = + // if isTypedArrayImpl array then + // let mutable acc = state + // let size = array.Length + // for i = 1 to size do + // acc <- folder (i-1) array.[size - i] acc + // acc + // else + foldBackIndexedImpl (fun acc x i -> folder i x acc) state array + +let foldBack<'T, 'State> folder (array: 'T[]) (state: 'State) = + // if isTypedArrayImpl array then + // foldBackIndexed (fun _ x acc -> folder x acc) array state + // else + foldBackImpl (fun acc x -> folder x acc) state array + +let foldIndexed2 folder state (array1: _[]) (array2: _[]) = + let mutable acc = state + + if array1.Length <> array2.Length then + failwith "Arrays have different lengths" + + for i = 0 to array1.Length - 1 do + acc <- folder i acc array1.[i] array2.[i] + + acc + +let fold2<'T1, 'T2, 'State> + folder + (state: 'State) + (array1: 'T1[]) + (array2: 'T2[]) + = + foldIndexed2 (fun _ acc x y -> folder acc x y) state array1 array2 + +let foldBackIndexed2<'T1, 'T2, 'State> + folder + (array1: 'T1[]) + (array2: 'T2[]) + (state: 'State) + = + let mutable acc = state + + if array1.Length <> array2.Length then + differentLengths () + + let size = array1.Length + + for i = 1 to size do + acc <- folder (i - 1) array1.[size - i] array2.[size - i] acc + + acc + +let foldBack2<'T1, 'T2, 'State> + f + (array1: 'T1[]) + (array2: 'T2[]) + (state: 'State) + = + foldBackIndexed2 (fun _ x y acc -> f x y acc) array1 array2 state + +let reduce reduction (array: 'T[]) = + if array.Length = 0 then + invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString + // if isTypedArrayImpl array then + // foldIndexed (fun i acc x -> if i = 0 then x else reduction acc x) Unchecked.defaultof<_> array + // else + reduceImpl reduction array + +let reduceBack reduction (array: 'T[]) = + if array.Length = 0 then + invalidOp LanguagePrimitives.ErrorStrings.InputArrayEmptyString + // if isTypedArrayImpl array then + // foldBackIndexed (fun i x acc -> if i = 0 then x else reduction acc x) array Unchecked.defaultof<_> + // else + reduceBackImpl reduction array + +let forAll2 predicate array1 array2 = + fold2 (fun acc x y -> acc && predicate x y) true array1 array2 + +let rec existsOffset predicate (array: 'T[]) index = + if index = array.Length then + false + else + predicate array.[index] || existsOffset predicate array (index + 1) + +let exists predicate array = existsOffset predicate array 0 + +let rec existsOffset2 predicate (array1: _[]) (array2: _[]) index = + if index = array1.Length then + false + else + predicate array1.[index] array2.[index] + || existsOffset2 predicate array1 array2 (index + 1) + +let rec exists2 predicate (array1: _[]) (array2: _[]) = + if array1.Length <> array2.Length then + differentLengths () + + existsOffset2 predicate array1 array2 0 + +let sum (array: 'T[]) ([] adder: IGenericAdder<'T>) : 'T = + let mutable acc = adder.GetZero() + + for i = 0 to array.Length - 1 do + acc <- adder.Add(acc, array.[i]) + + acc + +let sumBy + (projection: 'T -> 'T2) + (array: 'T[]) + ([] adder: IGenericAdder<'T2>) + : 'T2 + = + let mutable acc = adder.GetZero() + + for i = 0 to array.Length - 1 do + acc <- adder.Add(acc, projection array.[i]) + + acc + +let maxBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs + +let max (xs: 'a[]) ([] comparer: IComparer<'a>) : 'a = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs + +let minBy + (projection: 'a -> 'b) + (xs: 'a[]) + ([] comparer: IComparer<'b>) + : 'a + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs + +let min (xs: 'a[]) ([] comparer: IComparer<'a>) : 'a = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs + +let average (array: 'T[]) ([] averager: IGenericAverager<'T>) : 'T = + if array.Length = 0 then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + + let mutable total = averager.GetZero() + + for i = 0 to array.Length - 1 do + total <- averager.Add(total, array.[i]) + + averager.DivideByInt(total, array.Length) + +let averageBy + (projection: 'T -> 'T2) + (array: 'T[]) + ([] averager: IGenericAverager<'T2>) + : 'T2 + = + if array.Length = 0 then + invalidArg "array" LanguagePrimitives.ErrorStrings.InputArrayEmptyString + + let mutable total = averager.GetZero() + + for i = 0 to array.Length - 1 do + total <- averager.Add(total, projection array.[i]) + + averager.DivideByInt(total, array.Length) + +// let toList (source: 'T[]) = List.ofArray (see Replacements) + +let windowed (windowSize: int) (source: 'T[]) : 'T[][] = + if windowSize <= 0 then + failwith "windowSize must be positive" + + let res = + FSharp.Core.Operators.max 0 (source.Length - windowSize + 1) + |> allocateArray + + for i = windowSize to source.Length do + res.[i - windowSize] <- source.[i - windowSize .. i - 1] + + res + +let splitInto (chunks: int) (array: 'T[]) : 'T[][] = + if chunks < 1 then + invalidArg "chunks" "The input must be positive." + + if array.Length = 0 then + [| [||] |] + else + let result: 'T[][] = [||] + let chunks = FSharp.Core.Operators.min chunks array.Length + let minChunkSize = array.Length / chunks + let chunksWithExtraItem = array.Length % chunks + + for i = 0 to chunks - 1 do + let chunkSize = + if i < chunksWithExtraItem then + minChunkSize + 1 + else + minChunkSize + + let start = + i * minChunkSize + + (FSharp.Core.Operators.min chunksWithExtraItem i) + + let slice = subArrayImpl array start chunkSize + pushImpl result slice |> ignore + + result + +let transpose + (arrays: 'T[] seq) + ([] cons: Cons<'T>) + : 'T[][] + = + let arrays = + if isDynamicArrayImpl arrays then + arrays :?> 'T[][] // avoid extra copy + else + arrayFrom arrays + + let len = arrays.Length + + match len with + | 0 -> allocateArray 0 + | _ -> + let firstArray = arrays.[0] + let lenInner = firstArray.Length + + if arrays |> forAll (fun a -> a.Length = lenInner) |> not then + differentLengths () + + let result: 'T[][] = allocateArray lenInner + + for i in 0 .. lenInner - 1 do + result.[i] <- allocateArrayFromCons cons len + + for j in 0 .. len - 1 do + result.[i].[j] <- arrays.[j].[i] + + result + +let insertAt + (index: int) + (y: 'T) + (xs: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = + let len = xs.Length + + if index < 0 || index > len then + invalidArg "index" SR.indexOutOfBounds + + let target = allocateArrayFromCons cons (len + 1) + + for i = 0 to (index - 1) do + target.[i] <- xs.[i] + + target.[index] <- y + + for i = index to (len - 1) do + target.[i + 1] <- xs.[i] + + target + +let insertManyAt + (index: int) + (ys: seq<'T>) + (xs: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = + let len = xs.Length + + if index < 0 || index > len then + invalidArg "index" SR.indexOutOfBounds + + let ys = arrayFrom ys + let len2 = ys.Length + let target = allocateArrayFromCons cons (len + len2) + + for i = 0 to (index - 1) do + target.[i] <- xs.[i] + + for i = 0 to (len2 - 1) do + target.[index + i] <- ys.[i] + + for i = index to (len - 1) do + target.[i + len2] <- xs.[i] + + target + +let removeAt (index: int) (xs: 'T[]) : 'T[] = + if index < 0 || index >= xs.Length then + invalidArg "index" SR.indexOutOfBounds + + let mutable i = -1 + + xs + |> filter (fun _ -> + i <- i + 1 + i <> index + ) + +let removeManyAt (index: int) (count: int) (xs: 'T[]) : 'T[] = + let mutable i = -1 + // incomplete -1, in-progress 0, complete 1 + let mutable status = -1 + + let ys = + xs + |> filter (fun _ -> + i <- i + 1 + + if i = index then + status <- 0 + false + elif i > index then + if i < index + count then + false + else + status <- 1 + true + else + true + ) + + let status = + if status = 0 && i + 1 = index + count then + 1 + else + status + + if status < 1 then + // F# always says the wrong parameter is index but the problem may be count + let arg = + if status < 0 then + "index" + else + "count" + + invalidArg arg SR.indexOutOfBounds + + ys + +let updateAt + (index: int) + (y: 'T) + (xs: 'T[]) + ([] cons: Cons<'T>) + : 'T[] + = + let len = xs.Length + + if index < 0 || index >= len then + invalidArg "index" SR.indexOutOfBounds + + let target = allocateArrayFromCons cons len + + for i = 0 to (len - 1) do + target.[i] <- + if i = index then + y + else + xs.[i] + + target diff --git a/src/fable-library-py/fable_library/Fable.Library.csproj b/src/fable-library-py/fable_library/Fable.Library.csproj deleted file mode 100644 index 0ed8766140..0000000000 --- a/src/fable-library-py/fable_library/Fable.Library.csproj +++ /dev/null @@ -1,35 +0,0 @@ - - - - Library - netstandard2.0 - $(DefineConstants);FABLE_COMPILER - $(DefineConstants);FX_NO_BIGINT - - - - - - - - - - - - - - - - - - - - - - - - - - - - diff --git a/src/fable-library-py/fable_library/Fable.Library.fsproj b/src/fable-library-py/fable_library/Fable.Library.fsproj index 0ed8766140..183137fd92 100644 --- a/src/fable-library-py/fable_library/Fable.Library.fsproj +++ b/src/fable-library-py/fable_library/Fable.Library.fsproj @@ -19,8 +19,8 @@ - - + + diff --git a/src/fable-library-py/fable_library/List.fs b/src/fable-library-py/fable_library/List.fs new file mode 100644 index 0000000000..4ec0b15be1 --- /dev/null +++ b/src/fable-library-py/fable_library/List.fs @@ -0,0 +1,1099 @@ +module ListModule + +open Fable.Core +open Native + +[] +[] +type LinkedList<'T> = + { + head: 'T + mutable tail: LinkedList<'T> option + } + + static member Empty: 'T list = + { + head = Unchecked.defaultof<'T> + tail = None + } + + static member Cons(x: 'T, xs: 'T list) = + { + head = x + tail = Some xs + } + + static member inline internal ConsNoTail(x: 'T) = + { + head = x + tail = None + } + + member inline internal xs.SetConsTail(t: 'T list) = xs.tail <- Some t + + member inline internal xs.AppendConsNoTail(x: 'T) = + let t = List.ConsNoTail x + xs.SetConsTail t + t + + member xs.IsEmpty = xs.tail.IsNone + + member xs.Length = + let rec loop i (xs: 'T list) = + match xs.tail with + | None -> i + | Some t -> loop (i + 1) t + + loop 0 xs + + member xs.Head = + match xs.tail with + | None -> invalidArg "list" SR.inputWasEmpty + | Some _ -> xs.head + + member xs.Tail = + match xs.tail with + | None -> invalidArg "list" SR.inputWasEmpty + | Some t -> t + + member xs.Item + with get (index) = + let rec loop i (xs: 'T list) = + match xs.tail with + | None -> invalidArg "index" SR.indexOutOfBounds + | Some t -> + if i = index then + xs.head + else + loop (i + 1) t + + loop 0 xs + + 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 + + let rec loop (xs: 'T list) (ys: 'T list) = + match xs.tail, ys.tail with + | None, None -> true + | None, Some _ -> false + | Some _, None -> false + | Some xt, Some yt -> + if Unchecked.equals xs.head ys.head then + loop xt yt + else + false + + loop xs ys + + override xs.GetHashCode() = + let inline combineHash i x y = (x <<< 1) + y + 631 * i + let iMax = 18 // limit the hash + + let rec loop i h (xs: 'T list) = + match xs.tail with + | None -> h + | Some t -> + if i > iMax then + h + else + loop (i + 1) (combineHash i h (Unchecked.hash xs.head)) t + + loop 0 0 xs + + interface IJsonSerializable with + member this.toJSON() = Helpers.arrayFrom (this) |> box + + interface System.IComparable with + member xs.CompareTo(other: obj) = + let ys = other :?> 'T list + + let rec loop (xs: 'T list) (ys: 'T list) = + match xs.tail, ys.tail with + | None, None -> 0 + | None, Some _ -> -1 + | Some _, None -> 1 + | Some xt, Some yt -> + let c = Unchecked.compare xs.head ys.head + + if c = 0 then + loop xt yt + else + c + + loop xs ys + + 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 it = xs + let mutable current = Unchecked.defaultof<'T> + + interface System.Collections.Generic.IEnumerator<'T> with + member _.Current = current + + interface System.Collections.IEnumerator with + member _.Current = box (current) + + member _.MoveNext() = + match it.tail with + | None -> false + | Some t -> + current <- it.head + it <- t + true + + member _.Reset() = + it <- xs + current <- Unchecked.defaultof<'T> + + interface System.IDisposable with + member _.Dispose() = () + +and 'T list = LinkedList<'T> +and List<'T> = LinkedList<'T> + +// [] +// [] +// module List = + +let indexNotFound () = + raise (System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) + +let empty () = List.Empty + +let cons (x: 'T) (xs: 'T list) = List.Cons(x, xs) + +let singleton x = List.Cons(x, List.Empty) + +let isEmpty (xs: 'T list) = xs.IsEmpty + +let length (xs: 'T list) = xs.Length + +let head (xs: 'T list) = xs.Head + +let tryHead (xs: 'T list) = + if xs.IsEmpty then + None + else + Some xs.Head + +let tail (xs: 'T list) = xs.Tail + +let rec tryLast (xs: 'T list) = + if xs.IsEmpty then + None + else + let t = xs.Tail + + if t.IsEmpty then + Some xs.Head + else + tryLast t + +let last (xs: 'T list) = + match tryLast xs with + | Some x -> x + | None -> failwith SR.inputWasEmpty + +let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list) : int = + let rec loop (xs: 'T list) (ys: 'T list) = + match xs.IsEmpty, ys.IsEmpty with + | true, true -> 0 + | true, false -> -1 + | false, true -> 1 + | false, false -> + let c = comparer xs.Head ys.Head + + if c = 0 then + loop xs.Tail ys.Tail + else + c + + loop xs ys + +let toArray (xs: 'T list) = + let len = xs.Length + let res = Array.zeroCreate len + + let rec loop i (xs: 'T list) = + if not xs.IsEmpty then + res.[i] <- xs.Head + loop (i + 1) xs.Tail + + loop 0 xs + res + +// let rec fold (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = +// if xs.IsEmpty then state +// else fold folder (folder state xs.Head) xs.Tail + +let fold<'T, 'State> + (folder: 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = + let mutable acc = state + let mutable xs = xs + + while not xs.IsEmpty do + acc <- folder acc (head xs) + xs <- xs.Tail + + acc + +let reverse (xs: 'T list) = + fold (fun acc x -> List.Cons(x, acc)) List.Empty xs + +let foldBack<'T, 'State> + (folder: 'T -> 'State -> 'State) + (xs: 'T list) + (state: 'State) + = + // fold (fun acc x -> folder x acc) state (reverse xs) + Array.foldBack folder (toArray xs) state + +let foldIndexed + (folder: int -> 'State -> 'T -> 'State) + (state: 'State) + (xs: 'T list) + = + let rec loop i acc (xs: 'T list) = + if xs.IsEmpty then + acc + else + loop (i + 1) (folder i acc xs.Head) xs.Tail + + loop 0 state xs + +// let rec fold2 (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: 'T1 list) (ys: 'T2 list) = +// if xs.IsEmpty || ys.IsEmpty then state +// else fold2 folder (folder state xs.Head ys.Head) xs.Tail ys.Tail + +let fold2<'T1, 'T2, 'State> + (folder: 'State -> 'T1 -> 'T2 -> 'State) + (state: 'State) + (xs: 'T1 list) + (ys: 'T2 list) + = + let mutable acc = state + let mutable xs = xs + let mutable ys = ys + + while not xs.IsEmpty && not ys.IsEmpty do + acc <- folder acc xs.Head ys.Head + xs <- xs.Tail + ys <- ys.Tail + + acc + +let foldBack2<'T1, 'T2, 'State> + (folder: 'T1 -> 'T2 -> 'State -> 'State) + (xs: 'T1 list) + (ys: 'T2 list) + (state: 'State) + = + // fold2 (fun acc x y -> folder x y acc) state (reverse xs) (reverse ys) + Array.foldBack2 folder (toArray xs) (toArray ys) state + +let unfold (gen: 'State -> ('T * 'State) option) (state: 'State) = + let rec loop acc (node: 'T list) = + match gen acc with + | None -> node + | Some(x, acc) -> loop acc (node.AppendConsNoTail x) + + let root = List.Empty + let node = loop state root + node.SetConsTail List.Empty + root.Tail + +let iterate action xs = fold (fun () x -> action x) () xs + +let iterate2 action xs ys = + fold2 (fun () x y -> action x y) () xs ys + +let iterateIndexed action xs = + fold + (fun i x -> + action i x + i + 1 + ) + 0 + xs + |> ignore + +let iterateIndexed2 action xs ys = + fold2 + (fun i x y -> + action i x y + i + 1 + ) + 0 + xs + ys + |> ignore + +let toSeq (xs: 'T list) : 'T seq = + xs :> System.Collections.Generic.IEnumerable<'T> + +let ofArrayWithTail (xs: 'T[]) (tail: 'T list) = + let mutable res = tail + + for i = xs.Length - 1 downto 0 do + res <- List.Cons(xs.[i], res) + + res + +let ofArray (xs: 'T[]) = ofArrayWithTail xs List.Empty + +let ofSeq (xs: seq<'T>) : 'T list = + match xs with + | :? array<'T> as xs -> ofArray xs + | :? list<'T> as xs -> xs + | _ -> + let root = List.Empty + let mutable node = root + + for x in xs do + node <- node.AppendConsNoTail x + + node.SetConsTail List.Empty + root.Tail + +let concat (lists: seq<'T list>) = + let root = List.Empty + let mutable node = root + + let action xs = + node <- fold (fun acc x -> acc.AppendConsNoTail x) node xs + + match lists with + | :? array<'T list> as xs -> Array.iter action xs + | :? list<'T list> as xs -> iterate action xs + | _ -> + for xs in lists do + action xs + + node.SetConsTail List.Empty + root.Tail + +let scan (folder: 'State -> 'T -> 'State) (state: 'State) (xs: 'T list) = + let root = List.Empty + let mutable node = root.AppendConsNoTail state + let mutable acc = state + let mutable xs = xs + + while not xs.IsEmpty do + acc <- folder acc xs.Head + node <- node.AppendConsNoTail acc + xs <- xs.Tail + + node.SetConsTail List.Empty + root.Tail + +let scanBack (folder: 'T -> 'State -> 'State) (xs: 'T list) (state: 'State) = + Array.scanBack folder (toArray xs) state |> ofArray + +let append (xs: 'T list) (ys: 'T list) = + fold (fun acc x -> List.Cons(x, acc)) ys (reverse xs) + +let collect (mapping: 'T -> 'U list) (xs: 'T list) = + let root = List.Empty + let mutable node = root + let mutable ys = xs + + while not ys.IsEmpty do + let mutable zs = mapping ys.Head + + while not zs.IsEmpty do + node <- node.AppendConsNoTail zs.Head + zs <- zs.Tail + + ys <- ys.Tail + + node.SetConsTail List.Empty + root.Tail + +let mapIndexed (mapping: int -> 'T -> 'U) (xs: 'T list) = + let root = List.Empty + let folder i (acc: 'U list) x = acc.AppendConsNoTail(mapping i x) + let node = foldIndexed folder root xs + node.SetConsTail List.Empty + root.Tail + +let map (mapping: 'T -> 'U) (xs: 'T list) = + let root = List.Empty + let folder (acc: 'U list) x = acc.AppendConsNoTail(mapping x) + let node = fold folder root xs + node.SetConsTail List.Empty + root.Tail + +let indexed xs = mapIndexed (fun i x -> (i, x)) xs + +let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: 'T1 list) (ys: 'T2 list) = + let root = List.Empty + let folder (acc: 'U list) x y = acc.AppendConsNoTail(mapping x y) + let node = fold2 folder root xs ys + node.SetConsTail List.Empty + root.Tail + +let mapIndexed2 + (mapping: int -> 'T1 -> 'T2 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + = + let rec loop i (acc: 'U list) (xs: 'T1 list) (ys: 'T2 list) = + if xs.IsEmpty || ys.IsEmpty then + acc + else + let node = acc.AppendConsNoTail(mapping i xs.Head ys.Head) + loop (i + 1) node xs.Tail ys.Tail + + let root = List.Empty + let node = loop 0 root xs ys + node.SetConsTail List.Empty + root.Tail + +let map3 + (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) + (xs: 'T1 list) + (ys: 'T2 list) + (zs: 'T3 list) + = + let rec loop (acc: 'U list) (xs: 'T1 list) (ys: 'T2 list) (zs: 'T3 list) = + if xs.IsEmpty || ys.IsEmpty || zs.IsEmpty then + acc + else + let node = acc.AppendConsNoTail(mapping xs.Head ys.Head zs.Head) + loop node xs.Tail ys.Tail zs.Tail + + let root = List.Empty + let node = loop root xs ys zs + node.SetConsTail List.Empty + root.Tail + +let mapFold + (mapping: 'State -> 'T -> 'Result * 'State) + (state: 'State) + (xs: 'T list) + = + let folder (node: 'Result list, st) x = + let r, st = mapping st x + node.AppendConsNoTail r, st + + let root = List.Empty + let node, state = fold folder (root, state) xs + node.SetConsTail List.Empty + root.Tail, state + +let mapFoldBack + (mapping: 'T -> 'State -> 'Result * 'State) + (xs: 'T list) + (state: 'State) + = + mapFold (fun acc x -> mapping x acc) state (reverse xs) + +let tryPick f xs = + let rec loop (xs: 'T list) = + if xs.IsEmpty then + None + else + match f xs.Head with + | Some _ as res -> res + | None -> loop xs.Tail + + loop xs + +let pick f xs = + match tryPick f xs with + | Some x -> x + | None -> indexNotFound () + +let tryFind f xs = + tryPick + (fun x -> + if f x then + Some x + else + None + ) + xs + +let find f xs = + match tryFind f xs with + | Some x -> x + | None -> indexNotFound () + +let tryFindBack f xs = xs |> toArray |> Array.tryFindBack f + +let findBack f xs = + match tryFindBack f xs with + | Some x -> x + | None -> indexNotFound () + +let tryFindIndex f xs : int option = + let rec loop i (xs: 'T list) = + if xs.IsEmpty then + None + else if f xs.Head then + Some i + else + loop (i + 1) xs.Tail + + loop 0 xs + +let findIndex f xs : int = + match tryFindIndex f xs with + | Some x -> x + | None -> + indexNotFound () + -1 + +let tryFindIndexBack f xs : int option = + xs |> toArray |> Array.tryFindIndexBack f + +let findIndexBack f xs : int = + match tryFindIndexBack f xs with + | Some x -> x + | None -> + indexNotFound () + -1 + +let tryItem n (xs: 'T list) = + let rec loop i (xs: 'T list) = + if xs.IsEmpty then + None + else if i = n then + Some xs.Head + else + loop (i + 1) xs.Tail + + loop 0 xs + +let item n (xs: 'T list) = xs.Item(n) + +let filter f (xs: 'T list) = + let root = List.Empty + + let folder (acc: 'T list) x = + if f x then + acc.AppendConsNoTail x + else + acc + + let node = fold folder root xs + node.SetConsTail List.Empty + root.Tail + +let partition f (xs: 'T list) = + let root1, root2 = List.Empty, List.Empty + + let folder (lacc: 'T list, racc: 'T list) x = + if f x then + lacc.AppendConsNoTail x, racc + else + lacc, racc.AppendConsNoTail x + + let node1, node2 = fold folder (root1, root2) xs + node1.SetConsTail List.Empty + node2.SetConsTail List.Empty + root1.Tail, root2.Tail + +let choose<'T, 'U> (f: 'T -> 'U option) (xs: 'T list) = + let root = List.Empty + + let folder (acc: 'U list) x = + match f x with + | Some y -> acc.AppendConsNoTail y + | None -> acc + + let node = fold folder root xs + node.SetConsTail List.Empty + root.Tail + +let contains + (value: 'T) + (xs: 'T list) + ([] eq: System.Collections.Generic.IEqualityComparer<'T>) + = + tryFindIndex (fun v -> eq.Equals(value, v)) xs |> Option.isSome + +let initialize n (f: int -> 'T) = + let root = List.Empty + let mutable node = root + + for i = 0 to n - 1 do + node <- node.AppendConsNoTail(f i) + + node.SetConsTail List.Empty + root.Tail + +let replicate n x = initialize n (fun _ -> x) + +let reduce f (xs: 'T list) = + if xs.IsEmpty then + invalidOp SR.inputWasEmpty + else + fold f (head xs) (tail xs) + +let reduceBack f (xs: 'T list) = + if xs.IsEmpty then + invalidOp SR.inputWasEmpty + else + foldBack f (tail xs) (head xs) + +let forAll f xs = fold (fun acc x -> acc && f x) true xs + +let forAll2 f xs ys = + fold2 (fun acc x y -> acc && f x y) true xs ys + +let exists f xs = tryFindIndex f xs |> Option.isSome + +let rec exists2 (f: 'T1 -> 'T2 -> bool) (xs: 'T1 list) (ys: 'T2 list) = + match xs.IsEmpty, ys.IsEmpty with + | true, true -> false + | false, false -> f xs.Head ys.Head || exists2 f xs.Tail ys.Tail + | _ -> invalidArg "list2" SR.differentLengths + +let unzip xs = + foldBack + (fun (x, y) (lacc, racc) -> List.Cons(x, lacc), List.Cons(y, racc)) + xs + (List.Empty, List.Empty) + +let unzip3 xs = + foldBack + (fun (x, y, z) (lacc, macc, racc) -> + List.Cons(x, lacc), List.Cons(y, macc), List.Cons(z, racc) + ) + xs + (List.Empty, List.Empty, List.Empty) + +let zip xs ys = map2 (fun x y -> x, y) xs ys + +let zip3 xs ys zs = map3 (fun x y z -> x, y, z) xs ys zs + +let sortWith (comparer: 'T -> 'T -> int) (xs: 'T list) = + let arr = toArray xs + Array.sortInPlaceWith comparer arr // Note: In JS this sort is stable + arr |> ofArray + +let sort + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'T>) + = + sortWith (fun x y -> comparer.Compare(x, y)) xs + +let sortBy + (projection: 'T -> 'U) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'U>) + = + sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs + +let sortDescending + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'T>) + = + sortWith (fun x y -> comparer.Compare(x, y) * -1) xs + +let sortByDescending + (projection: 'T -> 'U) + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'U>) + = + 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 + +let sumBy + (f: 'T -> 'U) + (xs: 'T list) + ([] adder: IGenericAdder<'U>) + : 'U + = + fold (fun acc x -> adder.Add(acc, f x)) (adder.GetZero()) xs + +let maxBy + (projection: 'T -> 'U) + xs + ([] comparer: System.Collections.Generic.IComparer<'U>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + y + else + x + ) + xs + +let max + xs + ([] comparer: System.Collections.Generic.IComparer<'T>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + y + else + x + ) + xs + +let minBy + (projection: 'T -> 'U) + xs + ([] comparer: System.Collections.Generic.IComparer<'U>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(projection y, projection x) > 0 then + x + else + y + ) + xs + +let min + (xs: 'T list) + ([] comparer: System.Collections.Generic.IComparer<'T>) + : 'T + = + reduce + (fun x y -> + if comparer.Compare(y, x) > 0 then + x + else + y + ) + xs + +let average (xs: 'T list) ([] averager: IGenericAverager<'T>) : 'T = + let mutable count = 0 + + let folder acc x = + count <- count + 1 + averager.Add(acc, x) + + let total = fold folder (averager.GetZero()) xs + averager.DivideByInt(total, count) + +let averageBy + (f: 'T -> 'U) + (xs: 'T list) + ([] averager: IGenericAverager<'U>) + : 'U + = + let mutable count = 0 + + let inline folder acc x = + count <- count + 1 + averager.Add(acc, f x) + + let total = fold folder (averager.GetZero()) xs + averager.DivideByInt(total, count) + +let permute f (xs: 'T list) = + toArray xs |> Array.permute f |> ofArray + +let chunkBySize (chunkSize: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.chunkBySize chunkSize |> Array.map ofArray |> ofArray + +let allPairs (xs: 'T1 list) (ys: 'T2 list) : ('T1 * 'T2) list = + let root = List.Empty + let mutable node = root + + iterate + (fun x -> iterate (fun y -> node <- node.AppendConsNoTail(x, y)) ys) + xs + + node.SetConsTail List.Empty + root.Tail + +let rec skip count (xs: 'T list) = + if count <= 0 then + xs + elif xs.IsEmpty then + invalidArg "list" SR.notEnoughElements + else + skip (count - 1) xs.Tail + +let rec skipWhile predicate (xs: 'T list) = + if xs.IsEmpty then + xs + elif not (predicate xs.Head) then + xs + else + skipWhile predicate xs.Tail + +let take count (xs: 'T list) = + if count < 0 then + invalidArg "count" SR.inputMustBeNonNegative + + let rec loop i (acc: 'T list) (xs: 'T list) = + if i <= 0 then + acc + elif xs.IsEmpty then + invalidArg "list" SR.notEnoughElements + else + loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + + let root = List.Empty + let node = loop count root xs + node.SetConsTail List.Empty + root.Tail + +let takeWhile predicate (xs: 'T list) = + let rec loop (acc: 'T list) (xs: 'T list) = + if xs.IsEmpty then + acc + elif not (predicate xs.Head) then + acc + else + loop (acc.AppendConsNoTail xs.Head) xs.Tail + + let root = List.Empty + let node = loop root xs + node.SetConsTail List.Empty + root.Tail + +let truncate count (xs: 'T list) = + let rec loop i (acc: 'T list) (xs: 'T list) = + if i <= 0 then + acc + elif xs.IsEmpty then + acc + else + loop (i - 1) (acc.AppendConsNoTail xs.Head) xs.Tail + + let root = List.Empty + let node = loop count root xs + node.SetConsTail List.Empty + root.Tail + +let getSlice (startIndex: int option) (endIndex: int option) (xs: 'T list) = + let len = length xs + + let startIndex = + let index = defaultArg startIndex 0 + + if index < 0 then + 0 + else + index + + let endIndex = + let index = defaultArg endIndex (len - 1) + + if index >= len then + len - 1 + else + index + + if endIndex < startIndex then + List.Empty + else + xs |> skip startIndex |> take (endIndex - startIndex + 1) + +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 exactlyOne (xs: 'T list) = + if xs.IsEmpty then + invalidArg "list" SR.inputSequenceEmpty + else if xs.Tail.IsEmpty then + xs.Head + else + invalidArg "list" SR.inputSequenceTooLong + +let tryExactlyOne (xs: 'T list) = + if not (xs.IsEmpty) && xs.Tail.IsEmpty then + Some(xs.Head) + else + None + +let where predicate (xs: 'T list) = filter predicate xs + +let pairwise (xs: 'T list) = toArray xs |> Array.pairwise |> ofArray + +let windowed (windowSize: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.windowed windowSize |> Array.map ofArray |> ofArray + +let splitInto (chunks: int) (xs: 'T list) : 'T list list = + toArray xs |> Array.splitInto chunks |> Array.map ofArray |> ofArray + +let transpose (lists: seq<'T list>) : 'T list list = + lists + |> Array.ofSeq + |> Array.map toArray + |> Array.transpose + |> Array.map ofArray + |> ofArray + +// let init = initialize +// let iter = iterate +// let iter2 = iterate2 +// let iteri = iterateIndexed +// let iteri2 = iterateIndexed2 +// let forall = forAll +// let forall2 = forAll2 +// let mapi = mapIndexed +// let mapi2 = mapIndexed2 +// let rev = reverse + +let insertAt (index: int) (y: 'T) (xs: 'T list) : 'T list = + let mutable i = -1 + let mutable isDone = false + + let result = + (List.Empty, xs) + ||> fold (fun acc x -> + i <- i + 1 + + if i = index then + isDone <- true + List.Cons(x, List.Cons(y, acc)) + else + List.Cons(x, acc) + ) + + let result = + if isDone then + result + elif i + 1 = index then + List.Cons(y, result) + else + invalidArg "index" SR.indexOutOfBounds + + reverse result + +let insertManyAt (index: int) (ys: seq<'T>) (xs: 'T list) : 'T list = + let mutable i = -1 + let mutable isDone = false + let ys = ofSeq ys + + let result = + (List.Empty, xs) + ||> fold (fun acc x -> + i <- i + 1 + + if i = index then + isDone <- true + List.Cons(x, append ys acc) + else + List.Cons(x, acc) + ) + + let result = + if isDone then + result + elif i + 1 = index then + append ys result + else + invalidArg "index" SR.indexOutOfBounds + + reverse result + +let removeAt (index: int) (xs: 'T list) : 'T list = + let mutable i = -1 + let mutable isDone = false + + let ys = + xs + |> filter (fun _ -> + i <- i + 1 + + if i = index then + isDone <- true + false + else + true + ) + + if not isDone then + invalidArg "index" SR.indexOutOfBounds + + ys + +let removeManyAt (index: int) (count: int) (xs: 'T list) : 'T list = + let mutable i = -1 + // incomplete -1, in-progress 0, complete 1 + let mutable status = -1 + + let ys = + xs + |> filter (fun _ -> + i <- i + 1 + + if i = index then + status <- 0 + false + elif i > index then + if i < index + count then + false + else + status <- 1 + true + else + true + ) + + let status = + if status = 0 && i + 1 = index + count then + 1 + else + status + + if status < 1 then + // F# always says the wrong parameter is index but the problem may be count + let arg = + if status < 0 then + "index" + else + "count" + + invalidArg arg SR.indexOutOfBounds + + ys + +let updateAt (index: int) (y: 'T) (xs: 'T list) : 'T list = + let mutable isDone = false + + let ys = + xs + |> mapIndexed (fun i x -> + if i = index then + isDone <- true + y + else + x + ) + + if not isDone then + invalidArg "index" SR.indexOutOfBounds + + ys diff --git a/src/fable-library-py/fable_library/Native.fs b/src/fable-library-py/fable_library/Native.fs index f32f8bc58b..1e6ce6bf40 100644 --- a/src/fable-library-py/fable_library/Native.fs +++ b/src/fable-library-py/fable_library/Native.fs @@ -141,11 +141,17 @@ module Helpers = nativeOnly // Inlining in combination with dynamic application may cause problems with uncurrying - // Using Emit keeps the argument signature. Note: Python cannot take an argument here. - [] + // Using Emit keeps the argument signature. + [] let sortInPlaceWithImpl (comparer: 'T -> 'T -> int) (array: 'T[]) : unit = nativeOnly + [] + let sortWithImpl (comparer: 'T -> 'T -> int) (array: 'T[]) : 'T[] = + nativeOnly + + [] + let copyToTypedArray (src: 'T[]) (srci: int) diff --git a/tests/Python/TestArray.fs b/tests/Python/TestArray.fs index 448084ee68..c6e89ee517 100644 --- a/tests/Python/TestArray.fs +++ b/tests/Python/TestArray.fs @@ -673,7 +673,6 @@ let ``test Array.scanBack works`` () = ys.[2] + ys.[3] |> equal 3. -(* [] let ``test Array.sort works`` () = let xs = [|3; 4; 1; -3; 2; 10|] @@ -686,7 +685,7 @@ let ``test Array.sort with tuples works`` () = let xs = [|3; 1; 1; -3|] let ys = [|"a"; "c"; "B"; "d"|] (xs, ys) ||> Array.zip |> Array.sort |> Array.item 1 |> equal (1, "B") -*) + [] let ``test Array.truncate works`` () = let xs = [|1.; 2.; 3.; 4.; 5.|] @@ -700,7 +699,6 @@ let ``test Array.truncate works`` () = try xs |> Array.truncate 20 |> Array.length with _ -> -1 |> equal 5 -(* [] let ``test Array.sortDescending works`` () = let xs = [|3; 4; 1; -3; 2; 10|] @@ -731,6 +729,7 @@ let ``test Array.sortWith works`` () = ys.[0] + ys.[1] |> equal 3. +(* [] let ``test Array.sortInPlace works`` () = let xs = [|3.; 4.; 1.; 2.; 10.|] @@ -1144,7 +1143,6 @@ let ``test Array.removeManyAt works`` () = throwsAnyError (fun () -> Array.removeManyAt -1 2 [|1|] |> ignore) throwsAnyError (fun () -> Array.removeManyAt 2 2 [|1|] |> ignore) -// Wait for main sync before enbling this test // [] // let ``test Array.compareWith works`` () = // See #2961 // let a = [|1;3|] diff --git a/tests/Python/TestList.fs b/tests/Python/TestList.fs index f5dd1bc436..2762e99c2f 100644 --- a/tests/Python/TestList.fs +++ b/tests/Python/TestList.fs @@ -432,13 +432,12 @@ let ``test List.sort with tuples works`` () = let ys = ["a"; "c"; "B"; "d"] (xs, ys) ||> List.zip |> List.sort |> List.item 1 |> equal (1, "B") -// TODO: Python sort cannot take arguments -// [] -// let ``test List.sortBy works`` () = -// let xs = [3; 1; 4; 2] -// let ys = xs |> List.sortBy (fun x -> -x) -// ys.Head + ys.Tail.Head -// |> equal 7 +[] +let ``test List.sortBy works`` () = + let xs = [3; 1; 4; 2] + let ys = xs |> List.sortBy (fun x -> -x) + ys.Head + ys.Tail.Head + |> equal 7 [] let ``test List.sortWith works`` () = @@ -447,13 +446,12 @@ let ``test List.sortWith works`` () = ys.Head + ys.Tail.Head |> equal 3 -// FIXME: -// [] -// let ``test List.sortDescending works`` () = -// let xs = [3; 4; 1; -3; 2; 10] -// xs |> List.sortDescending |> List.take 3 |> List.sum |> equal 17 -// let ys = ["a"; "c"; "B"; "d"] -// ys |> List.sortDescending |> List.item 1 |> equal "c" +[] +let ``test List.sortDescending works`` () = + let xs = [3; 4; 1; -3; 2; 10] + xs |> List.sortDescending |> List.take 3 |> List.sum |> equal 17 + let ys = ["a"; "c"; "B"; "d"] + ys |> List.sortDescending |> List.item 1 |> equal "c" [] let ``test List.sortByDescending works`` () =