diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 97f47fe49..55ecb0874 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -283,7 +283,7 @@ module Reflection = | Fable.Array _ | Fable.Tuple _ -> libCall com ctx None "Util" "isArrayLike" [|com.TransformAsExpr(ctx, expr)|] | Fable.List _ -> - jsInstanceof (libValue com ctx "Types" "List") expr + jsInstanceof (libValue com ctx "List" "FSharpList") expr | Fable.AnonymousRecordType _ -> warnAndEvalToFalse "anonymous records" | Fable.MetaType -> @@ -435,7 +435,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 @@ -662,12 +662,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 |> Expression.arrayExpression @@ -933,8 +927,8 @@ module Util = | Fable.NewArray (values, typ) -> makeTypedArray com ctx typ values | Fable.NewArrayFrom (size, typ) -> makeTypedAllocatedFrom com ctx typ size | Fable.NewTuple vals -> makeArray com ctx vals - | Fable.NewList (headAndTail, _) when List.contains "FABLE_LIBRARY" com.Options.Define -> - makeList com ctx r headAndTail + // | Fable.NewList (headAndTail, _) when List.contains "FABLE_LIBRARY" com.Options.Define -> + // makeList com ctx r headAndTail // Optimization for bundle size: compile list literals as List.ofArray | Fable.NewList (headAndTail, _) -> let rec getItems acc = function @@ -988,7 +982,7 @@ module Util = let enumerator2iterator com ctx = let enumerator = Expression.callExpression(get None (Expression.identifier("this")) "GetEnumerator", [||]) - BlockStatement([| Statement.returnStatement(libCall com ctx None "Seq" "toIterator" [|enumerator|])|]) + BlockStatement([| Statement.returnStatement(libCall com ctx None "Util" "toIterator" [|enumerator|])|]) let extractBaseExprFromBaseCall (com: IBabelCompiler) (ctx: Context) (baseType: Fable.DeclaredType option) baseCall = match baseCall, baseType with @@ -1206,10 +1200,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 @@ -1274,8 +1270,10 @@ module Util = Expression.binaryExpression(op, com.TransformAsExpr(ctx, expr), Expression.nullLiteral(), ?loc=range) | Fable.ListTest nonEmpty -> let expr = com.TransformAsExpr(ctx, expr) - let op = if nonEmpty then BinaryUnequal else BinaryEqual - Expression.binaryExpression(op, get None expr "tail", Expression.nullLiteral(), ?loc=range) + // let op = if nonEmpty then BinaryUnequal else BinaryEqual + // Expression.binaryExpression(op, get None expr "tail", Expression.nullLiteral(), ?loc=range) + let expr = libCall com ctx range "List" "isEmpty" [|expr|] + if nonEmpty then Expression.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 0fa0d0592..3eb803c83 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -1372,12 +1372,12 @@ let operators (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr o | _ -> args let modul, meth, args = match genArg with - | Char -> "Seq", "rangeChar", args - | Builtin BclInt64 -> "Seq", "rangeLong", (addStep args) @ [makeBoolConst false] - | Builtin BclUInt64 -> "Seq", "rangeLong", (addStep args) @ [makeBoolConst true] - | Builtin BclDecimal -> "Seq", "rangeDecimal", addStep args - | Builtin BclBigInt -> "BigInt", "range", addStep args - | _ -> "Seq", "rangeNumber", addStep args + | Char -> "Range", "rangeChar", args + | Builtin BclInt64 -> "Range", "rangeInt64", addStep args + | Builtin BclUInt64 -> "Range", "rangeUInt64", addStep args + | Builtin BclDecimal -> "Range", "rangeDecimal", addStep args + | Builtin BclBigInt -> "Range", "rangeBigInt", addStep args + | _ -> "Range", "rangeDouble", addStep args Helper.LibCall(com, modul, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some // Pipes and composition | "op_PipeRight", [x; f] @@ -1542,7 +1542,7 @@ let implementedStringFunctions = |] let getEnumerator com r t expr = - Helper.LibCall(com, "Seq", "getEnumerator", t, [toSeq Any expr], ?loc=r) + Helper.LibCall(com, "Util", "getEnumerator", t, [toSeq Any expr], ?loc=r) let strings (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, thisArg, args with @@ -1660,51 +1660,13 @@ let stringModule (com: ICompiler) (ctx: Context) r t (i: CallInfo) (_: Expr opti | meth, args -> Helper.LibCall(com, "String", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some -let seqs (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = - let sort r returnType descending projection args genArg = - let compareFn = - let identExpr ident = - match projection with - | Some projection -> - let info = makeCallInfo None [IdentExpr ident] [] - Call(projection, info, genArg, None) - | None -> IdentExpr ident - let x = makeUniqueIdent ctx genArg "x" - let y = makeUniqueIdent ctx genArg "y" - let comparison = - let comparison = compare com ctx None (identExpr x) (identExpr y) - if descending - then makeUnOp None (Number Int32) comparison UnaryMinus - else comparison - Delegate([x; y], comparison, None) - Helper.LibCall(com, "Seq", "sortWith", returnType, compareFn::args, ?loc=r) |> Some - +let seqModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (thisArg: Expr option) (args: Expr list) = match i.CompiledName, args with | "Cast", [arg] -> Some arg // Erase - | ("Cache" | "ToArray"), [arg] -> toArray r t arg |> Some - | "OfList", [arg] -> toSeq t arg |> Some - | "ToList", _ -> Helper.LibCall(com, "List", "ofSeq", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("ChunkBySize" | "Permute" | "SplitInto") as meth, [arg1; arg2] -> - let arg2 = toArray r (Array Any) arg2 - let result = Helper.LibCall(com, "Array", Naming.lowerFirst meth, Any, [arg1; arg2]) - Helper.LibCall(com, "Seq", "ofArray", t, [result]) |> Some - // For Using we need to cast the argument to IDisposable - | "EnumerateUsing", [arg; f] -> - Helper.LibCall(com, "Seq", "enumerateUsing", t, [arg; f], i.SignatureArgTypes, ?loc=r) |> Some - | ("Sort" | "SortDescending" as meth), args -> - (genArg com ctx r 0 i.GenericArgs) |> sort r t (meth = "SortDescending") None args - | ("SortBy" | "SortByDescending" as meth), projection::args -> - (genArg com ctx r 1 i.GenericArgs) |> sort r t (meth = "SortByDescending") (Some projection) args - | ("GroupBy" | "CountBy" as meth), args -> - let meth = Naming.lowerFirst meth - let args = injectArg com ctx r "Map" meth i.GenericArgs args - Helper.LibCall(com, "Map", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("Distinct" | "DistinctBy" as meth), args -> + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> let meth = Naming.lowerFirst meth - let args = injectArg com ctx r "Set" meth i.GenericArgs args - Helper.LibCall(com, "Set", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some - | "TryExactlyOne", args -> - tryCoreOp com r t "Seq" "exactlyOne" args |> Some + let args = injectArg com ctx r "Seq2" meth i.GenericArgs args + Helper.LibCall(com, "Seq2", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Seq" meth i.GenericArgs args @@ -1749,16 +1711,16 @@ let resizeArrays (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (this | "Clear", Some ar, _ -> Helper.LibCall(com, "Util", "clear", t, [ar], ?loc=r) |> Some | "Find", Some ar, [arg] -> - let opt = Helper.LibCall(com, "Seq", "tryFind", t, [arg; ar; defaultof com ctx t], ?loc=r) - Helper.LibCall(com, "Option", "value", t, [opt], ?loc=r) |> Some + let opt = Helper.LibCall(com, "Array", "tryFind", t, [arg; ar], ?loc=r) + Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx t], ?loc=r) |> Some | "Exists", Some ar, [arg] -> let left = Helper.InstanceCall(ar, "findIndex", Number Int32, [arg], ?loc=r) makeEqOp r left (makeIntConst -1) BinaryGreater |> Some | "FindLast", Some ar, [arg] -> - let opt = Helper.LibCall(com, "Seq", "tryFindBack", t, [arg; ar; defaultof com ctx t], ?loc=r) - Helper.LibCall(com, "Option", "value", t, [opt], ?loc=r) |> Some + let opt = Helper.LibCall(com, "Array", "tryFindBack", t, [arg; ar], ?loc=r) + Helper.LibCall(com, "Option", "defaultArg", t, [opt; defaultof com ctx t], ?loc=r) |> Some | "FindAll", Some ar, [arg] -> - Helper.LibCall(com, "Seq", "filter", t, [arg; ar], ?loc=r) |> toArray r t |> Some + Helper.LibCall(com, "Array", "filter", t, [arg; ar], ?loc=r) |> Some | "AddRange", Some ar, [arg] -> Helper.LibCall(com, "Array", "addRangeInPlace", t, [arg; ar], ?loc=r) |> Some | "GetRange", Some ar, [idx; cnt] -> @@ -1845,8 +1807,10 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex match i.CompiledName, args with | "ToSeq", [arg] -> Some arg | "OfSeq", [arg] -> toArray r t arg |> Some - | "OfList", [arg] -> toArray r t arg |> Some - | "ToList", _ -> Helper.LibCall(com, "List", "ofArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "OfList", [arg] -> + Helper.LibCall(com, "List", "toArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "ToList", args -> + Helper.LibCall(com, "List", "ofArray", t, args, i.SignatureArgTypes, ?loc=r) |> Some | ("Length" | "Count"), [arg] -> get r t arg "length" |> Some | "Item", [idx; ar] -> getExpr r t ar idx |> Some | "Get", [ar; idx] -> getExpr r t ar idx |> Some @@ -1858,22 +1822,16 @@ let arrayModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Ex newArray (makeIntConst 0) t |> Some | "IsEmpty", [ar] -> eq (get r (Number Int32) ar "length") (makeIntConst 0) |> Some - | "AllPairs", args -> - let allPairs = Helper.LibCall(com, "Seq", "allPairs", t, args, i.SignatureArgTypes, ?loc=r) - toArray r t allPairs |> Some - | "TryExactlyOne", args -> - tryCoreOp com r t "Array" "exactlyOne" args |> Some - | "SortInPlace", args -> - let _, thisArg = List.splitLast args - let argTypes = List.take (List.length args) i.SignatureArgTypes - let compareFn = (genArg com ctx r 0 i.GenericArgs) |> makeComparerFunction com ctx - Helper.InstanceCall(thisArg, "sort", t, [compareFn], argTypes, ?loc=r) |> Some | "CopyTo", args -> copyToArray com r t i args | Patterns.DicContains nativeArrayFunctions meth, _ -> let args, thisArg = List.splitLast args let argTypes = List.take (List.length args) i.SignatureArgTypes Helper.InstanceCall(thisArg, meth, t, args, argTypes, ?loc=r) |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + let meth = Naming.lowerFirst meth + let args = injectArg com ctx r "Seq2" meth i.GenericArgs args + Helper.LibCall(com, "Seq2", "Array_" + meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "Array" meth i.GenericArgs args @@ -1906,12 +1864,10 @@ let listModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: Exp // 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 - | "ToArray", [x] -> toArray r t x |> Some - | "AllPairs", args -> - let allPairs = Helper.LibCall(com, "Seq", "allPairs", t, args, i.SignatureArgTypes, ?loc=r) - toList com t allPairs |> Some - | "TryExactlyOne", args -> - tryCoreOp com r t "List" "exactlyOne" args |> Some + | ("Distinct" | "DistinctBy" | "Except" | "GroupBy" | "CountBy" as meth), args -> + let meth = Naming.lowerFirst meth + let args = injectArg com ctx r "Seq2" meth i.GenericArgs args + Helper.LibCall(com, "Seq2", "List_" + meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | meth, _ -> let meth = Naming.lowerFirst meth let args = injectArg com ctx r "List" meth i.GenericArgs args @@ -1989,19 +1945,20 @@ let optionModule (com: ICompiler) (ctx: Context) r (t: Type) (i: CallInfo) (_: E Helper.LibCall(com, "Option", Naming.lowerFirst meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | "ToArray", [arg] -> toArray r t arg |> Some + | "ToList", [arg] -> + let args = args |> List.replaceLast (toArray None t) + Helper.LibCall(com, "List", "ofArray", t, args, ?loc=r) |> Some | "FoldBack", [folder; opt; state] -> Helper.LibCall(com, "Seq", "foldBack", t, [folder; toArray None t opt; state], i.SignatureArgTypes, ?loc=r) |> Some | ("DefaultValue" | "OrElse"), _ -> Helper.LibCall(com, "Option", "defaultArg", t, List.rev args, ?loc=r) |> Some | ("DefaultWith" | "OrElseWith"), _ -> Helper.LibCall(com, "Option", "defaultArgWith", t, List.rev args, List.rev i.SignatureArgTypes, ?loc=r) |> Some - | ("Count" | "Contains" | "Exists" | "Fold" | "ForAll" | "Iterate" | "ToList" as meth), _ -> + | ("Count" | "Contains" | "Exists" | "Fold" | "ForAll" | "Iterate" as meth), _ -> + let meth = Naming.lowerFirst meth let args = args |> List.replaceLast (toArray None t) - let moduleName, meth = - if meth = "ToList" - then "List", "ofArray" - else "Seq", Naming.lowerFirst meth - Helper.LibCall(com, moduleName, meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some + let args = injectArg com ctx r "Seq" meth i.GenericArgs args + Helper.LibCall(com, "Seq", meth, t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let parseBool (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisArg: Expr option) (args: Expr list) = @@ -2266,7 +2223,7 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr // Type: RangeChar : char -> char -> seq // Usage: RangeChar start stop | "RangeChar", None, _ -> - Helper.LibCall(com, "Seq", "rangeChar", t, args, i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Range", "rangeChar", t, args, i.SignatureArgTypes, ?loc=r) |> Some // reference: https://msdn.microsoft.com/visualfsharpdocs/conceptual/operatorintrinsics.rangedouble-function-%5bfsharp%5d // Type: RangeDouble: float -> float -> float -> seq // Usage: RangeDouble start step stop @@ -2274,10 +2231,11 @@ let intrinsicFunctions (com: ICompiler) (ctx: Context) r t (i: CallInfo) (thisAr | "RangeInt16" | "RangeUInt16" | "RangeInt32" | "RangeUInt32" | "RangeSingle" | "RangeDouble"), None, args -> - Helper.LibCall(com, "Seq", "rangeNumber", t, args, i.SignatureArgTypes, ?loc=r) |> Some - | ("RangeInt64" | "RangeUInt64"), None, args -> - let isUnsigned = makeBoolConst (i.CompiledName = "RangeUInt64") - Helper.LibCall(com, "Seq", "rangeLong", t, args @ [isUnsigned] , i.SignatureArgTypes, ?loc=r) |> Some + Helper.LibCall(com, "Range", "rangeDouble", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "RangeInt64", None, args -> + Helper.LibCall(com, "Range", "rangeInt64", t, args, i.SignatureArgTypes, ?loc=r) |> Some + | "RangeUInt64", None, args -> + Helper.LibCall(com, "Range", "rangeUInt64", t, args, i.SignatureArgTypes, ?loc=r) |> Some | _ -> None let runtimeHelpers (com: ICompiler) (ctx: Context) r t (i: CallInfo) thisArg args = @@ -3061,8 +3019,8 @@ let private replacedModules = "Microsoft.FSharp.Collections.ListModule", listModule "Microsoft.FSharp.Collections.HashIdentity", fsharpModule "Microsoft.FSharp.Collections.ComparisonIdentity", fsharpModule - "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqs - "Microsoft.FSharp.Collections.SeqModule", seqs + "Microsoft.FSharp.Core.CompilerServices.RuntimeHelpers", seqModule + "Microsoft.FSharp.Collections.SeqModule", seqModule "System.Collections.Generic.KeyValuePair`2", keyValuePairs "System.Collections.Generic.Comparer`1", bclType "System.Collections.Generic.EqualityComparer`1", bclType diff --git a/src/Fable.Transforms/ReplacementsInject.fs b/src/Fable.Transforms/ReplacementsInject.fs index bcc1e5ae9..e4c4bc606 100644 --- a/src/Fable.Transforms/ReplacementsInject.fs +++ b/src/Fable.Transforms/ReplacementsInject.fs @@ -3,16 +3,6 @@ module Fable.Transforms.ReplacementsInject let fableReplacementsModules = Map [ - "Seq", Map [ - "maxBy", (Types.comparer, 1) - "max", (Types.comparer, 0) - "minBy", (Types.comparer, 1) - "min", (Types.comparer, 0) - "sumBy", (Types.adder, 1) - "sum", (Types.adder, 0) - "averageBy", (Types.averager, 1) - "average", (Types.averager, 0) - ] "Array", Map [ "append", (Types.arrayCons, 0) "mapIndexed", (Types.arrayCons, 1) @@ -25,12 +15,7 @@ let fableReplacementsModules = "mapFoldBack", (Types.arrayCons, 2) "concat", (Types.arrayCons, 0) "collect", (Types.arrayCons, 1) - "countBy", (Types.equalityComparer, 1) - "distinctBy", (Types.equalityComparer, 1) - "distinct", (Types.equalityComparer, 0) "contains", (Types.equalityComparer, 0) - "except", (Types.equalityComparer, 0) - "groupBy", (Types.equalityComparer, 1) "singleton", (Types.arrayCons, 0) "initialize", (Types.arrayCons, 0) "replicate", (Types.arrayCons, 0) @@ -60,7 +45,6 @@ let fableReplacementsModules = ] "List", Map [ "contains", (Types.equalityComparer, 0) - "except", (Types.equalityComparer, 0) "sort", (Types.comparer, 0) "sortBy", (Types.comparer, 1) "sortDescending", (Types.comparer, 0) @@ -73,10 +57,28 @@ let fableReplacementsModules = "min", (Types.comparer, 0) "average", ("Fable.Core.IGenericAverager`1", 0) "averageBy", ("Fable.Core.IGenericAverager`1", 1) - "distinctBy", (Types.equalityComparer, 1) + ] + "Seq", Map [ + "contains", (Types.equalityComparer, 0) + "sort", (Types.comparer, 0) + "sortBy", (Types.comparer, 1) + "sortDescending", (Types.comparer, 0) + "sortByDescending", (Types.comparer, 1) + "sum", ("Fable.Core.IGenericAdder`1", 0) + "sumBy", ("Fable.Core.IGenericAdder`1", 1) + "maxBy", (Types.comparer, 1) + "max", (Types.comparer, 0) + "minBy", (Types.comparer, 1) + "min", (Types.comparer, 0) + "average", ("Fable.Core.IGenericAverager`1", 0) + "averageBy", ("Fable.Core.IGenericAverager`1", 1) + ] + "Seq2", Map [ "distinct", (Types.equalityComparer, 0) - "groupBy", (Types.equalityComparer, 1) + "distinctBy", (Types.equalityComparer, 1) + "except", (Types.equalityComparer, 0) "countBy", (Types.equalityComparer, 1) + "groupBy", (Types.equalityComparer, 1) ] "Set", Map [ "FSharpSet__Map", (Types.comparer, 1) @@ -87,19 +89,11 @@ let fableReplacementsModules = "ofList", (Types.comparer, 0) "ofArray", (Types.comparer, 0) "ofSeq", (Types.comparer, 0) - "createMutable", (Types.equalityComparer, 0) - "distinct", (Types.equalityComparer, 0) - "distinctBy", (Types.equalityComparer, 1) "intersectWith", (Types.comparer, 0) "isSubsetOf", (Types.comparer, 0) "isSupersetOf", (Types.comparer, 0) "isProperSubsetOf", (Types.comparer, 0) "isProperSupersetOf", (Types.comparer, 0) ] - "Map", Map [ - "createMutable", (Types.equalityComparer, 0) - "groupBy", (Types.equalityComparer, 1) - "countBy", (Types.equalityComparer, 1) - ] ] diff --git a/src/fable-library/Array.fs b/src/fable-library/Array.fs index d26a1e2af..c3b5ac56a 100644 --- a/src/fable-library/Array.fs +++ b/src/fable-library/Array.fs @@ -1,4 +1,4 @@ -module Array +module ArrayModule // Disables warn:1204 raised by use of LanguagePrimitives.ErrorStrings.* #nowarn "1204" @@ -254,28 +254,6 @@ let collect (mapping: 'T -> 'U[]) (array: 'T[]) ([] cons: Cons<'U>): 'U[ concat mapped cons // collectImpl mapping array // flatMap not widely available yet -let countBy (projection: 'T -> 'Key) (array: 'T[]) ([] eq: IEqualityComparer<'Key>): ('Key * int)[] = - let dict = Dictionary<'Key, int>(eq) - let keys: 'Key[] = [||] - for value in array do - let key = projection value - match dict.TryGetValue(key) with - | true, prev -> - dict.[key] <- prev + 1 - | false, _ -> - dict.[key] <- 1 - pushImpl keys key |> ignore - let result = - map (fun key -> key, dict.[key]) keys Unchecked.defaultof<_> - result - -let distinctBy (projection: 'T -> 'Key) (array: 'T[]) ([] eq: IEqualityComparer<'Key>) = - let hashSet = HashSet<'Key>(eq) - array |> filter (projection >> hashSet.Add) - -let distinct (array: 'T[]) ([] eq: IEqualityComparer<'T>) = - distinctBy id array eq - let where predicate (array: _[]) = filterImpl predicate array let contains<'T> (value: 'T) (array: 'T[]) ([] eq: IEqualityComparer<'T>) = @@ -287,28 +265,6 @@ let contains<'T> (value: 'T) (array: 'T[]) ([] eq: IEqualityComparer<'T> else loop (i + 1) loop 0 -let except (itemsToExclude: seq<'T>) (array: 'T[]) ([] eq: IEqualityComparer<'T>): 'T[] = - if array.Length = 0 then - array - else - let cached = HashSet(itemsToExclude, eq) - array |> filterImpl cached.Add - -let groupBy (projection: 'T -> 'Key) (array: 'T[]) ([] eq: IEqualityComparer<'Key>): ('Key * 'T[])[] = - let dict = Dictionary<'Key, ResizeArray<'T>>(eq) - let keys: 'Key[] = [||] - for v in array do - let key = projection v - match dict.TryGetValue(key) with - | true, prev -> - prev.Add(v) - | false, _ -> - dict.Add(key, ResizeArray [|v|]) - pushImpl keys key |> ignore - let result = - map (fun key -> key, arrayFrom dict.[key]) keys Unchecked.defaultof<_> - result - let empty cons = allocateArrayFromCons cons 0 let singleton value ([] cons: Cons<'T>) = @@ -414,7 +370,8 @@ let addInPlace (x: 'T) (array: 'T[]) = let addRangeInPlace (range: seq<'T>) (array: 'T[]) = // if isTypedArrayImpl array then invalidArg "array" "Typed arrays not supported" - Seq.iter (fun x -> pushImpl array x |> ignore) range + for x in range do + addInPlace x array let removeInPlace (item: 'T) (array: 'T[]) = // if isTypedArrayImpl array then invalidArg "array" "Typed arrays not supported" @@ -676,6 +633,15 @@ let sortByDescending (projection: 'a->'b) (xs: 'a[]) ([] comparer: IComp let sortWith (comparer: 'T -> 'T -> int) (xs: 'T[]): 'T[] = sortInPlaceWith comparer (copyImpl 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 = @@ -769,6 +735,11 @@ let exactlyOne (array: 'T[]) = 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] diff --git a/src/fable-library/Async.ts b/src/fable-library/Async.ts index 6b0be3f06..5c34e33e7 100644 --- a/src/fable-library/Async.ts +++ b/src/fable-library/Async.ts @@ -7,7 +7,6 @@ import { protectedCont } from "./AsyncBuilder.js"; import { protectedBind } from "./AsyncBuilder.js"; import { protectedReturn } from "./AsyncBuilder.js"; import { FSharpChoice$2, Choice_makeChoice1Of2, Choice_makeChoice2Of2 } from "./Choice.js"; -import { map } from "./Seq.js"; // Implemented just for type references export class Async<_T> { } @@ -102,7 +101,7 @@ export function ignore(computation: IAsync) { } export function parallel(computations: Iterable>) { - return awaitPromise(Promise.all(map((w) => startAsPromise(w), computations))); + return awaitPromise(Promise.all(Array.from(computations, (w) => startAsPromise(w)))); } export function sleep(millisecondsDueTime: number) { diff --git a/src/fable-library/BigInt.fs b/src/fable-library/BigInt.fs index 188371a0d..c5c378d6a 100644 --- a/src/fable-library/BigInt.fs +++ b/src/fable-library/BigInt.fs @@ -88,7 +88,7 @@ let private flipTwosComplement currByte lowBitFound = | 0uy, false -> 0uy, false // Haven't found first bit yet and no chance to do so with zero byte | _, false -> // Found first byte containing a 1, flip higher bits and all future bytes - let firstBitIndex = [0..7] |> List.find (fun i -> currByte &&& (1uy <<< i) > 0uy) + let firstBitIndex = [|0;1;2;3;4;5;6;7|] |> Array.find (fun i -> currByte &&& (1uy <<< i) > 0uy) (currByte ^^^ (0b11111110uy <<< firstBitIndex)) &&& 255uy, true // Spec: @@ -148,7 +148,7 @@ let fromByteArray (bytes:byte array) = |> fun value -> if isPositive then value else bigint(-1) * value else let bytesToProcess = min bytesRemaining 4 - for i in 0 .. bytesToProcess - 1 do buffer.[i] <- bytes.[currIndex + i] // fill buffer with up to 4 bytes + for i = 0 to bytesToProcess - 1 do buffer.[i] <- bytes.[currIndex + i] // fill buffer with up to 4 bytes if isPositive then Array.fill buffer bytesToProcess (4 - bytesToProcess) 0uy // clear any unfilled bytes in buffer let value = @@ -170,19 +170,3 @@ let fromByteArray (bytes:byte array) = ||| (uint32 b3 <<< 24) loop (value :: accumUInt32) (currIndex + bytesToProcess) (bytesRemaining - bytesToProcess) lowBitFound loop [] 0 bytes.Length false - -let makeRangeStepFunction (step: bigint) (last: bigint) = - let stepComparedWithZero = compare step zero - if stepComparedWithZero = 0 then - failwith "The step of a range cannot be zero" - let stepGreaterThanZero = stepComparedWithZero > 0 - fun (x: bigint) -> - let comparedWithLast = compare x last - if (stepGreaterThanZero && comparedWithLast <= 0) - || (not stepGreaterThanZero && comparedWithLast >= 0) then - Some (x, x + step) - else None - -let range (first: bigint) (step: bigint) (last: bigint) = - let stepFn = makeRangeStepFunction step last - Seq.delay(fun () -> Seq.unfold stepFn first) diff --git a/src/fable-library/Decimal.ts b/src/fable-library/Decimal.ts index f62155c59..6f8b8d0ae 100644 --- a/src/fable-library/Decimal.ts +++ b/src/fable-library/Decimal.ts @@ -194,19 +194,19 @@ export function getBits(d: Decimal) { return [low, mid, high, signExp]; } -export function makeRangeStepFunction(step: Decimal, last: Decimal) { - const stepComparedWithZero = step.cmp(get_Zero); - if (stepComparedWithZero === 0) { - throw new Error("The step of a range cannot be zero"); - } - const stepGreaterThanZero = stepComparedWithZero > 0; - return (x: Decimal) => { - const comparedWithLast = x.cmp(last); - if ((stepGreaterThanZero && comparedWithLast <= 0) - || (!stepGreaterThanZero && comparedWithLast >= 0)) { - return [x, op_Addition(x, step)]; - } else { - return undefined; - } - }; -} +// export function makeRangeStepFunction(step: Decimal, last: Decimal) { +// const stepComparedWithZero = step.cmp(get_Zero); +// if (stepComparedWithZero === 0) { +// throw new Error("The step of a range cannot be zero"); +// } +// const stepGreaterThanZero = stepComparedWithZero > 0; +// return (x: Decimal) => { +// const comparedWithLast = x.cmp(last); +// if ((stepGreaterThanZero && comparedWithLast <= 0) +// || (!stepGreaterThanZero && comparedWithLast >= 0)) { +// return [x, op_Addition(x, step)]; +// } else { +// return undefined; +// } +// }; +// } diff --git a/src/fable-library/Event.ts b/src/fable-library/Event.ts index a0cee0557..5bad9f61b 100644 --- a/src/fable-library/Event.ts +++ b/src/fable-library/Event.ts @@ -1,7 +1,6 @@ import { IObservable, IObserver, Observer, protect } from "./Observable.js"; import { Option, some, value } from "./Option.js"; import { FSharpChoice$2, Choice_tryValueIfChoice1Of2, Choice_tryValueIfChoice2Of2 } from "./Choice.js"; -import { iterate as seqIterate } from "./Seq.js"; import { IDisposable } from "./Util.js"; export type Delegate = (x: T) => void; @@ -38,7 +37,7 @@ export class Event implements IEvent { } public Trigger(value: T) { - seqIterate((f) => f(value), this.delegates); + this.delegates.forEach((f) => f(value)); } // IDelegateEvent methods diff --git a/src/fable-library/Fable.Library.fsproj b/src/fable-library/Fable.Library.fsproj index da273c79e..8c638e193 100644 --- a/src/fable-library/Fable.Library.fsproj +++ b/src/fable-library/Fable.Library.fsproj @@ -24,6 +24,9 @@ + + + diff --git a/src/fable-library/List.fs b/src/fable-library/List.fs index a2d44cb3c..dcf0a8e18 100644 --- a/src/fable-library/List.fs +++ b/src/fable-library/List.fs @@ -1,304 +1,494 @@ -module List +module ListModule -// Disables warn:1204 raised by use of LanguagePrimitives.ErrorStrings.* -#nowarn "1204" - -open System.Collections.Generic open Fable.Core -[] -let private newList ([] args: obj list): 'a list = jsNative - -let empty<'a> : 'a list = newList [] -let singleton (x: 'a): 'a list = newList [x; empty] -let cons (x: 'a) (xs: 'a list): 'a list = newList [x; xs] - -let head = function - | x::_ -> x - | _ -> failwith "List was empty" - -let tryHead = function - | x::_ -> Some x - | _ -> None - -let tail = function - | _::xs -> xs - | _ -> failwith "List was empty" - -let rec last = function - | [] -> failwith "List was empty" - | [x] -> x - | _::xs -> last xs - -let rec tryLast = function - | [] -> None - | [x] -> Some x - | _::xs -> tryLast xs - -let compareWith (comparer: 'T -> 'T -> int) (xs: 'T list) (ys: 'T list): int = - if obj.ReferenceEquals(xs, ys) - then 0 +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 LinkedList<'T when 'T: comparison> = + { head: 'T; mutable tail: LinkedList<'T> option } + + static member inline Empty: 'T list = { head = Unchecked.defaultof<'T>; tail = None } + static member inline 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 inline xs.IsEmpty = xs.tail.IsNone + + member xs.Length = + let rec loop i xs = + 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.inputListWasEmpty + | Some _ -> xs.head + + member xs.Tail = + match xs.tail with + | None -> invalidArg "list" SR.inputListWasEmpty + | Some t -> t + + member xs.Item with get (index) = + let rec loop i xs = + 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 ys = + match xs.tail, ys.tail with + | None, None -> true + | None, Some _ -> false + | Some _, None -> false + | Some xt, Some yt -> + if 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 (hash xs.head)) t + loop 0 0 xs + + interface System.IComparable with + member xs.CompareTo(other: obj) = + let ys = other :?> 'T list + let rec loop xs ys = + match xs.tail, ys.tail with + | None, None -> 0 + | None, Some _ -> -1 + | Some _, None -> 1 + | Some xt, Some yt -> + let c = 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 when 'T: comparison>(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 when 'T: comparison = LinkedList<'T> +and List<'T> when 'T: comparison = LinkedList<'T> + +// [] +// [] +// module List = + +let inline 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 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) - -let toSeq (xs: 'a list): 'a seq = - Seq.map id xs - -let ofSeq (xs: 'a seq): 'a list = - Seq.fold (fun acc x -> x::acc) [] xs - |> reverse - -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 - -let fold2<'a, 'b, 'acc> f (state: 'acc) (xs: 'a list) (ys: 'b list) = - Seq.fold2 f state xs ys - -let foldBack2<'a, 'b, 'acc> f (xs: 'a list) (ys: 'b list) (state: 'acc) = - Seq.foldBack2 f xs ys state - -let unfold f state = - let rec unfoldInner acc state = - match f state with - | None -> reverse acc - | Some (x,state) -> unfoldInner (x::acc) state - unfoldInner [] state - -let rec foldIndexed3Aux f i acc bs cs ds = - match bs, cs, ds with - | [], [], [] -> acc - | x::xs, y::ys, z::zs -> foldIndexed3Aux f (i+1) (f i acc x y z) xs ys zs - | _ -> invalidOp "Lists had different lengths" + let t = xs.Tail + if t.IsEmpty then Some xs.Head + else tryLast t -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 scan<'a, 'acc> f (state: 'acc) (xs: 'a list) = - Seq.scan f state xs |> ofSeq - -let scanBack<'a, 'acc> f (xs: 'a list) (state: 'acc) = - Seq.scanBack f xs state |> ofSeq - -let length xs = - fold (fun acc _ -> acc + 1) 0 xs - -let append xs ys = - fold (fun acc x -> x::acc) ys (reverse xs) - -let 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 xs = - foldIndexed (fun i acc x -> f i x::acc) [] xs - |> reverse - -let indexed xs = - mapIndexed (fun i x -> (i,x)) xs - -let map2 f xs ys = - fold2 (fun acc x y -> f x y::acc) [] xs ys - |> reverse - -let mapIndexed2 f xs ys = - foldIndexed2 (fun i acc x y -> f i x y:: acc) [] xs ys - |> reverse - -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 - -let mapFold (f: 'S -> 'T -> 'R * 'S) s xs = - let foldFn (nxs, fs) x = - let nx, fs = f fs x - nx::nxs, fs - let nxs, s = fold foldFn ([], s) xs - reverse nxs, s - -let mapFoldBack (f: 'T -> 'S -> 'R * 'S) xs s = - mapFold (fun s v -> f v s) s (reverse xs) - -let iterate f xs = - fold (fun () x -> f x) () xs - -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 +let last (xs: 'T list) = + match tryLast xs with + | Some x -> x + | None -> failwith SR.inputListWasEmpty -let iterateIndexed2 f xs ys = - foldIndexed2 (fun i () x y -> f i x y) () xs ys +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 ofArrayWithTail (xs: IList<'T>) (tail: 'T list) = +// 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 (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 xs.Head + xs <- xs.Tail + acc + +let reverse (xs: 'T list) = + fold (fun acc x -> List.Cons(x, acc)) List.Empty xs + +let foldBack (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 (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 (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.Count - 1 downto 0 do - res <- xs.[i]::res + for i = xs.Length - 1 downto 0 do + res <- List.Cons(xs.[i], res) res -let ofArray (xs: IList<'T>) = - // Array.foldBack (fun x acc -> x::acc) xs [] - ofArrayWithTail xs [] +let ofArray (xs: 'T[]) = + ofArrayWithTail xs List.Empty -let isEmpty = function - | [] -> true - | _ -> false +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 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 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 tryPickIndexed f xs = - tryPickIndexedAux f 0 xs +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 = - tryPickIndexed (fun _ x -> f x) 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 - | None -> invalidOp "List did not contain any matching elements" | Some x -> x - -let tryFindIndexed f xs = - tryPickIndexed (fun i x -> if f i x then Some x else None) xs + | None -> indexNotFound() let tryFind f xs = - tryPickIndexed (fun _ x -> if f x then Some x else None) xs + tryPick (fun x -> if f 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" +let find f xs = + match tryFind f xs with | Some x -> x + | None -> indexNotFound() -let find f xs = - findIndexed (fun _ x -> f x) xs +let tryFindBack f xs = + xs |> toArray |> Array.tryFindBack f let findBack f xs = - xs |> reverse |> find f - -let tryFindBack f xs = - xs |> reverse |> tryFind f + match tryFindBack f xs with + | Some x -> x + | None -> indexNotFound() 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 + 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 - | None -> invalidOp "List did not contain any matching elements" | Some x -> x + | None -> indexNotFound() -let findIndexBack f xs: int = - List.toArray xs - |> Array.findIndexBack f - -let item n xs = - findIndexed (fun i _ -> n = i) xs - -let tryItem n xs = - tryFindIndexed (fun i _ -> n = i) xs - -let filter f xs = - fold (fun acc x -> - if f x then x::acc - else acc) [] xs |> reverse +let tryFindIndexBack f xs: int option = + xs |> toArray |> Array.tryFindIndexBack f -let partition f xs = - fold (fun (lacc, racc) x -> - if f x then x::lacc, racc - else lacc,x::racc) ([],[]) (reverse xs) +let findIndexBack f xs: int = + match tryFindIndexBack f xs with + | Some x -> x + | None -> indexNotFound() -let choose f xs = - fold (fun acc x -> +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 f (xs: 'T list) = + let root = List.Empty + let folder (acc: 'T list) 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 - else - let cached = HashSet(itemsToExclude, eq) - array |> filter cached.Add - -let initialize n f = - let mutable xs = [] - for i = 0 to n-1 do xs <- (f i)::xs - reverse xs + | 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 = function - | [] -> invalidOp "List was empty" - | h::t -> fold f h t +let reduce f (xs: 'T list) = + if xs.IsEmpty then invalidOp 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 xs.IsEmpty then invalidOp SR.inputListWasEmpty + else foldBack f (tail xs) (head xs) let forAll f xs = fold (fun acc x -> acc && f x) true xs @@ -306,21 +496,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: '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.listsHadDifferentLengths let unzip xs = - foldBack (fun (x, y) (lacc, racc) -> x::lacc, y::racc) 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) -> x::lacc, y::macc, z::racc) 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 @@ -328,201 +517,176 @@ 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 (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 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>) = + 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: 'T -> 'U) (xs: 'T list) ([] comparer: System.Collections.Generic.IComparer<'U>) = + 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>) = + 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: '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 -> 'T2) (xs: 'T list) ([] adder: IGenericAdder<'T2>): 'T2 = +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: 'a -> 'b) (xs: 'a list) ([] comparer: IComparer<'b>): 'a = +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 (li:'a list) ([] comparer: IComparer<'a>): 'a = - reduce (fun x y -> if comparer.Compare(y, x) > 0 then y else x) li +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: 'a -> 'b) (xs: 'a list) ([] comparer: IComparer<'b>): 'a = +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: 'a list) ([] comparer: IComparer<'a>): 'a = +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 total = fold (fun acc x -> averager.Add(acc, x)) (averager.GetZero()) xs - averager.DivideByInt(total, length xs) - -let averageBy (f: 'T -> 'T2) (xs: 'T list) ([] averager: IGenericAverager<'T2>): 'T2 = - let total = fold (fun acc x -> averager.Add(acc, f x)) (averager.GetZero()) xs - averager.DivideByInt(total, length xs) - -let permute f xs = - xs - |> List.toArray + let 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 = - xs - |> List.toArray + toArray xs |> Array.chunkBySize chunkSize + |> Array.map ofArray |> 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 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 = defaultArg startIndex 0 + let endIndex = defaultArg endIndex (len - 1) + if startIndex < 0 then invalidArg "startIndex" SR.indexOutOfBounds + elif endIndex >= len then invalidArg "endIndex" SR.indexOutOfBounds + elif 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 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 getSlice (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 [] +let exactlyOne (xs: 'T list) = + if xs.IsEmpty + then invalidArg "list" SR.inputSequenceEmpty 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) - xs |> filter (projection >> hashSet.Add) - -let distinct (xs: 'T list) ([] eq: IEqualityComparer<'T>) = - distinctBy id xs eq + if xs.Tail.IsEmpty then xs.Head + else invalidArg "list" SR.inputSequenceTooLong -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 = [] - xs |> iterate (fun v -> - let key = projection v - match dict.TryGetValue(key) with - | true, prev -> - dict.[key] <- v::prev - | false, _ -> - dict.Add(key, [v]) - keys <- key::keys ) - let mutable result = [] - keys |> iterate (fun key -> result <- (key, reverse dict.[key]) :: result) - result - -let countBy (projection: 'T -> 'Key) (xs: 'T list)([] eq: IEqualityComparer<'Key>) = - let dict = Dictionary<'Key, int>(eq) - let mutable keys = [] - xs |> iterate (fun v -> - let key = projection v - match dict.TryGetValue(key) with - | true, prev -> - dict.[key] <- prev + 1 - | false, _ -> - dict.[key] <- 1 - keys <- key::keys ) - let mutable result = [] - keys |> iterate (fun key -> result <- (key, dict.[key]) :: result) - result - -let where predicate source = - filter predicate source - -let pairwise source = - Seq.pairwise source - |> 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 <- (getSlice (Some(i-windowSize)) (Some(i-1)) source) :: res - res +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) (source: 'T list): 'T list list = - source - |> List.toArray +let splitInto (chunks: int) (xs: 'T list): 'T list list = + toArray xs |> Array.splitInto chunks + |> Array.map ofArray |> ofArray - |> map ofArray let transpose (lists: seq<'T list>): 'T list list = lists - |> Seq.transpose - |> Seq.map ofSeq - |> ofSeq + |> 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 diff --git a/src/fable-library/Long.ts b/src/fable-library/Long.ts index 731399f7c..2a99dc86f 100644 --- a/src/fable-library/Long.ts +++ b/src/fable-library/Long.ts @@ -127,19 +127,19 @@ export function ticksToUnixEpochMilliseconds(ticks: Long) { return LongLib.toNumber(op_Subtraction(op_Division(ticks, 10000), 62135596800000)); } -export function makeRangeStepFunction(step: Long, last: Long, unsigned: boolean) { - const stepComparedWithZero = LongLib.compare(step, unsigned ? LongLib.UZERO : LongLib.ZERO); - if (stepComparedWithZero === 0) { - throw new Error("The step of a range cannot be zero"); - } - const stepGreaterThanZero = stepComparedWithZero > 0; - return (x: Long) => { - const comparedWithLast = LongLib.compare(x, last); - if ((stepGreaterThanZero && comparedWithLast <= 0) - || (!stepGreaterThanZero && comparedWithLast >= 0)) { - return [x, op_Addition(x, step)]; - } else { - return undefined; - } - }; -} +// export function makeRangeStepFunction(step: Long, last: Long, unsigned: boolean) { +// const stepComparedWithZero = LongLib.compare(step, unsigned ? LongLib.UZERO : LongLib.ZERO); +// if (stepComparedWithZero === 0) { +// throw new Error("The step of a range cannot be zero"); +// } +// const stepGreaterThanZero = stepComparedWithZero > 0; +// return (x: Long) => { +// const comparedWithLast = LongLib.compare(x, last); +// if ((stepGreaterThanZero && comparedWithLast <= 0) +// || (!stepGreaterThanZero && comparedWithLast >= 0)) { +// return [x, op_Addition(x, step)]; +// } else { +// return undefined; +// } +// }; +// } diff --git a/src/fable-library/Map.fs b/src/fable-library/Map.fs index 80f8d6e16..892f83ce1 100644 --- a/src/fable-library/Map.fs +++ b/src/fable-library/Map.fs @@ -408,8 +408,15 @@ module MapTree = | _ -> (m2.Key, m2.Value) :: acc loop m [] - let toArray (m: MapTree<'Key, 'Value>): ('Key * 'Value)[] = - m |> toList |> Array.ofList + let copyToArray m (arr: _[]) i = + let mutable j = i + iter (fun x y -> arr.[j] <- KeyValuePair(x, y); j <- j + 1) m + + let toArray m = + let n = size m + let res = Array.zeroCreate n + copyToArray m res 0 + res let ofList comparer l = List.fold (fun acc (k, v) -> add comparer k v acc) empty l @@ -426,18 +433,14 @@ module MapTree = res <- add comparer x y res res - let ofSeq comparer (c: seq<'Key * 'T>) = + let ofSeq comparer (c: seq<'Key * 'Value>) = match c with - | :? array<'Key * 'T> as xs -> ofArray comparer xs - | :? list<'Key * 'T> as xs -> ofList comparer xs + | :? array<'Key * 'Value> as xs -> ofArray comparer xs + | :? list<'Key * 'Value> as xs -> ofList comparer xs | _ -> use ie = c.GetEnumerator() mkFromEnumerator comparer empty ie - let copyToArray m (arr: _[]) i = - let mutable j = i - m |> iter (fun x y -> arr.[j] <- KeyValuePair(x, y); j <- j + 1) - /// Imperative left-to-right iterators. [] type MapIterator<'Key, 'Value when 'Key : comparison > = @@ -859,8 +862,8 @@ let ofSeq elements = // [] let ofArray (elements: ('Key * 'Value) array) = - let comparer = LanguagePrimitives.FastGenericComparer<'Key> - new Map<_, _>(comparer, MapTree.ofArray comparer elements) + let comparer = LanguagePrimitives.FastGenericComparer<'Key> + new Map<_, _>(comparer, MapTree.ofArray comparer elements) // [] let toList (table: Map<_, _>) = @@ -874,34 +877,6 @@ let toArray (table: Map<_, _>) = let empty<'Key, 'Value when 'Key : comparison> = Map<'Key, 'Value>.Empty -let createMutable (source: KeyValuePair<'Key, 'Value> seq) ([] comparer: IEqualityComparer<'Key>) = - let map = Fable.Collections.MutableMap(source, comparer) - map :> Fable.Core.JS.Map<_,_> - -let groupBy (projection: 'T -> 'Key) (xs: 'T seq) ([] comparer: IEqualityComparer<'Key>): ('Key * 'T seq) seq = - let dict: Fable.Core.JS.Map<_,ResizeArray<'T>> = createMutable Seq.empty comparer - - // Build the groupings - for v in xs do - let key = projection v - if dict.has(key) then dict.get(key).Add(v) - else dict.set(key, ResizeArray [v]) |> ignore - - // Mapping shouldn't be necessary because KeyValuePair compiles - // as a tuple, but let's do it just in case the implementation changes - dict.entries() |> Seq.map (fun (k,v) -> k, upcast v) - -let countBy (projection: 'T -> 'Key) (xs: 'T seq) ([] comparer: IEqualityComparer<'Key>): ('Key * int) seq = - let dict = createMutable Seq.empty comparer - - for value in xs do - let key = projection value - if dict.has(key) then dict.set(key, dict.get(key) + 1) - else dict.set(key, 1) - |> ignore - - dict.entries() - // [] let count (table: Map<_, _>) = table.Count \ No newline at end of file diff --git a/src/fable-library/MutableMap.fs b/src/fable-library/MutableMap.fs index b4755c658..c6b3c8264 100644 --- a/src/fable-library/MutableMap.fs +++ b/src/fable-library/MutableMap.fs @@ -37,7 +37,10 @@ type MutableMap<'Key, 'Value when 'Key: equality>(pairs: KeyValuePair<'Key, 'Val hashMap.Clear() member this.Count = - hashMap.Values |> Seq.sumBy (fun pairs -> pairs.Count) + let mutable count = 0 + for pairs in hashMap.Values do + count <- count + pairs.Count + count member this.Item with get (k: 'Key) = diff --git a/src/fable-library/MutableSet.fs b/src/fable-library/MutableSet.fs index 8aa8d5f0f..ce73b08aa 100644 --- a/src/fable-library/MutableSet.fs +++ b/src/fable-library/MutableSet.fs @@ -37,7 +37,10 @@ type MutableSet<'T when 'T: equality>(items: 'T seq, comparer: IEqualityComparer hashMap.Clear() member this.Count = - hashMap.Values |> Seq.sumBy (fun pairs -> pairs.Count) + let mutable count = 0 + for items in hashMap.Values do + count <- count + items.Count + count member this.Add(k) = match this.TryFindIndex(k) with diff --git a/src/fable-library/Numeric.ts b/src/fable-library/Numeric.ts index 636b691e5..824e4c272 100644 --- a/src/fable-library/Numeric.ts +++ b/src/fable-library/Numeric.ts @@ -50,7 +50,6 @@ export function toPrecision(x: Numeric, sd?: number) { } } - export function toExponential(x: Numeric, dp?: number) { if (typeof x === "number") { return x.toExponential(dp); diff --git a/src/fable-library/Range.fs b/src/fable-library/Range.fs new file mode 100644 index 000000000..5d5130573 --- /dev/null +++ b/src/fable-library/Range.fs @@ -0,0 +1,28 @@ +module FSharp.Core.OperatorIntrinsics + +let makeRangeStepFunction<'T when 'T: comparison> (step: 'T) (stop: 'T) (zero: 'T) (add:'T -> 'T -> 'T) = + let stepComparedWithZero = compare step zero + if stepComparedWithZero = 0 then + failwith "The step of a range cannot be zero" + let stepGreaterThanZero = stepComparedWithZero > 0 + fun x -> + let comparedWithLast = compare x stop + if (stepGreaterThanZero && comparedWithLast <= 0) + || (not stepGreaterThanZero && comparedWithLast >= 0) then + Some (x, add x step) + else None + +let integralRangeStep<'T when 'T: comparison> (start: 'T) (step: 'T) (stop: 'T) (zero:'T) (add: 'T -> 'T -> 'T) = + let stepFn = makeRangeStepFunction step stop zero add + Seq.delay(fun () -> Seq.unfold stepFn start) + +let rangeBigInt start step stop = integralRangeStep start step stop 0I (+) +let rangeDecimal start step stop = integralRangeStep start step stop 0m (+) +let rangeDouble start step stop = integralRangeStep start step stop 0.0 (+) +let rangeInt64 start step stop = integralRangeStep start step stop 0L (+) +let rangeUInt64 start step stop = integralRangeStep start step stop 0UL (+) + +let rangeChar (start: char) (stop: char) = + let intStop = int stop + let stepFn c = if c <= intStop then Some (char c, c + 1) else None + Seq.delay(fun () -> Seq.unfold stepFn (int start)) diff --git a/src/fable-library/Seq.fs b/src/fable-library/Seq.fs new file mode 100644 index 000000000..5151a7e66 --- /dev/null +++ b/src/fable-library/Seq.fs @@ -0,0 +1,846 @@ +// Adapted from: +// https://github.com/fsprojects/FSharpx.Extras/blob/master/src/FSharpx.Extras/ComputationExpressions/Enumerator.fs +// https://github.com/dotnet/fsharp/blob/main/src/fsharp/FSharp.Core/seq.fs +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module SeqModule + +open Fable.Core + +type IEnumerator<'T> = System.Collections.Generic.IEnumerator<'T> +type IEnumerable<'T> = System.Collections.Generic.IEnumerable<'T> + +module SR = + let enumerationAlreadyFinished = "Enumeration already finished." + let enumerationNotStarted = "Enumeration has not started. Call MoveNext." + 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 notEnoughElements = "The input sequence has an insufficient number of elements." + let resetNotSupported = "Reset is not supported on this enumerator." + +module Enumerator = + + let noReset() = raise (new System.NotSupportedException(SR.resetNotSupported)) + let notStarted() = raise (new System.InvalidOperationException(SR.enumerationNotStarted)) + let alreadyFinished() = raise (new System.InvalidOperationException(SR.enumerationAlreadyFinished)) + + [] + [] + type Enumerable<'T>(f) = + interface IEnumerable<'T> with + member x.GetEnumerator() = f() + interface System.Collections.IEnumerable with + member x.GetEnumerator() = f() :> System.Collections.IEnumerator + override xs.ToString() = + let maxCount = 4 + let mutable i = 0 + let mutable str = "seq [" + use e = (xs :> IEnumerable<'T>).GetEnumerator() + while (i < maxCount && e.MoveNext()) do + if i > 0 then str <- str + "; " + str <- str + (string e.Current) + i <- i + 1 + if i = maxCount then + str <- str + "; ..." + str + "]" + + type FromFunctions<'T>(current, next, dispose) = + interface IEnumerator<'T> with + member __.Current = current() + interface System.Collections.IEnumerator with + member __.Current = box (current()) + member __.MoveNext() = next() + member __.Reset() = noReset() + interface System.IDisposable with + member __.Dispose() = dispose() + + let inline fromFunctions current next dispose: IEnumerator<'T> = + new FromFunctions<_>(current, next, dispose) :> IEnumerator<'T> + + // // implementation for languages where arrays are not IEnumerable + // + // let empty<'T>(): IEnumerator<'T> = + // let mutable started = false + // let current() = if not started then notStarted() else alreadyFinished() + // let next() = started <- true; false + // let dispose() = () + // fromFunctions current next dispose + // + // let singleton (x: 'T): IEnumerator<'T> = + // let mutable index = -1 + // let current() = + // if index < 0 then notStarted() + // if index > 0 then alreadyFinished() + // x + // let next() = index <- index + 1; index = 0 + // let dispose() = () + // fromFunctions current next dispose + // + // let ofArray (arr: 'T[]): IEnumerator<'T> = + // let len = arr.Length + // let mutable i = -1 + // let current() = + // if i < 0 then notStarted() + // elif i >= len then alreadyFinished() + // else arr.[i] + // let next() = + // if i < len then + // i <- i + 1 + // i < len + // else false + // let dispose() = () + // fromFunctions current next dispose + + let cast (e: System.Collections.IEnumerator): IEnumerator<'T> = + let current() = unbox<'T> e.Current + let next() = e.MoveNext() + let dispose() = + match e with + | :? System.IDisposable as e -> e.Dispose() + | _ -> () + fromFunctions current next dispose + + let concat<'T,'U when 'U :> seq<'T>> (sources: seq<'U>) = + let mutable outerOpt: IEnumerator<'U> option = None + let mutable innerOpt: IEnumerator<'T> option = None + let mutable started = false + let mutable finished = false + let mutable curr = None + let current() = + if not started then notStarted() + elif finished then alreadyFinished() + match curr with + | None -> alreadyFinished() + | Some x -> x + let finish() = + finished <- true + match innerOpt with + | None -> () + | Some inner -> + try inner.Dispose() + finally innerOpt <- None + match outerOpt with + | None -> () + | Some outer -> + try outer.Dispose() + finally outerOpt <- None + let loop () = + let mutable res = None + while Option.isNone res do + match outerOpt, innerOpt with + | None, _ -> + outerOpt <- Some (sources.GetEnumerator()) + | Some outer, None -> + if outer.MoveNext() then + let ie = outer.Current + innerOpt <- Some (ie.GetEnumerator()) + else + finish() + res <- Some false + | Some _, Some inner -> + if inner.MoveNext() then + curr <- Some (inner.Current) + res <- Some true + else + try inner.Dispose() + finally innerOpt <- None + res.Value + let next() = + if not started then started <- true + if finished then false + else loop () + let dispose() = if not finished then finish() + fromFunctions current next dispose + + let enumerateThenFinally f (e: IEnumerator<'T>): IEnumerator<'T> = + let current() = e.Current + let next() = e.MoveNext() + let dispose() = try e.Dispose() finally f() + fromFunctions current next dispose + + let generateWhileSome (openf: unit -> 'T) (compute: 'T -> 'U option) (closef: 'T -> unit): IEnumerator<'U> = + let mutable started = false + let mutable curr = None + let mutable state = Some (openf()) + let current() = + if not started then notStarted() + match curr with + | None -> alreadyFinished() + | Some x -> x + let dispose() = + match state with + | None -> () + | Some x -> + try closef x + finally state <- None + let finish() = + try dispose() + finally curr <- None + let next() = + if not started then started <- true + match state with + | None -> false + | Some s -> + match (try compute s with _ -> finish(); reraise()) with + | None -> finish(); false + | Some _ as x -> curr <- x; true + fromFunctions current next dispose + + let unfold (f: 'State -> ('T * 'State) option) (state: 'State): IEnumerator<'T> = + let mutable curr: ('T * 'State) option = None + let mutable acc: 'State = state + let current() = + match curr with + | None -> notStarted() + | Some (x, st) -> x + let next() = + curr <- f acc + match curr with + | None -> false + | Some (x, st) -> + acc <- st + true + let dispose() = () + fromFunctions current next dispose + +// [] +// [] +// module Seq = + +let indexNotFound() = raise (new System.Collections.Generic.KeyNotFoundException(SR.keyNotFoundAlt)) + +let checkNonNull argName arg = if isNull arg then nullArg argName + +let mkSeq (f: unit -> IEnumerator<'T>): seq<'T> = + Enumerator.Enumerable(f) :> IEnumerable<'T> + +let ofSeq (xs: seq<'T>): IEnumerator<'T> = + checkNonNull "source" xs + xs.GetEnumerator() + +let delay (generator: unit -> seq<'T>) = + mkSeq (fun () -> generator().GetEnumerator()) + +let concat (sources: seq<#seq<'T>>) = + mkSeq (fun () -> Enumerator.concat sources) + +let unfold (generator: 'State -> ('T * 'State) option) (state: 'State) = + mkSeq (fun () -> Enumerator.unfold generator state) + +let empty () = + delay (fun () -> Array.empty :> seq<'T>) + +let singleton x = + delay (fun () -> (Array.singleton x) :> seq<'T>) + +let ofArray (arr: 'T[]) = + arr :> seq<'T> + +let toArray (xs: seq<'T>): 'T[] = + match xs with + | :? array<'T> as a -> a + | :? list<'T> as a -> Array.ofList a + | _ -> Array.ofSeq xs + +let ofList (xs: 'T list) = + (xs :> seq<'T>) + +let toList (xs: seq<'T>): 'T list = + match xs with + | :? array<'T> as a -> List.ofArray a + | :? list<'T> as a -> a + | _ -> List.ofSeq xs + +let generate create compute dispose = + mkSeq (fun () -> Enumerator.generateWhileSome create compute dispose) + +let generateIndexed create compute dispose = + mkSeq (fun () -> + let mutable i = -1 + Enumerator.generateWhileSome create (fun x -> i <- i + 1; compute i x) dispose + ) + +// let inline generateUsing (openf: unit -> ('U :> System.IDisposable)) compute = +// generate openf compute (fun (s: 'U) -> s.Dispose()) + +let append (xs: seq<'T>) (ys: seq<'T>) = + concat [| xs; ys |] + +let cast (xs: System.Collections.IEnumerable) = + mkSeq (fun () -> + checkNonNull "source" xs + xs.GetEnumerator() + |> Enumerator.cast + ) + +let choose (chooser: 'T -> 'U option) (xs: seq<'T>) = + generate + (fun () -> ofSeq xs) + (fun e -> + let mutable curr = None + while (Option.isNone curr && e.MoveNext()) do + curr <- chooser e.Current + curr) + (fun e -> e.Dispose()) + +let compareWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) (ys: seq<'T>): int = + use e1 = ofSeq xs + use e2 = ofSeq ys + let mutable c = 0 + let mutable b1 = e1.MoveNext() + let mutable b2 = e2.MoveNext() + while c = 0 && b1 && b2 do + c <- comparer e1.Current e2.Current + if c = 0 then + b1 <- e1.MoveNext() + b2 <- e2.MoveNext() + if c <> 0 then c + elif b1 then 1 + elif b2 then -1 + else 0 + +let contains (value: 'T) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = + use e = ofSeq xs + let mutable found = false + while (not found && e.MoveNext()) do + found <- comparer.Equals(value, e.Current) + found + +let enumerateFromFunctions create moveNext current = + generate + create + (fun x -> if moveNext x then Some(current x) else None) + (fun x -> match box(x) with :? System.IDisposable as id -> id.Dispose() | _ -> ()) + +let inline finallyEnumerable<'T> (compensation: unit -> unit, restf: unit -> seq<'T>) = + mkSeq (fun () -> + try + let e = restf() |> ofSeq + Enumerator.enumerateThenFinally compensation e + with _ -> + compensation() + reraise() + ) + +let enumerateThenFinally (source: seq<'T>) (compensation: unit -> unit) = + finallyEnumerable(compensation, (fun () -> source)) + +let enumerateUsing (resource: 'T :> System.IDisposable) (source: 'T -> #seq<'U>) = + finallyEnumerable( + (fun () -> match box resource with null -> () | _ -> resource.Dispose()), + (fun () -> source resource :> seq<_>)) + +let enumerateWhile (guard: unit -> bool) (xs: seq<'T>) = + concat (unfold (fun i -> if guard() then Some(xs, i + 1) else None) 0) + +let filter f (xs: seq<'T>) = + xs |> choose (fun x -> if f x then Some x else None) + +let exists predicate (xs: seq<'T>) = + use e = ofSeq xs + let mutable found = false + while (not found && e.MoveNext()) do + found <- predicate e.Current + found + +let exists2 (predicate: 'T1 -> 'T2 -> bool) (xs: seq<'T1>) (ys: seq<'T2>) = + use e1 = ofSeq xs + use e2 = ofSeq ys + let mutable found = false + while (not found && e1.MoveNext() && e2.MoveNext()) do + found <- predicate e1.Current e2.Current + found + +let exactlyOne (xs: seq<'T>) = + use e = ofSeq xs + if e.MoveNext() then + let v = e.Current + if e.MoveNext() + then invalidArg "source" SR.inputSequenceTooLong + else v + else + invalidArg "source" SR.inputSequenceEmpty + +let tryExactlyOne (xs: seq<'T>) = + use e = ofSeq xs + if e.MoveNext() then + let v = e.Current + if e.MoveNext() + then None + else Some v + else + None + +let tryFind predicate (xs: seq<'T>) = + use e = ofSeq xs + let mutable res = None + while (Option.isNone res && e.MoveNext()) do + let c = e.Current + if predicate c then res <- Some c + res + +let find predicate (xs: seq<'T>) = + match tryFind predicate xs with + | Some x -> x + | None -> indexNotFound() + +let tryFindBack predicate (xs: seq<'T>) = + xs + |> toArray + |> Array.tryFindBack predicate + +let findBack predicate (xs: seq<'T>) = + match tryFindBack predicate xs with + | Some x -> x + | None -> indexNotFound() + +let tryFindIndex predicate (xs: seq<'T>) = + use e = ofSeq xs + let rec loop i = + if e.MoveNext() then + if predicate e.Current then Some i + else loop (i + 1) + else + None + loop 0 + +let findIndex predicate (xs: seq<'T>) = + match tryFindIndex predicate xs with + | Some x -> x + | None -> indexNotFound() + +let tryFindIndexBack predicate (xs: seq<'T>) = + xs + |> toArray + |> Array.tryFindIndexBack predicate + +let findIndexBack predicate (xs: seq<'T>) = + match tryFindIndexBack predicate xs with + | Some x -> x + | None -> indexNotFound() + +let fold (folder: 'State -> 'T -> 'State) (state: 'State) (xs: seq<'T>) = + use e = ofSeq xs + let mutable acc = state + while e.MoveNext() do + acc <- folder acc e.Current + acc + +let foldBack folder (xs: seq<'T>) state = + Array.foldBack folder (toArray xs) state + +let fold2 (folder: 'State -> 'T1 -> 'T2 -> 'State) (state: 'State) (xs: seq<'T1>) (ys: seq<'T2>) = + use e1 = ofSeq xs + use e2 = ofSeq ys + let mutable acc = state + while e1.MoveNext() && e2.MoveNext() do + acc <- folder acc e1.Current e2.Current + acc + +let foldBack2 (folder: 'T1 -> 'T2 -> 'State -> 'State) (xs: seq<'T1>) (ys: seq<'T2>) (state: 'State) = + Array.foldBack2 folder (toArray xs) (toArray ys) state + +let forAll predicate xs = + not (exists (fun x -> not (predicate x)) xs) + +let forAll2 predicate xs ys = + not (exists2 (fun x y -> not (predicate x y)) xs ys) + +let tryHead (xs: seq<'T>) = + match xs with + | :? array<'T> as a -> Array.tryHead a + | :? list<'T> as a -> List.tryHead a + | _ -> + use e = ofSeq xs + if e.MoveNext() + then Some (e.Current) + else None + +let head (xs: seq<'T>) = + match tryHead xs with + | Some x -> x + | None -> invalidArg "source" SR.inputSequenceEmpty + +let initialize count f = + unfold (fun i -> if (i < count) then Some(f i, i + 1) else None) 0 + +let initializeInfinite f = + initialize (System.Int32.MaxValue) f + +let isEmpty (xs: seq<'T>) = + match xs with + | :? array<'T> as a -> Array.isEmpty a + | :? list<'T> as a -> List.isEmpty a + | _ -> + use e = ofSeq xs + not (e.MoveNext()) + +let tryItem index (xs: seq<'T>) = + match xs with + | :? array<'T> as a -> Array.tryItem index a + | :? list<'T> as a -> List.tryItem index a + | _ -> + use e = ofSeq xs + let rec loop index = + if not (e.MoveNext()) then None + elif index = 0 then Some e.Current + else loop (index - 1) + loop index + +let item index (xs: seq<'T>) = + match tryItem index xs with + | Some x -> x + | None -> invalidArg "index" SR.notEnoughElements + +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 tryLast (xs: seq<'T>) = + // if isEmpty xs then None + // else Some (reduce (fun _ x -> x) xs) + use e = ofSeq xs + let rec loop acc = + if not (e.MoveNext()) then acc + else loop e.Current + if e.MoveNext() + then Some (loop e.Current) + else None + +let last (xs: seq<'T>) = + match tryLast xs with + | Some x -> x + | None -> invalidArg "source" SR.notEnoughElements + +let length (xs: seq<'T>) = + match xs with + | :? array<'T> as a -> Array.length a + | :? list<'T> as a -> List.length a + | _ -> + use e = ofSeq xs + let mutable count = 0 + while e.MoveNext() do + count <- count + 1 + count + +let map (mapping: 'T -> 'U) (xs: seq<'T>) = + generate + (fun () -> ofSeq xs) + (fun e -> if e.MoveNext() then Some (mapping e.Current) else None) + (fun e -> e.Dispose()) + +let mapIndexed (mapping: int -> 'T -> 'U) (xs: seq<'T>) = + generateIndexed + (fun () -> ofSeq xs) + (fun i e -> if e.MoveNext() then Some (mapping i e.Current) else None) + (fun e -> e.Dispose()) + +let indexed (xs: seq<'T>) = + xs |> mapIndexed (fun i x -> (i, x)) + +let map2 (mapping: 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) = + generate + (fun () -> (ofSeq xs, ofSeq ys)) + (fun (e1, e2) -> + if e1.MoveNext() && e2.MoveNext() + then Some (mapping e1.Current e2.Current) + else None) + (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + +let mapIndexed2 (mapping: int -> 'T1 -> 'T2 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) = + generateIndexed + (fun () -> (ofSeq xs, ofSeq ys)) + (fun i (e1, e2) -> + if e1.MoveNext() && e2.MoveNext() + then Some (mapping i e1.Current e2.Current) + else None) + (fun (e1, e2) -> try e1.Dispose() finally e2.Dispose()) + +let map3 (mapping: 'T1 -> 'T2 -> 'T3 -> 'U) (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>) = + generate + (fun () -> (ofSeq xs, ofSeq ys, ofSeq zs)) + (fun (e1, e2, e3) -> + if e1.MoveNext() && e2.MoveNext() && e3.MoveNext() + then Some (mapping e1.Current e2.Current e3.Current) + else None) + (fun (e1, e2, e3) -> try e1.Dispose() finally try e2.Dispose() finally e3.Dispose()) + +let readOnly (xs: seq<'T>) = + checkNonNull "source" xs + map id xs + +let cache (xs: seq<'T>) = + let mutable cached = false + let xsCache = ResizeArray() + delay (fun () -> + if not cached then + cached <- true + xs |> map (fun x -> xsCache.Add(x); x) + else + xsCache :> seq<'T> + ) + +let allPairs (xs: seq<'T1>) (ys: seq<'T2>): seq<'T1 * 'T2> = + let ysCache = cache ys + delay (fun () -> + let mapping x = ysCache |> map (fun y -> (x, y)) + concat (map mapping xs) + ) + +let mapFold (mapping: 'State -> 'T -> 'Result * 'State) state (xs: seq<'T>) = + let arr, state = Array.mapFold mapping state (toArray xs) + readOnly arr, state + +let mapFoldBack (mapping: 'T -> 'State -> 'Result * 'State) (xs: seq<'T>) state = + let arr, state = Array.mapFoldBack mapping (toArray xs) state + readOnly arr, state + +let tryPick chooser (xs: seq<'T>) = + use e = ofSeq xs + let mutable res = None + while (Option.isNone res && e.MoveNext()) do + res <- chooser e.Current + res + +let pick chooser (xs: seq<'T>) = + match tryPick chooser xs with + | Some x -> x + | None -> indexNotFound() + +let reduce folder (xs: seq<'T>) = + use e = ofSeq xs + let rec loop acc = + if e.MoveNext() + then loop (folder acc e.Current) + else acc + if e.MoveNext() + then loop e.Current + else invalidOp SR.inputSequenceEmpty + +let reduceBack folder (xs: seq<'T>) = + let arr = toArray xs + if arr.Length > 0 + then Array.reduceBack folder arr + else invalidOp SR.inputSequenceEmpty + +let replicate n x = + initialize n (fun _ -> x) + +let reverse (xs: seq<'T>) = + delay (fun () -> + xs + |> toArray + |> Array.rev + |> ofArray + ) + +let scan folder (state: 'State) (xs: seq<'T>) = + delay (fun () -> + let first = singleton state + let mutable acc = state + let rest = xs |> map (fun x -> acc <- folder acc x; acc) + [| first; rest |] |> concat + ) + +let scanBack folder (xs: seq<'T>) (state: 'State) = + delay (fun () -> + let arr = toArray xs + Array.scanBack folder arr state + |> ofArray + ) + +let skip count (xs: seq<'T>) = + mkSeq (fun () -> + let e = ofSeq xs + try + for i = 1 to count do + if not (e.MoveNext()) then + invalidArg "source" SR.notEnoughElements + let compensation () = () + Enumerator.enumerateThenFinally compensation e + with _ -> + e.Dispose() + reraise() + ) + +let skipWhile predicate (xs: seq<'T>) = + delay (fun () -> + let mutable skipped = true + xs |> filter (fun x -> + if skipped then + skipped <- predicate x + not skipped + ) + ) + +let tail (xs: seq<'T>) = + skip 1 xs + +let take count (xs: seq<'T>) = + generateIndexed + (fun () -> ofSeq xs) + (fun i e -> + if i < count then + if e.MoveNext() + then Some (e.Current) + else invalidArg "source" SR.notEnoughElements + else None) + (fun e -> e.Dispose()) + +let takeWhile predicate (xs: seq<'T>) = + generate + (fun () -> ofSeq xs) + (fun e -> + if e.MoveNext() && predicate e.Current + then Some (e.Current) + else None) + (fun e -> e.Dispose()) + +let truncate count (xs: seq<'T>) = + generateIndexed + (fun () -> ofSeq xs) + (fun i e -> + if i < count && e.MoveNext() + then Some (e.Current) + else None) + (fun e -> e.Dispose()) + +let zip (xs: seq<'T1>) (ys: seq<'T2>) = + map2 (fun x y -> (x, y)) xs ys + +let zip3 (xs: seq<'T1>) (ys: seq<'T2>) (zs: seq<'T3>) = + map3 (fun x y z -> (x, y, z)) xs ys zs + +let collect (mapping: 'T -> 'U seq) (xs: seq<'T>) = + delay (fun () -> + xs + |> map mapping + |> concat + ) + +let where predicate (xs: seq<'T>) = + filter predicate xs + +let pairwise (xs: seq<'T>) = + delay (fun () -> + xs + |> toArray + |> Array.pairwise + |> ofArray + ) + +let splitInto (chunks: int) (xs: seq<'T>): 'T seq seq = + delay (fun () -> + xs + |> toArray + |> Array.splitInto chunks + |> Array.map ofArray + |> ofArray + ) + +let windowed windowSize (xs: seq<'T>): 'T seq seq = + delay (fun () -> + xs + |> toArray + |> Array.windowed windowSize + |> Array.map ofArray + |> ofArray + ) + +let transpose (xss: seq<#seq<'T>>) = + delay (fun () -> + xss + |> toArray + |> Array.map toArray + |> Array.transpose + |> Array.map ofArray + |> ofArray + ) + +let sortWith (comparer: 'T -> 'T -> int) (xs: seq<'T>) = + delay (fun () -> + let arr = toArray xs + Array.sortInPlaceWith comparer arr // Note: In JS this sort is stable + arr |> ofArray + ) + +let sort (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'T>) = + sortWith (fun x y -> comparer.Compare(x, y)) xs + +let sortBy (projection: 'T -> 'U) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'U>) = + sortWith (fun x y -> comparer.Compare(projection x, projection y)) xs + +let sortDescending (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'T>) = + sortWith (fun x y -> comparer.Compare(x, y) * -1) xs + +let sortByDescending (projection: 'T -> 'U) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IComparer<'U>) = + sortWith (fun x y -> comparer.Compare(projection x, projection y) * -1) xs + +let sum (xs: seq<'T>) ([] adder: IGenericAdder<'T>): 'T = + fold (fun acc x -> adder.Add(acc, x)) (adder.GetZero()) xs + +let sumBy (f: 'T -> 'U) (xs: seq<'T>) ([] 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: seq<'T>) ([] 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: seq<'T>) ([] 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: seq<'T>) ([] 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: seq<'T>) = + delay (fun () -> + xs + |> toArray + |> Array.permute f + |> ofArray + ) + +let chunkBySize (chunkSize: int) (xs: seq<'T>): seq> = + delay (fun () -> + xs + |> toArray + |> Array.chunkBySize chunkSize + |> Array.map ofArray + |> ofArray + ) + +// let init = initialize +// let initInfinite = initializeInfinite +// 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 readonly = readOnly +// let rev = reverse diff --git a/src/fable-library/Seq2.fs b/src/fable-library/Seq2.fs new file mode 100644 index 000000000..d86ceffca --- /dev/null +++ b/src/fable-library/Seq2.fs @@ -0,0 +1,90 @@ +// split from Seq to remove circular dependencies +module SeqModule2 + +open Fable.Core + +let distinct (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = + Seq.delay (fun () -> + let hashSet = System.Collections.Generic.HashSet<'T>(comparer) + xs |> Seq.filter (fun x -> hashSet.Add(x)) + ) + +let distinctBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>) = + Seq.delay (fun () -> + let hashSet = System.Collections.Generic.HashSet<'Key>(comparer) + xs |> Seq.filter (fun x -> hashSet.Add(projection x)) + ) + +let except (itemsToExclude: seq<'T>) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>) = + Seq.delay (fun () -> + let hashSet = System.Collections.Generic.HashSet<'T>(itemsToExclude, comparer) + xs |> Seq.filter (fun x -> hashSet.Add(x)) + ) + +let countBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int) seq = + Seq.delay (fun () -> + let dict = System.Collections.Generic.Dictionary<'Key, int>(comparer) + let keys = ResizeArray<'Key>() + for x in xs do + let key = projection x + match dict.TryGetValue(key) with + | true, prev -> + dict.[key] <- prev + 1 + | false, _ -> + dict.[key] <- 1 + keys.Add(key) + Seq.map (fun key -> key, dict.[key]) keys + ) + +let groupBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * seq<'T>) seq = + Seq.delay (fun () -> + let dict = System.Collections.Generic.Dictionary<'Key, ResizeArray<'T>>(comparer) + let keys = ResizeArray<'Key>() + for x in xs do + let key = projection x + match dict.TryGetValue(key) with + | true, prev -> + prev.Add(x) + | false, _ -> + dict.Add(key, ResizeArray [|x|]) + keys.Add(key) + Seq.map (fun key -> key, dict.[key] :> seq<'T>) keys + ) + +module Array = + + let distinct (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T[] = + distinct xs comparer |> Seq.toArray + + let distinctBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): 'T[] = + distinctBy projection xs comparer |> Seq.toArray + + let except (itemsToExclude: seq<'T>) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T[] = + except itemsToExclude xs comparer |> Seq.toArray + + let countBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int)[] = + countBy projection xs comparer |> Seq.toArray + + let groupBy (projection: 'T -> 'Key) (xs: 'T[]) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T[])[] = + groupBy projection xs comparer + |> Seq.map (fun (key, values) -> key, Seq.toArray values) + |> Seq.toArray + +module List = + + let distinct (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T list = + distinct xs comparer |> Seq.toList + + let distinctBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): 'T list = + distinctBy projection xs comparer |> Seq.toList + + let except (itemsToExclude: seq<'T>) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'T>): 'T list = + except itemsToExclude xs comparer |> Seq.toList + + let countBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * int) list = + countBy projection xs comparer |> Seq.toList + + let groupBy (projection: 'T -> 'Key) (xs: 'T list) ([] comparer: System.Collections.Generic.IEqualityComparer<'Key>): ('Key * 'T list) list = + groupBy projection xs comparer + |> Seq.map (fun (key, values) -> key, Seq.toList values) + |> Seq.toList diff --git a/src/fable-library/Seq.ts b/src/fable-library/Seq_old.ts similarity index 95% rename from src/fable-library/Seq.ts rename to src/fable-library/Seq_old.ts index 19c36f908..aa5fe83af 100644 --- a/src/fable-library/Seq.ts +++ b/src/fable-library/Seq_old.ts @@ -1,5 +1,5 @@ -import Decimal, { makeRangeStepFunction as makeDecimalRangeStepFunction } from "./Decimal.js"; -import Long, { makeRangeStepFunction as makeLongRangeStepFunction } from "./Long.js"; +// import Decimal, { makeRangeStepFunction as makeDecimalRangeStepFunction } from "./Decimal.js"; +// import Long, { makeRangeStepFunction as makeLongRangeStepFunction } from "./Long.js"; import { Option, some, value } from "./Option.js"; import { compare, equals, IComparer, IDisposable } from "./Util.js"; @@ -618,28 +618,28 @@ export function pairwise(xs: Iterable): IterableIterator<[T, T]> { }); } -export function rangeChar(first: string, last: string) { - const firstNum = first.charCodeAt(0); - const lastNum = last.charCodeAt(0); - return delay(() => unfold((x) => x <= lastNum ? [String.fromCharCode(x), x + 1] : undefined, firstNum)); -} +// export function rangeChar(first: string, last: string) { +// const firstNum = first.charCodeAt(0); +// const lastNum = last.charCodeAt(0); +// return delay(() => unfold((x) => x <= lastNum ? [String.fromCharCode(x), x + 1] : undefined, firstNum)); +// } -export function rangeLong(first: Long, step: Long, last: Long, unsigned: boolean): IterableIterator { - const stepFn = makeLongRangeStepFunction(step, last, unsigned) as (arg: Long) => Option<[Long, Long]>; - return delay(() => unfold(stepFn, first)); -} +// export function rangeLong(first: Long, step: Long, last: Long, unsigned: boolean): IterableIterator { +// const stepFn = makeLongRangeStepFunction(step, last, unsigned) as (arg: Long) => Option<[Long, Long]>; +// return delay(() => unfold(stepFn, first)); +// } -export function rangeDecimal(first: Decimal, step: Decimal, last: Decimal): IterableIterator { - const stepFn = makeDecimalRangeStepFunction(step, last) as (arg: Decimal) => Option<[Decimal, Decimal]>; - return delay(() => unfold(stepFn, first)); -} +// export function rangeDecimal(first: Decimal, step: Decimal, last: Decimal): IterableIterator { +// const stepFn = makeDecimalRangeStepFunction(step, last) as (arg: Decimal) => Option<[Decimal, Decimal]>; +// return delay(() => unfold(stepFn, first)); +// } -export function rangeNumber(first: number, step: number, last: number) { - if (step === 0) { - throw new Error("Step cannot be 0"); - } - return delay(() => unfold((x) => step > 0 && x <= last || step < 0 && x >= last ? [x, x + step] : undefined, first)); -} +// export function rangeNumber(first: number, step: number, last: number) { +// if (step === 0) { +// throw new Error("Step cannot be 0"); +// } +// return delay(() => unfold((x) => step > 0 && x <= last || step < 0 && x >= last ? [x, x + step] : undefined, first)); +// } export function readOnly(xs: Iterable) { return map((x) => x, xs); diff --git a/src/fable-library/Set.fs b/src/fable-library/Set.fs index a747629bf..407e4ec39 100644 --- a/src/fable-library/Set.fs +++ b/src/fable-library/Set.fs @@ -564,8 +564,8 @@ module SetTree = iter (fun x -> arr.[j] <- x; j <- j + 1) s let toArray s = - let n = (count s) - let res = Array.Helpers.allocateArray n + let n = count s + let res = Array.zeroCreate n copyToArray s res 0 res @@ -574,13 +574,22 @@ module SetTree = mkFromEnumerator comparer (add comparer e.Current acc) e else acc - let ofSeq comparer (c: IEnumerable<_>) = - use ie = c.GetEnumerator() - mkFromEnumerator comparer empty ie - let ofArray comparer l = Array.fold (fun acc k -> add comparer k acc) empty l + let ofList comparer l = + List.fold (fun acc k -> add comparer k acc) empty l + + let ofSeq comparer (c: seq<'T>) = + match c with + | :? array<'T> as xs -> ofArray comparer xs + | :? list<'T> as xs -> ofList comparer xs + | _ -> + use ie = c.GetEnumerator() + mkFromEnumerator comparer empty ie + +open Fable.Core + [] [] [] @@ -682,7 +691,7 @@ type Set<[]'T when 'T: comparison >(comparer:IComparer<'T else Set(s.Comparer, SetTree.filter s.Comparer f s.Tree) - member s.Map(f, [] comparer: IComparer<'U>) : Set<'U> = + member s.Map(f, [] comparer: IComparer<'U>) : Set<'U> = Set(comparer, SetTree.fold (fun acc k -> SetTree.add comparer (f k) acc) (SetTree.empty) s.Tree) member s.Exists f = @@ -828,7 +837,7 @@ let contains element (set: Set<'T>) = set.Contains element let add value (set: Set<'T>) = set.Add value // [] -let singleton (value: 'T) ([] comparer: IComparer<'T>) : Set<'T> = +let singleton (value: 'T) ([] comparer: IComparer<'T>) : Set<'T> = Set<'T>.Empty(comparer).Add value // [] @@ -838,7 +847,7 @@ let remove value (set: Set<'T>) = set.Remove value let union (set1: Set<'T>) (set2: Set<'T>) = set1 + set2 // [] -let unionMany (sets: seq>) ([] comparer: IComparer<'T>) = +let unionMany (sets: seq>) ([] comparer: IComparer<'T>) = Seq.fold (fun s1 s2 -> s1 + s2) (Set<'T>.Empty comparer) sets // [] @@ -851,7 +860,7 @@ let intersectMany (sets: seq>) = Set.IntersectionMany sets let iterate action (set: Set<'T>) = set.Iterate action // [] -let empty<'T when 'T : comparison> ([] comparer: IComparer<'T>): Set<'T> = Set<'T>.Empty comparer +let empty<'T when 'T : comparison> ([] comparer: IComparer<'T>): Set<'T> = Set<'T>.Empty comparer // [] let forAll predicate (set: Set<'T>) = set.ForAll predicate @@ -872,17 +881,17 @@ let fold<'T, 'State when 'T : comparison> folder (state:'State) (set: Set<'T>) let foldBack<'T, 'State when 'T : comparison> folder (set: Set<'T>) (state:'State) = SetTree.foldBack folder set.Tree state // [] -let map mapping (set: Set<'T>) ([] comparer: IComparer<'U>) = set.Map(mapping, comparer) +let map mapping (set: Set<'T>) ([] comparer: IComparer<'U>) = set.Map(mapping, comparer) // [] let count (set: Set<'T>) = set.Count // [] -let ofList elements ([] comparer: IComparer<'T>) = +let ofList elements ([] comparer: IComparer<'T>) = Set(comparer, SetTree.ofSeq comparer elements) // [] -let ofArray (array: 'T array) ([] comparer: IComparer<'T>) = +let ofArray (array: 'T array) ([] comparer: IComparer<'T>) = Set(comparer, SetTree.ofArray comparer array) // [] @@ -895,7 +904,7 @@ let toArray (set: Set<'T>) = set.ToArray() let toSeq (set: Set<'T>) = (set |> Seq.map id) // [] -let ofSeq (elements: seq<_>) ([] comparer: IComparer<'T>) = +let ofSeq (elements: seq<_>) ([] comparer: IComparer<'T>) = Set(comparer, SetTree.ofSeq comparer elements) // [] @@ -919,32 +928,12 @@ let minElement (set: Set<'T>) = set.MinimumElement // [] let maxElement (set: Set<'T>) = set.MaximumElement -let createMutable (source: seq<'T>) ([] comparer: IEqualityComparer<'T>) = - let set = Fable.Collections.MutableSet(source, comparer) - set :> Fable.Core.JS.Set<_> - -let distinct (xs: seq<'T>) ([] comparer: IEqualityComparer<'T>) = - seq { - let set = Fable.Collections.MutableSet(Seq.empty, comparer) - for x in xs do - if set.Add(x) then - yield x - } - -let distinctBy (projection: 'T -> 'Key) (xs: seq<'T>) ([] comparer: IEqualityComparer<'Key>) = - seq { - let set = Fable.Collections.MutableSet(Seq.empty, comparer) - for x in xs do - if set.Add(projection x) then - yield x - } - // Helpers to replicate HashSet methods let unionWith (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) = (s1, s2) ||> Seq.fold (fun acc x -> acc.add x) -let intersectWith (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = +let intersectWith (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = let s2 = ofSeq s2 comparer for x in s1.keys() do if not (s2.Contains x) then @@ -954,14 +943,14 @@ let exceptWith (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) = for x in s2 do s1.delete x |> ignore -let isSubsetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = +let isSubsetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = isSubset (ofSeq (s1.values()) comparer) (ofSeq s2 comparer) -let isSupersetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = +let isSupersetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = isSuperset (ofSeq (s1.values()) comparer) (ofSeq s2 comparer) -let isProperSubsetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = +let isProperSubsetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = isProperSubset (ofSeq (s1.values()) comparer) (ofSeq s2 comparer) -let isProperSupersetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = +let isProperSupersetOf (s1: Fable.Core.JS.Set<'T>) (s2: 'T seq) ([] comparer: IComparer<'T>) = isProperSuperset (ofSeq (s1.values()) comparer) (ofSeq s2 comparer) diff --git a/src/fable-library/System.Text.fs b/src/fable-library/System.Text.fs index c22e9d58e..2b889e69c 100644 --- a/src/fable-library/System.Text.fs +++ b/src/fable-library/System.Text.fs @@ -18,7 +18,11 @@ type StringBuilder(value: string, capacity: int) = member x.AppendLine() = buf.Add(System.Environment.NewLine); x member x.AppendLine(s: string) = buf.Add(s); buf.Add(System.Environment.NewLine); x override __.ToString() = System.String.Concat(buf) - member x.Length = buf |> Seq.sumBy String.length + member x.Length = + let mutable len = 0 + for i = buf.Count - 1 downto 0 do + len <- len + buf.Item(i).Length + len member x.ToString(firstIndex: int, length: int) = let str = x.ToString() str.Substring(firstIndex, length) diff --git a/src/fable-library/Types.ts b/src/fable-library/Types.ts index e704b5a63..644266184 100644 --- a/src/fable-library/Types.ts +++ b/src/fable-library/Types.ts @@ -34,51 +34,51 @@ 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; - } -} +// 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; +// 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; - } +// 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 [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 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); } -} +// public toJSON() { return Array.from(this); } +// 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; diff --git a/src/fable-library/Util.ts b/src/fable-library/Util.ts index 8d4f69861..cfe33d2bd 100644 --- a/src/fable-library/Util.ts +++ b/src/fable-library/Util.ts @@ -79,6 +79,57 @@ export function sameConstructor(x: T, y: T) { return Object.getPrototypeOf(x).constructor === Object.getPrototypeOf(y).constructor; } +export interface IEnumerator extends IDisposable { + ["System.Collections.Generic.IEnumerator`1.get_Current"](): T | undefined; + ["System.Collections.IEnumerator.get_Current"](): T | undefined; + ["System.Collections.IEnumerator.MoveNext"](): boolean; + ["System.Collections.IEnumerator.Reset"](): void; + Dispose(): void; +} + +export interface IEnumerable extends Iterable { + GetEnumerator(): IEnumerator; +} + +export class Enumerator implements IEnumerator { + private current?: T; + constructor(private iter: Iterator) { } + public ["System.Collections.Generic.IEnumerator`1.get_Current"]() { + return this.current; + } + public ["System.Collections.IEnumerator.get_Current"]() { + return this.current; + } + public ["System.Collections.IEnumerator.MoveNext"]() { + const cur = this.iter.next(); + this.current = cur.value; + return !cur.done; + } + public ["System.Collections.IEnumerator.Reset"]() { + throw new Error("JS iterators cannot be reset"); + } + public Dispose() { + return; + } +} + +export function getEnumerator(o: Iterable): IEnumerator { + return typeof (o as any).GetEnumerator === "function" + ? (o as IEnumerable).GetEnumerator() + : new Enumerator(o[Symbol.iterator]()); +} + +export function toIterator(en: IEnumerator): IterableIterator { + return { + [Symbol.iterator]() { return this; }, + next() { + const hasNext = en["System.Collections.IEnumerator.MoveNext"](); + const current = hasNext ? en["System.Collections.IEnumerator.get_Current"]() : undefined; + return { done: !hasNext, value: current } as IteratorResult; + }, + }; +} + export class Comparer implements IComparer { public Compare: (x: T, y: T) => number; @@ -617,7 +668,7 @@ export function partialApply(arity: number, f: Function, args: any[]): any { } else if (CURRIED_KEY in f) { f = (f as any)[CURRIED_KEY]; for (let i = 0; i < args.length; i++) { - f = f(args[i]) ; + f = f(args[i]); } return f; } else { diff --git a/src/fable-library/package.json b/src/fable-library/package.json new file mode 100644 index 000000000..e986b24bb --- /dev/null +++ b/src/fable-library/package.json @@ -0,0 +1,4 @@ +{ + "private": true, + "type": "module" +} diff --git a/src/tools/InjectProcessor/InjectProcessor.fs b/src/tools/InjectProcessor/InjectProcessor.fs index 83a985921..bb4267d9a 100644 --- a/src/tools/InjectProcessor/InjectProcessor.fs +++ b/src/tools/InjectProcessor/InjectProcessor.fs @@ -11,7 +11,7 @@ let typeAliases = Map [ "System.Collections.Generic.IComparer`1", "comparer" "System.Collections.Generic.IEqualityComparer`1", "equalityComparer" - "Array.Cons`1", "arrayCons" + "ArrayModule.Cons`1", "arrayCons" ] let parse (checker: FSharpChecker) projFile = @@ -89,17 +89,7 @@ let main _argv = module Fable.Transforms.ReplacementsInject let fableReplacementsModules = - Map [ - "Seq", Map [ - "maxBy", (Types.comparer, 1) - "max", (Types.comparer, 0) - "minBy", (Types.comparer, 1) - "min", (Types.comparer, 0) - "sumBy", (Types.adder, 1) - "sum", (Types.adder, 0) - "averageBy", (Types.averager, 1) - "average", (Types.averager, 0) - ]""" + Map [""" for file in proj.AssemblyContents.ImplementationFiles do let fileName = System.IO.Path.GetFileNameWithoutExtension(file.FileName) // Apparently FCS generates the AssemblyInfo file automatically diff --git a/tests/Main/ListTests.fs b/tests/Main/ListTests.fs index 16e4bfc12..0b9583b6c 100644 --- a/tests/Main/ListTests.fs +++ b/tests/Main/ListTests.fs @@ -110,6 +110,17 @@ let tests = ys.Head + xs.Head |> equal zs.Head + testCase "List.cons works II" <| fun () -> + let li = [1;2;3;4;5] + let li2 = li.Tail + let li3 = [8;9;11] @ li2 + let li3b = [20;16] @ li3.Tail + let li4 = 14 :: li3b + li4.[1] |> equal 20 + li4.[3] |> equal 9 + List.length li4 |> equal 9 + List.sum li4 |> equal 84 + testCase "List.empty works" <| fun () -> let xs = 1 :: List.Empty let ys = 1 :: List.empty @@ -122,6 +133,26 @@ let tests = zs.Head + zs.Tail.Head |> equal 1 + testCase "List.append works II" <| fun () -> + let li = [1;2;3;4;5] + let li2 = li.Tail + let li3 = [8;9;11] @ li2 + let li3b = [20;16] @ li3.Tail + let li4 = li3b @ li2 + li4.[1] |> equal 16 + li4.[9] |> equal 3 + List.length li4 |> equal 12 + List.sum li4 |> equal 84 + + testCase "List.append works with empty list" <| fun () -> + let li = [{| value = 2|}; {| value = 4|};] + let li = li @ [] + let li = [] @ li + li + |> Seq.map (fun x -> 20 / x.value) + |> Seq.sum + |> equal 15 + testCase "List.choose works" <| fun () -> let xs = [1; 2; 3; 4] let result = xs |> List.choose (fun x -> diff --git a/tests/Main/SeqTests.fs b/tests/Main/SeqTests.fs index e93241c8a..5a6c2e37b 100644 --- a/tests/Main/SeqTests.fs +++ b/tests/Main/SeqTests.fs @@ -872,10 +872,10 @@ let tests = let res1 = List.ofSeq res let res2 = List.ofSeq res let expected = - [(1, 'a'); (1, 'b'); (1, 'c'); (1, 'd'); (1, 'e'); (1, 'f'); (2, 'a'); - (2, 'b'); (2, 'c'); (2, 'd'); (2, 'e'); (2, 'f'); (3, 'a'); (3, 'b'); - (3, 'c'); (3, 'd'); (3, 'e'); (3, 'f'); (4, 'a'); (4, 'b'); (4, 'c'); - (4, 'd'); (4, 'e'); (4, 'f')] + [(1, 'a'); (1, 'b'); (1, 'c'); (1, 'd'); (1, 'e'); (1, 'f'); + (2, 'a'); (2, 'b'); (2, 'c'); (2, 'd'); (2, 'e'); (2, 'f'); + (3, 'a'); (3, 'b'); (3, 'c'); (3, 'd'); (3, 'e'); (3, 'f'); + (4, 'a'); (4, 'b'); (4, 'c'); (4, 'd'); (4, 'e'); (4, 'f')] accX |> equal 2 accY |> equal 1 equal expected res1