From 86a17b8770504e4afe466b1fcf47a4ada99558d2 Mon Sep 17 00:00:00 2001 From: Dag Brattli Date: Sat, 13 Jun 2026 14:42:58 +0200 Subject: [PATCH] refactor(transforms): add [] to partial active patterns Convert 73 partial active patterns across the compiler transforms to struct-returning (ValueOption) form, resolving all open IONIDE-009 code scanning alerts in src/Fable.Transforms. Only return-position values were changed to ValueSome/ValueNone; nested option match patterns and inner option plumbing are left intact (bridged with explicit matches or ValueOption.ofOption where a helper produced a plain option). The (|CustomOp|_|) pattern is also invoked as a plain function in Beam/Replacements.fs; those two call sites are adapted to the new voption result. Fable.AST/Fable.fs is intentionally not touched: changing a public AST active pattern's return type is a binary-breaking change. Co-Authored-By: Claude Opus 4.8 (1M context) --- src/Fable.Transforms/Beam/Replacements.fs | 8 +- src/Fable.Transforms/FSharp2Fable.Util.fs | 137 ++++++----- src/Fable.Transforms/Fable2Babel.fs | 26 ++- src/Fable.Transforms/FableTransforms.fs | 25 +- src/Fable.Transforms/Global/Naming.fs | 19 +- src/Fable.Transforms/Global/Prelude.fs | 21 +- src/Fable.Transforms/Python/Replacements.fs | 23 +- src/Fable.Transforms/Replacements.Util.fs | 241 ++++++++++++-------- src/Fable.Transforms/Replacements.fs | 51 +++-- src/Fable.Transforms/Transforms.Util.fs | 93 +++++--- 10 files changed, 385 insertions(+), 259 deletions(-) diff --git a/src/Fable.Transforms/Beam/Replacements.fs b/src/Fable.Transforms/Beam/Replacements.fs index c004b396c5..76404d0fb7 100644 --- a/src/Fable.Transforms/Beam/Replacements.fs +++ b/src/Fable.Transforms/Beam/Replacements.fs @@ -458,8 +458,8 @@ let private operators let opName = info.CompiledName match (|CustomOp|_|) com ctx r _t opName args argTypes with - | Some _ as e -> e - | None -> + | ValueSome e -> Some e + | ValueNone -> match opName, args with | Operators.addition, [ left; right ] -> makeBinOp r _t left right BinaryPlus |> Some | Operators.subtraction, [ left; right ] -> makeBinOp r _t left right BinaryMinus |> Some @@ -542,8 +542,8 @@ let private languagePrimitives let argTypes = args |> List.map (fun a -> a.Type) // Check for custom operator on DeclaredType before falling back to native ops match (|CustomOp|_|) com ctx r t operation args argTypes with - | Some _ as e -> e - | None -> + | ValueSome e -> Some e + | ValueNone -> // For Dynamic ops, map to standard binary operations match operation, args with | "op_Addition", [ left; right ] -> makeBinOp r t left right BinaryPlus |> Some diff --git a/src/Fable.Transforms/FSharp2Fable.Util.fs b/src/Fable.Transforms/FSharp2Fable.Util.fs index bff29f9e05..d0a40cc139 100644 --- a/src/Fable.Transforms/FSharp2Fable.Util.fs +++ b/src/Fable.Transforms/FSharp2Fable.Util.fs @@ -1078,6 +1078,7 @@ module Patterns = let inline (|Transform|) (com: IFableCompiler) ctx e = com.Transform(ctx, e) let inline (|FieldName|) (fi: FSharpField) = fi.Name + [] let (|CommonNamespace|_|) = function | (FSharpImplementationFileDeclaration.Entity(ent, subDecls)) :: restDecls when ent.IsNamespace -> @@ -1094,7 +1095,8 @@ module Patterns = | _ -> None ) |> Option.map (fun subDecls -> ent, subDecls) - | _ -> None + |> ValueOption.ofOption + | _ -> ValueNone let inline (|NonAbbreviatedType|) (t: FSharpType) = nonAbbreviatedType t @@ -1103,23 +1105,28 @@ module Patterns = | AddressOf value -> value | _ -> expr + [] let (|TypeDefinition|_|) (NonAbbreviatedType t) = if t.HasTypeDefinition then - Some t.TypeDefinition + ValueSome t.TypeDefinition else - None + ValueNone /// DOES NOT check if the type is abbreviated, mainly intended to identify Fable.Core.Applicable + [] let (|FSharpExprTypeFullName|_|) (e: FSharpExpr) = let t = e.Type if t.HasTypeDefinition then - t.TypeDefinition.TryFullName + match t.TypeDefinition.TryFullName with + | Some n -> ValueSome n + | None -> ValueNone else - None + ValueNone let (|MemberFullName|) (memb: FSharpMemberOrFunctionOrValue) = memb.FullName + [] let (|UnionCaseTesterFor|_|) (memb: FSharpMemberOrFunctionOrValue) = match memb.DeclaringEntity with | Some ent when ent.IsFSharpUnion -> @@ -1131,17 +1138,22 @@ module Patterns = && memb.LogicalName.StartsWith("get_Is", StringComparison.Ordinal) then let unionCaseName = memb.LogicalName |> Naming.replacePrefix "get_Is" "" - ent.UnionCases |> Seq.tryFind (fun uc -> uc.Name = unionCaseName) + + match ent.UnionCases |> Seq.tryFind (fun uc -> uc.Name = unionCaseName) with + | Some uc -> ValueSome uc + | None -> ValueNone else - None - | _ -> None + ValueNone + | _ -> ValueNone + [] let (|RefType|_|) = function - | TypeDefinition tdef as t when tdef.TryFullName = Some Types.refCell -> Some t - | _ -> None + | TypeDefinition tdef as t when tdef.TryFullName = Some Types.refCell -> ValueSome t + | _ -> ValueNone /// Detects AST pattern of "raise MatchFailureException()" + [] let (|RaisingMatchFailureExpr|_|) (expr: FSharpExpr) = match expr with | Call(None, methodInfo, [], [ _unitType ], [ value ]) -> @@ -1150,12 +1162,13 @@ module Patterns = match value with | NewRecord(recordType, [ Const(value, _valueT); _rangeFrom; _rangeTo ]) -> match recordType.TypeDefinition.TryFullName with - | Some Types.matchFail -> Some(value.ToString()) - | _ -> None - | _ -> None - | _ -> None - | _ -> None + | Some Types.matchFail -> ValueSome(value.ToString()) + | _ -> ValueNone + | _ -> ValueNone + | _ -> ValueNone + | _ -> ValueNone + [] let (|NestedLambda|_|) x = let rec nestedLambda args = function @@ -1163,9 +1176,10 @@ module Patterns = | body -> List.rev args, body match x with - | Lambda(arg, body) -> nestedLambda [ arg ] body |> Some - | _ -> None + | Lambda(arg, body) -> nestedLambda [ arg ] body |> ValueSome + | _ -> ValueNone + [] let (|ForOf|_|) = function | Let((_, value, _), // Coercion to seq @@ -1176,25 +1190,26 @@ module Patterns = meth.CompiledName = "GetEnumerator" -> // when meth.FullName = "System.Collections.Generic.IEnumerable.GetEnumerator" -> - Some(ident, value, body) + ValueSome(ident, value, body) // optimized "for x in list" | Let((_, UnionCaseGet(value, typ, unionCase, field), _), WhileLoop(_, Let((ident, _, _), body), _)) when (getFsTypeFullName typ) = Types.list && unionCase.Name = "op_ColonColon" && field.Name = "Tail" -> - Some(ident, value, body) + ValueSome(ident, value, body) // optimized "for _x in list" | Let((ident, UnionCaseGet(value, typ, unionCase, field), _), WhileLoop(_, body, _)) when (getFsTypeFullName typ) = Types.list && unionCase.Name = "op_ColonColon" && field.Name = "Tail" -> - Some(ident, value, body) - | _ -> None + ValueSome(ident, value, body) + | _ -> ValueNone /// This matches the boilerplate generated for TryGetValue/TryParse/DivRem (see #154, or #1744) /// where the F# compiler automatically passes a byref arg and returns it as a tuple + [] let (|ByrefArgToTuple|_|) = function | Let((outArg1, (DefaultValue _ as def), _), @@ -1203,11 +1218,12 @@ module Patterns = -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some(callee, memb, ownerGenArgs, membGenArgs, callArgs @ [ def ]) - | _ -> None - | _ -> None + ValueSome(callee, memb, ownerGenArgs, membGenArgs, callArgs @ [ def ]) + | _ -> ValueNone + | _ -> ValueNone /// This matches the boilerplate generated for TryGetValue/TryParse/DivRem (--optimize+) + [] let (|ByrefArgToTupleOptimizedIf|_|) = function | Let((outArg1, (DefaultValue _ as def), _), @@ -1216,11 +1232,12 @@ module Patterns = -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some(outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs @ [ def ], thenExpr, elseExpr) - | _ -> None - | _ -> None + ValueSome(outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs @ [ def ], thenExpr, elseExpr) + | _ -> ValueNone + | _ -> ValueNone /// This matches another boilerplate generated for TryGetValue/TryParse/DivRem (--optimize+) + [] let (|ByrefArgToTupleOptimizedTree|_|) = function | Let((outArg1, (DefaultValue _ as def), _), @@ -1228,7 +1245,7 @@ module Patterns = targetsExpr)) when List.isMultiple callArgs && outArg1.IsCompilerGenerated -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some( + ValueSome( outArg1, callee, memb, @@ -1239,10 +1256,11 @@ module Patterns = elseExpr, targetsExpr ) - | _ -> None - | _ -> None + | _ -> ValueNone + | _ -> ValueNone /// This matches another boilerplate generated for TryGetValue/TryParse/DivRem (--crossoptimize-) + [] let (|ByrefArgToTupleOptimizedLet|_|) = function | Let((outArg1, (DefaultValue _ as def), _), @@ -1251,11 +1269,12 @@ module Patterns = -> match List.splitLast callArgs with | callArgs, AddressOf(Value outArg2) when outArg1 = outArg2 -> - Some(arg_0, outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs @ [ def ], restExpr) - | _ -> None - | _ -> None + ValueSome(arg_0, outArg1, callee, memb, ownerGenArgs, membGenArgs, callArgs @ [ def ], restExpr) + | _ -> ValueNone + | _ -> ValueNone /// This matches the boilerplate generated to wrap .NET events from F# + [] let (|CreateEvent|_|) = function | Call(None, @@ -1280,18 +1299,20 @@ module Patterns = klass.MembersFunctionsAndValues |> Seq.tryFind (fun m -> m.LogicalName = eventName) |> function - | Some memb -> Some(callee, memb) - | _ -> None - | _ -> None - | _ -> None + | Some memb -> ValueSome(callee, memb) + | _ -> ValueNone + | _ -> ValueNone + | _ -> ValueNone + [] let (|ConstructorCall|_|) = function - | NewObject(baseCall, genArgs, baseArgs) -> Some(baseCall, genArgs, baseArgs) + | NewObject(baseCall, genArgs, baseArgs) -> ValueSome(baseCall, genArgs, baseArgs) | Call(None, baseCall, genArgs1, genArgs2, baseArgs) when baseCall.IsConstructor -> - Some(baseCall, genArgs1 @ genArgs2, baseArgs) - | _ -> None + ValueSome(baseCall, genArgs1 @ genArgs2, baseArgs) + | _ -> ValueNone + [] let (|OptimizedOperator|_|) (com: Compiler) fsExpr = if com.Options.OptimizeFSharpAst then match fsExpr with @@ -1303,13 +1324,13 @@ module Patterns = && vv.FullName = "matchValue" && (getFsTypeFullName tt) = "System.IFormattable" -> - Some(memb, None, "toString", membArgTypes, membArgs) + ValueSome(memb, None, "toString", membArgTypes, membArgs) // work-around for optimized hash operator (Operators.hash) | Call(Some expr, memb, _, [], [ Call(None, comp, [], [], []) ]) when memb.FullName.EndsWith(".GetHashCode", StringComparison.Ordinal) && comp.FullName = "Microsoft.FSharp.Core.LanguagePrimitives.GenericEqualityERComparer" -> - Some(memb, Some comp, "GenericHash", [ expr.Type ], [ expr ]) + ValueSome(memb, Some comp, "GenericHash", [ expr.Type ], [ expr ]) // work-around for optimized equality operator (Operators.(=)) | Call(Some e1, memb, _, [], [ Coerce(t2, e2); Call(None, comp, [], [], []) ]) when memb.FullName.EndsWith(".Equals", StringComparison.Ordinal) @@ -1317,10 +1338,10 @@ module Patterns = && t2.TypeDefinition.CompiledName = "obj" && comp.FullName = "Microsoft.FSharp.Core.LanguagePrimitives.GenericEqualityComparer" -> - Some(memb, Some comp, "GenericEquality", [ e1.Type; e2.Type ], [ e1; e2 ]) - | _ -> None + ValueSome(memb, Some comp, "GenericEquality", [ e1.Type; e2.Type ], [ e1; e2 ]) + | _ -> ValueNone else - None + ValueNone let inline (|FableType|) _com (ctx: Context) t = TypeHelpers.makeType ctx.GenericArgs t @@ -2611,6 +2632,7 @@ module Util = msg |> addErrorAndReturnNull com ctx.InlinePath r + [] let (|Replaced|_|) (com: IFableCompiler) (ctx: Context) @@ -2642,7 +2664,7 @@ module Util = // Deal with reraise so we don't need to save caught exception every time match ctx.CaughtException, info.DeclaringEntityFullName, info.CompiledName with | Some ex, "Microsoft.FSharp.Core.Operators", "Reraise" when com.Options.Language <> Dart -> - makeThrow r typ (Fable.IdentExpr ex) |> Some + makeThrow r typ (Fable.IdentExpr ex) |> ValueSome | _ -> // If it's an interface compile the call to the attached member just in case let attachedCall = @@ -2654,19 +2676,20 @@ module Util = let e = Fable.UnresolvedReplaceCall(callInfo.ThisArg, callInfo.Args, info, attachedCall) - Fable.Unresolved(e, typ, r) |> Some + Fable.Unresolved(e, typ, r) |> ValueSome | None -> match com.TryReplace(ctx, r, typ, info, callInfo.ThisArg, callInfo.Args) with - | Some e -> Some e - | None when info.IsInterface -> callAttachedMember com ctx r typ callInfo ent memb |> Some - | None -> failReplace com ctx r info callInfo.ThisArg |> Some - | _ -> None + | Some e -> ValueSome e + | None when info.IsInterface -> callAttachedMember com ctx r typ callInfo ent memb |> ValueSome + | None -> failReplace com ctx r info callInfo.ThisArg |> ValueSome + | _ -> ValueNone let addWatchDependencyFromMember (com: Compiler) (memb: FSharpMemberOrFunctionOrValue) = memb.DeclaringEntity |> Option.bind (fun ent -> FsEnt.Ref(ent).SourcePath) |> Option.iter com.AddWatchDependency + [] let (|Emitted|_|) (com: Compiler) (ctx: Context) @@ -2712,7 +2735,9 @@ module Util = Fable.Emit(emitInfo, typ, r) |> Some | _ -> None ) + |> ValueOption.ofOption + [] let (|Imported|_|) (com: Compiler) (ctx: Context) @@ -2793,6 +2818,7 @@ module Util = | None, _ -> None | _ -> None |> Option.tap (fun _ -> addWatchDependencyFromMember com memb) + |> ValueOption.ofOption let inlineExpr (com: IFableCompiler) (ctx: Context) r t callee (info: Fable.CallInfo) membUniqueName = let args: Fable.Expr list = @@ -2863,6 +2889,7 @@ module Util = List.fold (fun body (ident, value) -> Fable.Let(ident, value, body)) body bindings + [] let (|Inlined|_|) (com: IFableCompiler) (ctx: Context) r t callee info (memb: FSharpMemberOrFunctionOrValue) = if isInline memb then let membUniqueName = getMemberUniqueName memb @@ -2871,14 +2898,14 @@ module Util = | Some memb2 when memb.Equals(memb2) -> $"Recursive functions cannot be inlined: (%s{memb.FullName})" |> addErrorAndReturnNull com [] r - |> Some + |> ValueSome | Some _ -> let e = Fable.UnresolvedInlineCall(membUniqueName, ctx.Witnesses, callee, info) - Fable.Unresolved(e, t, r) |> Some - | None -> inlineExpr com ctx r t callee info membUniqueName |> Some + Fable.Unresolved(e, t, r) |> ValueSome + | None -> inlineExpr com ctx r t callee info membUniqueName |> ValueSome else - None + ValueNone /// Removes optional arguments set to None in tail position let transformOptionalArguments diff --git a/src/Fable.Transforms/Fable2Babel.fs b/src/Fable.Transforms/Fable2Babel.fs index 15a481350b..5795dee0d6 100644 --- a/src/Fable.Transforms/Fable2Babel.fs +++ b/src/Fable.Transforms/Fable2Babel.fs @@ -1045,17 +1045,19 @@ module Util = let (|TransformExpr|) (com: IBabelCompiler) ctx e = com.TransformAsExpr(ctx, e) + [] let (|Function|_|) = function - | Fable.Lambda(arg, body, _) -> Some([ arg ], body) - | Fable.Delegate(args, body, _, []) -> Some(args, body) - | _ -> None + | Fable.Lambda(arg, body, _) -> ValueSome([ arg ], body) + | Fable.Delegate(args, body, _, []) -> ValueSome(args, body) + | _ -> ValueNone + [] let (|Lets|_|) = function - | Fable.Let(ident, value, body) -> Some([ ident, value ], body) - | Fable.LetRec(bindings, body) -> Some(bindings, body) - | _ -> None + | Fable.Let(ident, value, body) -> ValueSome([ ident, value ], body) + | Fable.LetRec(bindings, body) -> ValueSome(bindings, body) + | _ -> ValueNone let getUniqueNameInRootScope (ctx: Context) name = let name = @@ -2150,16 +2152,18 @@ but thanks to the optimisation done below we get | _ -> false // Check if the provided expression is equal to the expected identiferText (as a string) + [] let rec (|IdentifierIs|_|) (identifierText: string) expression = match expression with - | Expression.Identifier(Identifier(currentCallerText, _)) when identifierText = currentCallerText -> Some() - | _ -> None + | Expression.Identifier(Identifier(currentCallerText, _)) when identifierText = currentCallerText -> + ValueSome() + | _ -> ValueNone // Make it easy to check if we are calling the expected function - and (|CalledExpression|_|) (callerText: string) value = + and [] (|CalledExpression|_|) (callerText: string) value = match value with - | CallExpression(IdentifierIs callerText, UnrollerFromArray exprs, _, _) -> Some exprs - | _ -> None + | CallExpression(IdentifierIs callerText, UnrollerFromArray exprs, _, _) -> ValueSome exprs + | _ -> ValueNone and (|UnrollerFromSingleton|) (expr: Expression) : Expression list = [ expr ] diff --git a/src/Fable.Transforms/FableTransforms.fs b/src/Fable.Transforms/FableTransforms.fs index 4d8b6b007a..77fa10a212 100644 --- a/src/Fable.Transforms/FableTransforms.fs +++ b/src/Fable.Transforms/FableTransforms.fs @@ -319,20 +319,21 @@ let private uncurryType' typ = let uncurryType typ = uncurryType' typ |> snd module private Transforms = + [] let rec (|ImmediatelyApplicable|_|) appliedArgsLen expr = if appliedArgsLen = 0 then - None + ValueNone else match expr with | Lambda(arg, body, _) -> let appliedArgsLen = appliedArgsLen - 1 if appliedArgsLen = 0 then - Some([ arg ], body) + ValueSome([ arg ], body) else match body with - | ImmediatelyApplicable appliedArgsLen (args, body) -> Some(arg :: args, body) - | _ -> Some([ arg ], body) + | ImmediatelyApplicable appliedArgsLen (args, body) -> ValueSome(arg :: args, body) + | _ -> ValueSome([ arg ], body) // If the lambda is immediately applied we don't need the closures | NestedRevLets(bindings, Lambda(arg, body, _)) -> let body = List.fold (fun body (i, v) -> Let(i, v, body)) body bindings @@ -340,12 +341,12 @@ module private Transforms = let appliedArgsLen = appliedArgsLen - 1 if appliedArgsLen = 0 then - Some([ arg ], body) + ValueSome([ arg ], body) else match body with - | ImmediatelyApplicable appliedArgsLen (args, body) -> Some(arg :: args, body) - | _ -> Some([ arg ], body) - | _ -> None + | ImmediatelyApplicable appliedArgsLen (args, body) -> ValueSome(arg :: args, body) + | _ -> ValueSome([ arg ], body) + | _ -> ValueNone let tryInlineBinding (com: Compiler) (ident: Ident) value letBody = let canInlineBinding = @@ -706,19 +707,21 @@ module private Transforms = Body = body } + [] let (|GetField|_|) (com: Compiler) = function | Get(callee, kind, _, r) -> match kind with - | FieldGet { FieldType = Some fieldType } -> Some(callee, fieldType, r) + | FieldGet { FieldType = Some fieldType } -> ValueSome(callee, fieldType, r) | UnionField info -> let e = com.GetEntity(info.Entity) List.tryItem info.CaseIndex e.UnionCases |> Option.bind (fun c -> List.tryItem info.FieldIndex c.UnionCaseFields) |> Option.map (fun f -> callee, f.FieldType, r) - | _ -> None - | _ -> None + |> ValueOption.ofOption + | _ -> ValueNone + | _ -> ValueNone let isGetterOrValueWithoutGenerics (memb: MemberFunctionOrValue) = memb.IsGetter || (memb.IsValue && List.isEmpty memb.GenericParameters) diff --git a/src/Fable.Transforms/Global/Naming.fs b/src/Fable.Transforms/Global/Naming.fs index 53a03effd2..83b0ece01e 100644 --- a/src/Fable.Transforms/Global/Naming.fs +++ b/src/Fable.Transforms/Global/Naming.fs @@ -6,25 +6,32 @@ module Naming = open Fable.Core open System.Text.RegularExpressions + [] let (|StartsWith|_|) (pattern: string) (txt: string) = if txt.StartsWith(pattern, StringComparison.Ordinal) then - txt.Substring(pattern.Length) |> Some + txt.Substring(pattern.Length) |> ValueSome else - None + ValueNone + [] let (|EndsWith|_|) (pattern: string) (txt: string) = if txt.EndsWith(pattern, StringComparison.Ordinal) then - txt.Substring(0, txt.Length - pattern.Length) |> Some + txt.Substring(0, txt.Length - pattern.Length) |> ValueSome else - None + ValueNone + [] let (|Regex|_|) (reg: Regex) (str: string) = let m = reg.Match(str) if m.Success then - m.Groups |> Seq.cast |> Seq.map (fun g -> g.Value) |> Seq.toList |> Some + m.Groups + |> Seq.cast + |> Seq.map (fun g -> g.Value) + |> Seq.toList + |> ValueSome else - None + ValueNone [] let fableCompilerConstant = "FABLE_COMPILER" diff --git a/src/Fable.Transforms/Global/Prelude.fs b/src/Fable.Transforms/Global/Prelude.fs index 0dccbf8a30..014d597a91 100644 --- a/src/Fable.Transforms/Global/Prelude.fs +++ b/src/Fable.Transforms/Global/Prelude.fs @@ -218,30 +218,37 @@ module Result = | Error e -> extractError e module Patterns = - let (|Try|_|) (f: 'a -> 'b option) a = f a + [] + let (|Try|_|) (f: 'a -> 'b option) a = + match f a with + | Some x -> ValueSome x + | None -> ValueNone let (|Run|) (f: 'a -> 'b) a = f a + [] let (|DicContains|_|) (dic: System.Collections.Generic.IDictionary<'k, 'v>) key = let success, value = dic.TryGetValue key if success then - Some value + ValueSome value else - None + ValueNone + [] let (|SetContains|_|) set item = if Set.contains item set then - Some SetContains + ValueSome SetContains else - None + ValueNone + [] let (|ListLast|_|) (xs: 'a list) = if List.isEmpty xs then - None + ValueNone else let xs, last = List.splitLast xs - Some(xs, last) + ValueSome(xs, last) module Path = open System diff --git a/src/Fable.Transforms/Python/Replacements.fs b/src/Fable.Transforms/Python/Replacements.fs index 94a2f63006..217e3f12e5 100644 --- a/src/Fable.Transforms/Python/Replacements.fs +++ b/src/Fable.Transforms/Python/Replacements.fs @@ -16,19 +16,20 @@ type Context = FSharp2Fable.Context type ICompiler = FSharp2Fable.IFableCompiler type CallInfo = ReplaceCallInfo +[] let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = match arrayKind, t with - | ResizeArray, _ -> None + | ResizeArray, _ -> ValueNone | _, Number(kind, _) when com.Options.TypedArrays -> match kind with - | Int8 -> Some "Int8ArrayCons" - | UInt8 -> Some "UInt8ArrayCons" - | Int16 -> Some "Int16ArrayCons" - | UInt16 -> Some "UInt16ArrayCons" - | Int32 -> Some "Int32ArrayCons" - | UInt32 -> Some "UInt32ArrayCons" - | Float32 -> Some "Float32ArrayCons" - | Float64 -> Some "Float64ArrayCons" + | Int8 -> ValueSome "Int8ArrayCons" + | UInt8 -> ValueSome "UInt8ArrayCons" + | Int16 -> ValueSome "Int16ArrayCons" + | UInt16 -> ValueSome "UInt16ArrayCons" + | Int32 -> ValueSome "Int32ArrayCons" + | UInt32 -> ValueSome "UInt32ArrayCons" + | Float32 -> ValueSome "Float32ArrayCons" + | Float64 -> ValueSome "Float64ArrayCons" // Don't use typed array for int64 until we remove our int64 polyfill // and use JS BigInt to represent int64 // | Int64 -> Some "BigInt64ArrayCons" @@ -41,8 +42,8 @@ let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = | BigInt | Decimal | NativeInt - | UNativeInt -> None - | _ -> None + | UNativeInt -> ValueNone + | _ -> ValueNone let error com msg = Helper.ConstructorCall(makeIdentExpr "Exception", Any, [ msg ]) diff --git a/src/Fable.Transforms/Replacements.Util.fs b/src/Fable.Transforms/Replacements.Util.fs index 5df3422f42..8de130601f 100644 --- a/src/Fable.Transforms/Replacements.Util.fs +++ b/src/Fable.Transforms/Replacements.Util.fs @@ -304,48 +304,52 @@ type BuiltinType = | FSharpResult of ok: Type * err: Type | FSharpReference of Type +[] let (|BuiltinDefinition|_|) = function - | Types.guid -> Some BclGuid - | Types.timespan -> Some BclTimeSpan - | Types.datetime -> Some BclDateTime - | Types.datetimeOffset -> Some BclDateTimeOffset - | Types.dateOnly -> Some BclDateOnly - | Types.timeOnly -> Some BclTimeOnly - | "System.Timers.Timer" -> Some BclTimer - | Types.fsharpSet -> Some(FSharpSet(Any)) - | Types.fsharpMap -> Some(FSharpMap(Any, Any)) - | Types.hashset -> Some(BclHashSet(Any)) - | Types.dictionary -> Some(BclDictionary(Any, Any)) - | Types.keyValuePair -> Some(BclKeyValuePair(Any, Any)) - | Types.result -> Some(FSharpResult(Any, Any)) - | Types.byref -> Some(FSharpReference(Any)) - | Types.byref2 -> Some(FSharpReference(Any)) - | Types.refCell -> Some(FSharpReference(Any)) - | Naming.StartsWith Types.choiceNonGeneric genArgs -> List.replicate (int genArgs[1..]) Any |> FSharpChoice |> Some - | _ -> None - + | Types.guid -> ValueSome BclGuid + | Types.timespan -> ValueSome BclTimeSpan + | Types.datetime -> ValueSome BclDateTime + | Types.datetimeOffset -> ValueSome BclDateTimeOffset + | Types.dateOnly -> ValueSome BclDateOnly + | Types.timeOnly -> ValueSome BclTimeOnly + | "System.Timers.Timer" -> ValueSome BclTimer + | Types.fsharpSet -> ValueSome(FSharpSet(Any)) + | Types.fsharpMap -> ValueSome(FSharpMap(Any, Any)) + | Types.hashset -> ValueSome(BclHashSet(Any)) + | Types.dictionary -> ValueSome(BclDictionary(Any, Any)) + | Types.keyValuePair -> ValueSome(BclKeyValuePair(Any, Any)) + | Types.result -> ValueSome(FSharpResult(Any, Any)) + | Types.byref -> ValueSome(FSharpReference(Any)) + | Types.byref2 -> ValueSome(FSharpReference(Any)) + | Types.refCell -> ValueSome(FSharpReference(Any)) + | Naming.StartsWith Types.choiceNonGeneric genArgs -> + List.replicate (int genArgs[1..]) Any |> FSharpChoice |> ValueSome + | _ -> ValueNone + +[] let (|BuiltinEntity|_|) (ent: string, genArgs) = match ent, genArgs with - | BuiltinDefinition(FSharpSet _), [ t ] -> Some(FSharpSet(t)) - | BuiltinDefinition(FSharpMap _), [ k; v ] -> Some(FSharpMap(k, v)) - | BuiltinDefinition(BclHashSet _), [ t ] -> Some(BclHashSet(t)) - | BuiltinDefinition(BclDictionary _), [ k; v ] -> Some(BclDictionary(k, v)) - | BuiltinDefinition(BclKeyValuePair _), [ k; v ] -> Some(BclKeyValuePair(k, v)) - | BuiltinDefinition(FSharpResult _), [ k; v ] -> Some(FSharpResult(k, v)) - | BuiltinDefinition(FSharpReference _), [ t ] -> Some(FSharpReference(t)) - | BuiltinDefinition(FSharpReference _), [ t; _ ] -> Some(FSharpReference(t)) - | BuiltinDefinition(FSharpChoice _), genArgs -> Some(FSharpChoice genArgs) - | BuiltinDefinition t, _ -> Some t - | _ -> None - + | BuiltinDefinition(FSharpSet _), [ t ] -> ValueSome(FSharpSet(t)) + | BuiltinDefinition(FSharpMap _), [ k; v ] -> ValueSome(FSharpMap(k, v)) + | BuiltinDefinition(BclHashSet _), [ t ] -> ValueSome(BclHashSet(t)) + | BuiltinDefinition(BclDictionary _), [ k; v ] -> ValueSome(BclDictionary(k, v)) + | BuiltinDefinition(BclKeyValuePair _), [ k; v ] -> ValueSome(BclKeyValuePair(k, v)) + | BuiltinDefinition(FSharpResult _), [ k; v ] -> ValueSome(FSharpResult(k, v)) + | BuiltinDefinition(FSharpReference _), [ t ] -> ValueSome(FSharpReference(t)) + | BuiltinDefinition(FSharpReference _), [ t; _ ] -> ValueSome(FSharpReference(t)) + | BuiltinDefinition(FSharpChoice _), genArgs -> ValueSome(FSharpChoice genArgs) + | BuiltinDefinition t, _ -> ValueSome t + | _ -> ValueNone + +[] let (|Builtin|_|) = function | DeclaredType(ent, genArgs) -> match ent.FullName, genArgs with - | BuiltinEntity x -> Some x - | _ -> None - | _ -> None + | BuiltinEntity x -> ValueSome x + | _ -> ValueNone + | _ -> ValueNone let (|BuiltinSystemException|_|) (ent: string) = match ent with @@ -706,11 +710,19 @@ let uncurryExprAtRuntime (com: Compiler) arity (expr: Expr) = Helper.LibCall(com, "Option", "map", Option(uncurried.Type, isStruct), [ fn; expr ]) | expr -> uncurry expr -let (|Namesof|_|) com ctx e = namesof com ctx [] e +[] +let (|Namesof|_|) com ctx e = + match namesof com ctx [] e with + | Some x -> ValueSome x + | None -> ValueNone +[] let (|Nameof|_|) com ctx e = - namesof com ctx [] e |> Option.bind List.tryLast + match namesof com ctx [] e |> Option.bind List.tryLast with + | Some x -> ValueSome x + | None -> ValueNone +[] let (|ReplaceName|_|) (namesAndReplacements: (string * string) list) name = namesAndReplacements |> List.tryPick (fun (name2, replacement) -> @@ -719,32 +731,38 @@ let (|ReplaceName|_|) (namesAndReplacements: (string * string) list) name = else None ) + |> function + | Some x -> ValueSome x + | None -> ValueNone let (|OrDefault|) (def: 'T) = function | Some v -> v | None -> def +[] let (|IsByRefType|_|) (com: Compiler) = function | DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) match ent.IsByRef, genArgs with - | true, (genArg :: _) -> Some genArg - | _ -> None - | _ -> None + | true, (genArg :: _) -> ValueSome genArg + | _ -> ValueNone + | _ -> ValueNone +[] let (|IsInRefType|_|) (com: Compiler) = function | DeclaredType(entRef, genArgs) -> let ent = com.GetEntity(entRef) match ent.IsByRef, genArgs with - | true, [ genArg; DeclaredType(byRefKind, _) ] when byRefKind.FullName = Types.byrefKindIn -> Some genArg - | _ -> None - | _ -> None + | true, [ genArg; DeclaredType(byRefKind, _) ] when byRefKind.FullName = Types.byrefKindIn -> ValueSome genArg + | _ -> ValueNone + | _ -> ValueNone +[] let (|IsReferenceType|_|) (com: Compiler) (t: Type) = match t with | Measure _ @@ -752,43 +770,44 @@ let (|IsReferenceType|_|) (com: Compiler) (t: Type) = | Unit | Boolean | Char - | Number _ -> None + | Number _ -> ValueNone | Any | Regex | String | LambdaType _ - | DelegateType _ -> Some t + | DelegateType _ -> ValueSome t | Array _ - | List _ -> Some t + | List _ -> ValueSome t | Nullable(_, isStruct) | Option(_, isStruct) | Tuple(_, isStruct) | AnonymousRecordType(_, _, isStruct) -> if isStruct then - None + ValueNone else - Some t + ValueSome t | GenericParam(_name, _isMeasure, constraints) -> let isNullable = constraints |> List.contains Fable.Constraint.IsNullable let isReferenceType = constraints |> List.contains Fable.Constraint.IsReferenceType if isNullable || isReferenceType then - Some t + ValueSome t else - None + ValueNone | DeclaredType(entRef, _) -> let ent = com.GetEntity(entRef) if ent.IsValueType then - None + ValueNone else - Some t + ValueSome t +[] let rec (|HasReferenceEquality|_|) (com: Compiler) (t: Type) = match t with | Measure _ @@ -796,44 +815,45 @@ let rec (|HasReferenceEquality|_|) (com: Compiler) (t: Type) = | Unit | Boolean | Char - | Number _ -> None + | Number _ -> ValueNone | Any | Regex | String | LambdaType _ - | DelegateType _ -> Some t + | DelegateType _ -> ValueSome t | Array _ - | List _ -> None + | List _ -> ValueNone | Nullable(genArg, isStruct) -> if isStruct then - None + ValueNone else (|HasReferenceEquality|_|) com genArg | Option _ | Tuple _ - | AnonymousRecordType _ -> None + | AnonymousRecordType _ -> ValueNone | GenericParam(_name, _isMeasure, constraints) -> let isNullable = constraints |> List.contains Fable.Constraint.IsNullable let isReferenceType = constraints |> List.contains Fable.Constraint.IsReferenceType if isNullable || isReferenceType then - Some t + ValueSome t else - None + ValueNone | DeclaredType(entRef, _) -> let ent = com.GetEntity(entRef) if ent |> FSharp2Fable.Util.hasStructuralEquality then - None + ValueNone else - Some t + ValueSome t +[] let (|ListLiteral|_|) expr = let rec untail t acc = function @@ -842,23 +862,28 @@ let (|ListLiteral|_|) expr = | _ -> None match expr with - | NewList(None, t) -> Some([], t) - | NewList(Some(head, tail), t) -> untail t [ head ] tail - | _ -> None - + | NewList(None, t) -> ValueSome([], t) + | NewList(Some(head, tail), t) -> + match untail t [ head ] tail with + | Some x -> ValueSome x + | None -> ValueNone + | _ -> ValueNone + +[] let (|ArrayOrListLiteral|_|) = function - | MaybeCasted(Value((NewArray(ArrayValues vals, t, _) | ListLiteral(vals, t)), _)) -> Some(vals, t) - | _ -> None + | MaybeCasted(Value((NewArray(ArrayValues vals, t, _) | ListLiteral(vals, t)), _)) -> ValueSome(vals, t) + | _ -> ValueNone +[] let (|IsEntity|_|) fullName = function | DeclaredType(entRef, genArgs) -> if entRef.FullName = fullName then - Some(entRef, genArgs) + ValueSome(entRef, genArgs) else - None - | _ -> None + ValueNone + | _ -> ValueNone let (|IDictionary|IEqualityComparer|Other|) = function @@ -890,23 +915,25 @@ let (|Enumerator|Other|) = | "System.Collections.Generic.Dictionary`2.ValueCollection.Enumerator" -> Enumerator | _ -> Other +[] let (|IsEnumerator|_|) = function | MaybeNullable(DeclaredType(entRef, genArgs)) | DeclaredType(entRef, genArgs) -> match entRef.FullName with - | Enumerator -> Some(entRef, genArgs) - | _ -> None - | _ -> None + | Enumerator -> ValueSome(entRef, genArgs) + | _ -> ValueNone + | _ -> ValueNone +[] let (|IsNewAnonymousRecord|_|) = function // The F# compiler may create some bindings of expression arguments to fix https://github.com/dotnet/fsharp/issues/6487 | NestedRevLets(bindings, Value(NewAnonymousRecord(exprs, fieldNames, genArgs, isStruct), r)) -> - Some(List.rev bindings, exprs, fieldNames, genArgs, isStruct, r) + ValueSome(List.rev bindings, exprs, fieldNames, genArgs, isStruct, r) | Value(NewAnonymousRecord(exprs, fieldNames, genArgs, isStruct), r) -> - Some([], exprs, fieldNames, genArgs, isStruct, r) - | _ -> None + ValueSome([], exprs, fieldNames, genArgs, isStruct, r) + | _ -> ValueNone let (|ListSingleton|) x = [ x ] @@ -938,13 +965,14 @@ let (|MaybeInScope|) (ctx: Context) e = | None -> e | e -> e +[] let rec (|MaybeInScopeStringConst|_|) ctx = function | MaybeInScope ctx expr -> match expr with - | StringConst s -> Some s + | StringConst s -> ValueSome s | Operation(Binary(BinaryPlus, (MaybeInScopeStringConst ctx s1), (MaybeInScopeStringConst ctx s2)), _, _, _) -> - Some(s1 + s2) + ValueSome(s1 + s2) | Value(StringTemplate(None, start :: parts, values), _) -> (Some [], values) ||> List.fold (fun acc value -> @@ -958,7 +986,10 @@ let rec (|MaybeInScopeStringConst|_|) ctx = (start, valuesAndParts) ||> List.fold (fun acc (v, p) -> acc + v + p) ) - | _ -> None + |> function + | Some x -> ValueSome x + | None -> ValueNone + | _ -> ValueNone let rec (|RequireStringConst|) com (ctx: Context) r e = match e with @@ -977,13 +1008,14 @@ let rec (|RequireStringConstOrTemplate|) com (ctx: Context) r e = addError com ctx.InlinePath r "Expecting string literal" [ "" ], [] +[] let (|CustomOp|_|) (com: ICompiler) (ctx: Context) r t opName (argExprs: Expr list) sourceTypes = let argTypes = argExprs |> List.map (fun a -> a.Type) match FSharp2Fable.TypeHelpers.tryFindWitness ctx argTypes false opName with | Some w -> let callInfo = makeCallInfo None argExprs w.ArgTypes - makeCall r t callInfo w.Expr |> Some + makeCall r t callInfo w.Expr |> ValueSome | None -> sourceTypes |> List.tryPick ( @@ -995,7 +1027,11 @@ let (|CustomOp|_|) (com: ICompiler) (ctx: Context) r t opName (argExprs: Expr li | _ -> None ) |> Option.map (FSharp2Fable.Util.makeCallFrom com ctx r t [] None argExprs) + |> function + | Some x -> ValueSome x + | None -> ValueNone +[] let (|RegexFlags|_|) e = let rec getFlags = function @@ -1013,12 +1049,18 @@ let (|RegexFlags|_|) e = | _ -> None | _ -> None - getFlags e + match getFlags e with + | Some x -> ValueSome x + | None -> ValueNone +[] let (|UniversalFableCoreHelpers|_|) (com: ICompiler) (ctx: Context) r t (i: CallInfo) args error = function - | "op_ErasedCast" -> List.tryHead args - | ".ctor" -> typedObjExpr t [] |> Some + | "op_ErasedCast" -> + match List.tryHead args with + | Some x -> ValueSome x + | None -> ValueNone + | ".ctor" -> typedObjExpr t [] |> ValueSome | "jsNative" | "pyNative" | "nativeOnly" -> @@ -1034,19 +1076,19 @@ let (|UniversalFableCoreHelpers|_|) (com: ICompiler) (ctx: Context) r t (i: Call |> StringConstant |> makeValue None - makeThrow r t (error com runtimeMsg) |> Some + makeThrow r t (error com runtimeMsg) |> ValueSome | "nameof" | "nameof2" as meth -> match args with | [ Nameof com ctx name as arg ] -> if meth = "nameof2" then - makeTuple r true [ makeStrConst name; arg ] |> Some + makeTuple r true [ makeStrConst name; arg ] |> ValueSome else - makeStrConst name |> Some + makeStrConst name |> ValueSome | _ -> "Cannot infer name of expression" |> addError com ctx.InlinePath r - makeStrConst Naming.unknown |> Some + makeStrConst Naming.unknown |> ValueSome | "nameofLambda" | "namesofLambda" as meth -> @@ -1059,9 +1101,11 @@ let (|UniversalFableCoreHelpers|_|) (com: ICompiler) (ctx: Context) r t (i: Call ) |> fun names -> if meth = "namesofLambda" then - List.map makeStrConst names |> makeArray String |> Some + List.map makeStrConst names |> makeArray String |> ValueSome else - List.tryHead names |> Option.map makeStrConst + match List.tryHead names |> Option.map makeStrConst with + | Some x -> ValueSome x + | None -> ValueNone | "casenameWithFieldCount" | "casenameWithFieldIndex" as meth -> @@ -1106,8 +1150,11 @@ let (|UniversalFableCoreHelpers|_|) (com: ICompiler) (ctx: Context) r t (i: Call Some(Naming.unknown, -1) ) |> Option.map (fun (s, i) -> makeTuple r true [ makeStrConst s; makeIntConst i ]) + |> function + | Some x -> ValueSome x + | None -> ValueNone - | _ -> None + | _ -> ValueNone module AnonRecords = open System @@ -1166,16 +1213,16 @@ module AnonRecords = tys |> List.map (fun t -> Fable.Option(makeType t, isStruct)) |> List.distinct | _ -> makeType ty |> List.singleton - and private (|OptionType|_|) (ty: FSharpType) = + and [] private (|OptionType|_|) (ty: FSharpType) = match ty with | Patterns.TypeDefinition tdef -> match FsEnt.FullName tdef with - | Types.valueOption -> Some(Helpers.nonAbbreviatedType ty.GenericArguments[0], true) - | Types.option -> Some(Helpers.nonAbbreviatedType ty.GenericArguments[0], false) - | _ -> None - | _ -> None + | Types.valueOption -> ValueSome(Helpers.nonAbbreviatedType ty.GenericArguments[0], true) + | Types.option -> ValueSome(Helpers.nonAbbreviatedType ty.GenericArguments[0], false) + | _ -> ValueNone + | _ -> ValueNone - and private (|UType|_|) (ty: FSharpType) = + and [] private (|UType|_|) (ty: FSharpType) = let (|UName|_|) (tdef: FSharpEntity) = if tdef.Namespace = Some "Fable.Core" @@ -1187,8 +1234,8 @@ module AnonRecords = None match ty with - | Patterns.TypeDefinition UName -> ty.GenericArguments |> Seq.mapToList Helpers.nonAbbreviatedType |> Some - | _ -> None + | Patterns.TypeDefinition UName -> ty.GenericArguments |> Seq.mapToList Helpers.nonAbbreviatedType |> ValueSome + | _ -> ValueNone /// Special Rules mostly for Indexers: /// For direct interface member implementation we want to be precise (-> exact_ish match) diff --git a/src/Fable.Transforms/Replacements.fs b/src/Fable.Transforms/Replacements.fs index d62da76075..a085664a4b 100644 --- a/src/Fable.Transforms/Replacements.fs +++ b/src/Fable.Transforms/Replacements.fs @@ -10,13 +10,15 @@ open Fable.AST.Fable open Fable.Transforms open Replacements.Util +[] let (|Floats|_|) = function | Float16 | Float32 - | Float64 as kind -> Some kind - | _ -> None + | Float64 as kind -> ValueSome kind + | _ -> ValueNone +[] let (|Integers|_|) = function | Int8 @@ -24,9 +26,10 @@ let (|Integers|_|) = | Int16 | UInt16 | Int32 - | UInt32 as kind -> Some kind - | _ -> None + | UInt32 as kind -> ValueSome kind + | _ -> ValueNone +[] let (|BigIntegers|_|) = function | Int64 @@ -35,31 +38,33 @@ let (|BigIntegers|_|) = | UInt128 | NativeInt | UNativeInt - | BigInt as kind -> Some kind - | _ -> None + | BigInt as kind -> ValueSome kind + | _ -> ValueNone +[] let (|Numbers|_|) = function - | Integers kind -> Some kind - | Floats kind -> Some kind - | _ -> None + | Integers kind -> ValueSome kind + | Floats kind -> ValueSome kind + | _ -> ValueNone +[] let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = match arrayKind, t with - | ResizeArray, _ -> None + | ResizeArray, _ -> ValueNone | _, Number(kind, _) when com.Options.TypedArrays -> match kind with - | Int8 -> Some "Int8Array" - | UInt8 when com.Options.ClampByteArrays -> Some "Uint8ClampedArray" - | UInt8 -> Some "Uint8Array" - | Int16 -> Some "Int16Array" - | UInt16 -> Some "Uint16Array" - | Int32 -> Some "Int32Array" - | UInt32 -> Some "Uint32Array" - | Int64 -> Some "BigInt64Array" - | UInt64 -> Some "BigUint64Array" - | Float32 -> Some "Float32Array" - | Float64 -> Some "Float64Array" + | Int8 -> ValueSome "Int8Array" + | UInt8 when com.Options.ClampByteArrays -> ValueSome "Uint8ClampedArray" + | UInt8 -> ValueSome "Uint8Array" + | Int16 -> ValueSome "Int16Array" + | UInt16 -> ValueSome "Uint16Array" + | Int32 -> ValueSome "Int32Array" + | UInt32 -> ValueSome "Uint32Array" + | Int64 -> ValueSome "BigInt64Array" + | UInt64 -> ValueSome "BigUint64Array" + | Float32 -> ValueSome "Float32Array" + | Float64 -> ValueSome "Float64Array" | Float16 | Int128 @@ -67,8 +72,8 @@ let (|TypedArrayCompatible|_|) (com: Compiler) (arrayKind: ArrayKind) t = | NativeInt | UNativeInt | Decimal - | BigInt -> None - | _ -> None + | BigInt -> ValueNone + | _ -> ValueNone let error com msg = Helper.LibCall(com, "Util", "Exception", Any, [ msg ], isConstructor = true) diff --git a/src/Fable.Transforms/Transforms.Util.fs b/src/Fable.Transforms/Transforms.Util.fs index 80bb5a71ec..5c3199805e 100644 --- a/src/Fable.Transforms/Transforms.Util.fs +++ b/src/Fable.Transforms/Transforms.Util.fs @@ -724,10 +724,11 @@ module AST = let inline (|EntFullName|) (e: Entity) = e.FullName let inline (|EntRefFullName|) (e: EntityRef) = e.FullName + [] let (|DeclaredTypeFullName|_|) = function - | DeclaredType(entRef, _) -> Some entRef.FullName - | _ -> None + | DeclaredType(entRef, _) -> ValueSome entRef.FullName + | _ -> ValueNone let rec uncurryLambdaType maxArity (revArgTypes: Type list) (returnType: Type) = match returnType with @@ -735,10 +736,11 @@ module AST = uncurryLambdaType (maxArity - 1) (argType :: revArgTypes) returnType | t -> List.rev revArgTypes, t + [] let (|NestedLambdaType|_|) = function - | LambdaType(argType, returnType) -> Some(uncurryLambdaType -1 [ argType ] returnType) - | _ -> None + | LambdaType(argType, returnType) -> ValueSome(uncurryLambdaType -1 [ argType ] returnType) + | _ -> ValueNone /// In lambdas with tuple arguments, F# compiler deconstructs the tuple before the next nested lambda. /// This makes it harder to uncurry lambdas, so we try to move the bindings to the inner lambda. @@ -780,21 +782,31 @@ module AST = | _ -> None /// Makes sure to capture the same number of args as the arity of the lambda - let (|NestedLambdaWithSameArity|_|) expr = nestedLambda true expr + [] + let (|NestedLambdaWithSameArity|_|) expr = + match nestedLambda true expr with + | Some x -> ValueSome x + | None -> ValueNone /// Doesn't check the type of lambda body has same arity as discovered arguments - let (|NestedLambda|_|) expr = nestedLambda false expr + [] + let (|NestedLambda|_|) expr = + match nestedLambda false expr with + | Some x -> ValueSome x + | None -> ValueNone + [] let (|NestedApply|_|) expr = let rec nestedApply r t accArgs applied = match applied with | CurriedApply(applied, args, _, _) -> nestedApply r t (args @ accArgs) applied - | _ -> Some(applied, accArgs, t, r) + | _ -> ValueSome(applied, accArgs, t, r) match expr with | CurriedApply(applied, args, t, r) -> nestedApply r t args applied - | _ -> None + | _ -> ValueNone + [] let (|LambdaUncurriedAtCompileTime|_|) arity expr = let rec uncurryLambdaInner (name: string option) accArgs remainingArity expr = if remainingArity = Some 0 then @@ -810,13 +822,19 @@ module AST = // We cannot flatten lambda to the expected arity | _, _ -> None - match expr with - // Uncurry also function options - | Value(NewOption(Some expr, _, isStruct), r) -> - uncurryLambdaInner None [] arity expr - |> Option.map (fun expr -> Value(NewOption(Some expr, expr.Type, isStruct), r)) - | _ -> uncurryLambdaInner None [] arity expr + let result = + match expr with + // Uncurry also function options + | Value(NewOption(Some expr, _, isStruct), r) -> + uncurryLambdaInner None [] arity expr + |> Option.map (fun expr -> Value(NewOption(Some expr, expr.Type, isStruct), r)) + | _ -> uncurryLambdaInner None [] arity expr + match result with + | Some x -> ValueSome x + | None -> ValueNone + + [] let (|NestedRevLets|_|) expr = let rec inner bindings = function @@ -824,8 +842,8 @@ module AST = | body -> bindings, body match expr with - | Let(i, v, body) -> inner [ i, v ] body |> Some - | _ -> None + | Let(i, v, body) -> inner [ i, v ] body |> ValueSome + | _ -> ValueNone let rec (|MaybeCasted|) = function @@ -848,49 +866,56 @@ module AST = | MaybeCasted(LambdaUncurriedAtCompileTime None lambda) -> lambda | e -> e + [] let (|StringConst|_|) = function - | MaybeCasted(Value(StringConstant str, _)) -> Some str - | _ -> None + | MaybeCasted(Value(StringConstant str, _)) -> ValueSome str + | _ -> ValueNone + [] let (|StringTempl|_|) = function - | MaybeCasted(Value(StringTemplate(None, [ fmt ], args), _)) -> Some(fmt, args) - | _ -> None + | MaybeCasted(Value(StringTemplate(None, [ fmt ], args), _)) -> ValueSome(fmt, args) + | _ -> ValueNone + [] let (|BoolConst|_|) = function - | MaybeCasted(Value(BoolConstant v, _)) -> Some v - | _ -> None + | MaybeCasted(Value(BoolConstant v, _)) -> ValueSome v + | _ -> ValueNone + [] let (|NumberConst|_|) = function - | MaybeCasted(Value(NumberConstant(value, info), _)) -> Some(value, info) - | _ -> None + | MaybeCasted(Value(NumberConstant(value, info), _)) -> ValueSome(value, info) + | _ -> ValueNone + [] let (|NullConst|_|) = function - | MaybeCasted(Value(Null _, _)) -> Some() - | _ -> None + | MaybeCasted(Value(Null _, _)) -> ValueSome() + | _ -> ValueNone + [] let (|StringComparisonEnumValue|_|) e = match e with | Expr.Value(kind = NumberConstant(info = NumberInfo.IsEnum({ FullName = "System.StringComparison" }))) -> - Some() - | _ -> None + ValueSome() + | _ -> ValueNone + [] let (|NormalizationFormEnumValue|_|) e = match e with | Expr.Value( kind = NumberConstant(NumberValue.Int32 value, NumberInfo.IsEnum({ FullName = "System.Text.NormalizationForm" }))) -> match value with - | 1 -> Some "NFC" - | 2 -> Some "NFD" - | 5 -> Some "NFKC" - | 6 -> Some "NFKD" - | _ -> None - | _ -> None + | 1 -> ValueSome "NFC" + | 2 -> ValueSome "NFD" + | 5 -> ValueSome "NFKC" + | 6 -> ValueSome "NFKD" + | _ -> ValueNone + | _ -> ValueNone // TODO: Improve this, see https://github.com/fable-compiler/Fable/issues/1659#issuecomment-445071965 // This is mainly used for inlining so a computation or a reference to a mutable value are understood