diff --git a/src/Compiler/AbstractIL/ilread.fs b/src/Compiler/AbstractIL/ilread.fs index 78082e34ca7..4d28a9e9246 100644 --- a/src/Compiler/AbstractIL/ilread.fs +++ b/src/Compiler/AbstractIL/ilread.fs @@ -5014,11 +5014,11 @@ let OpenILModuleReader fileName opts = if keyOk && opts.pdbDirPath.IsNone then ilModuleReaderCache1Lock.AcquireLock(fun ltok -> ilModuleReaderCache1.TryGet(ltok, key)) else - None + ValueNone match cacheResult1 with - | Some ilModuleReader -> ilModuleReader - | None -> + | ValueSome ilModuleReader -> ilModuleReader + | ValueNone -> let cacheResult2 = // can't used a cached entry when reading PDBs, since it makes the returned object IDisposable diff --git a/src/Compiler/Checking/AttributeChecking.fs b/src/Compiler/Checking/AttributeChecking.fs index 2f02f794e8b..b0bc200e8fd 100644 --- a/src/Compiler/Checking/AttributeChecking.fs +++ b/src/Compiler/Checking/AttributeChecking.fs @@ -7,6 +7,7 @@ module internal FSharp.Compiler.AttributeChecking open System open System.Collections.Generic open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler open FSharp.Compiler.DiagnosticsLogger @@ -19,6 +20,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy + #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders open FSharp.Core.CompilerServices @@ -195,21 +197,21 @@ let BindMethInfoAttributes m minfo f1 f2 f3 = /// Analyze three cases for attributes declared on methods: IL-declared attributes, F#-declared attributes and /// provided attributes. -let TryBindMethInfoAttribute g (m: range) (AttribInfo(atref, _) as attribSpec) minfo f1 f2 f3 = +let TryBindMethInfoAttribute g (m: range) (AttribInfo(atref, _) as attribSpec) minfo f1 f2 f3 = #if NO_TYPEPROVIDERS // to prevent unused parameter warning ignore f3 #endif BindMethInfoAttributes m minfo - (fun ilAttribs -> TryDecodeILAttribute atref ilAttribs |> Option.bind f1) - (fun fsAttribs -> TryFindFSharpAttribute g attribSpec fsAttribs |> Option.bind f2) + (fun ilAttribs -> TryDecodeILAttribute atref ilAttribs |> ValueOption.bind f1) + (fun fsAttribs -> TryFindFSharpAttribute g attribSpec fsAttribs |> ValueOption.bind f2) #if !NO_TYPEPROVIDERS (fun provAttribs -> match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)), m) with | Some args -> f3 args - | None -> None) + | None -> ValueNone) #else - (fun _provAttribs -> None) + (fun _provAttribs -> ValueNone) #endif /// Try to find a specific attribute on a method, where the attribute accepts a string argument. @@ -217,17 +219,17 @@ let TryBindMethInfoAttribute g (m: range) (AttribInfo(atref, _) as attribSpec) m /// This is just used for the 'ConditionalAttribute' attribute let TryFindMethInfoStringAttribute g (m: range) attribSpec minfo = TryBindMethInfoAttribute g m attribSpec minfo - (function [ILAttribElem.String (Some msg) ], _ -> Some msg | _ -> None) - (function Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> Some msg | _ -> None) - (function [ Some (:? string as msg : obj) ], _ -> Some msg | _ -> None) + (function [ILAttribElem.String (Some msg) ], _ -> ValueSome msg | _ -> ValueNone) + (function Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> ValueSome msg | _ -> ValueNone) + (function [ Some (:? string as msg : obj) ], _ -> ValueSome msg | _ -> ValueNone) /// Check if a method has a specific attribute. let MethInfoHasAttribute g m attribSpec minfo = TryBindMethInfoAttribute g m attribSpec minfo - (fun _ -> Some ()) - (fun _ -> Some ()) - (fun _ -> Some ()) - |> Option.isSome + (fun _ -> ValueSome ()) + (fun _ -> ValueSome ()) + (fun _ -> ValueSome ()) + |> ValueOption.isSome let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = @@ -236,7 +238,7 @@ let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = // ObsoleteAttribute should be ignored if CompilerFeatureRequiredAttribute is present, and its name is "RequiredMembers". let (AttribInfo(tref,_)) = g.attrib_CompilerFeatureRequiredAttribute match TryDecodeILAttribute tref cattrs with - | Some([ILAttribElem.String (Some featureName) ], _) when featureName = "RequiredMembers" -> + | ValueSome([ILAttribElem.String (Some featureName) ], _) when featureName = "RequiredMembers" -> CompleteD | _ -> ErrorD (ObsoleteError(msg, m)) @@ -245,9 +247,9 @@ let private CheckCompilerFeatureRequiredAttribute (g: TcGlobals) cattrs msg m = let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = let (AttribInfo(tref,_)) = g.attrib_SystemObsolete match TryDecodeILAttribute tref cattrs with - | Some ([ILAttribElem.String (Some msg) ], _) when not isByrefLikeTyconRef -> + | ValueSome ([ILAttribElem.String (Some msg) ], _) when not isByrefLikeTyconRef -> WarnD(ObsoleteWarning(msg, m)) - | Some ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], _) when not isByrefLikeTyconRef -> + | ValueSome ([ILAttribElem.String (Some msg); ILAttribElem.Bool isError ], _) when not isByrefLikeTyconRef -> if isError then if g.langVersion.SupportsFeature(LanguageFeature.RequiredPropertiesSupport) then CheckCompilerFeatureRequiredAttribute g cattrs msg m @@ -255,9 +257,9 @@ let private CheckILAttributes (g: TcGlobals) isByrefLikeTyconRef cattrs m = ErrorD (ObsoleteError(msg, m)) else WarnD (ObsoleteWarning(msg, m)) - | Some ([ILAttribElem.String None ], _) when not isByrefLikeTyconRef -> + | ValueSome ([ILAttribElem.String None ], _) when not isByrefLikeTyconRef -> WarnD(ObsoleteWarning("", m)) - | Some _ when not isByrefLikeTyconRef -> + | ValueSome _ when not isByrefLikeTyconRef -> WarnD(ObsoleteWarning("", m)) | _ -> CompleteD @@ -271,20 +273,20 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = else trackErrors { match TryFindFSharpAttribute g g.attrib_SystemObsolete attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> do! WarnD(ObsoleteWarning(s, m)) - | Some(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribStringArg s; AttribBoolArg(isError) ], _, _, _, _)) -> if isError then do! ErrorD (ObsoleteError(s, m)) else do! WarnD (ObsoleteWarning(s, m)) - | Some _ -> + | ValueSome _ -> do! WarnD(ObsoleteWarning("", m)) - | None -> + | ValueNone -> () match TryFindFSharpAttribute g g.attrib_CompilerMessageAttribute attribs with - | Some(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribStringArg s ; AttribInt32Arg n ], namedArgs, _, _, _)) -> let msg = UserCompilerMessage(s, n, m) let isError = match namedArgs with @@ -302,7 +304,7 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = () match TryFindFSharpAttribute g g.attrib_ExperimentalAttribute attribs with - | Some(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribStringArg(s) ], _, _, _, _)) -> let isExperimentalAttributeDisabled (s:string) = if g.compilingFSharpCore then true @@ -310,13 +312,13 @@ let CheckFSharpAttributes (g:TcGlobals) attribs m = g.langVersion.IsPreviewEnabled && (s.IndexOf(langVersionPrefix, StringComparison.OrdinalIgnoreCase) >= 0) if not (isExperimentalAttributeDisabled s) then do! WarnD(Experimental(s, m)) - | Some _ -> + | ValueSome _ -> do! WarnD(Experimental(FSComp.SR.experimentalConstruct (), m)) | _ -> () match TryFindFSharpAttribute g g.attrib_UnverifiableAttribute attribs with - | Some _ -> + | ValueSome _ -> do! WarnD(PossibleUnverifiableCode(m)) | _ -> () @@ -344,14 +346,14 @@ let private CheckProvidedAttributes (g: TcGlobals) m (provAttribs: Tainted // Message number 62 is for "ML Compatibility". Items labelled with this are visible in intellisense // when mlCompatibility is set. @@ -359,7 +361,7 @@ let CheckFSharpAttributesForHidden g attribs = | _ -> false) || (match TryFindFSharpAttribute g g.attrib_ComponentModelEditorBrowsableAttribute attribs with - | Some(Attrib(_, _, [AttribInt32Arg state], _, _, _, _)) -> state = int System.ComponentModel.EditorBrowsableState.Never + | ValueSome(Attrib(_, _, [AttribInt32Arg state], _, _, _, _)) -> state = int System.ComponentModel.EditorBrowsableState.Never | _ -> false) /// Indicate if a list of F# attributes contains 'ObsoleteAttribute'. Used to suppress the item in intellisense. diff --git a/src/Compiler/Checking/AttributeChecking.fsi b/src/Compiler/Checking/AttributeChecking.fsi index b4a608ef1d1..8f2a35a8886 100644 --- a/src/Compiler/Checking/AttributeChecking.fsi +++ b/src/Compiler/Checking/AttributeChecking.fsi @@ -43,24 +43,24 @@ val TryBindMethInfoAttribute: m: range -> BuiltinAttribInfo -> minfo: MethInfo -> - f1: (ILAttribElem list * ILAttributeNamedArg list -> 'a option) -> - f2: (Attrib -> 'a option) -> + f1: (ILAttribElem list * ILAttributeNamedArg list -> 'a voption) -> + f2: (Attrib -> 'a voption) -> f3: _ -> - 'a option + 'a voption #else val TryBindMethInfoAttribute: g: TcGlobals -> m: range -> BuiltinAttribInfo -> minfo: MethInfo -> - f1: (ILAttribElem list * ILAttributeNamedArg list -> 'a option) -> - f2: (Attrib -> 'a option) -> - f3: (obj option list * (string * obj option) list -> 'a option) -> - 'a option + f1: (ILAttribElem list * ILAttributeNamedArg list -> 'a voption) -> + f2: (Attrib -> 'a voption) -> + f3: (obj option list * (string * obj option) list -> 'a voption) -> + 'a voption #endif val TryFindMethInfoStringAttribute: - g: TcGlobals -> m: range -> attribSpec: BuiltinAttribInfo -> minfo: MethInfo -> string option + g: TcGlobals -> m: range -> attribSpec: BuiltinAttribInfo -> minfo: MethInfo -> string voption val MethInfoHasAttribute: g: TcGlobals -> m: range -> attribSpec: BuiltinAttribInfo -> minfo: MethInfo -> bool diff --git a/src/Compiler/Checking/CheckComputationExpressions.fs b/src/Compiler/Checking/CheckComputationExpressions.fs index 26b10550394..2dc918860a7 100644 --- a/src/Compiler/Checking/CheckComputationExpressions.fs +++ b/src/Compiler/Checking/CheckComputationExpressions.fs @@ -5,6 +5,7 @@ module internal FSharp.Compiler.CheckComputationExpressions open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckExpressions @@ -37,21 +38,23 @@ let TryFindIntrinsicOrExtensionMethInfo collectionSettings (cenv: cenv) (env: Tc AllMethInfosOfTypeInScope collectionSettings cenv.infoReader env.NameEnv (Some nm) ad IgnoreOverrides m ty /// Ignores an attribute -let IgnoreAttribute _ = None +let inline IgnoreAttribute _ = ValueNone +[] let (|ExprAsPat|_|) (f: SynExpr) = match f with - | SingleIdent v1 | SynExprParen(SingleIdent v1, _, _, _) -> Some (mkSynPatVar None v1) + | SingleIdent v1 | SynExprParen(SingleIdent v1, _, _, _) -> ValueSome (mkSynPatVar None v1) | SynExprParen(SynExpr.Tuple (false, elems, commas, _), _, _, _) -> let elems = elems |> List.map (|SingleIdent|_|) if elems |> List.forall (fun x -> x.IsSome) then - Some (SynPat.Tuple(false, (elems |> List.map (fun x -> mkSynPatVar None x.Value)), commas, f.Range)) + ValueSome (SynPat.Tuple(false, (elems |> List.map (fun x -> mkSynPatVar None x.Value)), commas, f.Range)) else - None - | _ -> None + ValueNone + | _ -> ValueNone // For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition, // then pull the syntax apart again +[] let (|JoinRelation|_|) cenv env (expr: SynExpr) = let m = expr.Range let ad = env.eAccessRights @@ -63,23 +66,23 @@ let (|JoinRelation|_|) cenv env (expr: SynExpr) = | _ -> false match expr with - | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> Some (a, b) + | BinOpExpr(opId, a, b) when isOpName opNameEquals cenv.g.equals_operator_vref opId.idText -> ValueSome (a, b) | BinOpExpr(opId, a, b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText -> let a = SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [MangledGlobalName;"System"] "Nullable", a, a.Range) - Some (a, b) + ValueSome (a, b) | BinOpExpr(opId, a, b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText -> let b = SynExpr.App (ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [MangledGlobalName;"System"] "Nullable", b, b.Range) - Some (a, b) + ValueSome (a, b) | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> - Some (a, b) + ValueSome (a, b) - | _ -> None + | _ -> ValueNone let elimFastIntegerForLoop (spFor, spTo, id, start: SynExpr, dir, finish: SynExpr, innerExpr, m: range) = let mOp = (unionRanges start.Range finish.Range).MakeSynthetic() @@ -162,6 +165,7 @@ let YieldFree (cenv: cenv) expr = /// of semicolon separated values". For example [1;2;3]. /// 'acceptDeprecated' is true for the '[ ... ]' case, where we allow the syntax '[ if g then t else e ]' but ask it to be parenthesized /// +[] let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = let IsSimpleSemicolonSequenceElement expr = @@ -189,12 +193,12 @@ let (|SimpleSemicolonSequence|_|) cenv acceptDeprecated cexpr = if IsSimpleSemicolonSequenceElement e1 then TryGetSimpleSemicolonSequenceOfComprehension e2 (e1 :: acc) else - None + ValueNone | _ -> if IsSimpleSemicolonSequenceElement expr then - Some(List.rev (expr :: acc)) + ValueSome(List.rev (expr :: acc)) else - None + ValueNone TryGetSimpleSemicolonSequenceOfComprehension cexpr [] @@ -217,18 +221,18 @@ let RecordNameAndTypeResolutions cenv env tpenv expr = /// Used for all computation expressions except sequence expressions let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhole, interpExpr: Expr, builderTy, comp: SynExpr) = let overallTy = overallTy.Commit - + let g = cenv.g let ad = env.eAccessRights let mkSynDelay2 (e: SynExpr) = mkSynDelay (e.Range.MakeSynthetic()) e - + let builderValName = CompilerGeneratedName "builder" let mBuilderVal = interpExpr.Range - + // Give bespoke error messages for the FSharp.Core "query" builder - let isQuery = - match stripDebugPoints interpExpr with + let isQuery = + match stripDebugPoints interpExpr with // An unparameterized custom builder, e.g., `query`, `async`. | Expr.Val (vref, _, m) // A parameterized custom builder, e.g., `builder<…>`, `builder ()`. @@ -246,7 +250,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | [] -> SynExpr.Const (SynConst.Unit, m) | [arg] -> SynExpr.Paren (SynExpr.Paren (arg, range0, None, m), range0, None, m) | args -> SynExpr.Paren (SynExpr.Tuple (false, args, [], m), range0, None, m) - + let builderVal = mkSynIdGet m builderValName mkSynApp1 (SynExpr.DotGet (builderVal, range0, SynLongIdent([mkSynId m nm], [], [None]), m)) args m @@ -267,39 +271,42 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let isAutoQuote = hasMethInfo "Quote" let customOperationMethods = - AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides mBuilderVal builderTy - |> List.choose (fun methInfo -> - if not (IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo) then None else + let allMethInfosInScope = AllMethInfosOfTypeInScope ResultCollectionSettings.AllResults cenv.infoReader env.NameEnv None ad IgnoreOverrides mBuilderVal builderTy + + [ for methInfo in allMethInfosInScope do + if not (IsMethInfoAccessible cenv.amap mBuilderVal ad methInfo) then + () + else let nameSearch = - TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo + TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo IgnoreAttribute // We do not respect this attribute for IL methods - (function Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> Some msg | _ -> None) + (function Attrib(_, _, [ AttribStringArg msg ], _, _, _, _) -> ValueSome msg | _ -> ValueNone) IgnoreAttribute // We do not respect this attribute for provided methods match nameSearch with - | None -> None - | Some nm -> + | ValueNone -> () + | ValueSome nm -> let joinConditionWord = - TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo + TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo IgnoreAttribute // We do not respect this attribute for IL methods - (function Attrib(_, _, _, ExtractAttribNamedArg "JoinConditionWord" (AttribStringArg s), _, _, _) -> Some s | _ -> None) + (function Attrib(_, _, _, ExtractAttribNamedArg "JoinConditionWord" (AttribStringArg s), _, _, _) -> ValueSome s | _ -> ValueNone) IgnoreAttribute // We do not respect this attribute for provided methods - let flagSearch (propName: string) = - TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo + let flagSearch (propName: string) = + TryBindMethInfoAttribute cenv.g mBuilderVal cenv.g.attrib_CustomOperationAttribute methInfo IgnoreAttribute // We do not respect this attribute for IL methods - (function Attrib(_, _, _, ExtractAttribNamedArg propName (AttribBoolArg b), _, _, _) -> Some b | _ -> None) + (function Attrib(_, _, _, ExtractAttribNamedArg propName (AttribBoolArg b), _, _, _) -> ValueSome b | _ -> ValueNone) IgnoreAttribute // We do not respect this attribute for provided methods - let maintainsVarSpaceUsingBind = defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false - let maintainsVarSpace = defaultArg (flagSearch "MaintainsVariableSpace") false - let allowInto = defaultArg (flagSearch "AllowIntoPattern") false - let isLikeZip = defaultArg (flagSearch "IsLikeZip") false - let isLikeJoin = defaultArg (flagSearch "IsLikeJoin") false - let isLikeGroupJoin = defaultArg (flagSearch "IsLikeGroupJoin") false - - Some (nm, maintainsVarSpaceUsingBind, maintainsVarSpace, allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, joinConditionWord, methInfo)) + let maintainsVarSpaceUsingBind = ValueOption.defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false + let maintainsVarSpace = ValueOption.defaultArg (flagSearch "MaintainsVariableSpace") false + let allowInto = ValueOption.defaultArg (flagSearch "AllowIntoPattern") false + let isLikeZip = ValueOption.defaultArg (flagSearch "IsLikeZip") false + let isLikeJoin = ValueOption.defaultArg (flagSearch "IsLikeJoin") false + let isLikeGroupJoin = ValueOption.defaultArg (flagSearch "IsLikeGroupJoin") false + (nm, maintainsVarSpaceUsingBind, maintainsVarSpace, allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, joinConditionWord, methInfo) + ] let customOperationMethodsIndexedByKeyword = if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then customOperationMethods @@ -337,8 +344,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | _ :: _ -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations | _ -> false - match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with - | true, opDatas when isOpDataCountAllowed opDatas -> + match customOperationMethodsIndexedByKeyword.TryGetValue nm.idText with + | true, opDatas when isOpDataCountAllowed opDatas -> for opData in opDatas do let opName, maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, methInfo = opData if (maintainsVarSpaceUsingBind && maintainsVarSpace) || (isLikeZip && isLikeJoin) || (isLikeZip && isLikeGroupJoin) || (isLikeJoin && isLikeGroupJoin) then @@ -347,14 +354,16 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol match customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with | true, [_] -> () | _ -> errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) - Some opDatas - | true, opData :: _ -> errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)); Some [opData] - | _ -> None + ValueSome opDatas + | true, opData :: _ -> + errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) + ValueSome [opData] + | _ -> ValueNone /// Decide if the identifier represents a use of a custom query operator let hasCustomOperations () = if isNil customOperationMethods then CustomOperationsMode.Denied else CustomOperationsMode.Allowed - let isCustomOperation nm = tryGetDataForCustomOperation nm |> Option.isSome + let isCustomOperation nm = tryGetDataForCustomOperation nm |> ValueOption.isSome let customOperationCheckValidity m f opDatas = let vs = opDatas |> List.map f @@ -367,50 +376,50 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // Check for the MaintainsVariableSpace on custom operation let customOperationMaintainsVarSpace (nm: Ident) = match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> + | ValueNone -> false + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, _maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> maintainsVarSpace) let customOperationMaintainsVarSpaceUsingBind (nm: Ident) = match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> + | ValueNone -> false + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> maintainsVarSpaceUsingBind) let customOperationIsLikeZip (nm: Ident) = match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> + | ValueNone -> false + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeZip) let customOperationIsLikeJoin (nm: Ident) = match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> + | ValueNone -> false + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeJoin) let customOperationIsLikeGroupJoin (nm: Ident) = match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> + | ValueNone -> false + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, isLikeGroupJoin, _joinConditionWord, _methInfo) -> isLikeGroupJoin) let customOperationJoinConditionWord (nm: Ident) = match tryGetDataForCustomOperation nm with - | Some opDatas -> + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, joinConditionWord, _methInfo) -> joinConditionWord) - |> function None -> "on" | Some v -> v - | _ -> "on" + |> function ValueNone -> "on" | ValueSome v -> v + | _ -> "on" let customOperationAllowsInto (nm: Ident) = match tryGetDataForCustomOperation nm with - | None -> false - | Some opDatas -> + | ValueNone -> false + | ValueSome opDatas -> opDatas |> customOperationCheckValidity nm.idRange (fun (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, _methInfo) -> allowInto) let customOpUsageText nm = match tryGetDataForCustomOperation nm with - | Some ((_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, _methInfo) :: _) -> + | ValueSome ((_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, _methInfo) :: _) -> if isLikeGroupJoin then Some (FSComp.SR.customOperationTextLikeGroupJoin(nm.idText, customOperationJoinConditionWord nm, customOperationJoinConditionWord nm)) elif isLikeJoin then @@ -419,7 +428,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol Some (FSComp.SR.customOperationTextLikeZip(nm.idText)) else None - | _ -> None + | _ -> None /// Inside the 'query { ... }' use a modified name environment that contains fake 'CustomOperation' entries /// for all custom operations. This adds them to the completion lists and prevents them being used as values inside @@ -437,34 +446,34 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let tryGetArgAttribsForCustomOperator (nm: Ident) = match tryGetDataForCustomOperation nm with - | Some argInfos -> + | ValueSome argInfos -> argInfos |> List.map (fun (_nm, __maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, methInfo) -> match methInfo.GetParamAttribs(cenv.amap, mWhole) with - | [curriedArgInfo] -> Some curriedArgInfo // one for the actual argument group - | _ -> None) - |> Some - | _ -> None + | [curriedArgInfo] -> ValueSome curriedArgInfo // one for the actual argument group + | _ -> ValueNone) + |> ValueSome + | _ -> ValueNone let tryGetArgInfosForCustomOperator (nm: Ident) = match tryGetDataForCustomOperation nm with - | Some argInfos -> + | ValueSome argInfos -> argInfos |> List.map (fun (_nm, __maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, methInfo) -> match methInfo with | FSMeth(_, _, vref, _) -> match ArgInfosOfMember cenv.g vref with - | [curriedArgInfo] -> Some curriedArgInfo - | _ -> None - | _ -> None) - |> Some - | _ -> None + | [curriedArgInfo] -> ValueSome curriedArgInfo + | _ -> ValueNone + | _ -> ValueNone) + |> ValueSome + | _ -> ValueNone let tryExpectedArgCountForCustomOperator (nm: Ident) = match tryGetArgAttribsForCustomOperator nm with - | None -> None - | Some argInfosForOverloads -> - let nums = argInfosForOverloads |> List.map (function None -> -1 | Some argInfos -> List.length argInfos) + | ValueNone -> ValueNone + | ValueSome argInfosForOverloads -> + let nums = argInfosForOverloads |> List.map (function ValueNone -> -1 | ValueSome argInfos -> List.length argInfos) // Prior to 'OverloadsForCustomOperations' we count exact arguments. // @@ -474,26 +483,26 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol if cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations then argInfosForOverloads |> List.exists (fun info -> match info with - | None -> false - | Some args -> + | ValueNone -> false + | ValueSome args -> args |> List.exists (fun (ParamAttribs(isParamArrayArg, _isInArg, isOutArg, optArgInfo, _callerInfo, _reflArgInfo)) -> isParamArrayArg || isOutArg || optArgInfo.IsOptional)) else false if not isSpecial && nums |> List.forall (fun v -> v >= 0 && v = nums[0]) then - Some (max (nums[0] - 1) 0) // drop the computation context argument + ValueSome (max (nums[0] - 1) 0) // drop the computation context argument else - None + ValueNone // Check for the [] attribute on an argument position let isCustomOperationProjectionParameter i (nm: Ident) = match tryGetArgInfosForCustomOperator nm with - | None -> false - | Some argInfosForOverloads -> + | ValueNone -> false + | ValueSome argInfosForOverloads -> let vs = argInfosForOverloads |> List.map (function - | None -> false - | Some argInfos -> + | ValueNone -> false + | ValueSome argInfos -> i < argInfos.Length && let _, argInfo = List.item i argInfos HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs) @@ -524,8 +533,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // e1 on e2 (note: 'on' is the 'JoinConditionWord') let (|OnExpr|_|) nm synExpr = match tryGetDataForCustomOperation nm with - | None -> None - | Some _ -> + | ValueNone -> None + | ValueSome _ -> match synExpr with | SynExpr.App (_, _, SynExpr.App (_, _, e1, SingleIdent opName, _), e2, _) when opName.idText = customOperationJoinConditionWord nm -> let item = Item.CustomOperation (opName.idText, (fun () -> None), None) @@ -685,7 +694,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol Some intoInfo | None -> None - Some (nm, Option.get (tryGetDataForCustomOperation nm), core, core.Range, intoInfoOpt) + Some (nm, ValueOption.get (tryGetDataForCustomOperation nm), core, core.Range, intoInfoOpt) | _ -> None let mkSynLambda p e m = SynExpr.Lambda (false, false, p, e, None, m, SynExprLambdaTrivia.Zero) @@ -737,20 +746,20 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol match comp with | StripApps(SingleIdent nm, [StripApps(SingleIdent nm2, args); arg2]) when IsLogicalInfixOpName nm.idText && - (match tryExpectedArgCountForCustomOperator nm2 with Some n -> n > 0 | _ -> false) && + (match tryExpectedArgCountForCustomOperator nm2 with ValueSome n -> n > 0 | _ -> false) && not (List.isEmpty args) -> let estimatedRangeOfIntendedLeftAndRightArguments = unionRanges (List.last args).Range arg2.Range errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(), estimatedRangeOfIntendedLeftAndRightArguments)) true | SynExpr.Tuple (false, StripApps(SingleIdent nm2, args) :: _, _, m) when - (match tryExpectedArgCountForCustomOperator nm2 with Some n -> n > 0 | _ -> false) && + (match tryExpectedArgCountForCustomOperator nm2 with ValueSome n -> n > 0 | _ -> false) && not (List.isEmpty args) -> let estimatedRangeOfIntendedLeftAndRightArguments = unionRanges (List.last args).Range m.EndRange errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(), estimatedRangeOfIntendedLeftAndRightArguments)) true | _ -> false - + let addVarsToVarSpace (varSpace: LazyWithContext) f = LazyWithContext.Create ((fun m -> @@ -840,8 +849,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // check 'join' or 'groupJoin' or 'zip' is permitted for this builder match tryGetDataForCustomOperation nm with - | None -> error(Error(FSComp.SR.tcMissingCustomOperation(nm.idText), nm.idRange)) - | Some opDatas -> + | ValueNone -> error(Error(FSComp.SR.tcMissingCustomOperation(nm.idText), nm.idRange)) + | ValueSome opDatas -> let opName, _, _, _, _, _, _, _, methInfo = opDatas[0] // Record the resolution of the custom operation for posterity @@ -953,13 +962,13 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let varSpacePat = mkPatForVarSpace mOpCore valsInner let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr let consumingExpr = SynExpr.ForEach (DebugPointAtFor.No, DebugPointAtInOrTo.No, SeqExprOnly false, false, varSpacePat, joinExpr, innerComp, mOpCore) - Some (trans CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) + ValueSome (trans CompExprTranslationPass.Initial q varSpaceInner consumingExpr translatedCtxt) | SynExpr.ForEach (spFor, spIn, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _mEntireForEach) -> let sourceExpr = match RewriteRangeExpr sourceExpr with - | Some e -> e - | None -> sourceExpr + | ValueSome e -> e + | ValueNone -> sourceExpr let wrappedSourceExpr = mkSourceExprConditional isFromSource sourceExpr let mFor = @@ -986,7 +995,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv pat None vspecs, envinner) - Some (trans CompExprTranslationPass.Initial q varSpace innerComp + ValueSome (trans CompExprTranslationPass.Initial q varSpace innerComp (fun innerCompR -> let forCall = @@ -1006,7 +1015,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol if isQuery then errorR(Error(FSComp.SR.tcNoIntegerForLoopInQuery(), mFor)) let reduced = elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m) - Some (trans CompExprTranslationPass.Initial q varSpace reduced translatedCtxt ) + ValueSome (trans CompExprTranslationPass.Initial q varSpace reduced translatedCtxt ) | SynExpr.While (spWhile, guardExpr, innerComp, _) -> let mGuard = guardExpr.Range @@ -1027,7 +1036,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mWhile, false, guardExpr) | DebugPointAtWhile.No -> guardExpr - Some(trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> + ValueSome(trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "While" mWhile [ mkSynDelay2 guardExpr; @@ -1090,8 +1099,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | DebugPointAtTry.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mTry, true, innerExpr) | _ -> innerExpr - - Some (translatedCtxt + + ValueSome (translatedCtxt (mkSynCall "TryFinally" mTry [ mkSynCall "Delay" mTry [mkSynDelay innerComp.Range innerExpr] mkSynDelay2 unwindExpr2])) @@ -1107,8 +1116,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | SynExpr.ImplicitZero m -> if (not enableImplicitYield) && isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env m ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), m)) - Some (translatedCtxt (mkSynCall "Zero" m [])) - + ValueSome (translatedCtxt (mkSynCall "Zero" m [])) + | OptionalSequential (JoinOrGroupJoinOrZipClause (_, _, _, _, _, mClause), _) when firstTry = CompExprTranslationPass.Initial -> @@ -1116,14 +1125,14 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs let varSpacePat = mkPatForVarSpace mClause patvs - + let dataCompPrior = translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn ((true, false), varSpaceExpr, mClause))) // Rebind using for ... let rebind = SynExpr.ForEach (DebugPointAtFor.No, DebugPointAtInOrTo.No, SeqExprOnly false, false, varSpacePat, dataCompPrior, comp, comp.Range) - + // Retry with the 'for' loop packaging. Set firstTry=false just in case 'join' processing fails tryTrans CompExprTranslationPass.Subsequent q varSpace rebind id @@ -1134,29 +1143,27 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs - + let dataCompPriorToOp = let isYield = not (customOperationMaintainsVarSpaceUsingBind nm) translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn ((isYield, false), varSpaceExpr, mClause))) - + // Now run the consumeCustomOpClauses - Some (consumeCustomOpClauses q varSpace dataCompPriorToOp comp false mClause) + ValueSome (consumeCustomOpClauses q varSpace dataCompPriorToOp comp false mClause) | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> // Check for 'where x > y' and other mis-applications of infix operators. If detected, give a good error message, and just ignore innerComp1 if isQuery && checkForBinaryApp innerComp1 then - Some (trans CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt) - + ValueSome (trans CompExprTranslationPass.Initial q varSpace innerComp2 translatedCtxt) else - if isQuery && not(innerComp1.IsArbExprAndThusAlreadyReportedError) then match innerComp1 with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), innerComp1.RangeOfFirstPortion)) match tryTrans CompExprTranslationPass.Initial CustomOperationsMode.Denied varSpace innerComp1 id with - | Some c -> + | ValueSome c -> // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) let m1 = rangeForCombine innerComp1 @@ -1168,9 +1175,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let combineCall = mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]] - Some (translatedCtxt combineCall) + ValueSome (translatedCtxt combineCall) - | None -> + | ValueNone -> // "do! expr; cexpr" is treated as { let! () = expr in cexpr } match innerComp1 with | SynExpr.DoBang (rhsExpr, m) -> @@ -1180,11 +1187,11 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | DebugPointAtSequential.SuppressBoth -> DebugPointAtBinding.NoneAtDo | DebugPointAtSequential.SuppressStmt -> DebugPointAtBinding.Yes m | DebugPointAtSequential.SuppressNeither -> DebugPointAtBinding.Yes m - Some(trans CompExprTranslationPass.Initial q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, [], innerComp2, m, SynExprLetOrUseBangTrivia.Zero)) translatedCtxt) + ValueSome(trans CompExprTranslationPass.Initial q varSpace (SynExpr.LetOrUseBang (sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, [], innerComp2, m, SynExprLetOrUseBangTrivia.Zero)) translatedCtxt) // "expr; cexpr" is treated as sequential execution | _ -> - Some (trans CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> + ValueSome (trans CompExprTranslationPass.Initial q varSpace innerComp2 (fun holeFill -> let fillExpr = if enableImplicitYield then // When implicit yields are enabled, then if the 'innerComp1' checks as type @@ -1203,13 +1210,13 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol match elseCompOpt with | Some elseComp -> if isQuery then error(Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries(), trivia.IfToThenRange)) - Some (translatedCtxt (SynExpr.IfThenElse (guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia))) + ValueSome (translatedCtxt (SynExpr.IfThenElse (guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia))) | None -> let elseComp = if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env trivia.IfToThenRange ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), trivia.IfToThenRange)) mkSynCall "Zero" trivia.IfToThenRange [] - Some (trans CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse (guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia)))) + ValueSome (trans CompExprTranslationPass.Initial q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse (guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia)))) // 'let binds in expr' | SynExpr.LetOrUse (isRec, false, binds, innerComp, m, trivia) -> @@ -1239,7 +1246,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // error case error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings(), mQueryOp))) - Some (trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse (isRec, false, binds, holeFill, m, trivia)))) + ValueSome (trans CompExprTranslationPass.Initial q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse (isRec, false, binds, holeFill, m, trivia)))) // 'use x = expr in expr' | SynExpr.LetOrUse (isUse=true; bindings=[SynBinding (kind=SynBindingKind.Normal; headPat=pat; expr=rhsExpr; debugPoint=spBind)]; body=innerComp) -> @@ -1251,7 +1258,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol if isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), mBind)) - Some (translatedCtxt (mkSynCall "Using" mBind [rhsExpr; consumeExpr ]) |> addBindDebugPoint spBind) + ValueSome (translatedCtxt (mkSynCall "Using" mBind [rhsExpr; consumeExpr ]) |> addBindDebugPoint spBind) // 'let! pat = expr in expr' // --> build.Bind(e1, (fun _argN -> match _argN with pat -> expr)) @@ -1261,7 +1268,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let mBind = match spBind with DebugPointAtBinding.Yes m -> m | _ -> rhsExpr.Range if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), mBind)) - + // Add the variables to the query variable space, on demand let varSpace = addVarsToVarSpace varSpace (fun _mCustomOp env -> @@ -1270,7 +1277,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol vspecs, envinner) let rhsExpr = mkSourceExprConditional isFromSource rhsExpr - Some (transBind q varSpace mBind (addBindDebugPoint spBind) "Bind" [rhsExpr] pat innerComp translatedCtxt) + ValueSome (transBind q varSpace mBind (addBindDebugPoint spBind) "Bind" [rhsExpr] pat innerComp translatedCtxt) // 'use! pat = e1 in e2' --> build.Bind(e1, (function _argN -> match _argN with pat -> build.Using(x, (fun _argN -> match _argN with pat -> e2)))) | SynExpr.LetOrUseBang (bindDebugPoint=spBind; isUse=true; isFromSource=isFromSource; pat=SynPat.Named (ident=SynIdent(id,_); isThisVal=false) as pat; rhs=rhsExpr; andBangs=[]; body=innerComp) @@ -1292,7 +1299,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol mkSynCall "Bind" mBind [rhsExpr; consumeExpr] |> addBindDebugPoint spBind - Some(translatedCtxt bindExpr) + ValueSome(translatedCtxt bindExpr) // 'use! pat = e1 ... in e2' where 'pat' is not a simple name --> error | SynExpr.LetOrUseBang (isUse=true; pat=pat; andBangs=andBangs) -> @@ -1325,7 +1332,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol // Check if this is a Bind2Return etc. let hasBindReturnN = not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env mBind ad bindReturnNName builderTy)) - if hasBindReturnN && Option.isSome (convertSimpleReturnToExpr varSpace innerComp) then + if hasBindReturnN && ValueOption.isSome (convertSimpleReturnToExpr varSpace innerComp) then let consumePat = SynPat.Tuple(false, pats, [], letPat.Range) // Add the variables to the query variable space, on demand @@ -1335,7 +1342,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None vspecs, envinner) - Some (transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) + ValueSome (transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) else @@ -1351,7 +1358,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType g) env tpenv consumePat None vspecs, envinner) - Some (transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) + ValueSome (transBind q varSpace mBind (addBindDebugPoint spBind) bindNName sources consumePat innerComp translatedCtxt) else // Look for the maximum supported MergeSources, MergeSources3, ... @@ -1410,12 +1417,12 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol vspecs, envinner) // Build the 'Bind' call - Some (transBind q varSpace mBind (addBindDebugPoint spBind) "Bind" [mergedSources] consumePat innerComp translatedCtxt) + ValueSome (transBind q varSpace mBind (addBindDebugPoint spBind) "Bind" [mergedSources] consumePat innerComp translatedCtxt) | SynExpr.Match (spMatch, expr, clauses, m, trivia) -> if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), trivia.MatchKeyword)) let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp, patm, sp, trivia)) -> SynMatchClause(pat, cond, transNoQueryOps innerComp, patm, sp, trivia)) - Some(translatedCtxt (SynExpr.Match (spMatch, expr, clauses, m, trivia))) + ValueSome(translatedCtxt (SynExpr.Match (spMatch, expr, clauses, m, trivia))) // 'match! expr with pats ...' --> build.Bind(e1, (function pats ...)) // FUTURE: consider allowing translation to BindReturn @@ -1432,13 +1439,13 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let callExpr = mkSynCall "Bind" trivia.MatchBangKeyword [inputExpr; consumeExpr] |> addBindDebugPoint spMatch - - Some(translatedCtxt callExpr) + + ValueSome(translatedCtxt callExpr) | SynExpr.TryWith (innerComp, clauses, mTryToLast, spTry, spWith, trivia) -> let mTry = match spTry with DebugPointAtTry.Yes _ -> trivia.TryKeyword.NoteSourceConstruct(NotedSourceConstruct.Try) | _ -> trivia.TryKeyword let spWith2 = match spWith with DebugPointAtWith.Yes _ -> DebugPointAtBinding.Yes trivia.WithKeyword | _ -> DebugPointAtBinding.NoneAtInvisible - + if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(), mTry)) let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, clauseComp, patm, sp, trivia)) -> SynMatchClause(pat, cond, transNoQueryOps clauseComp, patm, sp, trivia)) @@ -1457,14 +1464,14 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | DebugPointAtTry.Yes _ -> SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes mTry, true, innerExpr) | _ -> innerExpr - + let callExpr = mkSynCall "TryWith" mTry [ mkSynCall "Delay" mTry [mkSynDelay2 innerExpr] consumeExpr ] - Some(translatedCtxt callExpr) + ValueSome(translatedCtxt callExpr) | SynExpr.YieldOrReturnFrom ((true, _), synYieldExpr, m) -> let yieldFromExpr = mkSourceExpr synYieldExpr @@ -1479,7 +1486,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol else SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldFromCall) - Some (translatedCtxt yieldFromCall) + ValueSome (translatedCtxt yieldFromCall) | SynExpr.YieldOrReturnFrom ((false, _), synReturnExpr, m) -> let returnFromExpr = mkSourceExpr synReturnExpr @@ -1496,7 +1503,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol else SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnFromCall) - Some (translatedCtxt returnFromCall) + ValueSome (translatedCtxt returnFromCall) | SynExpr.YieldOrReturn ((isYield, _), synYieldOrReturnExpr, m) -> let methName = (if isYield then "Yield" else "Return") @@ -1513,9 +1520,9 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol else SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, yieldOrReturnCall) - Some(translatedCtxt yieldOrReturnCall) + ValueSome(translatedCtxt yieldOrReturnCall) - | _ -> None + | _ -> ValueNone and consumeCustomOpClauses q (varSpace: LazyWithContext<_, _>) dataCompPrior compClausesExpr lastUsesBind mClause = @@ -1562,8 +1569,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol | StripApps(SingleIdent nm, args) -> let argCountsMatch = match expectedArgCount with - | Some n -> n = args.Length - | None -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations + | ValueSome n -> n = args.Length + | ValueNone -> cenv.g.langVersion.SupportsFeature LanguageFeature.OverloadsForCustomOperations if argCountsMatch then // Check for the [] attribute on each argument position let args = args |> List.mapi (fun i arg -> @@ -1572,7 +1579,7 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol else arg) mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) else - let expectedArgCount = defaultArg expectedArgCount 0 + let expectedArgCount = ValueOption.defaultArg expectedArgCount 0 errorR(Error(FSComp.SR.tcCustomOperationHasIncorrectArgCount(nm.idText, expectedArgCount, args.Length), nm.idRange)) mkSynCall methInfo.DisplayName mClause ([ dataCompPrior ] @ List.init expectedArgCount (fun i -> arbExpr("_arg" + string i, mClause))) | _ -> failwith "unreachable" @@ -1631,8 +1638,8 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol and trans firstTry q varSpace comp translatedCtxt = match tryTrans firstTry q varSpace comp translatedCtxt with - | Some e -> e - | None -> + | ValueSome e -> e + | ValueNone -> // This only occurs in final position in a sequence match comp with // "do! expr;" in final position is treated as { let! () = expr in return () } when Return is provided (and no Zero with Default attribute is available) or as { let! () = expr in zero } otherwise @@ -1677,10 +1684,10 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol let innerCompReturn = if cenv.g.langVersion.SupportsFeature LanguageFeature.AndBang then convertSimpleReturnToExpr varSpace innerComp - else None + else ValueNone match innerCompReturn with - | Some (innerExpr, customOpInfo) when + | ValueSome (innerExpr, customOpInfo) when (let bindName = bindName + "Return" not (isNil (TryFindIntrinsicOrExtensionMethInfo ResultCollectionSettings.AtMostOneResult cenv env bindRange ad bindName builderTy))) -> @@ -1712,53 +1719,53 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol /// The outer option indicates if .BindReturn is possible. When it returns None, .BindReturn cannot be used /// The inner option indicates if a custom operation is involved inside and convertSimpleReturnToExpr varSpace innerComp = - match innerComp with + match innerComp with | SynExpr.YieldOrReturn ((false, _), returnExpr, m) -> let returnExpr = SynExpr.DebugPoint(DebugPointAtLeafExpr.Yes m, false, returnExpr) - Some (returnExpr, None) + ValueSome (returnExpr, None) | SynExpr.Match (spMatch, expr, clauses, m, trivia) -> let clauses = clauses |> List.map (fun (SynMatchClause(pat, cond, innerComp2, patm, sp, trivia)) -> match convertSimpleReturnToExpr varSpace innerComp2 with - | None -> None // failure - | Some (_, Some _) -> None // custom op on branch = failure - | Some (innerExpr2, None) -> Some (SynMatchClause(pat, cond, innerExpr2, patm, sp, trivia))) + | ValueNone -> None // failure + | ValueSome (_, Some _) -> None // custom op on branch = failure + | ValueSome (innerExpr2, None) -> Some (SynMatchClause(pat, cond, innerExpr2, patm, sp, trivia))) if clauses |> List.forall Option.isSome then - Some (SynExpr.Match (spMatch, expr, (clauses |> List.map Option.get), m, trivia), None) + ValueSome (SynExpr.Match (spMatch, expr, (clauses |> List.map Option.get), m, trivia), None) else - None + ValueNone | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia) -> match convertSimpleReturnToExpr varSpace thenComp with - | None -> None - | Some (_, Some _) -> None - | Some (thenExpr, None) -> + | ValueNone -> ValueNone + | ValueSome (_, Some _) -> ValueNone + | ValueSome (thenExpr, None) -> let elseExprOptOpt = match elseCompOpt with // When we are missing an 'else' part alltogether in case of 'if cond then return exp', we fallback from BindReturn into regular Bind+Return - | None -> None + | None -> ValueNone | Some elseComp -> match convertSimpleReturnToExpr varSpace elseComp with - | None -> None // failure - | Some (_, Some _) -> None // custom op on branch = failure - | Some (elseExpr, None) -> Some (Some elseExpr) + | ValueNone -> ValueNone // failure + | ValueSome (_, Some _) -> ValueNone // custom op on branch = failure + | ValueSome (elseExpr, None) -> ValueSome (Some elseExpr) match elseExprOptOpt with - | None -> None - | Some elseExprOpt -> Some (SynExpr.IfThenElse (guardExpr, thenExpr, elseExprOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia), None) + | ValueNone -> ValueNone + | ValueSome elseExprOpt -> ValueSome (SynExpr.IfThenElse (guardExpr, thenExpr, elseExprOpt, spIfToThen, isRecovery, mIfToEndOfElseBranch, trivia), None) | SynExpr.LetOrUse (isRec, false, binds, innerComp, m, trivia) -> match convertSimpleReturnToExpr varSpace innerComp with - | None -> None - | Some (_, Some _) -> None - | Some (innerExpr, None) -> Some (SynExpr.LetOrUse (isRec, false, binds, innerExpr, m, trivia), None) + | ValueNone -> ValueNone + | ValueSome (_, Some _) -> ValueNone + | ValueSome (innerExpr, None) -> ValueSome (SynExpr.LetOrUse (isRec, false, binds, innerExpr, m, trivia), None) | OptionalSequential (CustomOperationClause (nm, _, _, mClause, _), _) when customOperationMaintainsVarSpaceUsingBind nm -> let patvs, _env = varSpace.Force comp.Range let varSpaceExpr = mkExprForVarSpace mClause patvs - Some (varSpaceExpr, Some (innerComp, mClause)) + ValueSome (varSpaceExpr, Some (innerComp, mClause)) | SynExpr.Sequential (sp, true, innerComp1, innerComp2, m) -> @@ -1766,12 +1773,12 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol if isSimpleExpr innerComp1 then // Check the second part is a simple return match convertSimpleReturnToExpr varSpace innerComp2 with - | None -> None - | Some (innerExpr2, optionalCont) -> Some (SynExpr.Sequential (sp, true, innerComp1, innerExpr2, m), optionalCont) + | ValueNone -> ValueNone + | ValueSome (innerExpr2, optionalCont) -> ValueSome (SynExpr.Sequential (sp, true, innerComp1, innerExpr2, m), optionalCont) else - None + ValueNone - | _ -> None + | _ -> ValueNone /// Check if an expression has no computation expression constructs and isSimpleExpr comp = @@ -1937,8 +1944,8 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = | SynExpr.ForEach (spFor, spIn, SeqExprOnly _seqExprOnly, _isFromSource, pat, pseudoEnumExpr, innerComp, _m) -> let pseudoEnumExpr = match RewriteRangeExpr pseudoEnumExpr with - | Some e -> e - | None -> pseudoEnumExpr + | ValueSome e -> e + | ValueNone -> pseudoEnumExpr // This expression is not checked with the knowledge it is an IEnumerable, since we permit other enumerable types with GetEnumerator/MoveNext methods, as does C# let pseudoEnumExpr, arbitraryTy, tpenv = TcExprOfUnknownType cenv env tpenv pseudoEnumExpr let enumExpr, enumElemTy = ConvertArbitraryExprToEnumerable cenv arbitraryTy env pseudoEnumExpr @@ -1971,17 +1978,17 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = // Note: the 'yield' part of the debug point for 'yield expr' is currently lost in debug points. let lam = mkLambda mIn v (recreate yieldExpr, genEnumElemTy) let enumExpr = mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g enumElemTy) (tyOfExpr cenv.g enumExpr) enumExpr - Some(mkCallSeqMap cenv.g mFor enumElemTy genEnumElemTy lam enumExpr, tpenv) + ValueSome(mkCallSeqMap cenv.g mFor enumElemTy genEnumElemTy lam enumExpr, tpenv) | _ -> // The debug point mFor is attached to the 'collect' // The debug point mIn is attached to the lambda let matchv, matchExpr = compileSeqExprMatchClauses cenv env enumExprRange (patR, vspecs) innerExpr None enumElemTy genOuterTy let lam = mkLambda mIn matchv (matchExpr, tyOfExpr cenv.g matchExpr) - Some(mkSeqCollect cenv env mFor enumElemTy genOuterTy lam enumExpr, tpenv) + ValueSome(mkSeqCollect cenv env mFor enumElemTy genOuterTy lam enumExpr, tpenv) | SynExpr.For (forDebugPoint=spFor; toDebugPoint=spTo; ident=id; identBody=start; direction=dir; toBody=finish; doBody=innerComp; range=m) -> - Some(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m))) + ValueSome(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spFor, spTo, id, start, dir, finish, innerComp, m))) | SynExpr.While (spWhile, guardExpr, innerComp, _m) -> let guardExpr, tpenv = @@ -2002,7 +2009,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = | _ -> guardExprMark let innerDelayedExpr = mkSeqDelayedExpr mWhile innerExpr - Some(mkSeqFromFunctions cenv env guardExprMark genOuterTy guardLambdaExpr innerDelayedExpr, tpenv) + ValueSome(mkSeqFromFunctions cenv env guardExprMark genOuterTy guardLambdaExpr innerDelayedExpr, tpenv) | SynExpr.TryFinally (innerComp, unwindExpr, mTryToLast, spTry, spFinally, trivia) -> let env = { env with eIsControlFlow = true } @@ -2023,13 +2030,13 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = let innerExpr = mkSeqDelayedExpr mTry innerExpr let unwindExpr = mkUnitDelayLambda cenv.g mFinally unwindExpr - Some(mkSeqFinally cenv env mTryToLast genOuterTy innerExpr unwindExpr, tpenv) + ValueSome(mkSeqFinally cenv env mTryToLast genOuterTy innerExpr unwindExpr, tpenv) | SynExpr.Paren (_, _, _, m) when not (cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield)-> error(Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression(), m)) | SynExpr.ImplicitZero m -> - Some(mkSeqEmpty cenv env m genOuterTy, tpenv ) + ValueSome(mkSeqEmpty cenv env m genOuterTy, tpenv ) | SynExpr.DoBang (_rhsExpr, m) -> error(Error(FSComp.SR.tcDoBangIllegalInSequenceExpression(), m)) @@ -2047,10 +2054,10 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = | Choice1Of2 innerExpr1 -> let innerExpr2, tpenv = tcSequenceExprBody env2 genOuterTy tpenv innerComp2 let innerExpr2 = mkSeqDelayedExpr innerExpr2.Range innerExpr2 - Some(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv) + ValueSome(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv) | Choice2Of2 stmt1 -> let innerExpr2, tpenv = tcSequenceExprBody env2 genOuterTy tpenv innerComp2 - Some(Expr.Sequential(stmt1, innerExpr2, NormalSeq, m), tpenv) + ValueSome(Expr.Sequential(stmt1, innerExpr2, NormalSeq, m), tpenv) | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, _isRecovery, mIfToEndOfElseBranch, trivia) -> let guardExpr', tpenv = TcExpr cenv (MustEqual cenv.g.bool_ty) env tpenv guardExpr @@ -2058,7 +2065,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = let thenExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv thenComp let elseComp = (match elseCompOpt with Some c -> c | None -> SynExpr.ImplicitZero trivia.IfToThenRange) let elseExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv elseComp - Some(mkCond spIfToThen mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv) + ValueSome(mkCond spIfToThen mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv) // 'let x = expr in expr' | SynExpr.LetOrUse (isUse=false (* not a 'use' binding *)) -> @@ -2068,7 +2075,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = tpenv true comp - id |> Some + id |> ValueSome // 'use x = expr in expr' | SynExpr.LetOrUse (isUse=true; bindings=[SynBinding (kind=SynBindingKind.Normal; headPat=pat; expr=rhsExpr; debugPoint=spBind)]; body=innerComp; range=wholeExprMark) -> @@ -2099,7 +2106,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = let consumeExpr = mkLambda mBind matchv (matchExpr, genOuterTy) // The 'mBind' is attached to the lambda - Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) + ValueSome(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) | SynExpr.LetOrUseBang (range=m) -> error(Error(FSComp.SR.tcUseForInSequenceExpression(), m)) @@ -2121,7 +2128,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = let inputExprMark = inputExpr.Range let matchv, matchExpr = CompilePatternForMatchClauses cenv env inputExprMark inputExprMark true ThrowIncompleteMatchException (Some inputExpr) inputExprTy genOuterTy tclauses - Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) + ValueSome(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) | SynExpr.TryWith (innerTry,withList,mTryToWith,_spTry,_spWith,trivia) -> if not(g.langVersion.SupportsFeature(LanguageFeature.TryWithInSeqExpression)) then @@ -2154,7 +2161,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = let handlerLambda = mkLambda handlerExpr.Range v2 (handlerExpr, genOuterTy) let combinatorExpr = mkSeqTryWith cenv env mTryToWith genOuterTy tryExpr filterLambda handlerLambda - Some (combinatorExpr,tpenv) + ValueSome (combinatorExpr,tpenv) | SynExpr.YieldOrReturnFrom ((isYield, _), synYieldExpr, m) -> let env = { env with eIsControlFlow = false } @@ -2172,7 +2179,7 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = else mkDebugPoint m resultExpr - Some(resultExpr, tpenv) + ValueSome(resultExpr, tpenv) | SynExpr.YieldOrReturn ((isYield, _), synYieldExpr, m) -> let env = { env with eIsControlFlow = false } @@ -2192,9 +2199,9 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = else mkDebugPoint m resultExpr - Some(resultExpr, tpenv ) + ValueSome(resultExpr, tpenv ) - | _ -> None + | _ -> ValueNone and tcSequenceExprBody env (genOuterTy: TType) tpenv comp = let res, tpenv = tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp @@ -2208,8 +2215,8 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = and tcSequenceExprBodyAsSequenceOrStatement env genOuterTy tpenv comp = match tryTcSequenceExprBody env genOuterTy tpenv comp with - | Some (expr, tpenv) -> Choice1Of2 expr, tpenv - | None -> + | ValueSome (expr, tpenv) -> Choice1Of2 expr, tpenv + | ValueNone -> let env = { env with eContextInfo = ContextInfo.SequenceExpression genOuterTy } @@ -2236,9 +2243,9 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m = let TcSequenceExpressionEntry (cenv: cenv) env (overallTy: OverallTy) tpenv (hasBuilder, comp) m = match RewriteRangeExpr comp with - | Some replacementExpr -> + | ValueSome replacementExpr -> TcExpr cenv overallTy env tpenv replacementExpr - | None -> + | ValueNone -> let implicitYieldEnabled = cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield @@ -2265,7 +2272,7 @@ let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpen // // The elaborated form of '[ n .. m ]' is 'List.ofSeq (seq (op_Range n m))' and this shouldn't change match RewriteRangeExpr comp with - | Some replacementExpr -> + | ValueSome replacementExpr -> let genCollElemTy = NewInferenceType g let genCollTy = (if isArray then mkArrayType else mkListTy) cenv.g genCollElemTy @@ -2283,7 +2290,7 @@ let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpen // We add a call to 'seq ... ' to make sure sequence expression compilation gets applied to the contents of the // comprehension. But don't do this in FSharp.Core.dll since 'seq' may not yet be defined. mkCallSeq cenv.g m genCollElemTy expr - + let expr = mkCoerceExpr(expr, exprTy, expr.Range, overallTy.Commit) let expr = @@ -2293,7 +2300,7 @@ let TcArrayOrListComputedExpression (cenv: cenv) env (overallTy: OverallTy) tpen mkCallSeqToList cenv.g m genCollElemTy expr expr, tpenv - | None -> + | ValueNone -> // LanguageFeatures.ImplicitYield do not require this validation let implicitYieldEnabled = cenv.g.langVersion.SupportsFeature LanguageFeature.ImplicitYield diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index da3ecc9b0d9..f3c57cab618 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -153,7 +153,7 @@ module MutRecShapes = | MutRecShape.Module (_, d) -> collectTycons d | _ -> []) - let topTycons x = + let topTycons x = x |> List.choose (function MutRecShape.Tycon a -> Some a | _ -> None) let rec iter f1 f2 f3 f4 f5 x = @@ -5297,16 +5297,20 @@ and TcMutRecDefsFinish cenv defs m = yield! openDeclsRef.Value | _ -> () ] - let tycons = defs |> List.choose (function MutRecShape.Tycon (Some tycon, _) -> Some tycon | _ -> None) + let tycons = + [ for def in defs do + match def with + | MutRecShape.Tycon (Some tycon, _) -> yield tycon + | _ -> () ] - let binds = - defs |> List.collect (function + let binds = + defs |> List.collect (function | MutRecShape.Open _ -> [] | MutRecShape.ModuleAbbrev _ -> [] - | MutRecShape.Tycon (_, binds) - | MutRecShape.Lets binds -> - binds |> List.map ModuleOrNamespaceBinding.Binding - | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleTyAcc, moduleEntity), _), moduleDefs) -> + | MutRecShape.Tycon (_, binds) + | MutRecShape.Lets binds -> + binds |> List.map ModuleOrNamespaceBinding.Binding + | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(moduleTyAcc, moduleEntity), _), moduleDefs) -> let moduleContents = TcMutRecDefsFinish cenv moduleDefs m moduleEntity.entity_modul_type <- MaybeLazy.Strict moduleTyAcc.Value [ ModuleOrNamespaceBinding.Module(moduleEntity, moduleContents) ]) diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index ade040f1ed6..6f5a8221f44 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -1233,10 +1233,10 @@ let CheckRequiredProperties (g:TcGlobals) (env: TcEnv) (cenv: TcFileState) (minf errorR(Error(FSComp.SR.tcMissingRequiredMembers details, mMethExpr)) let private HasMethodImplNoInliningAttribute g attrs = - match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with - // NO_INLINING = 8 - | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> (flags &&& 0x8) <> 0x0 - | _ -> false + match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with + // NO_INLINING = 8 + | ValueSome (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> (flags &&& 0x8) <> 0x0 + | _ -> false let MakeAndPublishVal (cenv: cenv) env (altActualParent, inSig, declKind, valRecInfo, vscheme, attrs, xmlDoc, konst, isGeneratedEventVal) = @@ -2948,8 +2948,8 @@ let BuildPossiblyConditionalMethodCall (cenv: cenv) env isMutable m isProp minfo | Some defines -> match TryFindMethInfoStringAttribute g m g.attrib_ConditionalAttribute minfo with - | None -> false - | Some d -> not (List.contains d defines) + | ValueNone -> false + | ValueSome d -> not (List.contains d defines) if shouldEraseCall then // Methods marked with 'Conditional' must return 'unit' @@ -3111,22 +3111,23 @@ let BuildRecdFieldSet g m objExpr (rfinfo: RecdFieldInfo) argExpr = //------------------------------------------------------------------------- // Helpers dealing with named and optional args at callsites //------------------------------------------------------------------------- - +[] let (|BinOpExpr|_|) expr = match expr with - | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent opId, a, _), b, _) -> Some (opId, a, b) - | _ -> None + | SynExpr.App (_, _, SynExpr.App (_, _, SingleIdent opId, a, _), b, _) -> ValueSome (opId, a, b) + | _ -> ValueNone +[] let (|SimpleEqualsExpr|_|) expr = match expr with - | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> Some (a, b) - | _ -> None + | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> ValueSome (a, b) + | _ -> ValueNone /// Detect a named argument at a callsite -let TryGetNamedArg expr = +let inline TryGetNamedArg expr = match expr with - | SimpleEqualsExpr(LongOrSingleIdent(isOpt, SynLongIdent([a], _, _), None, _), b) -> Some(isOpt, a, b) - | _ -> None + | SimpleEqualsExpr(LongOrSingleIdent(isOpt, SynLongIdent([a], _, _), None, _), b) -> ValueSome(isOpt, a, b) + | _ -> ValueNone let inline IsNamedArg expr = match expr with @@ -3146,20 +3147,18 @@ let GetMethodArgs arg = argExprs |> List.takeUntil IsNamedArg let namedCallerArgs = - namedCallerArgs - |> List.choose (fun argExpr -> - match TryGetNamedArg argExpr with - | None -> + [ for argExpr in namedCallerArgs do + match TryGetNamedArg argExpr with + | ValueNone -> // ignore errors to avoid confusing error messages in cases like foo(a = 1, ) // do not abort overload resolution in case if named arguments are mixed with errors match argExpr with - | SynExpr.ArbitraryAfterError _ -> None + | SynExpr.ArbitraryAfterError _ -> () | _ -> error(Error(FSComp.SR.tcNameArgumentsMustAppearLast(), argExpr.Range)) - | namedArg -> namedArg) + | ValueSome(namedArg) -> yield namedArg ] unnamedCallerArgs, namedCallerArgs - //------------------------------------------------------------------------- // Helpers dealing with pattern match compilation //------------------------------------------------------------------------- @@ -3975,6 +3974,15 @@ type ImplicitlyBoundTyparsAllowed = | NewTyparsOK | NoNewTypars +[] +let (|FittedArgs|_|) numArgTys arg = + match arg with + | SynExprParen(SynExpr.Tuple (false, args, _, _), _, _, _) + | SynExpr.Tuple (false, args, _, _) when numArgTys > 1 -> ValueSome args + | SynExprParen(arg, _, _, _) + | arg when numArgTys = 1 -> ValueSome [arg] + | _ -> ValueNone + //------------------------------------------------------------------------- // Checking types and type constraints //------------------------------------------------------------------------- @@ -4537,7 +4545,7 @@ and TcTupleType kindOpt (cenv: cenv) newOk checkConstraints occ env tpenv isStru else let argsR,tpenv = TcTypesAsTuple cenv newOk checkConstraints occ env tpenv args m TType_tuple(tupInfo, argsR), tpenv - + and CheckAnonRecdTypeDuplicateFields (elems: Ident array) = elems |> Array.iteri (fun i (uc1: Ident) -> elems |> Array.iteri (fun j (uc2: Ident) -> @@ -6224,7 +6232,7 @@ and RewriteRangeExpr synExpr = // a..b..c (parsed as (a..b)..c ) | SynExpr.IndexRange(Some (SynExpr.IndexRange(Some synExpr1, _, Some synStepExpr, _, _, _)), _, Some synExpr2, _m1, _m2, mWhole) -> let mWhole = mWhole.MakeSynthetic() - Some (mkSynTrifix mWhole ".. .." synExpr1 synStepExpr synExpr2) + ValueSome (mkSynTrifix mWhole ".. .." synExpr1 synStepExpr synExpr2) // a..b | SynExpr.IndexRange (Some synExpr1, mOperator, Some synExpr2, _m1, _m2, mWhole) -> let otherExpr = @@ -6232,8 +6240,8 @@ and RewriteRangeExpr synExpr = match mkSynInfix mOperator synExpr1 ".." synExpr2 with | SynExpr.App (a, b, c, d, _) -> SynExpr.App (a, b, c, d, mWhole) | _ -> failwith "impossible" - Some otherExpr - | _ -> None + ValueSome otherExpr + | _ -> ValueNone /// Check lambdas as a group, to catch duplicate names in patterns and TcIteratedLambdas (cenv: cenv) isFirst (env: TcEnv) overallTy takenNames tpenv e = @@ -7738,8 +7746,8 @@ and TcForEachExpr cenv overallTy env tpenv (seqExprOnly, isFromSource, synPat, s let synEnumExpr = match RewriteRangeExpr synEnumExpr with - | Some e -> e - | None -> synEnumExpr + | ValueSome e -> e + | ValueNone -> synEnumExpr let tryGetOptimizeSpanMethodsAux g m ty isReadOnlySpan = match (if isReadOnlySpan then tryDestReadOnlySpanTy g m ty else tryDestSpanTy g m ty) with @@ -8445,17 +8453,9 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen (cenv: cenv) overallTy env // Subsumption at data constructions if argument type is nominal prior to equations for any arguments or return types let flexes = argTys |> List.map (isTyparTy g >> not) - let (|FittedArgs|_|) arg = - match arg with - | SynExprParen(SynExpr.Tuple (false, args, _, _), _, _, _) - | SynExpr.Tuple (false, args, _, _) when numArgTys > 1 -> Some args - | SynExprParen(arg, _, _, _) - | arg when numArgTys = 1 -> Some [arg] - | _ -> None - match delayed with // This is where the constructor is applied to an argument - | DelayedApp (atomicFlag, _, _, (FittedArgs args as origArg), mExprAndArg) :: otherDelayed -> + | DelayedApp (atomicFlag, _, _, (FittedArgs numArgTys args as origArg), mExprAndArg) :: otherDelayed -> // assert the overall result type if possible if isNil otherDelayed then UnifyOverallType cenv env mExprAndArg overallTy ucaseAppTy @@ -10871,25 +10871,25 @@ and TcAttributeEx canFail (cenv: cenv) (env: TcEnv) attrTgt attrEx (synAttr: Syn let tref = g.attrib_AttributeUsageAttribute.TypeRef match TryDecodeILAttribute tref tdef.CustomAttrs with - | Some ([ILAttribElem.Int32 validOn ], named) -> + | ValueSome ([ILAttribElem.Int32 validOn ], named) -> let inherited = match List.tryPick (function "Inherited", _, _, ILAttribElem.Bool res -> Some res | _ -> None) named with | None -> inheritedDefault | Some x -> x (validOn, inherited) - | Some ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> + | ValueSome ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> (validOn, inherited) | _ -> (validOnDefault, inheritedDefault) else match (TryFindFSharpAttribute g g.attrib_AttributeUsageAttribute tcref.Attribs) with - | Some(Attrib(_, _, [ AttribInt32Arg validOn ], _, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribInt32Arg validOn ], _, _, _, _)) -> (validOn, inheritedDefault) - | Some(Attrib(_, _, [ AttribInt32Arg validOn - AttribBoolArg(_allowMultiple) - AttribBoolArg inherited], _, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribInt32Arg validOn + AttribBoolArg(_allowMultiple) + AttribBoolArg inherited], _, _, _, _)) -> (validOn, inherited) - | Some _ -> + | ValueSome _ -> warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) (validOnDefault, inheritedDefault) | _ -> diff --git a/src/Compiler/Checking/CheckExpressions.fsi b/src/Compiler/Checking/CheckExpressions.fsi index 0ecc045f05d..444f0f6a241 100644 --- a/src/Compiler/Checking/CheckExpressions.fsi +++ b/src/Compiler/Checking/CheckExpressions.fsi @@ -637,7 +637,7 @@ val CheckTupleIsCorrectLength: /// Converts 'a..b' to a call to the '(..)' operator in FSharp.Core /// Converts 'a..b..c' to a call to the '(.. ..)' operator in FSharp.Core -val RewriteRangeExpr: synExpr: SynExpr -> SynExpr option +val RewriteRangeExpr: synExpr: SynExpr -> SynExpr voption /// Check a syntactic expression and convert it to a typed tree expression val TcExprOfUnknownType: @@ -708,7 +708,7 @@ val TcMatchPattern: synWhenExprOpt: SynExpr option -> Pattern * Expr option * Val list * TcEnv * UnscopedTyparEnv -val (|BinOpExpr|_|): SynExpr -> (Ident * SynExpr * SynExpr) option +val (|BinOpExpr|_|): SynExpr -> (Ident * SynExpr * SynExpr) voption /// Check a set of let bindings in a class or module val TcLetBindings: diff --git a/src/Compiler/Checking/ConstraintSolver.fs b/src/Compiler/Checking/ConstraintSolver.fs index e552cb3e993..36c1403c3bb 100644 --- a/src/Compiler/Checking/ConstraintSolver.fs +++ b/src/Compiler/Checking/ConstraintSolver.fs @@ -468,6 +468,7 @@ type Trace = member t.Undo () = List.iter (fun (_, a) -> a ()) t.actions member t.Push f undo = t.actions <- (f, undo) :: t.actions +[] type OptionalTrace = | NoTrace | WithTrace of Trace @@ -501,16 +502,16 @@ let CollectThenUndo f = res let FilterEachThenUndo f meths = - meths - |> List.choose (fun calledMeth -> - let trace = Trace.New() + [ for calledMeth in meths do + let trace = Trace.New() let res = f trace calledMeth trace.Undo() - match CheckNoErrorsAndGetWarnings res with - | None -> None - | Some (warns, res) -> Some (calledMeth, warns, trace, res)) -let ShowAccessDomain ad = + match CheckNoErrorsAndGetWarnings res with + | ValueNone -> () + | ValueSome(warns, res) -> yield (calledMeth, warns, trace, res) ] + +let inline ShowAccessDomain ad = match ad with | AccessibleFromEverywhere -> "public" | AccessibleFrom _ -> "accessible" @@ -551,7 +552,7 @@ exception AbortForFailedMemberConstraintResolution /// This is used internally in method overload resolution let IgnoreFailedMemberConstraintResolution f1 f2 = - TryD + TryD f1 (function | AbortForFailedMemberConstraintResolution -> CompleteD @@ -1380,9 +1381,9 @@ and DepthCheck ndeep m = // If this is a type that's parameterized on a unit-of-measure (expected to be numeric), unify its measure with 1 and SolveDimensionlessNumericType (csenv: ConstraintSolverEnv) ndeep m2 trace ty = match getMeasureOfType csenv.g ty with - | Some (tcref, _) -> + | ValueSome (tcref, _) -> SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty (mkAppTy tcref [TType_measure Measure.One]) - | None -> + | ValueNone -> CompleteD /// Attempt to solve a statically resolved member constraint. @@ -1477,13 +1478,13 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // - Neither type contributes any methods OR // - We have the special case "decimal<_> * decimal". In this case we have some // possibly-relevant methods from "decimal" but we ignore them in this case. - (isNil minfos || (Option.isSome (getMeasureOfType g argTy1) && isDecimalTy g argTy2)) in + (isNil minfos || (ValueOption.isSome (getMeasureOfType g argTy1) && isDecimalTy g argTy2)) in checkRuleAppliesInPreferenceToMethods argTy1 argTy2 || checkRuleAppliesInPreferenceToMethods argTy2 argTy1) -> match getMeasureOfType g argTy1 with - | Some (tcref, ms1) -> + | ValueSome (tcref, ms1) -> let ms2 = freshMeasure () do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 (mkAppTy tcref [TType_measure ms2]) do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) @@ -1492,7 +1493,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _ -> match getMeasureOfType g argTy2 with - | Some (tcref, ms2) -> + | ValueSome (tcref, ms2) -> let ms1 = freshMeasure () do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkAppTy tcref [TType_measure ms1]) do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) @@ -1627,12 +1628,12 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | _, _, false, "Sqrt", [argTy1] when isFpTy g argTy1 -> match getMeasureOfType g argTy1 with - | Some (tcref, _) -> + | ValueSome (tcref, _) -> let ms1 = freshMeasure () do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy1 (mkAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))]) do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure ms1]) return TTraitBuiltIn - | None -> + | ValueNone -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 return TTraitBuiltIn @@ -1681,8 +1682,8 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload when isFpTy g argTy1 -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace argTy2 argTy1 match getMeasureOfType g argTy1 with - | None -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 - | Some (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure Measure.One]) + | ValueNone -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy argTy1 + | ValueSome (tcref, _) -> do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy (mkAppTy tcref [TType_measure Measure.One]) return TTraitBuiltIn | _ -> @@ -1698,7 +1699,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload let props = supportTys |> List.choose (fun ty -> match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere, false) FindMemberFlag.IgnoreOverrides m ty with - | Some (RecdFieldItem rfinfo) + | ValueSome (RecdFieldItem rfinfo) when (isGetProp || rfinfo.RecdField.IsMutable) && (rfinfo.IsStatic = not memFlags.IsInstance) && IsRecdFieldAccessible amap m AccessibleFromEverywhere rfinfo.RecdFieldRef && @@ -1707,10 +1708,10 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload Some (rfinfo, isSetProp) | _ -> None) match props with - | [ prop ] -> Some prop - | _ -> None + | [ prop ] -> ValueSome prop + | _ -> ValueNone else - None + ValueNone let anonRecdPropSearch = let isGetProp = nm.StartsWith "get_" @@ -1722,14 +1723,14 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload | Some (NameResolution.Item.AnonRecdField(anonInfo, tinst, i, _)) -> Some (anonInfo, tinst, i) | _ -> None) match props with - | [ prop ] -> Some prop - | _ -> None + | [ prop ] -> ValueSome prop + | _ -> ValueNone else - None + ValueNone // Now check if there are no feasible solutions at all match minfos, recdPropSearch, anonRecdPropSearch with - | [], None, None when MemberConstraintIsReadyForStrongResolution csenv traitInfo -> + | [], ValueNone, ValueNone when MemberConstraintIsReadyForStrongResolution csenv traitInfo -> if supportTys |> List.exists (isFunTy g) then return! ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(ConvertValLogicalNameToDisplayNameCore nm), m, m2)) elif supportTys |> List.exists (isAnyTupleTy g) then @@ -1778,19 +1779,19 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) CallerArgs.Empty AccessibleFromEverywhere calledMethGroup false (Some (MustEqual retTy))) match anonRecdPropSearch, recdPropSearch, methOverloadResult with - | Some (anonInfo, tinst, i), None, None -> + | ValueSome (anonInfo, tinst, i), ValueNone, None -> // OK, the constraint is solved by a record property. Assert that the return types match. let rty2 = List.item i tinst do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2 return TTraitSolvedAnonRecdProp(anonInfo, tinst, i) - | None, Some (rfinfo, isSetProp), None -> + | ValueNone, ValueSome (rfinfo, isSetProp), None -> // OK, the constraint is solved by a record property. Assert that the return types match. let rty2 = if isSetProp then g.unit_ty else rfinfo.FieldType do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace retTy rty2 return TTraitSolvedRecdProp(rfinfo, isSetProp) - | None, None, Some (calledMeth: CalledMeth<_>) -> + | ValueNone, ValueNone, Some (calledMeth: CalledMeth<_>) -> // OK, the constraint is solved. let minfo = calledMeth.Method @@ -2426,12 +2427,12 @@ and SolveTypeIsDelegate (csenv: ConstraintSolverEnv) ndeep m2 trace ty aty bty = | _ -> if isDelegateTy g ty then match TryDestStandardDelegateType csenv.InfoReader m AccessibleFromSomewhere ty with - | Some (tupledArgTy, retTy) -> + | ValueSome (tupledArgTy, retTy) -> trackErrors { do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace aty tupledArgTy do! SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace bty retTy } - | None -> + | ValueNone -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty), m, m2)) else ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty), m, m2)) @@ -3488,13 +3489,13 @@ let UndoIfFailed f = try f trace |> CheckNoErrorsAndGetWarnings - with e -> None + with e -> ValueNone match res with - | None -> + | ValueNone -> // Don't report warnings if we failed trace.Undo() false - | Some (warns, _) -> + | ValueSome (warns, _) -> // Report warnings if we succeeded ReportWarnings warns true @@ -3505,9 +3506,9 @@ let UndoIfFailedOrWarnings f = try f trace |> CheckNoErrorsAndGetWarnings - with _ -> None + with _ -> ValueNone match res with - | Some ([], _)-> + | ValueSome ([], _)-> true | _ -> trace.Undo() @@ -3675,12 +3676,13 @@ let CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs tcVal g amap m (t } /// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code -let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { - let css = CreateCodegenState tcVal g amap - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo - return GenWitnessExpr amap g m traitInfo argExprs - } +let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = + trackErrors { + let css = CreateCodegenState tcVal g amap + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.Yes 0 m NoTrace traitInfo + return GenWitnessExpr amap g m traitInfo argExprs + } /// Generate the lambda argument passed for a use of a generic construct that accepts trait witnesses let CodegenWitnessesForTyparInst tcVal g amap m typars tyargs = trackErrors { diff --git a/src/Compiler/Checking/ConstraintSolver.fsi b/src/Compiler/Checking/ConstraintSolver.fsi index eb48ce3b439..b94b6c2f9d2 100644 --- a/src/Compiler/Checking/ConstraintSolver.fsi +++ b/src/Compiler/Checking/ConstraintSolver.fsi @@ -239,6 +239,7 @@ val BakedInTraitConstraintNames: Set [] type Trace +[] type OptionalTrace = | NoTrace | WithTrace of Trace @@ -323,7 +324,7 @@ val ApplyTyparDefaultAtPriority: DisplayEnv -> ConstraintSolverState -> priority /// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code val CodegenWitnessExprForTraitConstraint: - TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult + TcValF -> TcGlobals -> ImportMap -> range -> TraitConstraintInfo -> Expr list -> OperationResult /// Determine if a codegen witness for a trait will require witness args to be available, e.g. in generic code val CodegenWitnessExprForTraitConstraintWillRequireWitnessArgs: diff --git a/src/Compiler/Checking/InfoReader.fs b/src/Compiler/Checking/InfoReader.fs index 86bbb1b83ca..0d6c6f26568 100644 --- a/src/Compiler/Checking/InfoReader.fs +++ b/src/Compiler/Checking/InfoReader.fs @@ -7,6 +7,7 @@ module internal FSharp.Compiler.InfoReader open System.Collections.Concurrent open System.Collections.Generic open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic @@ -248,14 +249,14 @@ let IsIndexerType g amap ty = let GetMostSpecificItemsByType g amap f xs = [ for x in xs do match f x with - | None -> () - | Some (xTy, m) -> + | ValueNone -> () + | ValueSome (xTy, m) -> let isEqual = xs |> List.forall (fun y -> match f y with - | None -> true - | Some (yTy, _) -> + | ValueNone -> true + | ValueSome (yTy, _) -> if typeEquiv g xTy yTy then true else not (TypeFeasiblySubsumesType 0 g amap m xTy CanCoerce yTy)) if isEqual then @@ -269,9 +270,9 @@ let GetMostSpecificMethodInfosByMethInfoSig g amap m (ty, minfo) minfos = typeEquiv g ty ty2 && MethInfosEquivByPartialSig EraseNone true g amap m minfo minfo2 if isEqual then - Some(minfo2.ApparentEnclosingType, m) + ValueSome(minfo2.ApparentEnclosingType, m) else - None) + ValueNone) /// From the given method sets, filter each set down to the most specific ones. let FilterMostSpecificMethInfoSets g amap m (minfoSets: NameMultiMap<_>) : NameMultiMap<_> = @@ -444,7 +445,7 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = /// The primitive reader for the named items up a hierarchy let GetIntrinsicNamedItemsUncached ((nm, ad, includeConstraints), m, ty) = - if nm = ".ctor" then None else // '.ctor' lookups only ever happen via constructor syntax + if nm = ".ctor" then ValueNone else // '.ctor' lookups only ever happen via constructor syntax let optFilter = Some nm FoldPrimaryHierarchyOfType (fun ty acc -> let qinfos = if includeConstraints then GetImmediateTraitsInfosOfType optFilter g ty else [] @@ -454,22 +455,22 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter, ad) m ty let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter, ad) m ty match acc with - | _ when not (isNil qinfos) -> Some(TraitItem (qinfos)) - | Some(MethodItem(inheritedMethSets)) when not (isNil minfos) -> Some(MethodItem (minfos :: inheritedMethSets)) - | _ when not (isNil minfos) -> Some(MethodItem [minfos]) - | Some(PropertyItem(inheritedPropSets)) when not (isNil pinfos) -> Some(PropertyItem(pinfos :: inheritedPropSets)) - | _ when not (isNil pinfos) -> Some(PropertyItem([pinfos])) - | _ when not (isNil finfos) -> Some(ILFieldItem(finfos)) - | _ when not (isNil einfos) -> Some(EventItem(einfos)) + | _ when not (isNil qinfos) -> ValueSome(TraitItem (qinfos)) + | ValueSome(MethodItem(inheritedMethSets)) when not (isNil minfos) -> ValueSome(MethodItem (minfos :: inheritedMethSets)) + | _ when not (isNil minfos) -> ValueSome(MethodItem [minfos]) + | ValueSome(PropertyItem(inheritedPropSets)) when not (isNil pinfos) -> ValueSome(PropertyItem(pinfos :: inheritedPropSets)) + | _ when not (isNil pinfos) -> ValueSome(PropertyItem([pinfos])) + | _ when not (isNil finfos) -> ValueSome(ILFieldItem(finfos)) + | _ when not (isNil einfos) -> ValueSome(EventItem(einfos)) | _ when not (isNil rfinfos) -> match rfinfos with - | [single] -> Some(RecdFieldItem(single)) + | [single] -> ValueSome(RecdFieldItem(single)) | _ -> failwith "Unexpected multiple fields with the same name" // Because an explicit name (i.e., nm) was supplied, there will be only one element at most. | _ -> acc) g amap m AllowMultiIntfInstantiations.Yes ty - None + ValueNone let GetImmediateIntrinsicOverrideMethodSetsOfType optFilter m (interfaceTys: TType list) ty acc = match tryAppTy g ty with @@ -907,14 +908,14 @@ type InfoReader(g: TcGlobals, amap: Import.ImportMap) as this = member _.GetTraitInfosInType optFilter ty = GetImmediateTraitsInfosOfType optFilter g ty - member infoReader.TryFindIntrinsicNamedItemOfType (nm, ad, includeConstraints) findFlag m ty = + member infoReader.TryFindIntrinsicNamedItemOfType (nm, ad, includeConstraints) findFlag m ty = match infoReader.TryFindNamedItemOfType((nm, ad, includeConstraints), m, ty) with - | Some item -> - match item with - | PropertyItem psets -> Some(PropertyItem (psets |> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m)) - | MethodItem msets -> Some(MethodItem (msets |> FilterOverridesOfMethInfos findFlag infoReader.g infoReader.amap m)) - | _ -> Some(item) - | None -> None + | ValueSome item -> + match item with + | PropertyItem psets -> ValueSome(PropertyItem (psets |> FilterOverridesOfPropInfos findFlag infoReader.g infoReader.amap m)) + | MethodItem msets -> ValueSome(MethodItem (msets |> FilterOverridesOfMethInfos findFlag infoReader.g infoReader.amap m)) + | _ -> ValueSome(item) + | ValueNone -> ValueNone /// Try to detect the existence of a method on a type. member infoReader.TryFindIntrinsicMethInfo m ad nm ty : MethInfo list = @@ -1020,8 +1021,8 @@ let TryDestStandardDelegateType (infoReader: InfoReader) m ad delTy = let g = infoReader.g let (SigOfFunctionForDelegate(_, delArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad match delArgTys with - | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> Some(mkRefTupledTy g argTys, delRetTy) - | _ -> None + | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys) -> ValueSome(mkRefTupledTy g argTys, delRetTy) + | _ -> ValueNone /// Indicates if an event info is associated with a delegate type that is a "standard" .NET delegate type @@ -1042,16 +1043,16 @@ let TryDestStandardDelegateType (infoReader: InfoReader) m ad delTy = let IsStandardEventInfo (infoReader: InfoReader) m ad (einfo: EventInfo) = let delTy = einfo.GetDelegateType(infoReader.amap, m) match TryDestStandardDelegateType infoReader m ad delTy with - | Some _ -> true - | None -> false + | ValueSome _ -> true + | ValueNone -> false /// Get the (perhaps tupled) argument type accepted by an event let ArgsTypeOfEventInfo (infoReader: InfoReader) m ad (einfo: EventInfo) = let amap = infoReader.amap let delTy = einfo.GetDelegateType(amap, m) match TryDestStandardDelegateType infoReader m ad delTy with - | Some(argTys, _) -> argTys - | None -> error(nonStandardEventError einfo.EventName m) + | ValueSome(argTys, _) -> argTys + | ValueNone -> error(nonStandardEventError einfo.EventName m) /// Get the type of the event when looked at as if it is a property /// Used when displaying the property in Intellisense @@ -1066,7 +1067,7 @@ let PropTypeOfEventInfo (infoReader: InfoReader) m ad (einfo: EventInfo) = let TryFindMetadataInfoOfExternalEntityRef (infoReader: InfoReader) m eref = let g = infoReader.g match eref with - | ERefLocal _ -> None + | ERefLocal _ -> ValueNone | ERefNonLocal nlref -> // Generalize to get a formal signature let formalTypars = eref.Typars m @@ -1074,15 +1075,14 @@ let TryFindMetadataInfoOfExternalEntityRef (infoReader: InfoReader) m eref = let ty = TType_app(eref, formalTypeInst, 0uy) if isILAppTy g ty then let formalTypeInfo = ILTypeInfo.FromType g ty - Some(nlref.Ccu.FileName, formalTypars, formalTypeInfo) - else None + ValueSome(nlref.Ccu.FileName, formalTypars, formalTypeInfo) + else ValueNone /// Try to find the xml doc associated with the assembly name and xml doc signature let TryFindXmlDocByAssemblyNameAndSig (infoReader: InfoReader) assemblyName xmlDocSig = infoReader.amap.assemblyLoader.TryFindXmlDocumentationInfo(assemblyName) - |> Option.bind (fun xmlDocInfo -> - xmlDocInfo.TryGetXmlDocBySig(xmlDocSig) - ) + |> ValueOption.bind (fun xmlDocInfo -> + xmlDocInfo.TryGetXmlDocBySig(xmlDocSig)) let private libFileOfEntityRef x = match x with @@ -1092,14 +1092,14 @@ let private libFileOfEntityRef x = let GetXmlDocSigOfEntityRef infoReader m (eref: EntityRef) = if eref.IsILTycon then match TryFindMetadataInfoOfExternalEntityRef infoReader m eref with - | None -> None - | Some (ccuFileName, _, formalTypeInfo) -> Some(ccuFileName, "T:"+formalTypeInfo.ILTypeRef.FullName) + | ValueNone -> ValueNone + | ValueSome (ccuFileName, _, formalTypeInfo) -> ValueSome(ccuFileName, "T:"+formalTypeInfo.ILTypeRef.FullName) else let ccuFileName = libFileOfEntityRef eref let m = eref.Deref if m.XmlDocSig = "" then m.XmlDocSig <- XmlDocSigOfEntity eref - Some (ccuFileName, m.XmlDocSig) + ValueSome (ccuFileName, m.XmlDocSig) let GetXmlDocSigOfScopedValRef g (tcref: TyconRef) (vref: ValRef) = let ccuFileName = libFileOfEntityRef tcref @@ -1113,21 +1113,21 @@ let GetXmlDocSigOfScopedValRef g (tcref: TyconRef) (vref: ValRef) = else ap v.XmlDocSig <- XmlDocSigOfVal g false path v - Some (ccuFileName, v.XmlDocSig) + ValueSome (ccuFileName, v.XmlDocSig) let GetXmlDocSigOfRecdFieldRef (rfref: RecdFieldRef) = let tcref = rfref.TyconRef let ccuFileName = libFileOfEntityRef tcref if rfref.RecdField.XmlDocSig = "" then rfref.RecdField.XmlDocSig <- XmlDocSigOfProperty [tcref.CompiledRepresentationForNamedType.FullName; rfref.RecdField.LogicalName] - Some (ccuFileName, rfref.RecdField.XmlDocSig) + ValueSome (ccuFileName, rfref.RecdField.XmlDocSig) let GetXmlDocSigOfUnionCaseRef (ucref: UnionCaseRef) = let tcref = ucref.TyconRef let ccuFileName = libFileOfEntityRef tcref if ucref.UnionCase.XmlDocSig = "" then ucref.UnionCase.XmlDocSig <- XmlDocSigOfUnionCase [tcref.CompiledRepresentationForNamedType.FullName; ucref.CaseName] - Some (ccuFileName, ucref.UnionCase.XmlDocSig) + ValueSome (ccuFileName, ucref.UnionCase.XmlDocSig) let GetXmlDocSigOfMethInfo (infoReader: InfoReader) m (minfo: MethInfo) = let amap = infoReader.amap @@ -1140,8 +1140,8 @@ let GetXmlDocSigOfMethInfo (infoReader: InfoReader) m (minfo: MethInfo) = let genericArity = if fmtps.Length=0 then "" else sprintf "``%d" fmtps.Length match TryFindMetadataInfoOfExternalEntityRef infoReader m ilminfo.DeclaringTyconRef with - | None -> None - | Some (ccuFileName, formalTypars, formalTypeInfo) -> + | ValueNone -> ValueNone + | ValueSome (ccuFileName, formalTypars, formalTypeInfo) -> let filminfo = ILMethInfo(g, formalTypeInfo.ToType, None, ilminfo.RawMetadata, fmtps) let args = if ilminfo.IsILExtensionMethod then @@ -1155,16 +1155,16 @@ let GetXmlDocSigOfMethInfo (infoReader: InfoReader) m (minfo: MethInfo) = // qualified name of the String constructor would be "System.String.#ctor". let normalizedName = ilminfo.ILName.Replace(".", "#") - Some (ccuFileName, "M:"+actualTypeName+"."+normalizedName+genericArity+XmlDocArgsEnc g (formalTypars, fmtps) args) + ValueSome (ccuFileName, "M:"+actualTypeName+"."+normalizedName+genericArity+XmlDocArgsEnc g (formalTypars, fmtps) args) | DefaultStructCtor(g, ty) -> match tryTcrefOfAppTy g ty with | ValueSome tcref -> - Some(None, $"M:{tcref.CompiledRepresentationForNamedType.FullName}.#ctor") - | _ -> None + ValueSome(None, $"M:{tcref.CompiledRepresentationForNamedType.FullName}.#ctor") + | _ -> ValueNone #if !NO_TYPEPROVIDERS - | ProvidedMeth _ -> None + | ProvidedMeth _ -> ValueNone #endif let GetXmlDocSigOfValRef g (vref: ValRef) = @@ -1173,42 +1173,42 @@ let GetXmlDocSigOfValRef g (vref: ValRef) = let v = vref.Deref if v.XmlDocSig = "" && v.HasDeclaringEntity then v.XmlDocSig <- XmlDocSigOfVal g false vref.DeclaringEntity.CompiledRepresentationForNamedType.Name v - Some (ccuFileName, v.XmlDocSig) + ValueSome (ccuFileName, v.XmlDocSig) else match vref.ApparentEnclosingEntity with | Parent tcref -> GetXmlDocSigOfScopedValRef g tcref vref | _ -> - None + ValueNone let GetXmlDocSigOfProp infoReader m (pinfo: PropInfo) = let g = pinfo.TcGlobals match pinfo with #if !NO_TYPEPROVIDERS - | ProvidedProp _ -> None // No signature is possible. If an xml comment existed it would have been returned by PropInfo.XmlDoc in infos.fs + | ProvidedProp _ -> ValueNone // No signature is possible. If an xml comment existed it would have been returned by PropInfo.XmlDoc in infos.fs #endif | FSProp _ as fspinfo -> match fspinfo.ArbitraryValRef with - | None -> None + | None -> ValueNone | Some vref -> GetXmlDocSigOfScopedValRef g pinfo.DeclaringTyconRef vref | ILProp(ILPropInfo(_, pdef)) -> match TryFindMetadataInfoOfExternalEntityRef infoReader m pinfo.DeclaringTyconRef with - | Some (ccuFileName, formalTypars, formalTypeInfo) -> + | ValueSome (ccuFileName, formalTypars, formalTypeInfo) -> let filpinfo = ILPropInfo(formalTypeInfo, pdef) - Some (ccuFileName, "P:"+formalTypeInfo.ILTypeRef.FullName+"."+pdef.Name+XmlDocArgsEnc g (formalTypars, []) (filpinfo.GetParamTypes(infoReader.amap, m))) - | _ -> None + ValueSome (ccuFileName, "P:"+formalTypeInfo.ILTypeRef.FullName+"."+pdef.Name+XmlDocArgsEnc g (formalTypars, []) (filpinfo.GetParamTypes(infoReader.amap, m))) + | _ -> ValueNone let GetXmlDocSigOfEvent infoReader m (einfo: EventInfo) = match einfo with | ILEvent _ -> match TryFindMetadataInfoOfExternalEntityRef infoReader m einfo.DeclaringTyconRef with - | Some (ccuFileName, _, formalTypeInfo) -> - Some(ccuFileName, "E:"+formalTypeInfo.ILTypeRef.FullName+"."+einfo.EventName) - | _ -> None - | _ -> None + | ValueSome (ccuFileName, _, formalTypeInfo) -> + ValueSome(ccuFileName, "E:"+formalTypeInfo.ILTypeRef.FullName+"."+einfo.EventName) + | _ -> ValueNone + | _ -> ValueNone let GetXmlDocSigOfILFieldInfo infoReader m (finfo: ILFieldInfo) = match TryFindMetadataInfoOfExternalEntityRef infoReader m finfo.DeclaringTyconRef with - | Some (ccuFileName, _, formalTypeInfo) -> - Some(ccuFileName, "F:"+formalTypeInfo.ILTypeRef.FullName+"."+finfo.FieldName) - | _ -> None + | ValueSome (ccuFileName, _, formalTypeInfo) -> + ValueSome(ccuFileName, "F:"+formalTypeInfo.ILTypeRef.FullName+"."+finfo.FieldName) + | _ -> ValueNone diff --git a/src/Compiler/Checking/InfoReader.fsi b/src/Compiler/Checking/InfoReader.fsi index 3e8ceb927ca..e3961ead7ab 100644 --- a/src/Compiler/Checking/InfoReader.fsi +++ b/src/Compiler/Checking/InfoReader.fsi @@ -60,7 +60,7 @@ val IsIndexerType: g: TcGlobals -> amap: ImportMap -> ty: TType -> bool /// Get the items that are considered the most specific in the hierarchy out of the given items by type. val GetMostSpecificItemsByType: - g: TcGlobals -> amap: ImportMap -> f: ('a -> (TType * range) option) -> xs: 'a list -> 'a list + g: TcGlobals -> amap: ImportMap -> f: ('a -> (TType * range) voption) -> xs: 'a list -> 'a list /// From the given method sets, filter each set down to the most specific ones. val FilterMostSpecificMethInfoSets: @@ -196,7 +196,7 @@ type InfoReader = findFlag: FindMemberFlag -> m: range -> ty: TType -> - HierarchyItem option + HierarchyItem voption /// Find the op_Implicit for a type member FindImplicitConversions: m: range -> ad: AccessorDomain -> ty: TType -> MethInfo list @@ -268,7 +268,7 @@ val TryFindIntrinsicNamedItemOfType: findFlag: FindMemberFlag -> m: range -> ty: TType -> - HierarchyItem option + HierarchyItem voption /// Try to detect the existence of a method on a type. val TryFindIntrinsicMethInfo: @@ -296,7 +296,7 @@ val GetSigOfFunctionForDelegate: /// Try and interpret a delegate type as a "standard" .NET delegate type associated with an event, with a "sender" parameter. val TryDestStandardDelegateType: - infoReader: InfoReader -> m: range -> ad: AccessorDomain -> delTy: TType -> (TType * TType) option + infoReader: InfoReader -> m: range -> ad: AccessorDomain -> delTy: TType -> (TType * TType) voption /// Indicates if an event info is associated with a delegate type that is a "standard" .NET delegate type /// with a sender parameter. @@ -308,27 +308,27 @@ val PropTypeOfEventInfo: infoReader: InfoReader -> m: range -> ad: AccessorDomai /// Try to find the name of the metadata file for this external definition val TryFindMetadataInfoOfExternalEntityRef: - infoReader: InfoReader -> m: range -> eref: EntityRef -> (string option * Typars * ILTypeInfo) option + infoReader: InfoReader -> m: range -> eref: EntityRef -> (string option * Typars * ILTypeInfo) voption /// Try to find the xml doc associated with the assembly name and metadata key val TryFindXmlDocByAssemblyNameAndSig: - infoReader: InfoReader -> assemblyName: string -> xmlDocSig: string -> XmlDoc option + infoReader: InfoReader -> assemblyName: string -> xmlDocSig: string -> XmlDoc voption -val GetXmlDocSigOfEntityRef: infoReader: InfoReader -> m: range -> eref: EntityRef -> (string option * string) option +val GetXmlDocSigOfEntityRef: infoReader: InfoReader -> m: range -> eref: EntityRef -> (string option * string) voption -val GetXmlDocSigOfScopedValRef: TcGlobals -> tcref: TyconRef -> vref: ValRef -> (string option * string) option +val GetXmlDocSigOfScopedValRef: TcGlobals -> tcref: TyconRef -> vref: ValRef -> (string option * string) voption -val GetXmlDocSigOfRecdFieldRef: rfref: RecdFieldRef -> (string option * string) option +val GetXmlDocSigOfRecdFieldRef: rfref: RecdFieldRef -> (string option * string) voption -val GetXmlDocSigOfUnionCaseRef: ucref: UnionCaseRef -> (string option * string) option +val GetXmlDocSigOfUnionCaseRef: ucref: UnionCaseRef -> (string option * string) voption -val GetXmlDocSigOfMethInfo: infoReader: InfoReader -> m: range -> minfo: MethInfo -> (string option * string) option +val GetXmlDocSigOfMethInfo: infoReader: InfoReader -> m: range -> minfo: MethInfo -> (string option * string) voption -val GetXmlDocSigOfValRef: TcGlobals -> vref: ValRef -> (string option * string) option +val GetXmlDocSigOfValRef: TcGlobals -> vref: ValRef -> (string option * string) voption -val GetXmlDocSigOfProp: infoReader: InfoReader -> m: range -> pinfo: PropInfo -> (string option * string) option +val GetXmlDocSigOfProp: infoReader: InfoReader -> m: range -> pinfo: PropInfo -> (string option * string) voption -val GetXmlDocSigOfEvent: infoReader: InfoReader -> m: range -> einfo: EventInfo -> (string option * string) option +val GetXmlDocSigOfEvent: infoReader: InfoReader -> m: range -> einfo: EventInfo -> (string option * string) voption val GetXmlDocSigOfILFieldInfo: - infoReader: InfoReader -> m: range -> finfo: ILFieldInfo -> (string option * string) option + infoReader: InfoReader -> m: range -> finfo: ILFieldInfo -> (string option * string) voption diff --git a/src/Compiler/Checking/MethodCalls.fs b/src/Compiler/Checking/MethodCalls.fs index 4878c66511c..f63fd496990 100644 --- a/src/Compiler/Checking/MethodCalls.fs +++ b/src/Compiler/Checking/MethodCalls.fs @@ -170,7 +170,7 @@ let AdjustDelegateTy (infoReader: InfoReader) actualTy reqdTy m = // let f (x: 'T) : Nullable<'T> = x // is enough, whereas // let f (x: 'T) : Nullable<_> = x -// let f x : Nullable<'T> = x +// let f x : Nullable<'T> = x // are not enough to activate. let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualTy m = @@ -179,11 +179,11 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT if g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then // shortcut - if typeEquiv g reqdTy actualTy then None else + if typeEquiv g reqdTy actualTy then ValueNone else let reqdTy2 = if isTyparTy g reqdTy then let tp = destTyparTy g reqdTy - match tp.Constraints |> List.choose (function TyparConstraint.CoercesTo (tgtTy, _) -> Some tgtTy | _ -> None) with + match [ for typarConstraint in tp.Constraints do match typarConstraint with | TyparConstraint.CoercesTo (tgtTy, _) -> yield tgtTy | _ -> () ] with | [reqdTy2] when tp.Rigidity = TyparRigidity.Flexible -> reqdTy2 | _ -> reqdTy else reqdTy @@ -217,17 +217,17 @@ let TryFindRelevantImplicitConversion (infoReader: InfoReader) ad reqdTy actualT match implicits with | [(minfo, staticTy) ] -> - Some (minfo, staticTy, (reqdTy, reqdTy2, ignore)) + ValueSome (minfo, staticTy, (reqdTy, reqdTy2, ignore)) | (minfo, staticTy) :: _ -> - Some (minfo, staticTy, (reqdTy, reqdTy2, fun denv -> + ValueSome (minfo, staticTy, (reqdTy, reqdTy2, fun denv -> let reqdTy2Text, actualTyText, _cxs = NicePrint.minimalStringsOfTwoTypes denv reqdTy2 actualTy let implicitsText = NicePrint.multiLineStringOfMethInfos infoReader m denv (List.map fst implicits) errorR(Error(FSComp.SR.tcAmbiguousImplicitConversion(actualTyText, reqdTy2Text, implicitsText), m)))) - | _ -> None + | _ -> ValueNone else - None + ValueNone else - None + ValueNone [] type TypeDirectedConversion = @@ -312,8 +312,8 @@ let rec AdjustRequiredTypeForTypeDirectedConversions (infoReader: InfoReader) ad // eliminate articifical constrained type variables. elif g.langVersion.SupportsFeature LanguageFeature.AdditionalTypeDirectedConversions then match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false, false), Some eqn - | None -> reqdTy, TypeDirectedConversionUsed.No, None + | ValueSome (minfo, _staticTy, eqn) -> actualTy, TypeDirectedConversionUsed.Yes(warn (TypeDirectedConversion.Implicit minfo), false, false), Some eqn + | ValueNone -> reqdTy, TypeDirectedConversionUsed.No, None else reqdTy, TypeDirectedConversionUsed.No, None @@ -1352,13 +1352,13 @@ let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReade MakeMethInfoCall amap m minfo [] [callerArgExprCoerced] None else match TryFindRelevantImplicitConversion infoReader ad reqdTy actualTy m with - | Some (minfo, staticTy, _) -> + | ValueSome (minfo, staticTy, _) -> MethInfoChecks g amap false None [] ad m minfo let staticTyOpt = if isTyparTy g staticTy then Some staticTy else None let callExpr, _ = BuildMethodCall tcVal g amap Mutates.NeverMutates m false minfo ValUseFlag.NormalValUse [] [] [expr] staticTyOpt assert (let resTy = tyOfExpr g callExpr in typeEquiv g reqdTy resTy) callExpr - | None -> mkCoerceIfNeeded g reqdTy actualTy expr + | ValueNone -> mkCoerceIfNeeded g reqdTy actualTy expr // Handle adhoc argument conversions let AdjustCallerArgExpr tcVal (g: TcGlobals) amap infoReader ad isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr = @@ -1815,7 +1815,7 @@ module ProvidedMethodCalls = let convertProvidedExpressionToExprAndWitness tcVal - (thisArg: Expr option, + (thisArg: Expr voption, allArgs: Exprs, paramVars: Tainted[], g, amap, mut, isProp, isSuperInit, m, @@ -1825,7 +1825,7 @@ module ProvidedMethodCalls = // note: Assuming the size based on paramVars // Doubling to decrease chance of collisions let dict = Dictionary.newWithSize (paramVars.Length*2) - for v, e in Seq.zip (paramVars |> Seq.map (fun x -> x.PUntaint(id, m))) (Option.toList thisArg @ allArgs) do + for v, e in Seq.zip (paramVars |> Seq.map (fun x -> x.PUntaint(id, m))) (ValueOption.toList thisArg @ allArgs) do dict.Add(v, (None, e)) dict @@ -2060,8 +2060,8 @@ module ProvidedMethodCalls = | [objArg] -> let erasedThisTy = eraseSystemType (amap, m, mi.PApply((fun mi -> nonNull mi.DeclaringType), m)) let thisVar = erasedThisTy.PApply((fun ty -> ty.AsProvidedVar("this")), m) - Some objArg, Array.append [| thisVar |] paramVars - | [] -> None, paramVars + ValueSome objArg, Array.append [| thisVar |] paramVars + | [] -> ValueNone, paramVars | _ -> failwith "multiple objArgs?" let ea = mi.PApplyWithProvider((fun (methodInfo, provider) -> GetInvokerExpression(provider, methodInfo, [| for p in paramVars -> p.PUntaintNoFailure id |])), m) @@ -2161,9 +2161,9 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = let receiverArgOpt, argExprs = if minfo.IsInstance then match argExprs with - | h :: t -> Some h, t - | argExprs -> None, argExprs - else None, argExprs + | h :: t -> ValueSome h, t + | argExprs -> ValueNone, argExprs + else ValueNone, argExprs // For methods taking no arguments, 'argExprs' will be a single unit expression here let argExprs = @@ -2173,8 +2173,8 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = let convertedArgs = (argExprs, argTypes) ||> List.map2 (fun expr expectedTy -> mkCoerceIfNeeded g expectedTy (tyOfExpr g expr) expr) match receiverArgOpt with - | Some r -> r :: convertedArgs - | None -> convertedArgs + | ValueSome r -> r :: convertedArgs + | ValueNone -> convertedArgs // Fix bug 1281: If we resolve to an instance method on a struct and we haven't yet taken // the address of the object then go do that @@ -2182,17 +2182,17 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = match argExprs with | h :: t when not (isByrefTy g (tyOfExpr g h)) -> let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false PossiblyMutates h None m - Some (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) + ValueSome (wrap (Expr.Op (TOp.TraitCall traitInfo, [], (h' :: t), m))) | _ -> - Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) + ValueSome (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) else - Some (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) + ValueSome (MakeMethInfoCall amap m minfo methArgTys argExprs staticTyOpt) | Choice2Of5 (tinst, rfref, isSet) -> match isSet, rfref.RecdField.IsStatic, argExprs.Length with // static setter | true, true, 1 -> - Some (mkStaticRecdFieldSet (rfref, tinst, argExprs[0], m)) + ValueSome (mkStaticRecdFieldSet (rfref, tinst, argExprs[0], m)) // instance setter | true, false, 2 -> @@ -2201,42 +2201,42 @@ let GenWitnessExpr amap g m (traitInfo: TraitConstraintInfo) argExprs = if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs[0])) then let h = List.head argExprs let wrap, h', _readonly, _writeonly = mkExprAddrOfExpr g true false DefinitelyMutates h None m - Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs[1], m))) + ValueSome (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs[1], m))) else - Some (mkRecdFieldSetViaExprAddr (argExprs[0], rfref, tinst, argExprs[1], m)) + ValueSome (mkRecdFieldSetViaExprAddr (argExprs[0], rfref, tinst, argExprs[1], m)) // static getter | false, true, 0 -> - Some (mkStaticRecdFieldGet (rfref, tinst, m)) + ValueSome (mkStaticRecdFieldGet (rfref, tinst, m)) // instance getter | false, false, 1 -> if rfref.Tycon.IsStructOrEnumTycon && isByrefTy g (tyOfExpr g argExprs[0]) then - Some (mkRecdFieldGetViaExprAddr (argExprs[0], rfref, tinst, m)) + ValueSome (mkRecdFieldGetViaExprAddr (argExprs[0], rfref, tinst, m)) else - Some (mkRecdFieldGet g (argExprs[0], rfref, tinst, m)) + ValueSome (mkRecdFieldGet g (argExprs[0], rfref, tinst, m)) - | _ -> None + | _ -> ValueNone | Choice3Of5 (anonInfo, tinst, i) -> let tupInfo = anonInfo.TupInfo if evalTupInfoIsStruct tupInfo && isByrefTy g (tyOfExpr g argExprs[0]) then - Some (mkAnonRecdFieldGetViaExprAddr (anonInfo, argExprs[0], tinst, i, m)) + ValueSome (mkAnonRecdFieldGetViaExprAddr (anonInfo, argExprs[0], tinst, i, m)) else - Some (mkAnonRecdFieldGet g (anonInfo, argExprs[0], tinst, i, m)) + ValueSome (mkAnonRecdFieldGet g (anonInfo, argExprs[0], tinst, i, m)) | Choice4Of5 expr -> - Some (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m)) + ValueSome (MakeApplicationAndBetaReduce g (expr, tyOfExpr g expr, [], argExprs, m)) | Choice5Of5 () -> match traitInfo.Solution with - | None -> None // the trait has been generalized + | None -> ValueNone // the trait has been generalized | Some _-> // For these operators, the witness is just a call to the coresponding FSharp.Core operator match g.TryMakeOperatorAsBuiltInWitnessInfo isStringTy isArrayTy traitInfo argExprs with - | Some (info, tyargs, actualArgExprs) -> + | ValueSome (info, tyargs, actualArgExprs) -> tryMkCallCoreFunctionAsBuiltInWitness g info tyargs actualArgExprs m - | None -> + | ValueNone -> // For all other built-in operators, the witness is a call to the coresponding BuiltInWitnesses operator // These are called as F# methods not F# functions tryMkCallBuiltInWitness g traitInfo argExprs m @@ -2248,9 +2248,9 @@ let GenWitnessExprLambda amap g m (traitInfo: TraitConstraintInfo) = let vse = argTysl |> List.mapiSquared (fun i j ty -> mkCompGenLocal m ("arg" + string i + "_" + string j) ty) let vsl = List.mapSquared fst vse match GenWitnessExpr amap g m traitInfo (List.concat (List.mapSquared snd vse)) with - | Some expr -> + | ValueSome expr -> Choice2Of2 (mkMemberLambdas g m [] None None vsl (expr, tyOfExpr g expr)) - | None -> + | ValueNone -> Choice1Of2 traitInfo /// Generate the arguments passed for a set of (solved) traits in non-generic code diff --git a/src/Compiler/Checking/MethodCalls.fsi b/src/Compiler/Checking/MethodCalls.fsi index 60a5ace7201..43f8f2f5d99 100644 --- a/src/Compiler/Checking/MethodCalls.fsi +++ b/src/Compiler/Checking/MethodCalls.fsi @@ -495,7 +495,7 @@ val CheckRecdFieldMutation: m: range -> denv: TypedTreeOps.DisplayEnv -> rfinfo: /// None is returned in the cases where the trait has not been solved (e.g. is part of generic code) /// or there is an unexpected mismatch of some kind. val GenWitnessExpr: - amap: ImportMap -> g: TcGlobals -> m: range -> traitInfo: TraitConstraintInfo -> argExprs: Expr list -> Expr option + amap: ImportMap -> g: TcGlobals -> m: range -> traitInfo: TraitConstraintInfo -> argExprs: Expr list -> Expr voption /// Generate a lambda expression for the given solved trait. val GenWitnessExprLambda: diff --git a/src/Compiler/Checking/MethodOverrides.fs b/src/Compiler/Checking/MethodOverrides.fs index 53f40ba7ce2..0b6f83e875f 100644 --- a/src/Compiler/Checking/MethodOverrides.fs +++ b/src/Compiler/Checking/MethodOverrides.fs @@ -466,25 +466,28 @@ module DispatchSlotChecking = res + let inline filterInterfaces g (ty, m) = + if isInterfaceTy g ty then + ValueSome(ty, m) + else + ValueNone + /// This is to find override methods that are at the most specific in the hierarchy of interface types. let GetMostSpecificOverrideInterfaceMethodSets (infoReader: InfoReader) allReqdTys = let g = infoReader.g let amap = infoReader.amap + let filterInterfaces = filterInterfaces g + let multipleSets = - allReqdTys - // Widdle down to the most specific interfaces. - |> GetMostSpecificItemsByType g amap (fun (ty, m) -> - if isInterfaceTy g ty then - Some(ty, m) - else - None) + [ for (ty, m) in GetMostSpecificItemsByType g amap filterInterfaces allReqdTys do + let mostSpecificOverrides = + GetIntrinisicMostSpecificOverrideMethInfoSetsOfType infoReader m ty - // Get the most specific method overrides for each interface type. - |> List.choose (fun (ty, m) -> - let mostSpecificOverrides = GetIntrinisicMostSpecificOverrideMethInfoSetsOfType infoReader m ty - if mostSpecificOverrides.IsEmpty then None - else Some mostSpecificOverrides) + if mostSpecificOverrides.IsEmpty then + () + else + yield mostSpecificOverrides ] match multipleSets with | [] -> NameMultiMap.Empty @@ -577,7 +580,7 @@ module DispatchSlotChecking = if isInterfaceTy g reqdTy then [ for impliedTy in impliedTys do yield (impliedTy, GetInterfaceDispatchSlots infoReader ad m availImpliedInterfaces mostSpecificOverrides impliedTy) ] - else + else [ (reqdTy, GetClassDispatchSlots infoReader ad m reqdTy) ] /// Check all implementations implement some dispatch slot. @@ -650,7 +653,7 @@ module DispatchSlotChecking = let g = infoReader.g let amap = infoReader.amap - + let availImpliedInterfaces : TType list = [ for reqdTy, m in allReqdTys do if not (isInterfaceTy g reqdTy) then @@ -658,7 +661,7 @@ module DispatchSlotChecking = match baseTyOpt with | None -> () | Some baseTy -> yield! AllInterfacesOfType g amap m AllowMultiIntfInstantiations.Yes baseTy ] - + // For each implemented type, get a list containing the transitive closure of // interface types implied by the type. This includes the implemented type itself if the implemented type // is an interface type. @@ -743,16 +746,16 @@ module DispatchSlotChecking = // If the slot is optional, then we do not need an explicit implementation. minfo.IsNewSlot && not reqdSlot.IsOptional) then errorR(Error(FSComp.SR.typrelNeedExplicitImplementation(NicePrint.minimalStringOfType denv ty), reqdTyRange)) - + // We also collect up the properties. This is used for abstract slot inference when overriding properties let isRelevantRequiredProperty (x: PropInfo) = (x.IsVirtualProperty && not (isInterfaceTy g reqdTy)) || isImpliedInterfaceType x.ApparentEnclosingType - + let reqdProperties = GetIntrinsicPropInfosOfType infoReader None ad AllowMultiIntfInstantiations.Yes IgnoreOverrides reqdTyRange reqdTy |> List.filter isRelevantRequiredProperty - + let dispatchSlots = dispatchSlotSet |> List.collect snd let dispatchSlotsKeyed = dispatchSlots |> NameMultiMap.initBy (fun reqdSlot -> reqdSlot.MethodInfo.LogicalName) yield SlotImplSet(dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, reqdProperties) ] diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index d4456d6ce54..e74941442cd 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -1741,88 +1741,101 @@ let (|ValRefOfProp|_|) (pi: PropInfo) = pi.ArbitraryValRef let (|ValRefOfMeth|_|) (mi: MethInfo) = mi.ArbitraryValRef let (|ValRefOfEvent|_|) (evt: EventInfo) = evt.ArbitraryValRef +[] let rec (|RecordFieldUse|_|) (item: Item) = match item with - | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, name))) -> Some (name, tcref) - | Item.SetterArg(_, RecordFieldUse f) -> Some f - | _ -> None + | Item.RecdField(RecdFieldInfo(_, RecdFieldRef(tcref, name))) -> ValueSome (name, tcref) + | Item.SetterArg(_, RecordFieldUse f) -> ValueSome f + | _ -> ValueNone +[] let (|UnionCaseFieldUse|_|) (item: Item) = match item with - | Item.UnionCaseField (uci, fieldIndex) -> Some (fieldIndex, uci.UnionCaseRef) - | _ -> None + | Item.UnionCaseField (uci, fieldIndex) -> ValueSome (fieldIndex, uci.UnionCaseRef) + | _ -> ValueNone +[] let rec (|ILFieldUse|_|) (item: Item) = match item with - | Item.ILField finfo -> Some finfo - | Item.SetterArg(_, ILFieldUse f) -> Some f - | _ -> None + | Item.ILField finfo -> ValueSome finfo + | Item.SetterArg(_, ILFieldUse f) -> ValueSome f + | _ -> ValueNone +[] let rec (|PropertyUse|_|) (item: Item) = match item with - | Item.Property(info = pinfo :: _) -> Some pinfo - | Item.SetterArg(_, PropertyUse pinfo) -> Some pinfo - | _ -> None + | Item.Property(info = pinfo :: _) -> ValueSome pinfo + | Item.SetterArg(_, PropertyUse pinfo) -> ValueSome pinfo + | _ -> ValueNone +[] let rec (|FSharpPropertyUse|_|) (item: Item) = match item with - | Item.Property(info = [ValRefOfProp vref]) -> Some vref - | Item.SetterArg(_, FSharpPropertyUse propDef) -> Some propDef - | _ -> None + | Item.Property(info = [ValRefOfProp vref]) -> ValueSome vref + | Item.SetterArg(_, FSharpPropertyUse propDef) -> ValueSome propDef + | _ -> ValueNone +[] let (|MethodUse|_|) (item: Item) = match item with - | Item.MethodGroup(_, [minfo], _) -> Some minfo - | _ -> None + | Item.MethodGroup(_, [minfo], _) -> ValueSome minfo + | _ -> ValueNone +[] let (|FSharpMethodUse|_|) (item: Item) = match item with - | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> Some vref - | Item.Value vref when vref.IsMember -> Some vref - | _ -> None + | Item.MethodGroup(_, [ValRefOfMeth vref], _) -> ValueSome vref + | Item.Value vref when vref.IsMember -> ValueSome vref + | _ -> ValueNone +[] let (|EntityUse|_|) (item: Item) = match item with - | Item.UnqualifiedType (tcref :: _) -> Some tcref - | Item.ExnCase tcref -> Some tcref + | Item.UnqualifiedType (tcref :: _) -> ValueSome tcref + | Item.ExnCase tcref -> ValueSome tcref | Item.Types(_, [AbbrevOrAppTy tcref]) | Item.DelegateCtor(AbbrevOrAppTy tcref) - | Item.FakeInterfaceCtor(AbbrevOrAppTy tcref) -> Some tcref + | Item.FakeInterfaceCtor(AbbrevOrAppTy tcref) -> ValueSome tcref | Item.CtorGroup(_, ctor :: _) -> match ctor.ApparentEnclosingType with - | AbbrevOrAppTy tcref -> Some tcref - | _ -> None - | _ -> None + | AbbrevOrAppTy tcref -> ValueSome tcref + | _ -> ValueNone + | _ -> ValueNone +[] let (|EventUse|_|) (item: Item) = match item with - | Item.Event einfo -> Some einfo - | _ -> None + | Item.Event einfo -> ValueSome einfo + | _ -> ValueNone +[] let (|FSharpEventUse|_|) (item: Item) = match item with - | Item.Event(ValRefOfEvent vref) -> Some vref - | _ -> None + | Item.Event(ValRefOfEvent vref) -> ValueSome vref + | _ -> ValueNone +[] let (|UnionCaseUse|_|) (item: Item) = match item with - | Item.UnionCase(UnionCaseInfo(_, u1), _) -> Some u1 - | _ -> None + | Item.UnionCase(UnionCaseInfo(_, u1), _) -> ValueSome u1 + | _ -> ValueNone +[] let (|ValUse|_|) (item: Item) = match item with | Item.Value vref | FSharpPropertyUse vref | FSharpMethodUse vref | FSharpEventUse vref - | Item.CustomBuilder(_, vref) -> Some vref - | _ -> None + | Item.CustomBuilder(_, vref) -> ValueSome vref + | _ -> ValueNone +[] let (|ActivePatternCaseUse|_|) (item: Item) = match item with - | Item.ActivePatternCase(APElemRef(_, vref, idx, _)) -> Some (vref.SigRange, vref.DefinitionRange, idx) - | Item.ActivePatternResult(ap, _, idx, _) -> Some (ap.Range, ap.Range, idx) - | _ -> None + | Item.ActivePatternCase(APElemRef(_, vref, idx, _)) -> ValueSome (vref.SigRange, vref.DefinitionRange, idx) + | Item.ActivePatternResult(ap, _, idx, _) -> ValueSome (ap.Range, ap.Range, idx) + | _ -> ValueNone let tyconRefDefnHash (_g: TcGlobals) (eref1: EntityRef) = hash eref1.LogicalName @@ -2616,10 +2629,10 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf | None -> match TryFindIntrinsicNamedItemOfType ncenv.InfoReader (nm, ad, true) findFlag m ty with - | Some (TraitItem (traitInfo :: _)) when isLookUpExpr -> + | ValueSome (TraitItem (traitInfo :: _)) when isLookUpExpr -> success [resInfo, Item.Trait traitInfo, rest] - | Some (PropertyItem psets) when isLookUpExpr -> + | ValueSome (PropertyItem psets) when isLookUpExpr -> let pinfos = psets |> ExcludeHiddenOfPropInfos g ncenv.amap m // fold the available extension members into the overload resolution @@ -2679,7 +2692,7 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf // `Some(PropertyItem psets) when isLookUpExpr` in the first place. raze (UndefinedName (depth, FSComp.SR.undefinedNameFieldConstructorOrMember, id, NoSuggestions)) - | Some(MethodItem msets) when isLookUpExpr -> + | ValueSome(MethodItem msets) when isLookUpExpr -> let minfos = msets |> ExcludeHiddenOfMethInfos g ncenv.amap m // fold the available extension members into the overload resolution @@ -2687,13 +2700,13 @@ let rec ResolveLongIdentInTypePrim (ncenv: NameResolver) nenv lookupKind (resInf success [resInfo, Item.MakeMethGroup (nm, minfos@extensionMethInfos), rest] - | Some (ILFieldItem (finfo :: _)) when (match lookupKind with LookupKind.Expr _ | LookupKind.Pattern -> true | _ -> false) -> + | ValueSome (ILFieldItem (finfo :: _)) when (match lookupKind with LookupKind.Expr _ | LookupKind.Pattern -> true | _ -> false) -> success [resInfo, Item.ILField finfo, rest] - | Some (EventItem (einfo :: _)) when isLookUpExpr -> + | ValueSome (EventItem (einfo :: _)) when isLookUpExpr -> success [resInfo, Item.Event einfo, rest] - | Some (RecdFieldItem rfinfo) when (match lookupKind with LookupKind.Expr _ | LookupKind.RecdField | LookupKind.Pattern -> true | _ -> false) -> + | ValueSome (RecdFieldItem rfinfo) when (match lookupKind with LookupKind.Expr _ | LookupKind.RecdField | LookupKind.Pattern -> true | _ -> false) -> success [resInfo, Item.RecdField rfinfo, rest] | _ -> @@ -2843,9 +2856,10 @@ let private ResolveLongIdentInTyconRefs atMostOne (ncenv: NameResolver) nenv loo // ResolveExprLongIdentInModuleOrNamespace //------------------------------------------------------------------------- +[] let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec = let eref = modref.NestedTyconRef mspec - if IsEntityAccessible amap m ad eref then Some eref else None + if IsEntityAccessible amap m ad eref then ValueSome eref else ValueNone let rec ResolveExprLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv (typeNameResInfo: TypeNameResolutionInfo) ad resInfo depth m modref (mty: ModuleOrNamespaceType) (id: Ident) (rest: Ident list) = // resInfo records the modules or namespaces actually relevant to a resolution @@ -3028,10 +3042,10 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified match AtMostOneResult m search with | Result (resInfo, item) -> ResolutionInfo.SendEntityPathToSink(sink, ncenv, nenv, ItemOccurence.Use, ad, resInfo, ResultTyparChecker(fun () -> CheckAllTyparsInferrable ncenv.amap m item)) - Some(resInfo.EnclosingTypeInst, item, rest) + ValueSome(resInfo.EnclosingTypeInst, item, rest) | Exception e -> typeError <- Some e - None + ValueNone | true, res -> let fresh = ResolveUnqualifiedItem ncenv nenv m res @@ -3040,16 +3054,16 @@ let rec ResolveExprLongIdentPrim sink (ncenv: NameResolver) first fullyQualified let isNameOfOperator = valRefEq ncenv.g ncenv.g.nameof_vref value if isNameOfOperator && not ncenv.languageSupportsNameOf then // Do not resolve `nameof` if the feature is unsupported, even if it is FSharp.Core - None + ValueNone else - Some (emptyEnclosingTypeInst, fresh, rest) - | _ -> Some (emptyEnclosingTypeInst, fresh, rest) + ValueSome (emptyEnclosingTypeInst, fresh, rest) + | _ -> ValueSome (emptyEnclosingTypeInst, fresh, rest) | _ -> - None + ValueNone match envSearch with - | Some res -> success res - | None -> + | ValueSome res -> success res + | ValueNone -> let innerSearch = // Check if it's a type name, e.g. a constructor call or a type instantiation let ctorSearch = @@ -4065,11 +4079,12 @@ let ResolveLongIdentAsExprAndComputeRange (sink: TcResultsSink) (ncenv: NameReso success (tinstEnclosing, item, itemRange, rest, afterResolution) +[] let (|NonOverridable|_|) namedItem = match namedItem with - | Item.MethodGroup(_, minfos, _) when minfos |> List.exists(fun minfo -> minfo.IsVirtual || minfo.IsAbstract) -> None - | Item.Property(info = pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> None - | _ -> Some () + | Item.MethodGroup(_, minfos, _) when minfos |> List.exists(fun minfo -> minfo.IsVirtual || minfo.IsAbstract) -> ValueNone + | Item.Property(info = pinfos) when pinfos |> List.exists(fun pinfo -> pinfo.IsVirtualProperty) -> ValueNone + | _ -> ValueSome () /// Called for 'expression.Bar' - for VS IntelliSense, we can filter out static members from method groups /// Also called for 'GenericType.Bar' - for VS IntelliSense, we can filter out non-static members from method groups diff --git a/src/Compiler/Checking/NicePrint.fs b/src/Compiler/Checking/NicePrint.fs index 12587b22aac..84c5dad7b18 100644 --- a/src/Compiler/Checking/NicePrint.fs +++ b/src/Compiler/Checking/NicePrint.fs @@ -256,16 +256,16 @@ module internal PrintUtilities = xmlDocL @@ restL else restL - let layoutXmlDocFromSig (denv: DisplayEnv) (infoReader: InfoReader) alwaysAddEmptyLine (possibleXmlDoc: XmlDoc) restL (info: (string option * string) option) = + let layoutXmlDocFromSig (denv: DisplayEnv) (infoReader: InfoReader) alwaysAddEmptyLine (possibleXmlDoc: XmlDoc) restL (info: (string option * string) voption) = let xmlDoc = if possibleXmlDoc.IsEmpty then match info with - | Some(Some ccuFileName, xmlDocSig) -> + | ValueSome(Some ccuFileName, xmlDocSig) -> infoReader.amap.assemblyLoader.TryFindXmlDocumentationInfo(Path.GetFileNameWithoutExtension ccuFileName) - |> Option.bind (fun xmlDocInfo -> + |> ValueOption.bind (fun xmlDocInfo -> xmlDocInfo.TryGetXmlDocBySig(xmlDocSig) ) - |> Option.defaultValue possibleXmlDoc + |> ValueOption.defaultValue possibleXmlDoc | _ -> possibleXmlDoc else @@ -2390,20 +2390,32 @@ module TastDefinitionPrinting = module InferredSigPrinting = open PrintTypes - + + [] + let rec (|NestedModule|_|) (currentContents:ModuleOrNamespaceContents) = + match currentContents with + | ModuleOrNamespaceContents.TMDefRec (bindings = [ ModuleOrNamespaceBinding.Module(mn, NestedModule(path, contents, attribs)) ]) -> + ValueSome ([ yield mn.DisplayNameCore; yield! path ], contents, List.append mn.Attribs attribs) + | ModuleOrNamespaceContents.TMDefs [ ModuleOrNamespaceContents.TMDefRec (bindings = [ ModuleOrNamespaceBinding.Module(mn, NestedModule(path, contents, attribs)) ]) ] -> + ValueSome ([ yield mn.DisplayNameCore; yield! path ], contents, List.append mn.Attribs attribs) + | ModuleOrNamespaceContents.TMDefs [ ModuleOrNamespaceContents.TMDefRec (bindings = [ ModuleOrNamespaceBinding.Module(mn, nestedModuleContents) ]) ] -> + ValueSome ([ mn.DisplayNameCore ], nestedModuleContents, mn.Attribs) + | _ -> + ValueNone + /// Layout the inferred signature of a compilation unit let layoutImpliedSignatureOfModuleOrNamespace showHeader denv infoReader ad m expr = let (@@*) = if denv.printVerboseSignatures then (@@----) else (@@--) - let rec isConcreteNamespace x = - match x with - | TMDefRec(_, _opens, tycons, mbinds, _) -> + let rec isConcreteNamespace x = + match x with + | TMDefRec(_, _opens, tycons, mbinds, _) -> not (isNil tycons) || (mbinds |> List.exists (function ModuleOrNamespaceBinding.Binding _ -> true | ModuleOrNamespaceBinding.Module(x, _) -> not x.IsNamespace)) | TMDefLet _ -> true | TMDefDo _ -> true | TMDefOpens _ -> false - | TMDefs defs -> defs |> List.exists isConcreteNamespace + | TMDefs defs -> defs |> List.exists isConcreteNamespace let rec imdefsL denv x = aboveListL (x |> List.map (imdefL denv)) @@ -2458,23 +2470,14 @@ module InferredSigPrinting = if mspec.IsImplicitNamespace then // The current mspec is a namespace that belongs to the `def` child (nested) module(s). let fullModuleName, def, denv, moduleAttribs = - let rec (|NestedModule|_|) (currentContents:ModuleOrNamespaceContents) = - match currentContents with - | ModuleOrNamespaceContents.TMDefRec (bindings = [ ModuleOrNamespaceBinding.Module(mn, NestedModule(path, contents, attribs)) ]) -> - Some ([ yield mn.DisplayNameCore; yield! path ], contents, List.append mn.Attribs attribs) - | ModuleOrNamespaceContents.TMDefs [ ModuleOrNamespaceContents.TMDefRec (bindings = [ ModuleOrNamespaceBinding.Module(mn, NestedModule(path, contents, attribs)) ]) ] -> - Some ([ yield mn.DisplayNameCore; yield! path ], contents, List.append mn.Attribs attribs) - | ModuleOrNamespaceContents.TMDefs [ ModuleOrNamespaceContents.TMDefRec (bindings = [ ModuleOrNamespaceBinding.Module(mn, nestedModuleContents) ]) ] -> - Some ([ mn.DisplayNameCore ], nestedModuleContents, mn.Attribs) - | _ -> - None + match def with | NestedModule(path, nestedModuleContents, moduleAttribs) -> let fullPath = mspec.DisplayNameCore :: path fullPath, nestedModuleContents, denv.AddOpenPath(fullPath), moduleAttribs | _ -> [ mspec.DisplayNameCore ], def, denv, List.empty - + let nmL = List.map (tagModule >> wordL) fullModuleName |> sepListL SepL.dot let nmL = layoutAccessibility denv mspec.Accessibility nmL let denv = denv.AddAccessibility mspec.Accessibility diff --git a/src/Compiler/Checking/PatternMatchCompilation.fs b/src/Compiler/Checking/PatternMatchCompilation.fs index 3caacecb982..c6e8724f75f 100644 --- a/src/Compiler/Checking/PatternMatchCompilation.fs +++ b/src/Compiler/Checking/PatternMatchCompilation.fs @@ -753,6 +753,7 @@ let (|ListEmptyDiscrim|_|) g = function | _ -> None #endif +[] let (|ConstNeedsDefaultCase|_|) c = match c with | Const.Decimal _ @@ -767,8 +768,8 @@ let (|ConstNeedsDefaultCase|_|) c = | Const.UInt64 _ | Const.IntPtr _ | Const.UIntPtr _ - | Const.Char _ -> Some () - | _ -> None + | Const.Char _ -> ValueSome () + | _ -> ValueNone /// Build a dtree, equivalent to: TDSwitch("expr", edges, default, m) /// diff --git a/src/Compiler/Checking/PostInferenceChecks.fs b/src/Compiler/Checking/PostInferenceChecks.fs index 62c5a2f5f11..f3001b8337d 100644 --- a/src/Compiler/Checking/PostInferenceChecks.fs +++ b/src/Compiler/Checking/PostInferenceChecks.fs @@ -747,8 +747,8 @@ let CheckMultipleInterfaceInstantiations cenv (ty:TType) (interfaces:TType list) | ExactlyEqual -> () | FeasiblyEqual -> match tryLanguageFeatureErrorOption cenv.g.langVersion LanguageFeature.InterfacesWithMultipleGenericInstantiation m with - | None -> () - | Some exn -> exn + | ValueNone -> () + | ValueSome exn -> exn let typ1Str = NicePrint.minimalStringOfType cenv.denv ty1 let typ2Str = NicePrint.minimalStringOfType cenv.denv ty2 @@ -760,8 +760,8 @@ let CheckMultipleInterfaceInstantiations cenv (ty:TType) (interfaces:TType list) | NotEqual -> match tryLanguageFeatureErrorOption cenv.g.langVersion LanguageFeature.InterfacesWithMultipleGenericInstantiation m with - | None -> () - | Some exn -> exn + | ValueNone -> () + | ValueSome exn -> exn } match Seq.tryHead errors with | None -> () @@ -2131,7 +2131,7 @@ let CheckModuleBinding cenv env (TBind(v, e, _) as bind) = let hasDefaultAugmentation = tcref.IsUnionTycon && match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b + | ValueSome(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> b | _ -> true (* not hiddenRepr *) let kind = (if v.IsMember then "member" else "value") diff --git a/src/Compiler/Checking/QuotationTranslator.fs b/src/Compiler/Checking/QuotationTranslator.fs index fa0d317ab95..173195e7bfb 100644 --- a/src/Compiler/Checking/QuotationTranslator.fs +++ b/src/Compiler/Checking/QuotationTranslator.fs @@ -736,11 +736,11 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP. if g.generateWitnesses then ConstraintSolver.CodegenWitnessExprForTraitConstraint cenv.tcVal g cenv.amap m traitInfo args |> CommitOperationResult else - None + ValueNone match minfoOpt with - | None -> + | ValueNone -> wfail(Error(FSComp.SR.crefQuotationsCantCallTraitMembers(), m)) - | Some expr -> + | ValueSome expr -> ConvExpr cenv env expr | _ -> @@ -1364,4 +1364,3 @@ let ConvReflectedDefinition cenv methName v e = let mbaseR = ConvMethodBase cenv env (methName, v) mbaseR, astExprWithWitnessLambdas - diff --git a/src/Compiler/Checking/TailCallChecks.fs b/src/Compiler/Checking/TailCallChecks.fs index 1faa9a50a35..b1d99881fba 100644 --- a/src/Compiler/Checking/TailCallChecks.fs +++ b/src/Compiler/Checking/TailCallChecks.fs @@ -18,16 +18,19 @@ open FSharp.Compiler.TypeRelations let PostInferenceChecksStackGuardDepth = GetEnvInteger "FSHARP_TailCallChecks" 50 +[] let (|ValUseAtApp|_|) e = match e with | InnerExprPat(Expr.App(funcExpr = InnerExprPat(Expr.Val(valRef = vref; flags = valUseFlags))) | Expr.Val( - valRef = vref; flags = valUseFlags)) -> Some(vref, valUseFlags) - | _ -> None + valRef = vref; flags = valUseFlags)) -> ValueSome(vref, valUseFlags) + | _ -> ValueNone +[] type TailCallReturnType = | MustReturnVoid // indicates "has unit return type and must return void" | NonVoid +[] type TailCall = | Yes of TailCallReturnType | No diff --git a/src/Compiler/Checking/import.fs b/src/Compiler/Checking/import.fs index 7f1f13efda2..f85ba2a9179 100644 --- a/src/Compiler/Checking/import.fs +++ b/src/Compiler/Checking/import.fs @@ -31,7 +31,7 @@ type AssemblyLoader = /// Resolve an Abstract IL assembly reference to a Ccu abstract FindCcuFromAssemblyRef : CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult - abstract TryFindXmlDocumentationInfo : assemblyName: string -> XmlDocumentationInfo option + abstract TryFindXmlDocumentationInfo : assemblyName: string -> XmlDocumentationInfo voption #if !NO_TYPEPROVIDERS @@ -710,4 +710,3 @@ let RescopeAndImportILType scoref amap m importInst ilTy = let CanRescopeAndImportILType scoref amap m ilTy = ilTy |> rescopeILType scoref |> CanImportILType amap m - diff --git a/src/Compiler/Checking/import.fsi b/src/Compiler/Checking/import.fsi index 830fd81b12d..eed268a1961 100644 --- a/src/Compiler/Checking/import.fsi +++ b/src/Compiler/Checking/import.fsi @@ -21,7 +21,7 @@ type AssemblyLoader = /// Resolve an Abstract IL assembly reference to a Ccu abstract FindCcuFromAssemblyRef: CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult - abstract TryFindXmlDocumentationInfo: assemblyName: string -> XmlDocumentationInfo option + abstract TryFindXmlDocumentationInfo: assemblyName: string -> XmlDocumentationInfo voption #if !NO_TYPEPROVIDERS /// Get a flag indicating if an assembly is a provided assembly, plus the diff --git a/src/Compiler/Checking/infos.fs b/src/Compiler/Checking/infos.fs index 05f361c1f81..4c448b5673a 100644 --- a/src/Compiler/Checking/infos.fs +++ b/src/Compiler/Checking/infos.fs @@ -324,7 +324,7 @@ let CrackParamAttribsInfo g (ty: TType, argInfo: ArgReprInfo) = | false, false, true -> CallerMemberName | false, true, true -> match TryFindFSharpAttribute g g.attrib_CallerMemberNameAttribute argInfo.Attribs with - | Some(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> + | ValueSome(Attrib(_, _, _, _, _, _, callerMemberNameAttributeRange)) -> warning(Error(FSComp.SR.CallerMemberNameIsOverriden(argInfo.Name.Value.idText), callerMemberNameAttributeRange)) CallerFilePath | _ -> failwith "Impossible" @@ -1171,8 +1171,8 @@ type MethInfo = let isParamArrayArg = TryFindILAttribute g.attrib_ParamArrayAttribute attrs let reflArgInfo = match TryDecodeILAttribute g.attrib_ReflectedDefinitionAttribute.TypeRef attrs with - | Some ([ILAttribElem.Bool b ], _) -> ReflectedArgInfo.Quote b - | Some _ -> ReflectedArgInfo.Quote false + | ValueSome ([ILAttribElem.Bool b ], _) -> ReflectedArgInfo.Quote b + | ValueSome _ -> ReflectedArgInfo.Quote false | _ -> ReflectedArgInfo.None let isOutArg = (p.IsOut && not p.IsIn) let isInArg = (p.IsIn && not p.IsOut) @@ -2377,18 +2377,19 @@ let SettersOfPropInfos (pinfos: PropInfo list) = pinfos |> List.choose (fun pinf let GettersOfPropInfos (pinfos: PropInfo list) = pinfos |> List.choose (fun pinfo -> if pinfo.HasGetter then Some(pinfo.GetterMethod, Some pinfo) else None) -let (|DifferentGetterAndSetter|_|) (pinfo: PropInfo) = +[] +let inline (|DifferentGetterAndSetter|_|) (pinfo: PropInfo) = if not (pinfo.HasGetter && pinfo.HasSetter) then - None + ValueNone else match pinfo.GetterMethod.ArbitraryValRef, pinfo.SetterMethod.ArbitraryValRef with | Some getValRef, Some setValRef -> if getValRef.Accessibility <> setValRef.Accessibility then - Some (getValRef, setValRef) + ValueSome (getValRef, setValRef) else match getValRef.ValReprInfo with | Some getValReprInfo when // Getter has an index parameter - getValReprInfo.TotalArgCount > 1 -> Some (getValRef, setValRef) - | _ -> None - | _ -> None \ No newline at end of file + getValReprInfo.TotalArgCount > 1 -> ValueSome (getValRef, setValRef) + | _ -> ValueNone + | _ -> ValueNone \ No newline at end of file diff --git a/src/Compiler/Checking/infos.fsi b/src/Compiler/Checking/infos.fsi index 041c652650a..3ce9bcbd705 100644 --- a/src/Compiler/Checking/infos.fsi +++ b/src/Compiler/Checking/infos.fsi @@ -1095,4 +1095,4 @@ val SettersOfPropInfos: pinfos: PropInfo list -> (MethInfo * PropInfo option) li val GettersOfPropInfos: pinfos: PropInfo list -> (MethInfo * PropInfo option) list -val (|DifferentGetterAndSetter|_|): pinfo: PropInfo -> (ValRef * ValRef) option +val inline (|DifferentGetterAndSetter|_|): pinfo: PropInfo -> (ValRef * ValRef) voption diff --git a/src/Compiler/CodeGen/IlxGen.fs b/src/Compiler/CodeGen/IlxGen.fs index 08661366b35..a83a02d5389 100644 --- a/src/Compiler/CodeGen/IlxGen.fs +++ b/src/Compiler/CodeGen/IlxGen.fs @@ -746,8 +746,8 @@ and ComputeUnionHasHelpers g (tcref: TyconRef) = SpecialFSharpOptionHelpers else match TryFindFSharpAttribute g g.attrib_DefaultAugmentationAttribute tcref.Attribs with - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> if b then AllHelpers else NoHelpers - | Some(Attrib(_, _, _, _, _, _, m)) -> + | ValueSome(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> if b then AllHelpers else NoHelpers + | ValueSome(Attrib(_, _, _, _, _, _, m)) -> errorR (Error(FSComp.SR.ilDefaultAugmentationAttributeCouldNotBeDecoded (), m)) AllHelpers | _ -> AllHelpers (* not hiddenRepr *) @@ -1311,8 +1311,8 @@ let ComputeGenerateWitnesses (g: TcGlobals) eenv = let TryStorageForWitness (_g: TcGlobals) eenv (w: TraitWitnessInfo) = match eenv.witnessesInScope.TryGetValue w with - | true, storage -> Some storage - | _ -> None + | true, storage -> ValueSome storage + | _ -> ValueNone let IsValRefIsDllImport g (vref: ValRef) = vref.Attribs |> HasFSharpAttributeOpt g g.attrib_DllImportAttribute @@ -2863,13 +2863,13 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel = if compileSequenceExpressions then LowerComputedCollectionExpressions.LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else - None + ValueNone match lowering with - | Some altExpr -> + | ValueSome altExpr -> GenExpr cenv cgbuf eenv altExpr sequel true - | None -> + | ValueNone -> let lowering = if compileSequenceExpressions then @@ -3977,7 +3977,7 @@ and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = let storage = TryStorageForWitness g eenv witnessInfo match storage with - | None -> + | ValueNone -> let witnessExpr = ConstraintSolver.CodegenWitnessArgForTraitConstraint cenv.tcVal g cenv.amap m traitInfo |> CommitOperationResult @@ -3989,7 +3989,7 @@ and GenWitnessArgFromTraitInfo cenv cgbuf eenv m traitInfo = | Choice2Of2 arg -> let eenv = { eenv with suppressWitnesses = true } GenExpr cenv cgbuf eenv arg Continue - | Some storage -> + | ValueSome storage -> let witnessInfo = traitInfo.GetWitnessInfo() let ty = GenWitnessTy g witnessInfo GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage None @@ -3999,10 +3999,10 @@ and GenWitnessArgFromWitnessInfo cenv cgbuf eenv m witnessInfo = let storage = TryStorageForWitness g eenv witnessInfo match storage with - | None -> + | ValueNone -> System.Diagnostics.Debug.Assert(false, "expected storage for witness") failwith "unexpected non-generation of witness " - | Some storage -> + | ValueSome storage -> let ty = GenWitnessTy g witnessInfo GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage None @@ -5392,17 +5392,17 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp let witnessInfo = traitInfo.GetWitnessInfo() TryStorageForWitness g eenv witnessInfo else - None + ValueNone match witness with - | Some storage -> + | ValueSome storage -> let witnessInfo = traitInfo.GetWitnessInfo() let ty = GenWitnessTy g witnessInfo let argExprs = if argExprs.Length = 0 then [ mkUnit g m ] else argExprs GenGetStorageAndSequel cenv cgbuf eenv m (ty, GenType cenv m eenv.tyenv ty) storage (Some([], argExprs, m, sequel)) - | None -> + | ValueNone -> // If witnesses are available, we should now always find trait witnesses in scope assert not generateWitnesses @@ -5411,14 +5411,14 @@ and GenTraitCall (cenv: cenv) cgbuf eenv (traitInfo: TraitConstraintInfo, argExp CommitOperationResult(ConstraintSolver.CodegenWitnessExprForTraitConstraint cenv.tcVal g cenv.amap m traitInfo argExprs) match exprOpt with - | None -> + | ValueNone -> let exnArg = mkString g m (FSComp.SR.ilDynamicInvocationNotSupported (traitInfo.MemberLogicalName)) let exnExpr = MakeNotSupportedExnExpr cenv eenv (exnArg, m) let replacementExpr = mkThrow m (tyOfExpr g expr) exnExpr GenExpr cenv cgbuf eenv replacementExpr sequel - | Some expr -> + | ValueSome expr -> let expr = cenv.optimizeDuringCodeGen false expr GenExpr cenv cgbuf eenv expr sequel @@ -8873,7 +8873,7 @@ and ComputeMethodImplAttribs cenv (_v: Val) attrs = let implflags = match TryFindFSharpAttribute g g.attrib_MethodImplAttribute attrs with - | Some(Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags + | ValueSome(Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 let hasPreserveSigAttr = @@ -9897,7 +9897,7 @@ and CreatePermissionSets cenv eenv (securityAttributes: Attrib list) = let _, ilNamedArgs = match TryDecodeILAttribute tref (mkILCustomAttrs [ ilattr ]) with - | Some(ae, na) -> ae, na + | ValueSome(ae, na) -> ae, na | _ -> [], [] let setArgs = ilNamedArgs |> List.map (fun (n, ilt, _, ilae) -> (n, ilt, ilae)) @@ -10773,8 +10773,8 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let ilFieldOffset = match TryFindFSharpAttribute g g.attrib_FieldOffsetAttribute fspec.FieldAttribs with - | Some(Attrib(_, _, [ AttribInt32Arg fieldOffset ], _, _, _, _)) -> Some fieldOffset - | Some attrib -> + | ValueSome(Attrib(_, _, [ AttribInt32Arg fieldOffset ], _, _, _, _)) -> Some fieldOffset + | ValueSome attrib -> errorR (Error(FSComp.SR.ilFieldOffsetAttributeCouldNotBeDecoded (), attrib.Range)) None | _ -> None @@ -11185,7 +11185,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = let tdLayout, tdEncoding = match TryFindFSharpAttribute g g.attrib_StructLayoutAttribute tycon.Attribs with - | Some(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> + | ValueSome(Attrib(_, _, [ AttribInt32Arg layoutKind ], namedArgs, _, _, _)) -> let decoder = AttributeDecoder namedArgs let ilPack = decoder.FindInt32 "Pack" 0x0 let ilSize = decoder.FindInt32 "Size" 0x0 @@ -11214,7 +11214,7 @@ and GenTypeDef cenv mgbuf lazyInitInfo eenv m (tycon: Tycon) = | _ -> ILTypeDefLayout.Auto tdLayout, tdEncoding - | Some(Attrib(_, _, _, _, _, _, m)) -> + | ValueSome(Attrib(_, _, _, _, _, _, m)) -> errorR (Error(FSComp.SR.ilStructLayoutAttributeCouldNotBeDecoded (), m)) ILTypeDefLayout.Auto, ILDefaultPInvokeEncoding.Ansi diff --git a/src/Compiler/Driver/CompilerImports.fs b/src/Compiler/Driver/CompilerImports.fs index e828863c3a8..12745a23ff1 100644 --- a/src/Compiler/Driver/CompilerImports.fs +++ b/src/Compiler/Driver/CompilerImports.fs @@ -1576,6 +1576,7 @@ and [] TcImports member _.TryFindXmlDocumentationInfo assemblyName = tcImports.TryFindXmlDocumentationInfo(assemblyName) + |> ValueOption.ofOption } #else { new AssemblyLoader with @@ -1584,6 +1585,7 @@ and [] TcImports member _.TryFindXmlDocumentationInfo assemblyName = tcImports.TryFindXmlDocumentationInfo(assemblyName) + |> ValueOption.ofOption member _.GetProvidedAssemblyInfo(ctok, m, assembly) = tcImports.GetProvidedAssemblyInfo(ctok, m, assembly) diff --git a/src/Compiler/Driver/CreateILModule.fs b/src/Compiler/Driver/CreateILModule.fs index 7fa60a25957..b0a4640bd18 100644 --- a/src/Compiler/Driver/CreateILModule.fs +++ b/src/Compiler/Driver/CreateILModule.fs @@ -35,7 +35,7 @@ module AttributeHelpers = | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with - | Some(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s + | ValueSome(Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s | _ -> None let TryFindIntAttribute (g: TcGlobals) attrib attribs = @@ -43,7 +43,7 @@ module AttributeHelpers = | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with - | Some(Attrib(_, _, [ AttribInt32Arg i ], _, _, _, _)) -> Some i + | ValueSome(Attrib(_, _, [ AttribInt32Arg i ], _, _, _, _)) -> Some i | _ -> None let TryFindBoolAttribute (g: TcGlobals) attrib attribs = @@ -51,14 +51,15 @@ module AttributeHelpers = | None -> None | Some attribRef -> match TryFindFSharpAttribute g attribRef attribs with - | Some(Attrib(_, _, [ AttribBoolArg p ], _, _, _, _)) -> Some p + | ValueSome(Attrib(_, _, [ AttribBoolArg p ], _, _, _, _)) -> Some p | _ -> None + [] let (|ILVersion|_|) (versionString: string) = try - Some(parseILVersion versionString) - with e -> - None + ValueSome(parseILVersion versionString) + with _ -> + ValueNone //---------------------------------------------------------------------------- // ValidateKeySigningAttributes, GetStrongNameSigner diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fs b/src/Compiler/Driver/ParseAndCheckInputs.fs index a9fc59b66d3..5024aed30c8 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fs +++ b/src/Compiler/Driver/ParseAndCheckInputs.fs @@ -1254,10 +1254,10 @@ let SkippedImplFilePlaceholder (tcConfig: TcConfig, tcImports: TcImports, tcGlob CheckedImplFile(qualNameOfFile, [], rootSigTy, ModuleOrNamespaceContents.TMDefs [], false, false, StampMap [], Map.empty) let tcEnvAtEnd = tcStateForImplFile.TcEnvFromImpls - Some((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) + ValueSome((tcEnvAtEnd, EmptyTopAttrs, Some emptyImplFile, ccuSigForFile), tcState) - | _ -> None - | _ -> None + | _ -> ValueNone + | _ -> ValueNone /// Typecheck a single file (or interactive entry into F# Interactive). let CheckOneInput diff --git a/src/Compiler/Driver/ParseAndCheckInputs.fsi b/src/Compiler/Driver/ParseAndCheckInputs.fsi index 745afa51be4..dcef01207b4 100644 --- a/src/Compiler/Driver/ParseAndCheckInputs.fsi +++ b/src/Compiler/Driver/ParseAndCheckInputs.fsi @@ -137,7 +137,7 @@ val GetInitialTcState: range * string * TcConfig * TcGlobals * TcImports * TcEnv /// Returns partial type check result for skipped implementation files. val SkippedImplFilePlaceholder: tcConfig: TcConfig * tcImports: TcImports * tcGlobals: TcGlobals * tcState: TcState * input: ParsedInput -> - ((TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState) option + ((TcEnv * TopAttribs * CheckedImplFile option * ModuleOrNamespaceType) * TcState) voption /// Check one input, returned as an Eventually computation val CheckOneInput: diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fs b/src/Compiler/Facilities/DiagnosticsLogger.fs index 24f6ebf2e6d..4715f289d83 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fs +++ b/src/Compiler/Facilities/DiagnosticsLogger.fs @@ -66,10 +66,11 @@ exception StopProcessingExn of exn option with | StopProcessingExn(Some exn) -> "StopProcessingExn, originally (" + exn.ToString() + ")" | _ -> "StopProcessingExn" +[] let (|StopProcessing|_|) exn = match exn with - | StopProcessingExn _ -> Some() - | _ -> None + | StopProcessingExn _ -> ValueSome() + | _ -> ValueNone let StopProcessing<'T> = StopProcessingExn None @@ -620,10 +621,10 @@ let conditionallySuppressErrorReporting cond f = // Errors as data: Sometimes we have to reify errors as data, e.g. if backtracking /// The result type of a computational modality to collect warnings and possibly fail -[] +[] type OperationResult<'T> = - | OkResult of warnings: exn list * result: 'T - | ErrorResult of warnings: exn list * error: exn + | OkResult of okwarnings: exn list * result: 'T + | ErrorResult of errorwarnings: exn list * error: exn type ImperativeOperationResult = OperationResult @@ -653,11 +654,11 @@ let inline ResultD x = OkResult([], x) let CheckNoErrorsAndGetWarnings res = match res with - | OkResult(warns, res2) -> Some(warns, res2) - | ErrorResult _ -> None + | OkResult(warns, res2) -> ValueSome(warns, res2) + | ErrorResult _ -> ValueNone [] -let inline bind f res = +let inline bind ([] f) res = match res with | OkResult([], res) -> (* tailcall *) f res | OkResult(warns, res) -> @@ -690,15 +691,15 @@ let rec MapD_loop f acc xs = let MapD f xs = MapD_loop f [] xs type TrackErrorsBuilder() = - member inline x.Bind(res, k) = bind k res + member inline x.Bind(res, [] k) = bind k res member inline x.Return res = ResultD res member inline x.ReturnFrom res = res member inline x.For(seq, k) = IterateD k seq member inline x.Combine(expr1, expr2) = bind expr2 expr1 member inline x.While(gd, k) = WhileD gd k member inline x.Zero() = CompleteD - member inline x.Delay(fn: unit -> _) = fn - member inline x.Run fn = fn () + member inline x.Delay([] fn: unit -> _) = fn + member inline x.Run([] fn) = fn () let trackErrors = TrackErrorsBuilder() @@ -811,7 +812,7 @@ let NormalizeErrorString (text: string MaybeNull) = /// Indicates whether a language feature check should be skipped. Typically used in recursive functions /// where we don't want repeated recursive calls to raise the same diagnostic multiple times. -[] +[] type internal SuppressLanguageFeatureCheck = | Yes | No @@ -824,19 +825,19 @@ let internal languageFeatureError (langVersion: LanguageVersion) (langFeature: L let private tryLanguageFeatureErrorAux (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) = if not (langVersion.SupportsFeature langFeature) then - Some(languageFeatureError langVersion langFeature m) + ValueSome(languageFeatureError langVersion langFeature m) else - None + ValueNone let internal checkLanguageFeatureError langVersion langFeature m = match tryLanguageFeatureErrorAux langVersion langFeature m with - | Some e -> error e - | None -> () + | ValueSome e -> error e + | ValueNone -> () let internal checkLanguageFeatureAndRecover langVersion langFeature m = match tryLanguageFeatureErrorAux langVersion langFeature m with - | Some e -> errorR e - | None -> () + | ValueSome e -> errorR e + | ValueNone -> () let internal tryLanguageFeatureErrorOption langVersion langFeature m = tryLanguageFeatureErrorAux langVersion langFeature m diff --git a/src/Compiler/Facilities/DiagnosticsLogger.fsi b/src/Compiler/Facilities/DiagnosticsLogger.fsi index e9040da36ed..59a2ff3f218 100644 --- a/src/Compiler/Facilities/DiagnosticsLogger.fsi +++ b/src/Compiler/Facilities/DiagnosticsLogger.fsi @@ -37,7 +37,7 @@ val NoSuggestions: Suggestions /// Thrown when we stop processing the F# Interactive entry or #load. exception StopProcessingExn of exn option -val (|StopProcessing|_|): exn: exn -> unit option +val (|StopProcessing|_|): exn: exn -> unit voption val StopProcessing<'T> : exn @@ -329,10 +329,10 @@ val suppressErrorReporting: f: (unit -> 'T) -> 'T val conditionallySuppressErrorReporting: cond: bool -> f: (unit -> 'T) -> 'T /// The result type of a computational modality to collect warnings and possibly fail -[] +[] type OperationResult<'T> = - | OkResult of warnings: exn list * result: 'T - | ErrorResult of warnings: exn list * error: exn + | OkResult of okwarnings: exn list * result: 'T + | ErrorResult of errorwarnings: exn list * error: exn type ImperativeOperationResult = OperationResult @@ -350,7 +350,7 @@ val CompleteD: OperationResult val inline ResultD: x: 'T -> OperationResult<'T> -val CheckNoErrorsAndGetWarnings: res: OperationResult<'T> -> (exn list * 'T) option +val CheckNoErrorsAndGetWarnings: res: OperationResult<'T> -> (exn list * 'T) voption /// The bind in the monad. Stop on first error. Accumulate warnings and continue. /// Not meant for direct usage. Used in other inlined functions @@ -428,7 +428,7 @@ val NormalizeErrorString: text: string -> string /// Indicates whether a language feature check should be skipped. Typically used in recursive functions /// where we don't want repeated recursive calls to raise the same diagnostic multiple times. -[] +[] type SuppressLanguageFeatureCheck = | Yes | No @@ -440,7 +440,7 @@ val checkLanguageFeatureError: langVersion: LanguageVersion -> langFeature: Lang val checkLanguageFeatureAndRecover: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit val tryLanguageFeatureErrorOption: - langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> exn option + langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> exn voption val languageFeatureNotSupportedInLibraryError: langFeature: LanguageFeature -> m: range -> 'T diff --git a/src/Compiler/Interactive/fsi.fs b/src/Compiler/Interactive/fsi.fs index 4cec0c7a8d2..e8aa1cfcc0c 100644 --- a/src/Compiler/Interactive/fsi.fs +++ b/src/Compiler/Interactive/fsi.fs @@ -2146,6 +2146,7 @@ type internal FsiDynamicCompiler let CheckEntryPoint (tcGlobals: TcGlobals) (declaredImpls: CheckedImplFile list) = let tryGetEntryPoint (TBind(var = value)) = TryFindFSharpAttribute tcGlobals tcGlobals.attrib_EntryPointAttribute value.Attribs + |> ValueOption.toOption |> Option.map (fun attrib -> value.DisplayName, attrib) let rec findEntryPointInContents = diff --git a/src/Compiler/Optimize/DetupleArgs.fs b/src/Compiler/Optimize/DetupleArgs.fs index 0021357366c..ed1432a45f2 100644 --- a/src/Compiler/Optimize/DetupleArgs.fs +++ b/src/Compiler/Optimize/DetupleArgs.fs @@ -150,14 +150,15 @@ let DetupleRewriteStackGuardDepth = StackGuard.GetDepthOption "DetupleRewrite" // Merge a tyapp node and and app node. +[] let (|TyappAndApp|_|) e = match e with | Expr.App(f, fty, tys, args, m) -> match stripDebugPoints (stripExpr f) with - | Expr.App(f2, fty2, tys2, [], m2) -> Some(f2, fty2, tys2 @ tys, args, m2) - | Expr.App _ -> Some(f, fty, tys, args, m) (* has args, so not combine ty args *) - | f -> Some(f, fty, tys, args, m) - | _ -> None + | Expr.App(f2, fty2, tys2, [], m2) -> ValueSome(f2, fty2, tys2 @ tys, args, m2) + | Expr.App _ -> ValueSome(f, fty, tys, args, m) (* has args, so not combine ty args *) + | f -> ValueSome(f, fty, tys, args, m) + | _ -> ValueNone [] module GlobalUsageAnalysis = @@ -234,16 +235,14 @@ module GlobalUsageAnalysis = z /// Log the definition of a non-recursive binding - let logNonRecBinding z (bind: Binding) = + let inline logNonRecBinding z (bind: Binding) = let v = bind.Var - let vs = [ v ] - { z with - RecursiveBindings = Zmap.add v (false, vs) z.RecursiveBindings + RecursiveBindings = Zmap.add v (false, [ v ]) z.RecursiveBindings Defns = Zmap.add v bind.Expr z.Defns } /// Log the definition of a recursive binding - let logRecBindings z binds = + let inline logRecBindings z binds = let vs = valsOfBinds binds { z with @@ -255,7 +254,7 @@ module GlobalUsageAnalysis = ||> List.fold (fun eqns bind -> Zmap.add bind.Var bind.Expr eqns) } /// Work locally under a lambda of some kind - let foldUnderLambda f z x = + let inline foldUnderLambda ([] f) z x = let saved = z.IterationIsAtTopLevel let z = { z with IterationIsAtTopLevel = false } let z = f z x diff --git a/src/Compiler/Optimize/LowerComputedCollections.fs b/src/Compiler/Optimize/LowerComputedCollections.fs index f2f3e4f6245..776bf146a32 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fs +++ b/src/Compiler/Optimize/LowerComputedCollections.fs @@ -219,9 +219,9 @@ let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = mkSequential m overallSeqExprR (mkCallCollectorClose tcVal g infoReader m collExpr)) - |> Some + |> ValueSome | Result.Error () -> - None + ValueNone let (|OptionalCoerce|) expr = match expr with @@ -230,27 +230,30 @@ let (|OptionalCoerce|) expr = // Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression // which only adds a 'seq' call outside of FSharp.Core +[] let (|OptionalSeq|_|) g amap expr = match expr with // use 'seq { ... }' as an indicator | Seq g (e, elemTy) -> - Some (e, elemTy) + ValueSome (e, elemTy) | _ -> - // search for the relevant element type - match tyOfExpr g expr with - | SeqElemTy g amap expr.Range elemTy -> - Some (expr, elemTy) - | _ -> None + // search for the relevant element type + match tyOfExpr g expr with + | SeqElemTy g amap expr.Range elemTy -> + ValueSome (expr, elemTy) + | _ -> ValueNone +[] let (|SeqToList|_|) g expr = match expr with - | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None + | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> ValueSome (seqExpr, m) + | _ -> ValueNone +[] let (|SeqToArray|_|) g expr = match expr with - | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None + | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> ValueSome (seqExpr, m) + | _ -> ValueNone let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = // If ListCollector is in FSharp.Core then this optimization kicks in @@ -260,11 +263,11 @@ let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> let collectorTy = g.mk_ListCollector_ty overallElemTy LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - + | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> let collectorTy = g.mk_ArrayCollector_ty overallElemTy LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - | _ -> None + | _ -> ValueNone else - None + ValueNone diff --git a/src/Compiler/Optimize/LowerComputedCollections.fsi b/src/Compiler/Optimize/LowerComputedCollections.fsi index a1656361776..8518116c321 100644 --- a/src/Compiler/Optimize/LowerComputedCollections.fsi +++ b/src/Compiler/Optimize/LowerComputedCollections.fsi @@ -7,4 +7,4 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree val LowerComputedListOrArrayExpr: - tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option + tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr voption diff --git a/src/Compiler/Optimize/LowerSequences.fs b/src/Compiler/Optimize/LowerSequences.fs index 3a7d733ec59..97acf18aa93 100644 --- a/src/Compiler/Optimize/LowerSequences.fs +++ b/src/Compiler/Optimize/LowerSequences.fs @@ -65,24 +65,25 @@ type LoweredSeqFirstPhaseResult = asyncVars: FreeVars } -let IsPossibleSequenceExpr g overallExpr = +let inline IsPossibleSequenceExpr g overallExpr = match overallExpr with Seq g _ -> true | _ -> false -let tyConfirmsToSeq g ty = +let inline tyConfirmsToSeq g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> tyconRefEq g tcref g.tcref_System_Collections_Generic_IEnumerable - | _ -> false + | _ -> false +[] let (|SeqElemTy|_|) g amap m ty = match SearchEntireHierarchyOfType (tyConfirmsToSeq g) g amap m ty with | None -> // printfn "FAILED - yield! did not yield a sequence! %s" (stringOfRange m) - None + ValueNone | Some seqTy -> // printfn "found yield!" let inpElemTy = List.head (argsOfAppTy g seqTy) - Some inpElemTy + ValueSome inpElemTy /// Analyze a TAST expression to detect the elaborated form of a sequence expression. /// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. @@ -720,4 +721,3 @@ let ConvertSequenceExprToObject g amap overallExpr = // printfn "FAILED: no compilation found! %s" (stringOfRange m) None | _ -> None - diff --git a/src/Compiler/Optimize/LowerSequences.fsi b/src/Compiler/Optimize/LowerSequences.fsi index aa675cda5c0..10ca0923627 100644 --- a/src/Compiler/Optimize/LowerSequences.fsi +++ b/src/Compiler/Optimize/LowerSequences.fsi @@ -9,7 +9,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.Text /// Detect a 'seq' type -val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option +val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType voption val callNonOverloadedILMethod: g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr @@ -26,4 +26,4 @@ val ConvertSequenceExprToObject: overallExpr: Expr -> (ValRef * ValRef * ValRef * ValRef list * Expr * Expr * Expr * TType * range) option -val IsPossibleSequenceExpr: g: TcGlobals -> overallExpr: Expr -> bool +val inline IsPossibleSequenceExpr: g: TcGlobals -> overallExpr: Expr -> bool diff --git a/src/Compiler/Optimize/LowerStateMachines.fs b/src/Compiler/Optimize/LowerStateMachines.fs index 7c4835b3460..f3de327f122 100644 --- a/src/Compiler/Optimize/LowerStateMachines.fs +++ b/src/Compiler/Optimize/LowerStateMachines.fs @@ -377,6 +377,7 @@ type LowerStateMachine(g: TcGlobals) = | None -> env2, expr2 // Detect a state machine with a single method override + [] let (|ExpandedStateMachineInContext|_|) inputExpr = // All expanded resumable code state machines e.g. 'task { .. }' begin with a bind of @builder or 'defn' let env, expr = BindResumableCodeDefinitions env.Empty inputExpr @@ -405,9 +406,9 @@ type LowerStateMachine(g: TcGlobals) = (moveNextThisVar, moveNextExprR), (setStateMachineThisVar, setStateMachineStateVar, setStateMachineBodyR), (afterCodeThisVar, afterCodeBodyR)) - Some (env, remake2, moveNextBody) - | _ -> - None + ValueSome (env, remake2, moveNextBody) + | _ -> + ValueNone // A utility to add a jump table an expression let addPcJumpTable m (pcs: int list) (pc2lab: Map) pcExpr expr = diff --git a/src/Compiler/Optimize/Optimizer.fs b/src/Compiler/Optimize/Optimizer.fs index a1e01d4a58d..b9a0bd0667a 100644 --- a/src/Compiler/Optimize/Optimizer.fs +++ b/src/Compiler/Optimize/Optimizer.fs @@ -2050,50 +2050,59 @@ let rec ExpandStructuralBinding cenv expr = ExpandStructuralBindingRaw cenv e /// Detect a query { ... } +[] let (|QueryRun|_|) g expr = match expr with | Expr.App (Expr.Val (vref, _, _), _, _, [_builder; arg], _) when valRefEq g vref g.query_run_value_vref -> - Some (arg, None) + ValueSome (arg, None) | Expr.App (Expr.Val (vref, _, _), _, [ elemTy ], [_builder; arg], _) when valRefEq g vref g.query_run_enumerable_vref -> - Some (arg, Some elemTy) - | _ -> - None + ValueSome (arg, Some elemTy) + | _ -> + ValueNone let (|MaybeRefTupled|) e = tryDestRefTupleExpr e +[] let (|AnyInstanceMethodApp|_|) e = match e with - | Expr.App (Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> Some (vref, tyargs, obj, args) - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> ValueSome (vref, tyargs, obj, args) + | _ -> ValueNone +[] let (|InstanceMethodApp|_|) g (expectedValRef: ValRef) e = match e with - | AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> Some (tyargs, obj, args) - | _ -> None + | AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> ValueSome (tyargs, obj, args) + | _ -> ValueNone +[] let (|QuerySourceEnumerable|_|) g = function - | InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> Some (resTy, res) - | _ -> None + | InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> ValueSome (resTy, res) + | _ -> ValueNone +[] let (|QueryFor|_|) g = function - | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) - | _ -> None + | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> ValueSome (qTy, srcTy, resTy, src, selector) + | _ -> ValueNone +[] let (|QueryYield|_|) g = function - | InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) - | _ -> None + | InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> ValueSome (qTy, resTy, res) + | _ -> ValueNone +[] let (|QueryYieldFrom|_|) g = function - | InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) - | _ -> None + | InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> ValueSome (qTy, resTy, res) + | _ -> ValueNone +[] let (|QuerySelect|_|) g = function - | InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) - | _ -> None + | InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> ValueSome (qTy, srcTy, resTy, src, selector) + | _ -> ValueNone +[] let (|QueryZero|_|) g = function - | InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> Some (qTy, resTy) - | _ -> None + | InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> ValueSome (qTy, resTy) + | _ -> ValueNone /// Look for a possible tuple and transform let (|AnyRefTupleTrans|) e = @@ -2102,11 +2111,12 @@ let (|AnyRefTupleTrans|) e = | _ -> [e], (function [e] -> e | _ -> assert false; failwith "unreachable") /// Look for any QueryBuilder.* operation and transform +[] let (|AnyQueryBuilderOpTrans|_|) g = function - | Expr.App (Expr.Val (vref, _, _) as v, vty, tyargs, [builder; AnyRefTupleTrans( src :: rest, replaceArgs) ], m) when + | Expr.App (Expr.Val (vref, _, _) as v, vty, tyargs, [builder; AnyRefTupleTrans( src :: rest, replaceArgs) ], m) when (match vref.ApparentEnclosingEntity with Parent tcref -> tyconRefEq g tcref g.query_builder_tcref | ParentNone -> false) -> - Some (src, (fun newSource -> Expr.App (v, vty, tyargs, [builder; replaceArgs(newSource :: rest)], m))) - | _ -> None + ValueSome (src, (fun newSource -> Expr.App (v, vty, tyargs, [builder; replaceArgs(newSource :: rest)], m))) + | _ ->ValueNone /// If this returns "Some" then the source is not IQueryable. // := @@ -2590,9 +2600,9 @@ and OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsR, arginfos, m) = | _ -> None match knownValue with | Some valu -> - match TryOptimizeVal cenv env (None, false, false, valu, m) with - | Some res -> OptimizeExpr cenv env res (* discard e1 since guard ensures it has no effects *) - | None -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu + match TryOptimizeVal cenv env (ValueNone, false, false, valu, m) with + | ValueSome res -> OptimizeExpr cenv env res (* discard e1 since guard ensures it has no effects *) + | ValueNone -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu | None -> OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos UnknownValue and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = @@ -2677,8 +2687,8 @@ and OptimizeExprOpFallback cenv env (op, tyargs, argsR, m) arginfos valu = // Replace entire expression with known value? match TryOptimizeValInfo cenv env m vinfo with - | Some res -> res, vinfo - | None -> + | ValueSome res -> res, vinfo + | ValueNone -> Expr.Op (op, tyargs, argsR, m), { TotalSize=argsTSize + cost FunctionSize=argsFSize + cost @@ -2709,8 +2719,8 @@ and TryOptimizeRecordFieldGet cenv _env (e1info, (RecdFieldRef (rtcref, _) as r) match destRecdValue e1info.Info with | Some finfos when cenv.settings.EliminateRecdFieldGet && not e1info.HasEffect -> match TryFindFSharpAttribute g g.attrib_CLIMutableAttribute rtcref.Attribs with - | Some _ -> None - | None -> + | ValueSome _ -> None + | ValueNone -> let n = r.Index if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range", m)) Some finfos[n] @@ -2981,7 +2991,7 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolve the static overloading early (during the compulsory rewrite phase) so we can inline. match ConstraintSolver.CodegenWitnessExprForTraitConstraint cenv.TcVal g cenv.amap m traitInfo args with - | OkResult (_, Some expr) -> OptimizeExpr cenv env expr + | OkResult (_, ValueSome expr) -> OptimizeExpr cenv env expr // Resolution fails when optimizing generic code, ignore the failure | _ -> @@ -3001,14 +3011,14 @@ and CopyExprForInlining cenv isInlineIfLambda expr (m: range) = /// Make optimization decisions once we know the optimization information /// for a value -and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, inlineIfLambda, valInfoForVal, m) = +and TryOptimizeVal cenv env (vOpt: ValRef voption, mustInline, inlineIfLambda, valInfoForVal, m) = let g = cenv.g match valInfoForVal with // Inline all constants immediately | ConstValue (c, ty) -> - Some (Expr.Const (c, m, ty)) + ValueSome (Expr.Const (c, m, ty)) | SizeValue (_, detail) -> TryOptimizeVal cenv env (vOpt, mustInline, inlineIfLambda, detail, m) @@ -3018,39 +3028,41 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, inlineIfLambda, va // Prefer to inline using the more specific info if possible // If the more specific info didn't reveal an inline then use the value match TryOptimizeVal cenv env (vOpt, mustInline, inlineIfLambda, detail, m) with - | Some e -> Some e - | None -> + | ValueSome e -> ValueSome e + | ValueNone -> // If we have proven 'v = compilerGeneratedValue' // and 'v' is being eliminated in favour of 'compilerGeneratedValue' // then replace the name of 'compilerGeneratedValue' // by 'v' and mark it not compiler generated so we preserve good debugging and names. // Don't do this for things represented statically as it may publish multiple values with the same name. match vOpt with - | Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated && not vR.IsCompiledAsTopLevel && not v.IsCompiledAsTopLevel -> + | ValueSome v when not v.IsCompilerGenerated && vR.IsCompilerGenerated && not vR.IsCompiledAsTopLevel && not v.IsCompiledAsTopLevel -> vR.Deref.SetIsCompilerGenerated(false) vR.Deref.SetLogicalName(v.LogicalName) | _ -> () - Some(exprForValRef m vR) + ValueSome(exprForValRef m vR) | ConstExprValue(_size, expr) -> - Some (remarkExpr m (copyExpr g CloneAllAndMarkExprValsAsCompilerGenerated expr)) + ValueSome (remarkExpr m (copyExpr g CloneAllAndMarkExprValsAsCompilerGenerated expr)) | CurriedLambdaValue (_, _, _, expr, _) when mustInline || inlineIfLambda -> let exprCopy = CopyExprForInlining cenv inlineIfLambda expr m - Some exprCopy + ValueSome exprCopy | TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline -> failwith "tuple, union and record values cannot be marked 'inline'" | UnknownValue when mustInline -> - warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(), m)); None + warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(), m)) + ValueNone | _ when mustInline -> - warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(), m)); None - | _ -> None + warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(), m)) + ValueNone + | _ -> ValueNone and TryOptimizeValInfo cenv env m vinfo = - if vinfo.HasEffect then None else TryOptimizeVal cenv env (None, false, false, vinfo.Info, m) + if vinfo.HasEffect then ValueNone else TryOptimizeVal cenv env (ValueNone, false, false, vinfo.Info, m) /// Add 'v1 = v2' information into the information stored about a value and AddValEqualityInfo g m (v: ValRef) info = @@ -3072,8 +3084,8 @@ and OptimizeVal cenv env expr (v: ValRef, m) = let valInfoForVal = GetInfoForVal cenv env m v - match TryOptimizeVal cenv env (Some v, v.MustInline, v.InlineIfLambda, valInfoForVal.ValExprInfo, m) with - | Some e -> + match TryOptimizeVal cenv env (ValueSome v, v.MustInline, v.InlineIfLambda, valInfoForVal.ValExprInfo, m) with + | ValueSome e -> // don't reoptimize inlined lambdas until they get applied to something match e with | Expr.TyLambda _ @@ -3088,7 +3100,7 @@ and OptimizeVal cenv env expr (v: ValRef, m) = let e, einfo = OptimizeExpr cenv env e e, AddValEqualityInfo g m v einfo - | None -> + | ValueNone -> if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) if v.InlineIfLambda then @@ -3163,8 +3175,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToValues with - | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | _ -> None + | Some (_, vref) -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs args m) + | _ -> ValueNone | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_comparison_withc_inner_vref ty args -> @@ -3175,8 +3187,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = // arg list, and create a tuple of y & comp // push the comparer to the end and box the argument let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty, m, ty) ; comp]] - Some (DevirtualizeApplication cenv env vref ty tyargs args2 m) - | _ -> None + ValueSome (DevirtualizeApplication cenv env vref ty tyargs args2 m) + | _ -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic when type is known // to be augmented with a visible equality-without-comparer value. @@ -3186,8 +3198,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsValues with - | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | _ -> None + | Some (_, vref) -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs args m) + | _ -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerFast | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_equality_withc_inner_vref ty args -> @@ -3196,8 +3208,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | Some (_, _, withcEqualsVal), [comp; x; y] -> // push the comparer to the end and box the argument let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty, m, ty) ; comp]] - Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) - | _ -> None + ValueSome (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) + | _ -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_equality_per_inner_vref ty args && not(isRefTupleTy g ty) -> @@ -3205,8 +3217,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, _, withcEqualsVal), [x; y] -> let args2 = [x; mkRefTupledNoTypes g m [mkCoerceExpr(y, g.obj_ty, m, ty); (mkCallGetGenericPEREqualityComparer g m)]] - Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) - | _ -> None + ValueSome (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) + | _ -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashIntrinsic | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_hash_inner_vref ty args -> @@ -3214,8 +3226,8 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, withcGetHashCodeVal, _), [x] -> let args2 = [x; mkCallGetGenericEREqualityComparer g m] - Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) - | _ -> None + ValueSome (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) + | _ -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic | Expr.Val (v, _, _), [ty], _ when CanDevirtualizeApplication cenv v g.generic_hash_withc_inner_vref ty args -> @@ -3223,36 +3235,36 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = match tcref.GeneratedHashAndEqualsWithComparerValues, args with | Some (_, withcGetHashCodeVal, _), [comp; x] -> let args2 = [x; comp] - Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) - | _ -> None + ValueSome (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) + | _ -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.generic_comparison_inner_vref && isRefTupleTy g ty -> let tyargs = destRefTupleTy g ty let vref = match tyargs.Length with - | 2 -> Some g.generic_compare_withc_tuple2_vref - | 3 -> Some g.generic_compare_withc_tuple3_vref - | 4 -> Some g.generic_compare_withc_tuple4_vref - | 5 -> Some g.generic_compare_withc_tuple5_vref - | _ -> None + | 2 -> ValueSome g.generic_compare_withc_tuple2_vref + | 3 -> ValueSome g.generic_compare_withc_tuple3_vref + | 4 -> ValueSome g.generic_compare_withc_tuple4_vref + | 5 -> ValueSome g.generic_compare_withc_tuple5_vref + | _ -> ValueNone match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericComparer g m :: args) m) - | None -> None + | ValueSome vref -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericComparer g m :: args) m) + | ValueNone -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.generic_hash_inner_vref && isRefTupleTy g ty -> let tyargs = destRefTupleTy g ty let vref = match tyargs.Length with - | 2 -> Some g.generic_hash_withc_tuple2_vref - | 3 -> Some g.generic_hash_withc_tuple3_vref - | 4 -> Some g.generic_hash_withc_tuple4_vref - | 5 -> Some g.generic_hash_withc_tuple5_vref - | _ -> None + | 2 -> ValueSome g.generic_hash_withc_tuple2_vref + | 3 -> ValueSome g.generic_hash_withc_tuple3_vref + | 4 -> ValueSome g.generic_hash_withc_tuple4_vref + | 5 -> ValueSome g.generic_hash_withc_tuple5_vref + | _ -> ValueNone match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer g m :: args) m) - | None -> None + | ValueSome vref -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer g m :: args) m) + | ValueNone -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types // REVIEW (5537): GenericEqualityIntrinsic implements PER semantics, and we are replacing it to something also @@ -3261,56 +3273,56 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = let tyargs = destRefTupleTy g ty let vref = match tyargs.Length with - | 2 -> Some g.generic_equals_withc_tuple2_vref - | 3 -> Some g.generic_equals_withc_tuple3_vref - | 4 -> Some g.generic_equals_withc_tuple4_vref - | 5 -> Some g.generic_equals_withc_tuple5_vref - | _ -> None + | 2 -> ValueSome g.generic_equals_withc_tuple2_vref + | 3 -> ValueSome g.generic_equals_withc_tuple3_vref + | 4 -> ValueSome g.generic_equals_withc_tuple4_vref + | 5 -> ValueSome g.generic_equals_withc_tuple5_vref + | _ -> ValueNone match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer g m :: args) m) - | None -> None + | ValueSome vref -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer g m :: args) m) + | ValueNone -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.generic_comparison_withc_inner_vref && isRefTupleTy g ty -> let tyargs = destRefTupleTy g ty let vref = match tyargs.Length with - | 2 -> Some g.generic_compare_withc_tuple2_vref - | 3 -> Some g.generic_compare_withc_tuple3_vref - | 4 -> Some g.generic_compare_withc_tuple4_vref - | 5 -> Some g.generic_compare_withc_tuple5_vref - | _ -> None + | 2 -> ValueSome g.generic_compare_withc_tuple2_vref + | 3 -> ValueSome g.generic_compare_withc_tuple3_vref + | 4 -> ValueSome g.generic_compare_withc_tuple4_vref + | 5 -> ValueSome g.generic_compare_withc_tuple5_vref + | _ -> ValueNone match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | None -> None + | ValueSome vref -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs args m) + | ValueNone -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.generic_hash_withc_inner_vref && isRefTupleTy g ty -> let tyargs = destRefTupleTy g ty let vref = match tyargs.Length with - | 2 -> Some g.generic_hash_withc_tuple2_vref - | 3 -> Some g.generic_hash_withc_tuple3_vref - | 4 -> Some g.generic_hash_withc_tuple4_vref - | 5 -> Some g.generic_hash_withc_tuple5_vref - | _ -> None + | 2 -> ValueSome g.generic_hash_withc_tuple2_vref + | 3 -> ValueSome g.generic_hash_withc_tuple3_vref + | 4 -> ValueSome g.generic_hash_withc_tuple4_vref + | 5 -> ValueSome g.generic_hash_withc_tuple5_vref + | _ -> ValueNone match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | None -> None + | ValueSome vref -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs args m) + | ValueNone -> ValueNone // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic for tuple types | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.generic_equality_withc_inner_vref && isRefTupleTy g ty -> let tyargs = destRefTupleTy g ty let vref = match tyargs.Length with - | 2 -> Some g.generic_equals_withc_tuple2_vref - | 3 -> Some g.generic_equals_withc_tuple3_vref - | 4 -> Some g.generic_equals_withc_tuple4_vref - | 5 -> Some g.generic_equals_withc_tuple5_vref - | _ -> None + | 2 -> ValueSome g.generic_equals_withc_tuple2_vref + | 3 -> ValueSome g.generic_equals_withc_tuple3_vref + | 4 -> ValueSome g.generic_equals_withc_tuple4_vref + | 5 -> ValueSome g.generic_equals_withc_tuple5_vref + | _ -> ValueNone match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | None -> None + | ValueSome vref -> ValueSome (DevirtualizeApplication cenv env vref ty tyargs args m) + | ValueNone -> ValueNone // Calls to LanguagePrimitives.IntrinsicFunctions.UnboxGeneric can be optimized to calls to UnboxFast when we know that the // target type isn't 'NullNotLiked', i.e. that the target type is not an F# union, record etc. @@ -3318,7 +3330,7 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.unbox_vref && canUseUnboxFast g m ty -> - Some(DevirtualizeApplication cenv env g.unbox_fast_vref ty tyargs args m) + ValueSome(DevirtualizeApplication cenv env g.unbox_fast_vref ty tyargs args m) // Calls to LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric can be optimized to calls to TypeTestFast when we know that the // target type isn't 'NullNotTrueValue', i.e. that the target type is not an F# union, record etc. @@ -3326,18 +3338,18 @@ and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = | Expr.Val (v, _, _), [ty], _ when valRefEq g v g.istype_vref && canUseTypeTestFast g ty -> - Some(DevirtualizeApplication cenv env g.istype_fast_vref ty tyargs args m) + ValueSome(DevirtualizeApplication cenv env g.istype_fast_vref ty tyargs args m) // Don't fiddle with 'methodhandleof' calls - just remake the application | Expr.Val (vref, _, _), _, _ when valRefEq g vref g.methodhandleof_vref -> - Some( MakeApplicationAndBetaReduce g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m), + ValueSome( MakeApplicationAndBetaReduce g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m), { TotalSize=1 FunctionSize=1 HasEffect=false MightMakeCriticalTailcall = false Info=UnknownValue}) - | _ -> None + | _ -> ValueNone /// Attempt to inline an application of a known value at callsites and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) = @@ -3363,7 +3375,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) | Expr.Val (vref, _, _) when vref.IsBaseVal -> true | _ -> false - if isBaseCall then None else + if isBaseCall then ValueNone else // Since Lazy`1 moved from FSharp.Core to mscorlib on .NET 4.0, inlining Lazy values from 2.0 will // confuse the optimizer if the assembly is referenced on 4.0, since there will be no value to tie back @@ -3385,7 +3397,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) | _ -> false | _ -> false - if isValFromLazyExtensions then None else + if isValFromLazyExtensions then ValueNone else let isSecureMethod = match finfo.Info with @@ -3393,14 +3405,14 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) vref.Attribs |> List.exists (fun a -> (IsSecurityAttribute g cenv.amap cenv.casApplied a m) || (IsSecurityCriticalAttribute g a)) | _ -> false - if isSecureMethod then None else + if isSecureMethod then ValueNone else let isGetHashCode = match finfo.Info with | ValValue(vref, _) -> vref.DisplayName = "GetHashCode" && vref.IsCompilerGenerated | _ -> false - if isGetHashCode then None else + if isGetHashCode then ValueNone else // Inlining lambda let f2R = CopyExprForInlining cenv false f2 m @@ -3415,9 +3427,9 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) // Inlining: beta reducing let exprR = MakeApplicationAndBetaReduce g (f2R, f2ty, [tyargs], argsR, m) // Inlining: reoptimizing - Some(OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} exprR) + ValueSome(OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} exprR) - | _ -> None + | _ -> ValueNone // Optimize the application of computed functions. // See https://github.com/fsharp/fslang-design/blob/master/tooling/FST-1034-lambda-optimizations.md @@ -3522,10 +3534,10 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = let g = cenv.g // trying to devirtualize match TryDevirtualizeApplication cenv env (f0, tyargs, args, m) with - | Some res -> + | ValueSome res -> // devirtualized res - | None -> + | ValueNone -> let optf0, finfo = OptimizeFuncInApplication cenv env f0 m match StripPreComputationsFromComputedFunction g optf0 args (fun f argsR -> MakeApplicationAndBetaReduce g (f, tyOfExpr g f, [tyargs], argsR, f.Range)) with @@ -3534,10 +3546,10 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = | Choice2Of2 (newf0, remake) -> match TryInlineApplication cenv env finfo (tyargs, args, m) with - | Some (res, info) -> + | ValueSome (res, info) -> // inlined (res |> remake), info - | None -> + | ValueNone -> let shapes = match newf0 with diff --git a/src/Compiler/Service/FSharpCheckerResults.fs b/src/Compiler/Service/FSharpCheckerResults.fs index 2b23d85a7ce..364eb792f52 100644 --- a/src/Compiler/Service/FSharpCheckerResults.fs +++ b/src/Compiler/Service/FSharpCheckerResults.fs @@ -1999,8 +1999,8 @@ type internal TypeCheckInfo let key = line, colAtEndOfNames, lineStr, width match getToolTipTextCache.TryGet(AnyCallerThread, key) with - | Some res -> res - | None -> + | ValueSome res -> res + | ValueNone -> let res = Compute() getToolTipTextCache.Put(AnyCallerThread, key, res) res diff --git a/src/Compiler/Service/IncrementalBuild.fs b/src/Compiler/Service/IncrementalBuild.fs index f6289a283ac..994fa13b8a4 100644 --- a/src/Compiler/Service/IncrementalBuild.fs +++ b/src/Compiler/Service/IncrementalBuild.fs @@ -9,6 +9,7 @@ open System.Diagnostics open System.IO open System.Threading open Internal.Utilities.Library +open Internal.Utilities.Library.Extras open Internal.Utilities.Collections open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL @@ -249,7 +250,7 @@ type BoundModel private ( fileChecked: Event, prevTcInfo: TcInfo, syntaxTreeOpt: SyntaxTree option, - ?tcStateOpt: GraphNode * GraphNode + tcStateOpt: (GraphNode * GraphNode) voption ) = let getTypeCheck (syntaxTree: SyntaxTree) : NodeCode = @@ -308,7 +309,7 @@ type BoundModel private ( | Some syntaxTree, Some (_, qualifiedName) when syntaxTree.HasSignature -> let input, _, fileName, _ = syntaxTree.Skip qualifiedName SkippedImplFilePlaceholder(tcConfig, tcImports, tcGlobals, prevTcInfo.tcState, input) - |> Option.map (fun ((_, topAttribs, _, ccuSigForFile), tcState) -> + |> ValueOption.map (fun ((_, topAttribs, _, ccuSigForFile), tcState) -> { tcState = tcState tcEnvAtEndOfFile = tcState.TcEnvFromImpls @@ -319,7 +320,7 @@ type BoundModel private ( tcDependencyFiles = fileName :: prevTcInfo.tcDependencyFiles sigNameOpt = Some(fileName, qualifiedName) }) - | _ -> None + | _ -> ValueNone let getTcInfo (typeCheck: GraphNode) = node { @@ -383,10 +384,10 @@ type BoundModel private ( let tcInfo, tcInfoExtras = match tcStateOpt with - | Some tcState -> tcState + | ValueSome tcState -> tcState | _ -> match skippedImplemetationTypeCheck with - | Some tcInfo -> + | ValueSome tcInfo -> // For skipped implementation sources do full type check only when requested. GraphNode.FromResult tcInfo, tcInfoExtras | _ -> @@ -437,7 +438,8 @@ type BoundModel private ( beforeFileChecked, fileChecked, tcInfo, - Some syntaxTree + Some syntaxTree, + ValueNone ) } @@ -458,7 +460,7 @@ type BoundModel private ( fileChecked, prevTcInfo, syntaxTreeOpt, - (GraphNode.FromResult finishState, this.TcInfoExtras) + ValueSome(GraphNode.FromResult finishState, this.TcInfoExtras) ) } @@ -482,7 +484,8 @@ type BoundModel private ( beforeFileChecked, fileChecked, prevTcInfo, - syntaxTreeOpt + syntaxTreeOpt, + ValueNone ) @@ -525,8 +528,8 @@ type FrameworkImportsCache(size) = let node = lock gate (fun () -> match frameworkTcImportsCache.TryGet (AnyCallerThread, key) with - | Some lazyWork -> lazyWork - | None -> + | ValueSome lazyWork -> lazyWork + | ValueNone -> let lazyWork = GraphNode(node { let tcConfigP = TcConfigProvider.Constant tcConfig return! TcImports.BuildFrameworkTcImports (tcConfigP, frameworkDLLs, nonFrameworkResolutions) @@ -585,7 +588,7 @@ type PartialCheckResults (boundModel: BoundModel, timeStamp: DateTime, projectTi module Utilities = let TryFindFSharpStringAttribute tcGlobals attribSpec attribs = match TryFindFSharpAttribute tcGlobals attribSpec attribs with - | Some (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s + | ValueSome (Attrib(_, _, [ AttribStringArg s ], _, _, _, _)) -> Some s | _ -> None /// The implementation of the information needed by TcImports in CompileOps.fs for an F# assembly reference. @@ -637,7 +640,7 @@ module IncrementalBuilderHelpers = nonFrameworkResolutions, unresolvedReferences, dependencyProvider, - loadClosureOpt: LoadClosure option, + loadClosureOpt: LoadClosure voption, basicDependencies, keepAssemblyContents, keepAllBackgroundResolutions, @@ -691,8 +694,8 @@ module IncrementalBuilderHelpers = let tcState = GetInitialTcState (rangeStartup, assemblyName, tcConfig, tcGlobals, tcImports, tcInitial, openDecls0) let loadClosureErrors = [ match loadClosureOpt with - | None -> () - | Some loadClosure -> + | ValueNone -> () + | ValueSome loadClosure -> for inp in loadClosure.Inputs do yield! inp.MetaCommandDiagnostics ] @@ -1355,7 +1358,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc legacyReferenceResolver, defaultFSharpBinariesDir, frameworkTcImportsCache: FrameworkImportsCache, - loadClosureOpt: LoadClosure option, + loadClosureOpt: LoadClosure voption, sourceFiles: string list, commandLineArgs: string list, projectReferences, @@ -1402,8 +1405,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let sdkDirOverride = match loadClosureOpt with - | None -> None - | Some loadClosure -> loadClosure.SdkDirOverride + | ValueNone -> None + | ValueSome loadClosure -> loadClosure.SdkDirOverride // see also fsc.fs: runFromCommandLineToImportingAssemblies(), as there are many similarities to where the PS creates a tcConfigB let tcConfigB = @@ -1420,8 +1423,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc tcConfigB.primaryAssembly <- match loadClosureOpt with - | None -> PrimaryAssembly.Mscorlib - | Some loadClosure -> + | ValueNone -> PrimaryAssembly.Mscorlib + | ValueSome loadClosure -> if loadClosure.UseDesktopFramework then PrimaryAssembly.Mscorlib else @@ -1451,6 +1454,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc // REVIEW: File IO - Will eventually need to change this to use a file system interface of some sort. XmlDocumentationInfo.TryCreateFromFile(xmlFileName) + |> ValueOption.toOption } |> Some @@ -1465,22 +1469,22 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc // NOTE: it would probably be cleaner and more accurate to re-run the load closure at this point. let setupConfigFromLoadClosure () = match loadClosureOpt with - | Some loadClosure -> + | ValueSome loadClosure -> let dllReferences = [for reference in tcConfigB.referencedDLLs do // If there's (one or more) resolutions of closure references then yield them all - match loadClosure.References |> List.tryFind (fun (resolved, _)->resolved=reference.Text) with - | Some (resolved, closureReferences) -> + match loadClosure.References |> List.tryFindV (fun (resolved, _)->resolved=reference.Text) with + | ValueSome (resolved, closureReferences) -> for closureReference in closureReferences do yield AssemblyReference(closureReference.originalReference.Range, resolved, None) - | None -> yield reference] + | ValueNone -> yield reference] tcConfigB.referencedDLLs <- [] tcConfigB.primaryAssembly <- (if loadClosure.UseDesktopFramework then PrimaryAssembly.Mscorlib else PrimaryAssembly.System_Runtime) // Add one by one to remove duplicates dllReferences |> List.iter (fun dllReference -> tcConfigB.AddReferencedAssemblyByPath(dllReference.Range, dllReference.Text)) tcConfigB.knownUnresolvedReferences <- loadClosure.UnresolvedReferences - | None -> () + | ValueNone -> () setupConfigFromLoadClosure() diff --git a/src/Compiler/Service/IncrementalBuild.fsi b/src/Compiler/Service/IncrementalBuild.fsi index b4e60d403f0..613063d5553 100644 --- a/src/Compiler/Service/IncrementalBuild.fsi +++ b/src/Compiler/Service/IncrementalBuild.fsi @@ -255,7 +255,7 @@ type internal IncrementalBuilder = legacyReferenceResolver: LegacyReferenceResolver * defaultFSharpBinariesDir: string * frameworkTcImportsCache: FrameworkImportsCache * - loadClosureOpt: LoadClosure option * + loadClosureOpt: LoadClosure voption * sourceFiles: string list * commandLineArgs: string list * projectReferences: IProjectReference list * diff --git a/src/Compiler/Service/QuickParse.fs b/src/Compiler/Service/QuickParse.fs index 7738d74ad80..81a062b37ed 100644 --- a/src/Compiler/Service/QuickParse.fs +++ b/src/Compiler/Service/QuickParse.fs @@ -78,6 +78,27 @@ module QuickParse = | true, _, true when name.Length > 2 -> isValidStrippedName (name.AsSpan(1, name.Length - 2)) 0 | _ -> false + [] + let (|Char|_|) (lineStr: string) p = + if p >= 0 && p < lineStr.Length then + ValueSome(lineStr[p]) + else + ValueNone + + [] + let (|IsLongIdentifierPartChar|_|) c = + if IsLongIdentifierPartCharacter c then + ValueSome() + else + ValueNone + + [] + let (|IsIdentifierPartChar|_|) c = + if IsIdentifierPartCharacter c then + ValueSome() + else + ValueNone + let GetCompleteIdentifierIslandImplAux (lineStr: string) (index: int) : (string * int * bool) option = if index < 0 || isNull lineStr || index >= lineStr.Length then None @@ -92,60 +113,48 @@ module QuickParse = Some index | _ -> None // not on a word or '.' - let (|Char|_|) p = - if p >= 0 && p < lineStr.Length then - Some(lineStr[p]) - else - None - - let (|IsLongIdentifierPartChar|_|) c = - if IsLongIdentifierPartCharacter c then Some() else None - - let (|IsIdentifierPartChar|_|) c = - if IsIdentifierPartCharacter c then Some() else None - let rec searchLeft p = match (p - 1), (p - 2) with - | Char '|', Char '[' -> p // boundary of array declaration - stop - | Char '|', _ - | Char IsLongIdentifierPartChar, _ -> searchLeft (p - 1) // allow normal chars and '.'s + | Char lineStr '|', Char lineStr '[' -> p // boundary of array declaration - stop + | Char lineStr '|', _ + | Char lineStr IsLongIdentifierPartChar, _ -> searchLeft (p - 1) // allow normal chars and '.'s | _ -> p let rec searchRight p = match (p + 1), (p + 2) with - | Char '|', Char ']' -> p // boundary of array declaration - stop - | Char '|', _ - | Char IsIdentifierPartChar, _ -> searchRight (p + 1) // allow only normal chars (stop at '.') + | Char lineStr '|', Char lineStr ']' -> p // boundary of array declaration - stop + | Char lineStr '|', _ + | Char lineStr IsIdentifierPartChar, _ -> searchRight (p + 1) // allow only normal chars (stop at '.') | _ -> p let tickColsOpt = let rec walkOutsideBackticks i = if i >= lineStr.Length then - None + ValueNone else match i, i + 1 with - | Char '`', Char '`' -> + | Char lineStr '`', Char lineStr '`' -> // dive into backticked part // if pos = i then it will be included in backticked range ($``identifier``) walkInsideBackticks (i + 2) i | _, _ -> if i >= index then - None + ValueNone else // we still not reached position p - continue walking walkOutsideBackticks (i + 1) and walkInsideBackticks i start = if i >= lineStr.Length then - None // non-closed backticks + ValueNone // non-closed backticks else match i, i + 1 with - | Char '`', Char '`' -> + | Char lineStr '`', Char lineStr '`' -> // found closing pair of backticks // if target position is between start and current pos + 1 (entire range of escaped identifier including backticks) - return success // else climb outside and continue walking if index >= start && index < (i + 2) then - Some(start, i) + ValueSome(start, i) else walkOutsideBackticks (i + 2) | _, _ -> walkInsideBackticks (i + 1) start @@ -153,7 +162,7 @@ module QuickParse = walkOutsideBackticks 0 match tickColsOpt with - | Some(prevTickTick, idxTickTick) -> + | ValueSome(prevTickTick, idxTickTick) -> // inside ``identifier`` (which can contain any characters!) so we try returning its location let pos = idxTickTick + 1 + MagicalAdjustmentConstant let ident = lineStr.Substring(prevTickTick, idxTickTick - prevTickTick + 2) diff --git a/src/Compiler/Service/SemanticClassification.fs b/src/Compiler/Service/SemanticClassification.fs index 3697d781373..472a910d2c5 100644 --- a/src/Compiler/Service/SemanticClassification.fs +++ b/src/Compiler/Service/SemanticClassification.fs @@ -19,6 +19,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeHierarchy +[] type SemanticClassificationType = | ReferenceType = 0 | ValueType = 1 @@ -133,6 +134,40 @@ module TcResolutionsExtensions = #endif | TNoRepr -> SemanticClassificationType.ReferenceType + [] + let inline (|LegitTypeOccurence|_|) occ = + match occ with + | ItemOccurence.UseInType + | ItemOccurence.UseInAttribute + | ItemOccurence.Use + | ItemOccurence.Binding + | ItemOccurence.Pattern + | ItemOccurence.Open -> ValueSome() + | _ -> ValueNone + + [] + let inline (|KeywordIntrinsicValue|_|) (g: TcGlobals) (vref: ValRef) = + if + valRefEq g g.raise_vref vref + || valRefEq g g.reraise_vref vref + || valRefEq g g.typeof_vref vref + || valRefEq g g.typedefof_vref vref + || valRefEq g g.sizeof_vref vref + || valRefEq g g.nameof_vref vref + then + ValueSome() + else + ValueNone + + [] + let inline (|EnumCaseFieldInfo|_|) (rfinfo: RecdFieldInfo) = + match rfinfo.TyconRef.TypeReprInfo with + | TFSharpTyconRepr x -> + match x.fsobjmodel_kind with + | TFSharpEnum -> ValueSome() + | _ -> ValueNone + | _ -> ValueNone + type TcResolutions with member sResolutions.GetSemanticClassification @@ -145,37 +180,6 @@ module TcResolutionsExtensions = DiagnosticsScope.Protect range0 (fun () -> - let (|LegitTypeOccurence|_|) occ = - match occ with - | ItemOccurence.UseInType - | ItemOccurence.UseInAttribute - | ItemOccurence.Use - | ItemOccurence.Binding - | ItemOccurence.Pattern - | ItemOccurence.Open -> Some() - | _ -> None - - let (|KeywordIntrinsicValue|_|) (vref: ValRef) = - if - valRefEq g g.raise_vref vref - || valRefEq g g.reraise_vref vref - || valRefEq g g.typeof_vref vref - || valRefEq g g.typedefof_vref vref - || valRefEq g g.sizeof_vref vref - || valRefEq g g.nameof_vref vref - then - Some() - else - None - - let (|EnumCaseFieldInfo|_|) (rfinfo: RecdFieldInfo) = - match rfinfo.TyconRef.TypeReprInfo with - | TFSharpTyconRepr x -> - match x.fsobjmodel_kind with - | TFSharpEnum -> Some() - | _ -> None - | _ -> None - // Custome builders like 'async { }' are both Item.Value and Item.CustomBuilder. // We should prefer the latter, otherwise they would not get classified as CEs. let takeCustomBuilder (cnrs: CapturedNameResolution[]) = @@ -216,7 +220,7 @@ module TcResolutionsExtensions = | Item.Value vref, _, m when isValRefMutable g vref -> add m SemanticClassificationType.MutableVar - | Item.Value KeywordIntrinsicValue, ItemOccurence.Use, m -> add m SemanticClassificationType.IntrinsicFunction + | Item.Value(KeywordIntrinsicValue g), ItemOccurence.Use, m -> add m SemanticClassificationType.IntrinsicFunction | Item.Value vref, _, m when isForallFunctionTy g vref.Type -> if isDiscard vref.DisplayName then diff --git a/src/Compiler/Service/ServiceLexing.fs b/src/Compiler/Service/ServiceLexing.fs index e3f4dcc3c4e..1ea5158ae2a 100644 --- a/src/Compiler/Service/ServiceLexing.fs +++ b/src/Compiler/Service/ServiceLexing.fs @@ -1042,8 +1042,8 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi false, (RQUOTE(s, raw), leftc, rightc - 1) | INFIX_COMPARE_OP(LexFilter.TyparsCloseOp(greaters, afterOp) as opstr) -> match afterOp with - | None -> () - | Some tok -> delayToken (tok, leftc + greaters.Length, rightc) + | ValueNone -> () + | ValueSome tok -> delayToken (tok, leftc + greaters.Length, rightc) for i = greaters.Length - 1 downto 1 do delayToken (greaters[i]false, leftc + i, rightc - opstr.Length + i + 1) @@ -1104,8 +1104,8 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi match token with | EOF lexcont -> // End of text! No more tokens. - None, lexcont, 0 - | LEX_FAILURE _ -> None, LexerStateEncoding.revertToDefaultLexCont, 0 + ValueNone, lexcont, 0 + | LEX_FAILURE _ -> ValueNone, LexerStateEncoding.revertToDefaultLexCont, 0 | _ -> // Get the information about the token let colorClass, charClass, triggerClass = TokenClassifications.tokenInfo token @@ -1136,7 +1136,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi FullMatchedLength = fullMatchedLength } - Some tokenData, lexcontFinal, tokenTag + ValueSome tokenData, lexcontFinal, tokenTag // Check for patterns like #-IDENT and see if they look like meta commands for .fsx files. If they do then merge them into a single token. let tokenDataOption, lexintFinal = @@ -1144,7 +1144,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi LexerStateEncoding.encodeLexInt indentationSyntaxStatus.Status lexcontFinal match tokenDataOption, singleLineTokenState, tokenTagToTokenId tokenTag with - | Some tokenData, SingleLineTokenState.BeforeHash, TOKEN_HASH -> + | ValueSome tokenData, SingleLineTokenState.BeforeHash, TOKEN_HASH -> // Don't allow further matches. singleLineTokenState <- SingleLineTokenState.NoFurtherMatchPossible // Peek at the next token @@ -1193,7 +1193,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi let lexintFinal = LexerStateEncoding.encodeLexInt indentationSyntaxStatus.Status lexcontFinal - Some tokenData, lexintFinal + ValueSome tokenData, lexintFinal | _ -> tokenDataOption, lexintFinal | _ -> tokenDataOption, lexintFinal | _, SingleLineTokenState.BeforeHash, TOKEN_WHITESPACE -> @@ -1203,7 +1203,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, maxLength: int option, fi singleLineTokenState <- SingleLineTokenState.NoFurtherMatchPossible tokenDataOption, lexintFinal - tokenDataOption, lexintFinal + (ValueOption.toOption tokenDataOption), lexintFinal static member ColorStateOfLexState(lexState: FSharpTokenizerLexState) = LexerStateEncoding.colorStateOfLexState lexState diff --git a/src/Compiler/Service/service.fs b/src/Compiler/Service/service.fs index c5b6e64ffdc..3491bcb607a 100644 --- a/src/Compiler/Service/service.fs +++ b/src/Compiler/Service/service.fs @@ -398,16 +398,16 @@ type BackgroundCompiler let tryGetBuilderNode options = incrementalBuildersCache.TryGet(AnyCallerThread, options) - let tryGetBuilder options : NodeCode option = - tryGetBuilderNode options |> Option.map (fun x -> x.GetOrComputeValue()) + let tryGetBuilder options : NodeCode voption = + tryGetBuilderNode options |> ValueOption.map (fun x -> x.GetOrComputeValue()) - let tryGetSimilarBuilder options : NodeCode option = + let tryGetSimilarBuilder options : NodeCode voption = incrementalBuildersCache.TryGetSimilar(AnyCallerThread, options) - |> Option.map (fun x -> x.GetOrComputeValue()) + |> ValueOption.map (fun x -> x.GetOrComputeValue()) - let tryGetAnyBuilder options : NodeCode option = + let tryGetAnyBuilder options : NodeCode voption = incrementalBuildersCache.TryGetAny(AnyCallerThread, options) - |> Option.map (fun x -> x.GetOrComputeValue()) + |> ValueOption.map (fun x -> x.GetOrComputeValue()) let createBuilderNode (options, userOpName, ct: CancellationToken) = lock gate (fun () -> @@ -427,7 +427,7 @@ type BackgroundCompiler let getOrCreateBuilder (options, userOpName) : NodeCode = match tryGetBuilder options with - | Some getBuilder -> + | ValueSome getBuilder -> node { match! getBuilder with | builderOpt, creationDiags when builderOpt.IsNone || not builderOpt.Value.IsReferencesInvalidated -> return builderOpt, creationDiags @@ -448,9 +448,9 @@ type BackgroundCompiler let getSimilarOrCreateBuilder (options, userOpName) = match tryGetSimilarBuilder options with - | Some res -> res + | ValueSome res -> res // The builder does not exist at all. Create it. - | None -> getOrCreateBuilder (options, userOpName) + | ValueNone -> getOrCreateBuilder (options, userOpName) let getOrCreateBuilderWithInvalidationFlag (options, canInvalidateProject, userOpName) = if canInvalidateProject then @@ -460,7 +460,7 @@ type BackgroundCompiler let getAnyBuilder (options, userOpName) = match tryGetAnyBuilder options with - | Some getBuilder -> getBuilder + | ValueSome getBuilder -> getBuilder | _ -> getOrCreateBuilder (options, userOpName) static let mutable actualParseFileCount = 0 @@ -475,7 +475,7 @@ type BackgroundCompiler let key = (fileName, sourceText.GetHashCode() |> int64, options) match checkFileInProjectCache.TryGet(ltok, key) with - | Some res -> res + | ValueSome res -> res | _ -> let res = GraphNode( @@ -507,8 +507,8 @@ type BackgroundCompiler let hash = sourceText.GetHashCode() |> int64 match parseCacheLock.AcquireLock(fun ltok -> parseFileCache.TryGet(ltok, (fileName, hash, options))) with - | Some res -> return res - | None -> + | ValueSome res -> return res + | ValueNone -> Interlocked.Increment(&actualParseFileCount) |> ignore let! ct = Async.CancellationToken @@ -590,7 +590,7 @@ type BackgroundCompiler let cachedResultsOpt = parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, key)) match cachedResultsOpt with - | Some cachedResults -> + | ValueSome cachedResults -> match! cachedResults.GetOrComputeValue() with | parseResults, checkResults, _, priorTimeStamp when (match builder.GetCheckResultsBeforeFileInProjectEvenIfStale fileName with @@ -635,7 +635,7 @@ type BackgroundCompiler tcPrior.TcImports, tcInfo.tcState, tcInfo.moduleNamesDict, - loadClosure, + (ValueOption.toOption loadClosure), tcInfo.TcDiagnostics, options.IsIncompleteTypeCheckEnvironment, options, @@ -941,7 +941,7 @@ type BackgroundCompiler tcResolutions, tcSymbolUses, tcEnvAtEnd.NameEnv, - loadClosure, + (ValueOption.toOption loadClosure), latestImplementationFile, tcOpenDeclarations ) @@ -1030,11 +1030,11 @@ type BackgroundCompiler parseCacheLock.AcquireLock(fun ltok -> checkFileInProjectCache.TryGet(ltok, (fileName, hash, options))) match resOpt with - | Some res -> + | ValueSome res -> match res.TryPeekValue() with | ValueSome(a, b, c, _) -> Some(a, b, c) | ValueNone -> None - | None -> None + | ValueNone -> None | None -> None /// Parse and typecheck the whole project (the implementation, called recursively as project graph is evaluated) @@ -1129,7 +1129,7 @@ type BackgroundCompiler /// Get the timestamp that would be on the output if fully built immediately member private _.TryGetLogicalTimeStampForProject(cache, options) = match tryGetBuilderNode options with - | Some lazyWork -> + | ValueSome lazyWork -> match lazyWork.TryPeekValue() with | ValueSome(Some builder, _) -> Some(builder.GetLogicalTimeStampForProject(cache)) | _ -> None @@ -1495,8 +1495,8 @@ type FSharpChecker async { match braceMatchCache.TryGet(AnyCallerThread, (fileName, hash, options)) with - | Some res -> return res - | None -> + | ValueSome res -> return res + | ValueNone -> let! ct = Async.CancellationToken let res = diff --git a/src/Compiler/Symbols/Exprs.fs b/src/Compiler/Symbols/Exprs.fs index 3aa8f1cbe5e..5d9eb380c97 100644 --- a/src/Compiler/Symbols/Exprs.fs +++ b/src/Compiler/Symbols/Exprs.fs @@ -775,10 +775,10 @@ module FSharpExprConvert = let argTy2 = tyOfExpr g arg2 let resTy = match getMeasureOfType g argTy1, getMeasureOfType g argTy2 with - | Some (tcref, ms1), Some (_tcref2, ms2) -> mkAppTy tcref [TType_measure (Measure.Prod(ms1, if isMul then ms2 else Measure.Inv ms2))] - | Some _, None -> argTy1 - | None, Some _ -> argTy2 - | None, None -> argTy1 + | ValueSome (tcref, ms1), ValueSome (_tcref2, ms2) -> mkAppTy tcref [TType_measure (Measure.Prod(ms1, if isMul then ms2 else Measure.Inv ms2))] + | ValueSome _, ValueNone -> argTy1 + | ValueNone, ValueSome _ -> argTy2 + | ValueNone, ValueNone -> argTy1 let op = binaryOp g m argTy1 argTy2 resTy arg1 arg2 ConvExprPrim cenv env op @@ -1493,4 +1493,3 @@ module FSharpExprPatterns = let (|TraitCall|_|) (e: FSharpExpr) = match e.E with E.TraitCall (a, b, c, d, e, f) -> Some (a, b, c, d, e, f) | _ -> None let (|WitnessArg|_|) (e: FSharpExpr) = match e.E with E.WitnessArg n -> Some n | _ -> None - diff --git a/src/Compiler/Symbols/FSharpDiagnostic.fs b/src/Compiler/Symbols/FSharpDiagnostic.fs index 2c27e7e2ff3..5b0c8d46f62 100644 --- a/src/Compiler/Symbols/FSharpDiagnostic.fs +++ b/src/Compiler/Symbols/FSharpDiagnostic.fs @@ -266,17 +266,17 @@ type DiagnosticsScope(flatErrors: bool) = use diagnosticsScope = new DiagnosticsScope(false) let res = try - Some (f()) + ValueSome (f()) with e -> // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. try errorRecovery e m with RecoverableException _ -> () - None + ValueNone match res with - | Some res -> res - | None -> + | ValueSome res -> res + | ValueNone -> match diagnosticsScope.TryGetFirstErrorText() with | Some text -> err text | None -> err "" diff --git a/src/Compiler/Symbols/SymbolHelpers.fs b/src/Compiler/Symbols/SymbolHelpers.fs index f3ad450a461..d03cc2f8a7c 100644 --- a/src/Compiler/Symbols/SymbolHelpers.fs +++ b/src/Compiler/Symbols/SymbolHelpers.fs @@ -247,7 +247,7 @@ module internal SymbolHelpers = let mkXmlComment thing = match thing with - | Some (Some fileName, xmlDocSig) -> FSharpXmlDoc.FromXmlFile(fileName, xmlDocSig) + | ValueSome (Some fileName, xmlDocSig) -> FSharpXmlDoc.FromXmlFile(fileName, xmlDocSig) | _ -> FSharpXmlDoc.None let GetXmlDocFromLoader (infoReader: InfoReader) xmlDoc = @@ -256,8 +256,8 @@ module internal SymbolHelpers = | FSharpXmlDoc.FromXmlText _ -> xmlDoc | FSharpXmlDoc.FromXmlFile(dllName, xmlSig) -> TryFindXmlDocByAssemblyNameAndSig infoReader (Path.GetFileNameWithoutExtension dllName) xmlSig - |> Option.map FSharpXmlDoc.FromXmlText - |> Option.defaultValue xmlDoc + |> ValueOption.map FSharpXmlDoc.FromXmlText + |> ValueOption.defaultValue xmlDoc /// This function gets the signature to pass to Visual Studio to use its lookup functions for .NET stuff. let rec GetXmlDocHelpSigOfItemForLookup (infoReader: InfoReader) m d = diff --git a/src/Compiler/Symbols/Symbols.fs b/src/Compiler/Symbols/Symbols.fs index ae8ce6b2500..e72901c90d8 100644 --- a/src/Compiler/Symbols/Symbols.fs +++ b/src/Compiler/Symbols/Symbols.fs @@ -198,7 +198,7 @@ module Impl = let getXmlDocSigForEntity (cenv: SymbolEnv) (ent:EntityRef)= match GetXmlDocSigOfEntityRef cenv.infoReader ent.Range ent with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" type FSharpDisplayContext(denv: TcGlobals -> DisplayEnv) = @@ -1012,7 +1012,7 @@ type FSharpUnionCase(cenv, v: UnionCaseRef) = checkIsResolved() let unionCase = UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange, v) match GetXmlDocSigOfUnionCaseRef unionCase.UnionCaseRef with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" member _.XmlDoc = @@ -1192,9 +1192,9 @@ type FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = GetXmlDocSigOfUnionCaseRef unionCase.UnionCaseRef | ILField f -> GetXmlDocSigOfILFieldInfo cenv.infoReader range0 f - | AnonField _ -> None + | AnonField _ -> ValueNone match xmlsig with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" member _.XmlDoc = @@ -1329,9 +1329,9 @@ type FSharpActivePatternCase(cenv, apinfo: ActivePatternInfo, ty, n, valOpt: Val let xmlsig = match valOpt with | Some valref -> GetXmlDocSigOfValRef cenv.g valref - | None -> None + | None -> ValueNone match xmlsig with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" type FSharpActivePatternGroup(cenv, apinfo:ActivePatternInfo, ty, valOpt) = @@ -1780,7 +1780,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member _.EventDelegateType = checkIsResolved() - match d with + match d with | E e -> FSharpType(cenv, e.GetDelegateType(cenv.amap, range0)) | P _ | M _ | C _ | V _ -> invalidOp "the value or member doesn't have an associated event delegate type" @@ -1789,7 +1789,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | E e -> let dty = e.GetDelegateType(cenv.amap, range0) - TryDestStandardDelegateType cenv.infoReader range0 AccessibleFromSomewhere dty |> Option.isSome + TryDestStandardDelegateType cenv.infoReader range0 AccessibleFromSomewhere dty |> ValueOption.isSome | P _ | M _ | C _ | V _ -> invalidOp "the value or member is not an event" member _.IsCompilerGenerated = @@ -2033,23 +2033,23 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | E e -> let range = defaultArg sym.DeclarationLocationOpt range0 match GetXmlDocSigOfEvent cenv.infoReader range e with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" | P p -> let range = defaultArg sym.DeclarationLocationOpt range0 match GetXmlDocSigOfProp cenv.infoReader range p with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" | M m | C m -> let range = defaultArg sym.DeclarationLocationOpt range0 match GetXmlDocSigOfMethInfo cenv.infoReader range m with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" | V v -> match v.TryDeclaringEntity with | Parent entityRef -> match GetXmlDocSigOfScopedValRef cenv.g entityRef v with - | Some (_, docsig) -> docsig + | ValueSome (_, docsig) -> docsig | _ -> "" | ParentNone -> "" @@ -2946,4 +2946,3 @@ type FSharpOpenDeclaration(target: SynOpenDeclTarget, range: range option, modul member _.AppliedScope = appliedScope member _.IsOwnNamespace = isOwnNamespace - diff --git a/src/Compiler/SyntaxTree/LexFilter.fs b/src/Compiler/SyntaxTree/LexFilter.fs index e592960c6ba..909ba594e74 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fs +++ b/src/Compiler/SyntaxTree/LexFilter.fs @@ -181,18 +181,20 @@ let infixTokenLength token = // // LBRACK_LESS and GREATER_RBRACK are not here because adding them in these active patterns // causes more offside warnings, while removing them doesn't add offside warnings in attributes. +[] let (|TokenLExprParen|_|) token = match token with | BEGIN | LPAREN | LBRACE _ | LBRACE_BAR | LBRACK | LBRACK_BAR | LQUOTE _ | LESS true - -> Some () - | _ -> None + -> ValueSome () + | _ -> ValueNone /// Matches against a right-parenthesis-like token that is valid in expressions. +[] let (|TokenRExprParen|_|) token = match token with | END | RPAREN | RBRACE _ | BAR_RBRACE | RBRACK | BAR_RBRACK | RQUOTE _ | GREATER true - -> Some () - | _ -> None + -> ValueSome () + | _ -> ValueNone /// Determine the tokens that may align with the 'if' of an 'if/then/elif/else' without closing /// the construct @@ -513,53 +515,54 @@ type TokenTupPool() = // Strip a bunch of leading '>' of a token, at the end of a typar application // Note: this is used in the 'service.fs' to do limited postprocessing +[] let (|TyparsCloseOp|_|) (txt: string) = let angles = txt |> Seq.takeWhile (fun c -> c = '>') |> Seq.toList let afterAngles = txt |> Seq.skipWhile (fun c -> c = '>') |> Seq.toList - if List.isEmpty angles then None else + if List.isEmpty angles then ValueNone else let afterOp = match (System.String(Array.ofSeq afterAngles)) with - | "." -> Some DOT - | "]" -> Some RBRACK - | "-" -> Some MINUS - | ".." -> Some DOT_DOT - | "?" -> Some QMARK - | "??" -> Some QMARK_QMARK - | ":=" -> Some COLON_EQUALS - | "::" -> Some COLON_COLON - | "*" -> Some STAR - | "&" -> Some AMP - | "->" -> Some RARROW - | "<-" -> Some LARROW - | "=" -> Some EQUALS - | "<" -> Some (LESS false) - | "$" -> Some DOLLAR - | "%" -> Some (PERCENT_OP("%") ) - | "%%" -> Some (PERCENT_OP("%%")) - | "" -> None + | "." -> ValueSome DOT + | "]" -> ValueSome RBRACK + | "-" -> ValueSome MINUS + | ".." -> ValueSome DOT_DOT + | "?" -> ValueSome QMARK + | "??" -> ValueSome QMARK_QMARK + | ":=" -> ValueSome COLON_EQUALS + | "::" -> ValueSome COLON_COLON + | "*" -> ValueSome STAR + | "&" -> ValueSome AMP + | "->" -> ValueSome RARROW + | "<-" -> ValueSome LARROW + | "=" -> ValueSome EQUALS + | "<" -> ValueSome (LESS false) + | "$" -> ValueSome DOLLAR + | "%" -> ValueSome (PERCENT_OP("%") ) + | "%%" -> ValueSome (PERCENT_OP("%%")) + | "" -> ValueNone | s -> match List.ofSeq afterAngles with | '=' :: _ | '!' :: '=' :: _ | '<' :: _ | '>' :: _ - | '$' :: _ -> Some (INFIX_COMPARE_OP s) - | '&' :: _ -> Some (INFIX_AMP_OP s) - | '|' :: _ -> Some (INFIX_BAR_OP s) + | '$' :: _ -> ValueSome (INFIX_COMPARE_OP s) + | '&' :: _ -> ValueSome (INFIX_AMP_OP s) + | '|' :: _ -> ValueSome (INFIX_BAR_OP s) | '!' :: _ | '?' :: _ - | '~' :: _ -> Some (PREFIX_OP s) + | '~' :: _ -> ValueSome (PREFIX_OP s) | '@' :: _ - | '^' :: _ -> Some (INFIX_AT_HAT_OP s) + | '^' :: _ -> ValueSome (INFIX_AT_HAT_OP s) | '+' :: _ - | '-' :: _ -> Some (PLUS_MINUS_OP s) - | '*' :: '*' :: _ -> Some (INFIX_STAR_STAR_OP s) + | '-' :: _ -> ValueSome (PLUS_MINUS_OP s) + | '*' :: '*' :: _ -> ValueSome (INFIX_STAR_STAR_OP s) | '*' :: _ | '/' :: _ - | '%' :: _ -> Some (INFIX_STAR_DIV_MOD_OP s) - | _ -> None - Some([| for _c in angles do yield GREATER |], afterOp) + | '%' :: _ -> ValueSome (INFIX_STAR_DIV_MOD_OP s) + | _ -> ValueNone + ValueSome([| for _c in angles do yield GREATER |], afterOp) [] type PositionWithColumn = @@ -1172,7 +1175,6 @@ type LexFilterImpl ( delayToken (pool.UseShiftedLocation(tokenTup, INFIX_AT_HAT_OP "^", 1, 0)) delayToken (pool.UseShiftedLocation(tokenTup, LESS res, 0, -1)) pool.Return tokenTup - | INFIX_COMPARE_OP ">:" -> delayToken (pool.UseShiftedLocation(tokenTup, COLON, 1, 0)) delayToken (pool.UseShiftedLocation(tokenTup, GREATER res, 0, -1)) @@ -1195,8 +1197,8 @@ type LexFilterImpl ( pool.Return tokenTup | INFIX_COMPARE_OP (TyparsCloseOp(greaters, afterOp) as opstr) -> match afterOp with - | None -> () - | Some tok -> delayToken (pool.UseShiftedLocation(tokenTup, tok, greaters.Length, 0)) + | ValueNone -> () + | ValueSome tok -> delayToken (pool.UseShiftedLocation(tokenTup, tok, greaters.Length, 0)) for i = greaters.Length - 1 downto 0 do delayToken (pool.UseShiftedLocation(tokenTup, greaters[i] res, i, -opstr.Length + i + 1)) pool.Return tokenTup diff --git a/src/Compiler/SyntaxTree/LexFilter.fsi b/src/Compiler/SyntaxTree/LexFilter.fsi index 319fd5ecd90..ff25ceb6f90 100644 --- a/src/Compiler/SyntaxTree/LexFilter.fsi +++ b/src/Compiler/SyntaxTree/LexFilter.fsi @@ -10,7 +10,7 @@ open FSharp.Compiler.Parser /// Match the close of '>' of a set of type parameters. /// This is done for tokens such as '>>' by smashing the token -val (|TyparsCloseOp|_|): txt: string -> ((bool -> token)[] * token option) option +val (|TyparsCloseOp|_|): txt: string -> ((bool -> token)[] * token voption) voption /// A stateful filter over the token stream that adjusts it for indentation-aware syntax rules /// Process the token stream prior to parsing. Implements the offside rule and other lexical transformations. diff --git a/src/Compiler/SyntaxTree/XmlDoc.fs b/src/Compiler/SyntaxTree/XmlDoc.fs index 0bfb9c09f48..639310a929f 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fs +++ b/src/Compiler/SyntaxTree/XmlDoc.fs @@ -303,7 +303,7 @@ type PreXmlDoc = static member Merge a b = PreXmlMerge(a, b) [] -type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option) = +type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument voption) = // 2 and 4 are arbitrary but should be reasonable enough [] @@ -325,10 +325,10 @@ type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option let tryGetSummaryNode (xmlDocSig: string) = if xmlDocSig.Contains "'" && xmlDocSig.Contains "\"" then // No easy way to find this signature with XPath - None + ValueNone else tryGetXmlDocument () - |> Option.bind (fun doc -> + |> ValueOption.bind (fun doc -> let name = if xmlDocSig.Contains "'" then $"\"{xmlDocSig}\"" @@ -336,13 +336,13 @@ type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option $"'{xmlDocSig}'" match doc.SelectSingleNode $"doc/members/member[@name={name}]" with - | null -> None - | node when node.HasChildNodes -> Some node - | _ -> None) + | null -> ValueNone + | node when node.HasChildNodes -> ValueSome node + | _ -> ValueNone) member _.TryGetXmlDocBySig(xmlDocSig: string) = tryGetSummaryNode xmlDocSig - |> Option.map (fun node -> + |> ValueOption.map (fun node -> let childNodes = node.ChildNodes let lines = Array.zeroCreate childNodes.Count @@ -357,7 +357,7 @@ type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option not (FileSystem.FileExistsShim(xmlFileName)) || not (String.Equals(Path.GetExtension(xmlFileName), ".xml", StringComparison.OrdinalIgnoreCase)) then - None + ValueNone else let tryGetXmlDocument () = try @@ -365,17 +365,17 @@ type XmlDocumentationInfo private (tryGetXmlDocument: unit -> XmlDocument option let cacheKey = (xmlFileName, lastWriteTime) match cache.TryGet((), cacheKey) with - | Some doc -> Some doc + | ValueSome doc -> ValueSome doc | _ -> let doc = XmlDocument() use xmlStream = FileSystem.OpenFileForReadShim(xmlFileName) doc.Load(xmlStream) cache.Put((), cacheKey, doc) - Some doc + ValueSome doc with _ -> - None + ValueNone - Some(XmlDocumentationInfo(tryGetXmlDocument)) + ValueSome(XmlDocumentationInfo(tryGetXmlDocument)) type IXmlDocumentationInfoLoader = diff --git a/src/Compiler/SyntaxTree/XmlDoc.fsi b/src/Compiler/SyntaxTree/XmlDoc.fsi index 33b168786cc..f288c8a1657 100644 --- a/src/Compiler/SyntaxTree/XmlDoc.fsi +++ b/src/Compiler/SyntaxTree/XmlDoc.fsi @@ -93,10 +93,10 @@ type public PreXmlDoc = type internal XmlDocumentationInfo = /// Look up an item in the XmlDoc file - member TryGetXmlDocBySig: xmlDocSig: string -> XmlDoc option + member TryGetXmlDocBySig: xmlDocSig: string -> XmlDoc voption /// Create an XmlDocumentationInfo from a file - static member TryCreateFromFile: xmlFileName: string -> XmlDocumentationInfo option + static member TryCreateFromFile: xmlFileName: string -> XmlDocumentationInfo voption /// Represents a capability to access XmlDoc files type internal IXmlDocumentationInfoLoader = diff --git a/src/Compiler/TypedTree/TcGlobals.fs b/src/Compiler/TypedTree/TcGlobals.fs index e754a5ad4ae..e2f2ded2289 100755 --- a/src/Compiler/TypedTree/TcGlobals.fs +++ b/src/Compiler/TypedTree/TcGlobals.fs @@ -1894,52 +1894,52 @@ type TcGlobals( // Call Operators.sign let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "sign", None, Some "Sign", [vara], ([[varaTy]], v_int32_ty)) let tyargs = [aty] - Some (info, tyargs, [objExpr]) + ValueSome (info, tyargs, [objExpr]) | "Sqrt", [aty], Some bty, [_] -> // Call Operators.sqrt let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "sqrt", None, Some "Sqrt", [vara; varb], ([[varaTy]], varbTy)) let tyargs = [aty; bty] - Some (info, tyargs, argExprs) + ValueSome (info, tyargs, argExprs) | "Pow", [aty;bty], _, [_;_] -> // Call Operators.(**) let info = v_exponentiation_info let tyargs = [aty;bty] - Some (info, tyargs, argExprs) + ValueSome (info, tyargs, argExprs) | "Atan2", [aty;_], Some bty, [_;_] -> // Call Operators.atan2 let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "atan2", None, Some "Atan2", [vara; varb], ([[varaTy]; [varaTy]], varbTy)) let tyargs = [aty;bty] - Some (info, tyargs, argExprs) + ValueSome (info, tyargs, argExprs) | "get_Zero", _, Some aty, ([] | [_]) -> // Call LanguagePrimitives.GenericZero let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericZero", None, None, [vara], ([], varaTy)) let tyargs = [aty] - Some (info, tyargs, []) + ValueSome (info, tyargs, []) | "get_One", _, Some aty, ([] | [_]) -> // Call LanguagePrimitives.GenericOne let info = makeOtherIntrinsicValRef (fslib_MFLanguagePrimitives_nleref, "GenericOne", None, None, [vara], ([], varaTy)) let tyargs = [aty] - Some (info, tyargs, []) + ValueSome (info, tyargs, []) | ("Abs" | "Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10"| "Log"), [aty], _, [_] -> // Call corresponding Operators.* let nm = t.MemberLogicalName let lower = if nm = "Ceiling" then "ceil" else nm.ToLowerInvariant() let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, lower, None, Some nm, [vara], ([[varaTy]], varaTy)) let tyargs = [aty] - Some (info, tyargs, argExprs) + ValueSome (info, tyargs, argExprs) | "get_Item", [arrTy; _], Some retTy, [_; _] when isArrayTy g arrTy -> - Some (g.array_get_info, [retTy], argExprs) + ValueSome (g.array_get_info, [retTy], argExprs) | "set_Item", [arrTy; _; elemTy], _, [_; _; _] when isArrayTy g arrTy -> - Some (g.array_set_info, [elemTy], argExprs) + ValueSome (g.array_set_info, [elemTy], argExprs) | "get_Item", [stringTy; _; _], _, [_; _] when isStringTy g stringTy -> - Some (g.getstring_info, [], argExprs) + ValueSome (g.getstring_info, [], argExprs) | "op_UnaryPlus", [aty], _, [_] -> // Call Operators.id let info = makeOtherIntrinsicValRef (fslib_MFOperators_nleref, "id", None, None, [vara], ([[varaTy]], varaTy)) let tyargs = [aty] - Some (info, tyargs, argExprs) + ValueSome (info, tyargs, argExprs) | _ -> - None + ValueNone #if DEBUG // This global is only used during debug output diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fs b/src/Compiler/TypedTree/TypedTreeBasics.fs index 651eadd0d65..57782a94a18 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fs +++ b/src/Compiler/TypedTree/TypedTreeBasics.fs @@ -258,24 +258,25 @@ let rec stripTyparEqnsAux canShortcut ty = TType_measure (stripUnitEqnsAux canShortcut unt) | _ -> ty -let stripTyparEqns ty = stripTyparEqnsAux false ty +let inline stripTyparEqns ty = stripTyparEqnsAux false ty -let stripUnitEqns unt = stripUnitEqnsAux false unt +let inline stripUnitEqns unt = stripUnitEqnsAux false unt /// Detect a use of a nominal type, including type abbreviations. +[] let (|AbbrevOrAppTy|_|) (ty: TType) = match stripTyparEqns ty with - | TType_app (tcref, _, _) -> Some tcref - | _ -> None + | TType_app (tcref, _, _) -> ValueSome tcref + | _ -> ValueNone //--------------------------------------------------------------------------- // These make local/non-local references to values according to whether // the item is globally stable ("published") or not. //--------------------------------------------------------------------------- -let mkLocalValRef (v: Val) = VRefLocal v -let mkLocalModuleRef (v: ModuleOrNamespace) = ERefLocal v -let mkLocalEntityRef (v: Entity) = ERefLocal v +let inline mkLocalValRef (v: Val) = VRefLocal v +let inline mkLocalModuleRef (v: ModuleOrNamespace) = ERefLocal v +let inline mkLocalEntityRef (v: Entity) = ERefLocal v let mkNonLocalCcuRootEntityRef ccu (x: Entity) = mkNonLocalTyconRefPreResolved x (mkNonLocalEntityRef ccu [| |]) x.LogicalName @@ -287,16 +288,16 @@ let mkNestedValRef (cref: EntityRef) (v: Val) : ValRef = mkNonLocalValRefPreResolved v nlr key /// From Ref_private to Ref_nonlocal when exporting data. -let rescopePubPathToParent viewedCcu (PubPath p) = NonLocalEntityRef(viewedCcu, p[0..p.Length-2]) +let inline rescopePubPathToParent viewedCcu (PubPath p) = NonLocalEntityRef(viewedCcu, p[0..p.Length-2]) /// From Ref_private to Ref_nonlocal when exporting data. -let rescopePubPath viewedCcu (PubPath p) = NonLocalEntityRef(viewedCcu, p) +let inline rescopePubPath viewedCcu (PubPath p) = NonLocalEntityRef(viewedCcu, p) //--------------------------------------------------------------------------- // Equality between TAST items. //--------------------------------------------------------------------------- -let valRefInThisAssembly compilingFSharpCore (x: ValRef) = +let inline valRefInThisAssembly compilingFSharpCore (x: ValRef) = match x with | VRefLocal _ -> true | VRefNonLocal _ -> compilingFSharpCore @@ -332,12 +333,12 @@ let nonLocalRefEq (NonLocalEntityRef(x1, y1) as smr1) (NonLocalEntityRef(x2, y2) /// different entities. Two references with the same named paths may resolve to the same /// entities even if they reference through different CCUs, because one reference /// may be forwarded to another via a .NET TypeForwarder. -let nonLocalRefDefinitelyNotEq (NonLocalEntityRef(_, y1)) (NonLocalEntityRef(_, y2)) = +let inline nonLocalRefDefinitelyNotEq (NonLocalEntityRef(_, y1)) (NonLocalEntityRef(_, y2)) = not (arrayPathEq y1 y2) -let pubPathEq (PubPath path1) (PubPath path2) = arrayPathEq path1 path2 +let inline pubPathEq (PubPath path1) (PubPath path2) = arrayPathEq path1 path2 -let fslibRefEq (nlr1: NonLocalEntityRef) (PubPath path2) = +let inline fslibRefEq (nlr1: NonLocalEntityRef) (PubPath path2) = arrayPathEq nlr1.Path path2 // Compare two EntityRef's for equality when compiling fslib (FSharp.Core.dll) @@ -455,8 +456,8 @@ let canAccessFromOneOf cpaths cpathTest = let canAccessFrom (TAccess x) cpath = x |> List.forall (fun cpath1 -> canAccessCompPathFrom cpath1 cpath) -let canAccessFromEverywhere (TAccess x) = x.IsEmpty -let canAccessFromSomewhere (TAccess _) = true +let inline canAccessFromEverywhere (TAccess x) = x.IsEmpty +let inline canAccessFromSomewhere (TAccess _) = true let isLessAccessible (TAccess aa) (TAccess bb) = not (aa |> List.forall(fun a -> bb |> List.exists (fun b -> canAccessCompPathFrom a b))) @@ -465,13 +466,12 @@ let accessSubstPaths (newPath, oldPath) (TAccess paths) = let subst cpath = if cpath=oldPath then newPath else cpath TAccess (List.map subst paths) -let compPathOfCcu (ccu: CcuThunk) = CompPath(ccu.ILScopeRef, []) +let inline compPathOfCcu (ccu: CcuThunk) = CompPath(ccu.ILScopeRef, []) let taccessPublic = TAccess [] -let taccessPrivate accessPath = TAccess [accessPath] +let inline taccessPrivate accessPath = TAccess [accessPath] let compPathInternal = CompPath(ILScopeRef.Local, []) let taccessInternal = TAccess [compPathInternal] -let combineAccess (TAccess a1) (TAccess a2) = TAccess(a1@a2) +let inline combineAccess (TAccess a1) (TAccess a2) = TAccess(a1@a2) exception Duplicate of string * string * range exception NameClash of string * string * string * range * string * string * range - diff --git a/src/Compiler/TypedTree/TypedTreeBasics.fsi b/src/Compiler/TypedTree/TypedTreeBasics.fsi index 8a73a609316..f9dcacf6b16 100644 --- a/src/Compiler/TypedTree/TypedTreeBasics.fsi +++ b/src/Compiler/TypedTree/TypedTreeBasics.fsi @@ -130,30 +130,30 @@ val stripUnitEqnsAux: canShortcut: bool -> unt: Measure -> Measure val stripTyparEqnsAux: canShortcut: bool -> ty: TType -> TType -val stripTyparEqns: ty: TType -> TType +val inline stripTyparEqns: ty: TType -> TType -val stripUnitEqns: unt: Measure -> Measure +val inline stripUnitEqns: unt: Measure -> Measure /// Detect a use of a nominal type, including type abbreviations. -val (|AbbrevOrAppTy|_|): ty: TType -> TyconRef option +val (|AbbrevOrAppTy|_|): ty: TType -> TyconRef voption -val mkLocalValRef: v: Val -> ValRef +val inline mkLocalValRef: v: Val -> ValRef -val mkLocalModuleRef: v: ModuleOrNamespace -> EntityRef +val inline mkLocalModuleRef: v: ModuleOrNamespace -> EntityRef -val mkLocalEntityRef: v: Entity -> EntityRef +val inline mkLocalEntityRef: v: Entity -> EntityRef val mkNonLocalCcuRootEntityRef: ccu: CcuThunk -> x: Entity -> EntityRef val mkNestedValRef: cref: EntityRef -> v: Val -> ValRef /// From Ref_private to Ref_nonlocal when exporting data. -val rescopePubPathToParent: viewedCcu: CcuThunk -> PublicPath -> NonLocalEntityRef +val inline rescopePubPathToParent: viewedCcu: CcuThunk -> PublicPath -> NonLocalEntityRef /// From Ref_private to Ref_nonlocal when exporting data. -val rescopePubPath: viewedCcu: CcuThunk -> PublicPath -> NonLocalEntityRef +val inline rescopePubPath: viewedCcu: CcuThunk -> PublicPath -> NonLocalEntityRef -val valRefInThisAssembly: compilingFSharpCore: bool -> x: ValRef -> bool +val inline valRefInThisAssembly: compilingFSharpCore: bool -> x: ValRef -> bool val tyconRefUsesLocalXmlDoc: compilingFSharpCore: bool -> x: TyconRef -> bool @@ -168,11 +168,11 @@ val nonLocalRefEq: NonLocalEntityRef -> NonLocalEntityRef -> bool /// different entities. Two references with the same named paths may resolve to the same /// entities even if they reference through different CCUs, because one reference /// may be forwarded to another via a .NET TypeForwarder. -val nonLocalRefDefinitelyNotEq: NonLocalEntityRef -> NonLocalEntityRef -> bool +val inline nonLocalRefDefinitelyNotEq: NonLocalEntityRef -> NonLocalEntityRef -> bool -val pubPathEq: PublicPath -> PublicPath -> bool +val inline pubPathEq: PublicPath -> PublicPath -> bool -val fslibRefEq: nlr1: NonLocalEntityRef -> PublicPath -> bool +val inline fslibRefEq: nlr1: NonLocalEntityRef -> PublicPath -> bool /// Compare two EntityRef's for equality when compiling fslib (FSharp.Core.dll) val fslibEntityRefEq: fslibCcu: CcuThunk -> eref1: EntityRef -> eref2: EntityRef -> bool @@ -204,26 +204,26 @@ val canAccessFromOneOf: cpaths: CompilationPath list -> cpathTest: CompilationPa val canAccessFrom: Accessibility -> cpath: CompilationPath -> bool -val canAccessFromEverywhere: Accessibility -> bool +val inline canAccessFromEverywhere: Accessibility -> bool -val canAccessFromSomewhere: Accessibility -> bool +val inline canAccessFromSomewhere: Accessibility -> bool val isLessAccessible: Accessibility -> Accessibility -> bool /// Given (newPath, oldPath) replace oldPath by newPath in the TAccess. val accessSubstPaths: newPath: CompilationPath * oldPath: CompilationPath -> Accessibility -> Accessibility -val compPathOfCcu: ccu: CcuThunk -> CompilationPath +val inline compPathOfCcu: ccu: CcuThunk -> CompilationPath val taccessPublic: Accessibility -val taccessPrivate: accessPath: CompilationPath -> Accessibility +val inline taccessPrivate: accessPath: CompilationPath -> Accessibility val compPathInternal: CompilationPath val taccessInternal: Accessibility -val combineAccess: Accessibility -> Accessibility -> Accessibility +val inline combineAccess: Accessibility -> Accessibility -> Accessibility exception Duplicate of string * string * range diff --git a/src/Compiler/TypedTree/TypedTreeOps.fs b/src/Compiler/TypedTree/TypedTreeOps.fs index a3b987f46f6..c41c9d6b2e8 100644 --- a/src/Compiler/TypedTree/TypedTreeOps.fs +++ b/src/Compiler/TypedTree/TypedTreeOps.fs @@ -1117,9 +1117,9 @@ let getMeasureOfType g ty = match ty with | AppTy g (tcref, [tyarg]) -> match stripTyEqns g tyarg with - | TType_measure ms when not (measureEquiv g ms Measure.One) -> Some (tcref, ms) - | _ -> None - | _ -> None + | TType_measure ms when not (measureEquiv g ms Measure.One) -> ValueSome (tcref, ms) + | _ -> ValueNone + | _ -> ValueNone let isErasedType g ty = match stripTyEqns g ty with @@ -1265,7 +1265,7 @@ type MatchBuilder(spBind, inpRange: range) = member _.Close(dtree, m, ty) = primMkMatch (spBind, inpRange, dtree, targets.ToArray(), m, ty) -let mkBoolSwitch m g t e = +let inline mkBoolSwitch m g t e = TDSwitch(g, [TCase(DecisionTreeTest.Const(Const.Bool true), t)], Some e, m) let primMkCond spBind m ty e1 e2 e3 = @@ -1280,8 +1280,8 @@ let mkCond spBind m ty e1 e2 e3 = // Primitive constructors //--------------------------------------------------------------------------- -let exprForValRef m vref = Expr.Val (vref, NormalValUse, m) -let exprForVal m v = exprForValRef m (mkLocalValRef v) +let inline exprForValRef m vref = Expr.Val (vref, NormalValUse, m) +let inline exprForVal m v = exprForValRef m (mkLocalValRef v) let mkLocalAux m s ty mut compgen = let thisv = Construct.NewVal(s, m, None, ty, mut, compgen, None, taccessPublic, ValNotInRecScope, None, NormalVal, [], ValInline.Optional, XmlDoc.Empty, false, false, false, false, false, false, None, ParentNone) thisv, exprForVal m thisv @@ -3413,31 +3413,56 @@ let isILAttrib (tref: ILTypeRef) (attr: ILAttribute) = let HasILAttribute tref (attrs: ILAttributes) = attrs.AsArray() |> Array.exists (isILAttrib tref) -let TryDecodeILAttribute tref (attrs: ILAttributes) = - attrs.AsArray() |> Array.tryPick (fun x -> if isILAttrib tref x then Some(decodeILAttribData x) else None) +let TryDecodeILAttribute tref (attrs: ILAttributes) = + attrs.AsArray() |> Array.tryPickV (fun x -> if isILAttrib tref x then ValueSome(decodeILAttribData x) else ValueNone) // F# view of attributes (these get converted to AbsIL attributes in ilxgen) let IsMatchingFSharpAttribute g (AttribInfo(_, tcref)) (Attrib(tcref2, _, _, _, _, _, _)) = tyconRefEq g tcref tcref2 let HasFSharpAttribute g tref attrs = List.exists (IsMatchingFSharpAttribute g tref) attrs -let TryFindFSharpAttribute g tref attrs = List.tryFind (IsMatchingFSharpAttribute g tref) attrs +let TryFindFSharpAttribute g tref attrs = List.tryFindV (IsMatchingFSharpAttribute g tref) attrs let TryFindFSharpAttributeOpt g tref attrs = match tref with None -> None | Some tref -> List.tryFind (IsMatchingFSharpAttribute g tref) attrs let HasFSharpAttributeOpt g trefOpt attrs = match trefOpt with Some tref -> List.exists (IsMatchingFSharpAttribute g tref) attrs | _ -> false let IsMatchingFSharpAttributeOpt g attrOpt (Attrib(tcref2, _, _, _, _, _, _)) = match attrOpt with Some (AttribInfo(_, tcref)) -> tyconRefEq g tcref tcref2 | _ -> false +[] let (|ExtractAttribNamedArg|_|) nm args = - args |> List.tryPick (function AttribNamedArg(nm2, _, _, v) when nm = nm2 -> Some v | _ -> None) + args |> List.tryPickV (function AttribNamedArg(nm2, _, _, v) when nm = nm2 -> ValueSome v | _ -> ValueNone) + +[] +let (|StringExpr|_|) expr = + match expr with + | Expr.Const (Const.String n, _, _) -> ValueSome n + | _ -> ValueNone -let (|StringExpr|_|) = function Expr.Const (Const.String n, _, _) -> Some n | _ -> None -let (|AttribInt32Arg|_|) = function AttribExpr(_, Expr.Const (Const.Int32 n, _, _)) -> Some n | _ -> None -let (|AttribInt16Arg|_|) = function AttribExpr(_, Expr.Const (Const.Int16 n, _, _)) -> Some n | _ -> None -let (|AttribBoolArg|_|) = function AttribExpr(_, Expr.Const (Const.Bool n, _, _)) -> Some n | _ -> None -let (|AttribStringArg|_|) = function AttribExpr(_, Expr.Const (Const.String n, _, _)) -> Some n | _ -> None +[] +let (|AttribInt32Arg|_|) expr = + match expr with + | AttribExpr (_, Expr.Const (Const.Int32 n, _, _)) -> ValueSome n + | _ -> ValueNone + +[] +let (|AttribInt16Arg|_|) expr = + match expr with + | AttribExpr (_, Expr.Const (Const.Int16 n, _, _)) -> ValueSome n + | _ -> ValueNone + +[] +let (|AttribBoolArg|_|) expr = + match expr with + | AttribExpr (_, Expr.Const (Const.Bool n, _, _)) -> ValueSome n + | _ -> ValueNone + +[] +let (|AttribStringArg|_|) expr = + match expr with + | AttribExpr(_, Expr.Const (Const.String n, _, _)) -> ValueSome n + | _ -> ValueNone let TryFindFSharpBoolAttributeWithDefault dflt g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some dflt - | Some(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> Some b + | ValueSome(Attrib(_, _, [ ], _, _, _, _)) -> Some dflt + | ValueSome(Attrib(_, _, [ AttribBoolArg b ], _, _, _, _)) -> Some b | _ -> None let TryFindFSharpBoolAttribute g nm attrs = TryFindFSharpBoolAttributeWithDefault true g nm attrs @@ -3445,12 +3470,12 @@ let TryFindFSharpBoolAttributeAssumeFalse g nm attrs = TryFindFSharpBoolAttribut let TryFindFSharpInt32Attribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribInt32Arg b ], _, _, _, _)) -> Some b + | ValueSome(Attrib(_, _, [ AttribInt32Arg b ], _, _, _, _)) -> Some b | _ -> None let TryFindFSharpStringAttribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> Some b + | ValueSome(Attrib(_, _, [ AttribStringArg b ], _, _, _, _)) -> Some b | _ -> None let TryFindILAttribute (AttribInfo (atref, _)) attrs = @@ -3477,11 +3502,11 @@ let TryBindTyconRefAttribute g (m: range) (AttribInfo (atref, _) as args) (tcref #endif | ILTypeMetadata (TILObjectReprData(_, _, tdef)) -> match TryDecodeILAttribute atref tdef.CustomAttrs with - | Some attr -> f1 attr + | ValueSome attr -> f1 attr | _ -> None | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> match TryFindFSharpAttribute g args tcref.Attribs with - | Some attr -> f2 attr + | ValueSome attr -> f2 attr | _ -> None let TryFindTyconRefBoolAttribute g m attribSpec tcref = @@ -3751,21 +3776,25 @@ type ValRef with | Some membInfo -> membInfo.MemberFlags.IsDispatchSlot | None -> false +[] let (|UnopExpr|_|) _g expr = match expr with - | Expr.App (Expr.Val (vref, _, _), _, _, [arg1], _) -> Some (vref, arg1) - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, _, [arg1], _) -> ValueSome (vref, arg1) + | _ -> ValueNone +[] let (|BinopExpr|_|) _g expr = match expr with - | Expr.App (Expr.Val (vref, _, _), _, _, [arg1;arg2], _) -> Some (vref, arg1, arg2) - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, _, [arg1;arg2], _) -> ValueSome (vref, arg1, arg2) + | _ -> ValueNone +[] let (|SpecificUnopExpr|_|) g vrefReqd expr = match expr with - | UnopExpr g (vref, arg1) when valRefEq g vref vrefReqd -> Some arg1 - | _ -> None + | UnopExpr g (vref, arg1) when valRefEq g vref vrefReqd -> ValueSome arg1 + | _ -> ValueNone +[] let (|SignedConstExpr|_|) expr = match expr with | Expr.Const (Const.Int32 _, _, _) @@ -3773,9 +3802,10 @@ let (|SignedConstExpr|_|) expr = | Expr.Const (Const.Int16 _, _, _) | Expr.Const (Const.Int64 _, _, _) | Expr.Const (Const.Single _, _, _) - | Expr.Const (Const.Double _, _, _) -> Some () - | _ -> None + | Expr.Const (Const.Double _, _, _) -> ValueSome () + | _ -> ValueNone +[] let (|IntegerConstExpr|_|) expr = match expr with | Expr.Const (Const.Int32 _, _, _) @@ -3785,37 +3815,42 @@ let (|IntegerConstExpr|_|) expr = | Expr.Const (Const.Byte _, _, _) | Expr.Const (Const.UInt16 _, _, _) | Expr.Const (Const.UInt32 _, _, _) - | Expr.Const (Const.UInt64 _, _, _) -> Some () - | _ -> None + | Expr.Const (Const.UInt64 _, _, _) -> ValueSome () + | _ -> ValueNone +[] let (|FloatConstExpr|_|) expr = match expr with | Expr.Const (Const.Single _, _, _) - | Expr.Const (Const.Double _, _, _) -> Some () - | _ -> None + | Expr.Const (Const.Double _, _, _) -> ValueSome () + | _ -> ValueNone +[] let (|SpecificBinopExpr|_|) g vrefReqd expr = match expr with - | BinopExpr g (vref, arg1, arg2) when valRefEq g vref vrefReqd -> Some (arg1, arg2) - | _ -> None + | BinopExpr g (vref, arg1, arg2) when valRefEq g vref vrefReqd -> ValueSome (arg1, arg2) + | _ -> ValueNone +[] let (|EnumExpr|_|) g expr = match (|SpecificUnopExpr|_|) g g.enum_vref expr with - | None -> (|SpecificUnopExpr|_|) g g.enumOfValue_vref expr + | ValueNone -> (|SpecificUnopExpr|_|) g g.enumOfValue_vref expr | x -> x +[] let (|BitwiseOrExpr|_|) g expr = (|SpecificBinopExpr|_|) g g.bitwise_or_vref expr +[] let (|AttribBitwiseOrExpr|_|) g expr = match expr with - | BitwiseOrExpr g (arg1, arg2) -> Some(arg1, arg2) + | BitwiseOrExpr g (arg1, arg2) -> ValueSome(arg1, arg2) // Special workaround, only used when compiling FSharp.Core.dll. Uses of 'a ||| b' occur before the '|||' bitwise or operator // is defined. These get through type checking because enums implicitly support the '|||' operator through // the automatic resolution of undefined operators (see tc.fs, Item.ImplicitOp). This then compiles as an // application of a lambda to two arguments. We recognize this pattern here | Expr.App (Expr.Lambda _, _, _, [arg1;arg2], _) when g.compilingFSharpCore -> - Some(arg1, arg2) - | _ -> None + ValueSome(arg1, arg2) + | _ -> ValueNone let isUncheckedDefaultOfValRef g vref = valRefEq g vref g.unchecked_defaultof_vref @@ -3842,35 +3877,41 @@ let isTypeDefOfValRef g vref = // There is an internal version of typedefof defined in prim-types.fs that needs to be detected || (g.compilingFSharpCore && vref.LogicalName = "typedefof") +[] let (|UncheckedDefaultOfExpr|_|) g expr = match expr with - | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> Some ty - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> ValueSome ty + | _ -> ValueNone +[] let (|TypeOfExpr|_|) g expr = match expr with - | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> Some ty - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> ValueSome ty + | _ -> ValueNone +[] let (|SizeOfExpr|_|) g expr = match expr with - | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> Some ty - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> ValueSome ty + | _ -> ValueNone +[] let (|TypeDefOfExpr|_|) g expr = match expr with - | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty - | _ -> None + | Expr.App (Expr.Val (vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> ValueSome ty + | _ -> ValueNone +[] let (|NameOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isNameOfValRef g vref -> Some ty - | _ -> None + | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isNameOfValRef g vref -> ValueSome ty + | _ -> ValueNone +[] let (|SeqExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,_,_,_) when valRefEq g vref g.seq_vref -> Some() - | _ -> None + | Expr.App(Expr.Val(vref,_,_),_,_,_,_) when valRefEq g vref g.seq_vref -> ValueSome() + | _ -> ValueNone //-------------------------------------------------------------------------- // DEBUG layout @@ -7762,18 +7803,18 @@ let tryMkCallBuiltInWitness (g: TcGlobals) traitInfo argExprs m = match vref.TryDeref with | ValueSome v -> let f = exprForValRef m vref - mkApps g ((f, v.Type), [tinst], argExprs, m) |> Some + mkApps g ((f, v.Type), [tinst], argExprs, m) |> ValueSome | ValueNone -> - None + ValueNone let tryMkCallCoreFunctionAsBuiltInWitness (g: TcGlobals) info tyargs argExprs m = let vref = ValRefForIntrinsic info match vref.TryDeref with | ValueSome v -> let f = exprForValRef m vref - mkApps g ((f, v.Type), [tyargs], argExprs, m) |> Some + mkApps g ((f, v.Type), [tyargs], argExprs, m) |> ValueSome | ValueNone -> - None + ValueNone let TryEliminateDesugaredConstants g m c = match c with @@ -8207,39 +8248,44 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, arg let MakeApplicationAndBetaReduce g (f, fty, tyargsl, argl, m) = MakeApplicationAndBetaReduceAux g (f, fty, tyargsl, argl, m) +[] let (|NewDelegateExpr|_|) g expr = match expr with | Expr.Obj (lambdaId, ty, a, b, [TObjExprMethod(c, d, e, tmvs, body, f)], [], m) when isDelegateTy g ty -> - Some (lambdaId, List.concat tmvs, body, m, (fun bodyR -> Expr.Obj (lambdaId, ty, a, b, [TObjExprMethod(c, d, e, tmvs, bodyR, f)], [], m))) - | _ -> None + ValueSome (lambdaId, List.concat tmvs, body, m, (fun bodyR -> Expr.Obj (lambdaId, ty, a, b, [TObjExprMethod(c, d, e, tmvs, bodyR, f)], [], m))) + | _ -> ValueNone +[] let (|DelegateInvokeExpr|_|) g expr = match expr with | Expr.App ((Expr.Val (invokeRef, _, _)) as delInvokeRef, delInvokeTy, [], [delExpr;delInvokeArg], m) when invokeRef.LogicalName = "Invoke" && isFSharpDelegateTy g (tyOfExpr g delExpr) -> - Some(delInvokeRef, delInvokeTy, delExpr, delInvokeArg, m) - | _ -> None + ValueSome(delInvokeRef, delInvokeTy, delExpr, delInvokeArg, m) + | _ -> ValueNone +[] let (|OpPipeRight|_|) g expr = match expr with | Expr.App (Expr.Val (vref, _, _), _, [_; resType], [xExpr; fExpr], m) when valRefEq g vref g.piperight_vref -> - Some(resType, xExpr, fExpr, m) - | _ -> None + ValueSome(resType, xExpr, fExpr, m) + | _ -> ValueNone +[] let (|OpPipeRight2|_|) g expr = match expr with | Expr.App (Expr.Val (vref, _, _), _, [_; _; resType], [Expr.Op (TOp.Tuple _, _, [arg1; arg2], _); fExpr], m) when valRefEq g vref g.piperight2_vref -> - Some(resType, arg1, arg2, fExpr, m) - | _ -> None + ValueSome(resType, arg1, arg2, fExpr, m) + | _ -> ValueNone +[] let (|OpPipeRight3|_|) g expr = match expr with | Expr.App (Expr.Val (vref, _, _), _, [_; _; _; resType], [Expr.Op (TOp.Tuple _, _, [arg1; arg2; arg3], _); fExpr], m) when valRefEq g vref g.piperight3_vref -> - Some(resType, arg1, arg2, arg3, fExpr, m) - | _ -> None + ValueSome(resType, arg1, arg2, arg3, fExpr, m) + | _ -> ValueNone let rec MakeFSharpDelegateInvokeAndTryBetaReduce g (delInvokeRef, delExpr, delInvokeTy, delInvokeArg, m) = match delExpr with @@ -8977,30 +9023,33 @@ let rec TypeHasDefaultValue g m ty = /// Determines types that are potentially known to satisfy the 'comparable' constraint and returns /// a set of residual types that must also satisfy the constraint -let (|SpecialComparableHeadType|_|) g ty = - if isAnyTupleTy g ty then +[] +let (|SpecialComparableHeadType|_|) g ty = + if isAnyTupleTy g ty then let _tupInfo, elemTys = destAnyTupleTy g ty - Some elemTys - elif isAnonRecdTy g ty then + ValueSome elemTys + elif isAnonRecdTy g ty then match tryDestAnonRecdTy g ty with - | ValueNone -> Some [] - | ValueSome (_anonInfo, elemTys) -> Some elemTys + | ValueNone -> ValueSome [] + | ValueSome (_anonInfo, elemTys) -> ValueSome elemTys else match tryAppTy g ty with | ValueSome (tcref, tinst) -> if isArrayTyconRef g tcref || tyconRefEq g tcref g.system_UIntPtr_tcref || tyconRefEq g tcref g.system_IntPtr_tcref then - Some tinst - else - None + ValueSome tinst + else + ValueNone | _ -> - None + ValueNone +[] let (|SpecialEquatableHeadType|_|) g ty = (|SpecialComparableHeadType|_|) g ty +[] let (|SpecialNotEquatableHeadType|_|) g ty = - if isFunTy g ty then Some() else None + if isFunTy g ty then ValueSome() else ValueNone // Can we use the fast helper for the 'LanguagePrimitives.IntrinsicFunctions.TypeTestGeneric'? let canUseTypeTestFast g ty = @@ -9898,23 +9947,24 @@ and EvaledAttribExprEquality g e1 e2 = | TypeDefOfExpr g ty1, TypeDefOfExpr g ty2 -> typeEquiv g ty1 ty2 | _ -> false +[] let (|ConstToILFieldInit|_|) c = match c with - | Const.SByte n -> Some (ILFieldInit.Int8 n) - | Const.Int16 n -> Some (ILFieldInit.Int16 n) - | Const.Int32 n -> Some (ILFieldInit.Int32 n) - | Const.Int64 n -> Some (ILFieldInit.Int64 n) - | Const.Byte n -> Some (ILFieldInit.UInt8 n) - | Const.UInt16 n -> Some (ILFieldInit.UInt16 n) - | Const.UInt32 n -> Some (ILFieldInit.UInt32 n) - | Const.UInt64 n -> Some (ILFieldInit.UInt64 n) - | Const.Bool n -> Some (ILFieldInit.Bool n) - | Const.Char n -> Some (ILFieldInit.Char (uint16 n)) - | Const.Single n -> Some (ILFieldInit.Single n) - | Const.Double n -> Some (ILFieldInit.Double n) - | Const.String s -> Some (ILFieldInit.String s) - | Const.Zero -> Some ILFieldInit.Null - | _ -> None + | Const.SByte n -> ValueSome (ILFieldInit.Int8 n) + | Const.Int16 n -> ValueSome (ILFieldInit.Int16 n) + | Const.Int32 n -> ValueSome (ILFieldInit.Int32 n) + | Const.Int64 n -> ValueSome (ILFieldInit.Int64 n) + | Const.Byte n -> ValueSome (ILFieldInit.UInt8 n) + | Const.UInt16 n -> ValueSome (ILFieldInit.UInt16 n) + | Const.UInt32 n -> ValueSome (ILFieldInit.UInt32 n) + | Const.UInt64 n -> ValueSome (ILFieldInit.UInt64 n) + | Const.Bool n -> ValueSome (ILFieldInit.Bool n) + | Const.Char n -> ValueSome (ILFieldInit.Char (uint16 n)) + | Const.Single n -> ValueSome (ILFieldInit.Single n) + | Const.Double n -> ValueSome (ILFieldInit.Double n) + | Const.String s -> ValueSome (ILFieldInit.String s) + | Const.Zero -> ValueSome ILFieldInit.Null + | _ -> ValueNone let EvalLiteralExprOrAttribArg g x = match x with @@ -9995,60 +10045,66 @@ let mkGetTupleItemN g m n (ty: ILType) isStruct expr retTy = mkAsmExpr ([mkNormalCall(mkILMethodSpecForTupleItem g ty n)], [], [expr], [retTy], m) /// Match an Int32 constant expression -let (|Int32Expr|_|) expr = - match expr with - | Expr.Const (Const.Int32 n, _, _) -> Some n - | _ -> None +[] +let (|Int32Expr|_|) expr = + match expr with + | Expr.Const (Const.Int32 n, _, _) -> ValueSome n + | _ -> ValueNone /// Match a try-finally expression +[] let (|TryFinally|_|) expr = match expr with - | Expr.Op (TOp.TryFinally _, [_resTy], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], _) -> Some(e1, e2) - | _ -> None + | Expr.Op (TOp.TryFinally _, [_resTy], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], _) -> ValueSome(e1, e2) + | _ -> ValueNone // detect ONLY the while loops that result from compiling 'for ... in ... do ...' +[] let (|WhileLoopForCompiledForEachExpr|_|) expr = match expr with | Expr.Op (TOp.While (spInWhile, WhileLoopForCompiledForEachExprMarker), _, [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], m) -> - Some(spInWhile, e1, e2, m) - | _ -> None - -let (|Let|_|) expr = - match expr with - | Expr.Let (TBind(v, e1, sp), e2, _, _) -> Some(v, e1, sp, e2) - | _ -> None + ValueSome(spInWhile, e1, e2, m) + | _ -> ValueNone -let (|RangeInt32Step|_|) g expr = - match expr with - // detect 'n .. m' +[] +let (|Let|_|) expr = + match expr with + | Expr.Let (TBind(v, e1, sp), e2, _, _) -> ValueSome(v, e1, sp, e2) + | _ -> ValueNone + +[] +let (|RangeInt32Step|_|) g expr = + match expr with + // detect 'n .. m' | Expr.App (Expr.Val (vf, _, _), _, [tyarg], [startExpr;finishExpr], _) - when valRefEq g vf g.range_op_vref && typeEquiv g tyarg g.int_ty -> Some(startExpr, 1, finishExpr) - + when valRefEq g vf g.range_op_vref && typeEquiv g tyarg g.int_ty -> ValueSome(startExpr, 1, finishExpr) // detect (RangeInt32 startExpr N finishExpr), the inlined/compiled form of 'n .. m' and 'n .. N .. m' | Expr.App (Expr.Val (vf, _, _), _, [], [startExpr; Int32Expr n; finishExpr], _) - when valRefEq g vf g.range_int32_op_vref -> Some(startExpr, n, finishExpr) + when valRefEq g vf g.range_int32_op_vref -> ValueSome(startExpr, n, finishExpr) - | _ -> None + | _ -> ValueNone -let (|GetEnumeratorCall|_|) expr = - match expr with +[] +let (|GetEnumeratorCall|_|) expr = + match expr with | Expr.Op (TOp.ILCall ( _, _, _, _, _, _, _, ilMethodRef, _, _, _), _, [Expr.Val (vref, _, _) | Expr.Op (_, _, [Expr.Val (vref, ValUseFlag.NormalValUse, _)], _) ], _) -> - if ilMethodRef.Name = "GetEnumerator" then Some vref - else None - | _ -> None + if ilMethodRef.Name = "GetEnumerator" then ValueSome vref + else ValueNone + | _ -> ValueNone // This code matches exactly the output of TcForEachExpr -let (|CompiledForEachExpr|_|) g expr = +[] +let (|CompiledForEachExpr|_|) g expr = match expr with - | Let (enumerableVar, enumerableExpr, spFor, - Let (enumeratorVar, GetEnumeratorCall enumerableVar2, _enumeratorBind, - TryFinally (WhileLoopForCompiledForEachExpr (spInWhile, _, (Let (elemVar, _, _, bodyExpr) as elemLet), _), _))) + | Let (enumerableVar, enumerableExpr, spFor, + Let (enumeratorVar, GetEnumeratorCall enumerableVar2, _enumeratorBind, + TryFinally (WhileLoopForCompiledForEachExpr (spInWhile, _, (Let (elemVar, _, _, bodyExpr) as elemLet), _), _))) // Apply correctness conditions to ensure this really is a compiled for-each expression. when valRefEq g (mkLocalValRef enumerableVar) enumerableVar2 && enumerableVar.IsCompilerGenerated && enumeratorVar.IsCompilerGenerated && (let fvs = (freeInExpr CollectLocals bodyExpr) - not (Zset.contains enumerableVar fvs.FreeLocals) && + not (Zset.contains enumerableVar fvs.FreeLocals) && not (Zset.contains enumeratorVar fvs.FreeLocals)) -> // Extract useful ranges @@ -10061,18 +10117,19 @@ let (|CompiledForEachExpr|_|) g expr = let spInWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No let enumerableTy = tyOfExpr g enumerableExpr - Some (enumerableTy, enumerableExpr, elemVar, bodyExpr, (mBody, spFor, spIn, mFor, mIn, spInWhile, mWholeExpr)) - | _ -> None - + ValueSome (enumerableTy, enumerableExpr, elemVar, bodyExpr, (mBody, spFor, spIn, mFor, mIn, spInWhile, mWholeExpr)) + | _ -> ValueNone -let (|CompiledInt32RangeForEachExpr|_|) g expr = + +[] +let (|CompiledInt32RangeForEachExpr|_|) g expr = match expr with | CompiledForEachExpr g (_, RangeInt32Step g (startExpr, step, finishExpr), elemVar, bodyExpr, ranges) -> - Some (startExpr, step, finishExpr, elemVar, bodyExpr, ranges) - | _ -> None + ValueSome (startExpr, step, finishExpr, elemVar, bodyExpr, ranges) + | _ -> ValueNone -let mkDebugPoint m expr = +let mkDebugPoint m expr = Expr.DebugPoint(DebugPointAtLeafExpr.Yes m, expr) type OptimizeForExpressionOptions = @@ -10180,11 +10237,11 @@ let mkUnitDelayLambda (g: TcGlobals) m e = let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty mkLambda m uv (e, tyOfExpr g e) - +[] let (|ValApp|_|) g vref expr = match expr with - | Expr.App (Expr.Val (vref2, _, _), _f0ty, tyargs, args, m) when valRefEq g vref vref2 -> Some (tyargs, args, m) - | _ -> None + | Expr.App (Expr.Val (vref2, _, _), _f0ty, tyargs, args, m) when valRefEq g vref vref2 -> ValueSome (tyargs, args, m) + | _ -> ValueNone let (|UseResumableStateMachinesExpr|_|) g expr = match expr with @@ -10192,18 +10249,20 @@ let (|UseResumableStateMachinesExpr|_|) g expr = | _ -> None /// Match an if...then...else expression or the result of "a && b" or "a || b" +[] let (|IfThenElseExpr|_|) expr = match expr with | Expr.Match (_spBind, _exprm, TDSwitch(cond, [ TCase( DecisionTreeTest.Const (Const.Bool true), TDSuccess ([], 0) )], Some (TDSuccess ([], 1)), _), - [| TTarget([], thenExpr, _); TTarget([], elseExpr, _) |], _m, _ty) -> - Some (cond, thenExpr, elseExpr) - | _ -> None + [| TTarget([], thenExpr, _); TTarget([], elseExpr, _) |], _m, _ty) -> + ValueSome (cond, thenExpr, elseExpr) + | _ -> ValueNone /// if __useResumableCode then ... else ... +[] let (|IfUseResumableStateMachinesExpr|_|) g expr = match expr with - | IfThenElseExpr(UseResumableStateMachinesExpr g (), thenExpr, elseExpr) -> Some (thenExpr, elseExpr) - | _ -> None + | IfThenElseExpr(UseResumableStateMachinesExpr g (), thenExpr, elseExpr) -> ValueSome (thenExpr, elseExpr) + | _ -> ValueNone /// Combine a list of ModuleOrNamespaceType's making up the description of a CCU. checking there are now /// duplicate modules etc. @@ -10279,30 +10338,35 @@ let EmptyTraitWitnessInfoHashMap g : TraitWitnessInfoHashMap<'T> = member _.GetHashCode(a) = hash a.MemberName }) +[] let (|WhileExpr|_|) expr = match expr with | Expr.Op (TOp.While (sp1, sp2), _, [Expr.Lambda (_, _, _, [_gv], guardExpr, _, _);Expr.Lambda (_, _, _, [_bv], bodyExpr, _, _)], m) -> - Some (sp1, sp2, guardExpr, bodyExpr, m) - | _ -> None + ValueSome (sp1, sp2, guardExpr, bodyExpr, m) + | _ -> ValueNone +[] let (|TryFinallyExpr|_|) expr = match expr with | Expr.Op (TOp.TryFinally (sp1, sp2), [ty], [Expr.Lambda (_, _, _, [_], e1, _, _); Expr.Lambda (_, _, _, [_], e2, _, _)], m) -> - Some (sp1, sp2, ty, e1, e2, m) - | _ -> None + ValueSome (sp1, sp2, ty, e1, e2, m) + | _ -> ValueNone +[] let (|IntegerForLoopExpr|_|) expr = match expr with | Expr.Op (TOp.IntegerForLoop (sp1, sp2, style), _, [Expr.Lambda (_, _, _, [_], e1, _, _);Expr.Lambda (_, _, _, [_], e2, _, _);Expr.Lambda (_, _, _, [v], e3, _, _)], m) -> - Some (sp1, sp2, style, e1, e2, v, e3, m) - | _ -> None + ValueSome (sp1, sp2, style, e1, e2, v, e3, m) + | _ -> ValueNone +[] let (|TryWithExpr|_|) expr = match expr with | Expr.Op (TOp.TryWith (spTry, spWith), [resTy], [Expr.Lambda (_, _, _, [_], bodyExpr, _, _); Expr.Lambda (_, _, _, [filterVar], filterExpr, _, _); Expr.Lambda (_, _, _, [handlerVar], handlerExpr, _, _)], m) -> - Some (spTry, spWith, resTy, bodyExpr, filterVar, filterExpr, handlerVar, handlerExpr, m) - | _ -> None + ValueSome (spTry, spWith, resTy, bodyExpr, filterVar, filterExpr, handlerVar, handlerExpr, m) + | _ -> ValueNone +[] let (|MatchTwoCasesExpr|_|) expr = match expr with | Expr.Match (spBind, mExpr, TDSwitch(cond, [ TCase( DecisionTreeTest.UnionCase (ucref, a), TDSuccess ([], tg1) )], Some (TDSuccess ([], tg2)), b), tgs, m, ty) -> @@ -10311,11 +10375,12 @@ let (|MatchTwoCasesExpr|_|) expr = let rebuild (cond, ucref, tg1, tg2, tgs) = Expr.Match (spBind, mExpr, TDSwitch(cond, [ TCase( DecisionTreeTest.UnionCase (ucref, a), TDSuccess ([], tg1) )], Some (TDSuccess ([], tg2)), b), tgs, m, ty) - Some (cond, ucref, tg1, tg2, tgs, rebuild) + ValueSome (cond, ucref, tg1, tg2, tgs, rebuild) - | _ -> None + | _ -> ValueNone /// match e with None -> ... | Some v -> ... or other variations of the same +[] let (|MatchOptionExpr|_|) expr = match expr with | MatchTwoCasesExpr(cond, ucref, tg1, tg2, tgs, rebuildTwoCases) -> @@ -10334,34 +10399,28 @@ let (|MatchOptionExpr|_|) expr = Expr.Let(TBind(someVar, Expr.Op(TOp.UnionCaseFieldGet (a6a, a6b), a7, a8, a9), a10), someBranchExpr, a11, a12), a13, a14), a16) rebuildTwoCases (cond, ucref, tg1, tg2, tgs) - Some (cond, noneBranchExpr, someVar, someBranchExpr, rebuild) - | _ -> None - | _ -> None - -let (|ResumableEntryAppExpr|_|) g expr = - match expr with - | ValApp g g.cgh__resumableEntry_vref (_, _, _m) -> Some () - | _ -> None + ValueSome (cond, noneBranchExpr, someVar, someBranchExpr, rebuild) + | _ -> ValueNone + | _ -> ValueNone /// Match an (unoptimized) __resumableEntry expression +[] let (|ResumableEntryMatchExpr|_|) g expr = match expr with | Expr.Let(TBind(matchVar, matchExpr, sp1), MatchOptionExpr (Expr.Val(matchVar2, b, c), noneBranchExpr, someVar, someBranchExpr, rebuildMatch), d, e) -> match matchExpr with - | ResumableEntryAppExpr g () -> - if valRefEq g (mkLocalValRef matchVar) matchVar2 then + | ValApp g g.cgh__resumableEntry_vref (_, _, _) + when valRefEq g (mkLocalValRef matchVar) matchVar2 -> // How to rebuild this construct let rebuild (noneBranchExpr, someBranchExpr) = Expr.Let(TBind(matchVar, matchExpr, sp1), rebuildMatch (Expr.Val(matchVar2, b, c), noneBranchExpr, someVar, someBranchExpr), d, e) - Some (noneBranchExpr, someVar, someBranchExpr, rebuild) - - else None - - | _ -> None - | _ -> None + ValueSome (noneBranchExpr, someVar, someBranchExpr, rebuild) + | _ -> ValueNone + | _ -> ValueNone +[] let (|StructStateMachineExpr|_|) g expr = match expr with | ValApp g g.cgh__stateMachine_vref ([dataTy; _resultTy], [moveNext; setStateMachine; afterCode], _m) -> @@ -10369,37 +10428,40 @@ let (|StructStateMachineExpr|_|) g expr = | NewDelegateExpr g (_, [moveNextThisVar], moveNextBody, _, _), NewDelegateExpr g (_, [setStateMachineThisVar;setStateMachineStateVar], setStateMachineBody, _, _), NewDelegateExpr g (_, [afterCodeThisVar], afterCodeBody, _, _) -> - Some (dataTy, + ValueSome (dataTy, (moveNextThisVar, moveNextBody), (setStateMachineThisVar, setStateMachineStateVar, setStateMachineBody), (afterCodeThisVar, afterCodeBody)) - | _ -> None - | _ -> None + | _ -> ValueNone + | _ -> ValueNone +[] let (|ResumeAtExpr|_|) g expr = match expr with - | ValApp g g.cgh__resumeAt_vref (_, [pcExpr], _m) -> Some pcExpr - | _ -> None + | ValApp g g.cgh__resumeAt_vref (_, [pcExpr], _m) -> ValueSome pcExpr + | _ -> ValueNone // Detect __debugPoint calls +[] let (|DebugPointExpr|_|) g expr = match expr with - | ValApp g g.cgh__debugPoint_vref (_, [StringExpr debugPointName], _m) -> Some debugPointName - | _ -> None + | ValApp g g.cgh__debugPoint_vref (_, [StringExpr debugPointName], _m) -> ValueSome debugPointName + | _ -> ValueNone // Detect sequencing constructs in state machine code +[] let (|SequentialResumableCode|_|) (g: TcGlobals) expr = match expr with // e1; e2 | Expr.Sequential(e1, e2, NormalSeq, m) -> - Some (e1, e2, m, (fun e1 e2 -> Expr.Sequential(e1, e2, NormalSeq, m))) + ValueSome (e1, e2, m, (fun e1 e2 -> Expr.Sequential(e1, e2, NormalSeq, m))) // let __stack_step = e1 in e2 | Expr.Let(bind, e2, m, _) when bind.Var.CompiledName(g.CompilerGlobalState).StartsWith(stackVarPrefix) -> - Some (bind.Expr, e2, m, (fun e1 e2 -> mkLet bind.DebugPoint m bind.Var e1 e2)) + ValueSome (bind.Expr, e2, m, (fun e1 e2 -> mkLet bind.DebugPoint m bind.Var e1 e2)) - | _ -> None + | _ -> ValueNone let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e @@ -10409,13 +10471,14 @@ let rec isReturnsResumableCodeTy g ty = if isFunTy g ty then isReturnsResumableCodeTy g (rangeOfFunTy g ty) else isResumableCodeTy g ty +[] let (|ResumableCodeInvoke|_|) g expr = match expr with // defn.Invoke x --> let arg = x in [defn][arg/x] | Expr.App ((Expr.Val (invokeRef, _, _) as iref), a, b, (f :: args), m) when invokeRef.LogicalName = "Invoke" && isReturnsResumableCodeTy g (tyOfExpr g f) -> - Some (iref, f, args, m, (fun (f2, args2) -> Expr.App ((iref, a, b, (f2 :: args2), m)))) - | _ -> None + ValueSome (iref, f, args, m, (fun (f2, args2) -> Expr.App ((iref, a, b, (f2 :: args2), m)))) + | _ -> ValueNone let ComputeUseMethodImpl g (v: Val) = v.ImplementedSlotSigs |> List.exists (fun slotsig -> @@ -10445,27 +10508,31 @@ let ComputeUseMethodImpl g (v: Val) = not isStructural)) +[] let (|Seq|_|) g expr = match expr with // use 'seq { ... }' as an indicator - | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) - | _ -> None + | ValApp g g.seq_vref ([elemTy], [e], _m) -> ValueSome (e, elemTy) + | _ -> ValueNone /// Detect a 'yield x' within a 'seq { ... }' +[] let (|SeqYield|_|) g expr = match expr with - | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) - | _ -> None + | ValApp g g.seq_singleton_vref (_, [arg], m) -> ValueSome (arg, m) + | _ -> ValueNone /// Detect a 'expr; expr' within a 'seq { ... }' +[] let (|SeqAppend|_|) g expr = match expr with - | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) - | _ -> None + | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> ValueSome (arg1, arg2, m) + | _ -> ValueNone let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals /// Detect a 'while gd do expr' within a 'seq { ... }' +[] let (|SeqWhile|_|) g expr = match expr with | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) @@ -10474,11 +10541,12 @@ let (|SeqWhile|_|) g expr = // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression let mWhile = innerExpr.Range let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No - Some (guardExpr, innerExpr, spWhile, m) + ValueSome (guardExpr, innerExpr, spWhile, m) | _ -> - None + ValueNone +[] let (|SeqTryFinally|_|) g expr = match expr with | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) @@ -10491,53 +10559,58 @@ let (|SeqTryFinally|_|) g expr = let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No - Some (arg1, compensation, spTry, spFinally, m) + ValueSome (arg1, compensation, spTry, spFinally, m) | _ -> - None + ValueNone +[] let (|SeqUsing|_|) g expr = match expr with | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> // The debug point mFor at the 'use x = ... ' gets attached to the lambda let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible - Some (resource, v, body, elemTy, spBind, m) + ValueSome (resource, v, body, elemTy, spBind, m) | _ -> - None + ValueNone +[] let (|SeqForEach|_|) g expr = match expr with // Nested for loops are represented by calls to Seq.collect | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - Some (inp, v, body, genElemTy, mFor, mIn, spIn) + ValueSome (inp, v, body, genElemTy, mFor, mIn, spIn) // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression - Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) + ValueSome (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) - | _ -> None + | _ -> ValueNone +[] let (|SeqDelay|_|) g expr = match expr with - | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) - when not (isVarFreeInExpr v e) -> - Some (e, elemTy) - | _ -> None + | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) + when not (isVarFreeInExpr v e) -> + ValueSome (e, elemTy) + | _ -> ValueNone +[] let (|SeqEmpty|_|) g expr = match expr with - | ValApp g g.seq_empty_vref (_, [], m) -> Some m - | _ -> None + | ValApp g g.seq_empty_vref (_, [], m) -> ValueSome m + | _ -> ValueNone let isFSharpExceptionTy g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> tcref.IsFSharpException | _ -> false +[] let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceContents) = match moduleOrNamespaceContents with | TMDefs(defs = defs) -> @@ -10566,10 +10639,10 @@ let (|EmptyModuleOrNamespaces|_|) (moduleOrNamespaceContents: ModuleOrNamespaceC | _ -> None) if mdDefsLength = emptyModuleOrNamespaces.Length then - Some emptyModuleOrNamespaces + ValueSome emptyModuleOrNamespaces else - None - | _ -> None + ValueNone + | _ -> ValueNone let tryAddExtensionAttributeIfNotAlreadyPresent (tryFindExtensionAttributeIn: (Attrib list -> Attrib option) -> Attrib option) diff --git a/src/Compiler/TypedTree/TypedTreeOps.fsi b/src/Compiler/TypedTree/TypedTreeOps.fsi index 7cc531b71c7..379451878a1 100755 --- a/src/Compiler/TypedTree/TypedTreeOps.fsi +++ b/src/Compiler/TypedTree/TypedTreeOps.fsi @@ -32,7 +32,7 @@ val typeEquiv: TcGlobals -> TType -> TType -> bool val measureEquiv: TcGlobals -> Measure -> Measure -> bool /// Get the unit of measure for an annotated type -val getMeasureOfType: TcGlobals -> TType -> (TyconRef * Measure) option +val getMeasureOfType: TcGlobals -> TType -> (TyconRef * Measure) voption /// Reduce a type to its more canonical form subject to an erasure flag, inference equations and abbreviations val stripTyEqnsWrtErasure: Erasure -> TcGlobals -> TType -> TType @@ -94,7 +94,7 @@ type MatchBuilder = member Close: DecisionTree * range * TType -> Expr /// Add an if-then-else boolean conditional node into a decision tree -val mkBoolSwitch: range -> Expr -> DecisionTree -> DecisionTree -> DecisionTree +val inline mkBoolSwitch: range -> Expr -> DecisionTree -> DecisionTree -> DecisionTree /// Build a conditional expression val primMkCond: DebugPointAtBinding -> range -> TType -> Expr -> Expr -> Expr -> Expr @@ -110,10 +110,10 @@ val mkIfThen: TcGlobals -> range -> Expr -> Expr -> Expr /// Build an expression corresponding to the use of a value /// Note: try to use exprForValRef or the expression returned from mkLocal instead of this. -val exprForVal: range -> Val -> Expr +val inline exprForVal: range -> Val -> Expr /// Build an expression corresponding to the use of a reference to a value -val exprForValRef: range -> ValRef -> Expr +val inline exprForValRef: range -> ValRef -> Expr /// Make a new local value and build an expression to reference it val mkLocal: range -> string -> TType -> Val * Expr @@ -2210,11 +2210,11 @@ val mkStaticCall_String_Concat4: TcGlobals -> range -> Expr -> Expr -> Expr -> E val mkStaticCall_String_Concat_Array: TcGlobals -> range -> Expr -> Expr /// Use a witness in BuiltInWitnesses -val tryMkCallBuiltInWitness: TcGlobals -> TraitConstraintInfo -> Expr list -> range -> Expr option +val tryMkCallBuiltInWitness: TcGlobals -> TraitConstraintInfo -> Expr list -> range -> Expr voption /// Use an operator as a witness val tryMkCallCoreFunctionAsBuiltInWitness: - TcGlobals -> IntrinsicValRef -> TType list -> Expr list -> range -> Expr option + TcGlobals -> IntrinsicValRef -> TType list -> Expr list -> range -> Expr voption //------------------------------------------------------------------------- // operations primarily associated with the optimization to fix @@ -2233,7 +2233,7 @@ val mkLdelem: TcGlobals -> range -> TType -> Expr -> Expr -> Expr // Analyze attribute sets //------------------------------------------------------------------------- -val TryDecodeILAttribute: ILTypeRef -> ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) option +val TryDecodeILAttribute: ILTypeRef -> ILAttributes -> (ILAttribElem list * ILAttributeNamedArg list) voption val TryFindILAttribute: BuiltinAttribInfo -> ILAttributes -> bool @@ -2247,7 +2247,7 @@ val HasFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> bool val HasFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> bool -val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib option +val TryFindFSharpAttribute: TcGlobals -> BuiltinAttribInfo -> Attribs -> Attrib voption val TryFindFSharpAttributeOpt: TcGlobals -> BuiltinAttribInfo option -> Attribs -> Attrib option @@ -2491,19 +2491,19 @@ type EntityRef with member HasMember: TcGlobals -> string -> TType list -> bool -val (|AttribBitwiseOrExpr|_|): TcGlobals -> Expr -> (Expr * Expr) option +val (|AttribBitwiseOrExpr|_|): TcGlobals -> Expr -> (Expr * Expr) voption -val (|EnumExpr|_|): TcGlobals -> Expr -> Expr option +val (|EnumExpr|_|): TcGlobals -> Expr -> Expr voption -val (|TypeOfExpr|_|): TcGlobals -> Expr -> TType option +val (|TypeOfExpr|_|): TcGlobals -> Expr -> TType voption -val (|TypeDefOfExpr|_|): TcGlobals -> Expr -> TType option +val (|TypeDefOfExpr|_|): TcGlobals -> Expr -> TType voption val isNameOfValRef: TcGlobals -> ValRef -> bool -val (|NameOfExpr|_|): TcGlobals -> Expr -> TType option +val (|NameOfExpr|_|): TcGlobals -> Expr -> TType voption -val (|SeqExpr|_|): TcGlobals -> Expr -> unit option +val (|SeqExpr|_|): TcGlobals -> Expr -> unit voption val EvalLiteralExprOrAttribArg: TcGlobals -> Expr -> Expr @@ -2511,27 +2511,27 @@ val EvaledAttribExprEquality: TcGlobals -> Expr -> Expr -> bool val IsSimpleSyntacticConstantExpr: TcGlobals -> Expr -> bool -val (|ConstToILFieldInit|_|): Const -> ILFieldInit option +val (|ConstToILFieldInit|_|): Const -> ILFieldInit voption -val (|ExtractAttribNamedArg|_|): string -> AttribNamedArg list -> AttribExpr option +val (|ExtractAttribNamedArg|_|): string -> AttribNamedArg list -> AttribExpr voption -val (|AttribInt32Arg|_|): AttribExpr -> int32 option +val (|AttribInt32Arg|_|): (AttribExpr -> int32 voption) -val (|AttribInt16Arg|_|): AttribExpr -> int16 option +val (|AttribInt16Arg|_|): (AttribExpr -> int16 voption) -val (|AttribBoolArg|_|): AttribExpr -> bool option +val (|AttribBoolArg|_|): (AttribExpr -> bool voption) -val (|AttribStringArg|_|): AttribExpr -> string option +val (|AttribStringArg|_|): (AttribExpr -> string voption) -val (|Int32Expr|_|): Expr -> int32 option +val (|Int32Expr|_|): Expr -> int32 voption /// Determines types that are potentially known to satisfy the 'comparable' constraint and returns /// a set of residual types that must also satisfy the constraint -val (|SpecialComparableHeadType|_|): TcGlobals -> TType -> TType list option +val (|SpecialComparableHeadType|_|): TcGlobals -> TType -> TType list voption -val (|SpecialEquatableHeadType|_|): TcGlobals -> TType -> TType list option +val (|SpecialEquatableHeadType|_|): TcGlobals -> TType -> TType list voption -val (|SpecialNotEquatableHeadType|_|): TcGlobals -> TType -> unit option +val (|SpecialNotEquatableHeadType|_|): TcGlobals -> TType -> unit voption type OptimizeForExpressionOptions = | OptimizeIntRangesOnly @@ -2588,48 +2588,48 @@ type TraitWitnessInfoHashMap<'T> = ImmutableDictionary val EmptyTraitWitnessInfoHashMap: TcGlobals -> TraitWitnessInfoHashMap<'T> /// Match expressions that are an application of a particular F# function value -val (|ValApp|_|): TcGlobals -> ValRef -> Expr -> (TypeInst * Exprs * range) option +val (|ValApp|_|): TcGlobals -> ValRef -> Expr -> (TypeInst * Exprs * range) voption /// Match expressions that represent the creation of an instance of an F# delegate value -val (|NewDelegateExpr|_|): TcGlobals -> Expr -> (Unique * Val list * Expr * range * (Expr -> Expr)) option +val (|NewDelegateExpr|_|): TcGlobals -> Expr -> (Unique * Val list * Expr * range * (Expr -> Expr)) voption /// Match a .Invoke on a delegate -val (|DelegateInvokeExpr|_|): TcGlobals -> Expr -> (Expr * TType * Expr * Expr * range) option +val (|DelegateInvokeExpr|_|): TcGlobals -> Expr -> (Expr * TType * Expr * Expr * range) voption /// Match 'if __useResumableCode then ... else ...' expressions -val (|IfUseResumableStateMachinesExpr|_|): TcGlobals -> Expr -> (Expr * Expr) option +val (|IfUseResumableStateMachinesExpr|_|): TcGlobals -> Expr -> (Expr * Expr) voption val CombineCcuContentFragments: ModuleOrNamespaceType list -> ModuleOrNamespaceType /// Recognise a 'match __resumableEntry() with ...' expression -val (|ResumableEntryMatchExpr|_|): g: TcGlobals -> Expr -> (Expr * Val * Expr * (Expr * Expr -> Expr)) option +val (|ResumableEntryMatchExpr|_|): g: TcGlobals -> Expr -> (Expr * Val * Expr * (Expr * Expr -> Expr)) voption /// Recognise a '__stateMachine' expression val (|StructStateMachineExpr|_|): - g: TcGlobals -> expr: Expr -> (TType * (Val * Expr) * (Val * Val * Expr) * (Val * Expr)) option + g: TcGlobals -> expr: Expr -> (TType * (Val * Expr) * (Val * Val * Expr) * (Val * Expr)) voption /// Recognise a sequential or binding construct in a resumable code -val (|SequentialResumableCode|_|): g: TcGlobals -> Expr -> (Expr * Expr * range * (Expr -> Expr -> Expr)) option +val (|SequentialResumableCode|_|): g: TcGlobals -> Expr -> (Expr * Expr * range * (Expr -> Expr -> Expr)) voption /// Recognise a '__debugPoint' expression -val (|DebugPointExpr|_|): g: TcGlobals -> Expr -> string option +val (|DebugPointExpr|_|): g: TcGlobals -> Expr -> string voption /// Recognise a '__resumeAt' expression -val (|ResumeAtExpr|_|): g: TcGlobals -> Expr -> Expr option +val (|ResumeAtExpr|_|): g: TcGlobals -> Expr -> Expr voption /// Recognise a while expression -val (|WhileExpr|_|): Expr -> (DebugPointAtWhile * SpecialWhileLoopMarker * Expr * Expr * range) option +val (|WhileExpr|_|): Expr -> (DebugPointAtWhile * SpecialWhileLoopMarker * Expr * Expr * range) voption /// Recognise an integer for-loop expression val (|IntegerForLoopExpr|_|): - Expr -> (DebugPointAtFor * DebugPointAtInOrTo * ForLoopStyle * Expr * Expr * Val * Expr * range) option + Expr -> (DebugPointAtFor * DebugPointAtInOrTo * ForLoopStyle * Expr * Expr * Val * Expr * range) voption /// Recognise a try-with expression val (|TryWithExpr|_|): - Expr -> (DebugPointAtTry * DebugPointAtWith * TType * Expr * Val * Expr * Val * Expr * range) option + Expr -> (DebugPointAtTry * DebugPointAtWith * TType * Expr * Val * Expr * Val * Expr * range) voption /// Recognise a try-finally expression -val (|TryFinallyExpr|_|): Expr -> (DebugPointAtTry * DebugPointAtFinally * TType * Expr * Expr * range) option +val (|TryFinallyExpr|_|): Expr -> (DebugPointAtTry * DebugPointAtFinally * TType * Expr * Expr * range) voption /// Add a label to use as the target for a goto val mkLabelled: range -> ILCodeLabel -> Expr -> Expr @@ -2652,48 +2652,48 @@ val TryBindTyconRefAttribute: 'a option val (|ResumableCodeInvoke|_|): - g: TcGlobals -> expr: Expr -> (Expr * Expr * Expr list * range * (Expr * Expr list -> Expr)) option + g: TcGlobals -> expr: Expr -> (Expr * Expr * Expr list * range * (Expr * Expr list -> Expr)) voption -val (|OpPipeRight|_|): g: TcGlobals -> expr: Expr -> (TType * Expr * Expr * range) option +val (|OpPipeRight|_|): g: TcGlobals -> expr: Expr -> (TType * Expr * Expr * range) voption -val (|OpPipeRight2|_|): g: TcGlobals -> expr: Expr -> (TType * Expr * Expr * Expr * range) option +val (|OpPipeRight2|_|): g: TcGlobals -> expr: Expr -> (TType * Expr * Expr * Expr * range) voption -val (|OpPipeRight3|_|): g: TcGlobals -> expr: Expr -> (TType * Expr * Expr * Expr * Expr * range) option +val (|OpPipeRight3|_|): g: TcGlobals -> expr: Expr -> (TType * Expr * Expr * Expr * Expr * range) voption val mkDebugPoint: m: range -> expr: Expr -> Expr /// Match an if...then...else expression or the result of "a && b" or "a || b" -val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) option +val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) voption /// Determine if a value is a method implementing an interface dispatch slot using a private method impl val ComputeUseMethodImpl: g: TcGlobals -> v: Val -> bool /// Detect the de-sugared form of a 'yield x' within a 'seq { ... }' -val (|SeqYield|_|): TcGlobals -> Expr -> (Expr * range) option +val (|SeqYield|_|): TcGlobals -> Expr -> (Expr * range) voption /// Detect the de-sugared form of a 'expr; expr' within a 'seq { ... }' -val (|SeqAppend|_|): TcGlobals -> Expr -> (Expr * Expr * range) option +val (|SeqAppend|_|): TcGlobals -> Expr -> (Expr * Expr * range) voption /// Detect the de-sugared form of a 'while gd do expr' within a 'seq { ... }' -val (|SeqWhile|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) option +val (|SeqWhile|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) voption /// Detect the de-sugared form of a 'try .. finally .. ' within a 'seq { ... }' -val (|SeqTryFinally|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) option +val (|SeqTryFinally|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) voption /// Detect the de-sugared form of a 'use x = ..' within a 'seq { ... }' -val (|SeqUsing|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) option +val (|SeqUsing|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) voption /// Detect the de-sugared form of a 'for x in collection do ..' within a 'seq { ... }' -val (|SeqForEach|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) option +val (|SeqForEach|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) voption /// Detect the outer 'Seq.delay' added for a construct 'seq { ... }' -val (|SeqDelay|_|): TcGlobals -> Expr -> (Expr * TType) option +val (|SeqDelay|_|): TcGlobals -> Expr -> (Expr * TType) voption /// Detect a 'Seq.empty' implicit in the implied 'else' branch of an 'if .. then' in a seq { ... } -val (|SeqEmpty|_|): TcGlobals -> Expr -> range option +val (|SeqEmpty|_|): TcGlobals -> Expr -> range voption /// Detect a 'seq { ... }' expression -val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option +val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) voption /// Indicates if an F# type is the type associated with an F# exception declaration val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool @@ -2720,7 +2720,7 @@ type TraitConstraintInfo with /// Signatures printed via the typed tree in NicePrint don't print TMDefOpens or TMDefDo. /// This will match anything that does not have any types or bindings. val (|EmptyModuleOrNamespaces|_|): - moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) option + moduleOrNamespaceContents: ModuleOrNamespaceContents -> (ModuleOrNamespace list) voption /// Add an System.Runtime.CompilerServices.ExtensionAttribute to the Entity if found via predicate and not already present. val tryAddExtensionAttributeIfNotAlreadyPresent: diff --git a/src/Compiler/Utilities/InternalCollections.fs b/src/Compiler/Utilities/InternalCollections.fs index 7d350830370..b6b4f3b1be4 100755 --- a/src/Compiler/Utilities/InternalCollections.fs +++ b/src/Compiler/Utilities/InternalCollections.fs @@ -35,10 +35,10 @@ type internal AgedLookup<'Token, 'Key, 'Value when 'Value: not struct>(keepStron // Treat a list of key-value pairs as a lookup collection. // This function returns true if two keys are the same according to the predicate // function passed in. - | [] -> None + | [] -> ValueNone | (similarKey, value) :: t -> if areSimilar (key, similarKey) then - Some(similarKey, value) + ValueSome(similarKey, value) else Lookup key t @@ -64,10 +64,10 @@ type internal AgedLookup<'Token, 'Key, 'Value when 'Value: not struct>(keepStron let TryGetKeyValueImpl (data, key) = match TryPeekKeyValueImpl(data, key) with - | Some(similarKey, value) as result -> + | ValueSome(similarKey, value) as result -> // If the result existed, move it to the end of the list (more likely to keep it) result, Promote(data, similarKey, value) - | None -> None, data + | ValueNone -> ValueNone, data /// Remove weak entries from the list that have been collected. let FilterAndHold (tok: 'Token) = @@ -136,8 +136,8 @@ type internal AgedLookup<'Token, 'Key, 'Value when 'Value: not struct>(keepStron AssignWithStrength(tok, newData) match result with - | Some(_, value) -> Some(value) - | None -> None + | ValueSome(_, value) -> ValueSome(value) + | ValueNone -> ValueNone member al.Put(tok, key, value) = let data = FilterAndHold(tok) @@ -185,32 +185,40 @@ type internal MruCache<'Token, 'Key, 'Value when 'Value: not struct> member bc.ContainsSimilarKey(tok, key) = match cache.TryPeekKeyValue(tok, key) with - | Some(_similarKey, _value) -> true - | None -> false + | ValueSome(_similarKey, _value) -> true + | ValueNone -> false member bc.TryGetAny(tok, key) = match cache.TryPeekKeyValue(tok, key) with - | Some(similarKey, value) -> if areSame (similarKey, key) then Some(value) else None - | None -> None + | ValueSome(similarKey, value) -> + if areSame (similarKey, key) then + ValueSome(value) + else + ValueNone + | ValueNone -> ValueNone member bc.TryGet(tok, key) = match cache.TryGetKeyValue(tok, key) with - | Some(similarKey, value) -> + | ValueSome(similarKey, value) -> if areSame (similarKey, key) && isStillValid (key, value) then - Some value + ValueSome value else - None - | None -> None + ValueNone + | ValueNone -> ValueNone member bc.TryGetSimilarAny(tok, key) = match cache.TryGetKeyValue(tok, key) with - | Some(_, value) -> Some value - | None -> None + | ValueSome(_, value) -> ValueSome value + | ValueNone -> ValueNone member bc.TryGetSimilar(tok, key) = match cache.TryGetKeyValue(tok, key) with - | Some(_, value) -> if isStillValid (key, value) then Some value else None - | None -> None + | ValueSome(_, value) -> + if isStillValid (key, value) then + ValueSome value + else + ValueNone + | ValueNone -> ValueNone member bc.Set(tok, key: 'Key, value: 'Value) = cache.Put(tok, key, value) diff --git a/src/Compiler/Utilities/InternalCollections.fsi b/src/Compiler/Utilities/InternalCollections.fsi index 712f8373e3e..c706fd89c3d 100755 --- a/src/Compiler/Utilities/InternalCollections.fsi +++ b/src/Compiler/Utilities/InternalCollections.fsi @@ -15,15 +15,15 @@ type internal AgedLookup<'Token, 'Key, 'Value when 'Value: not struct> = /// Lookup the value without making it the most recent. /// Returns the original key value because the areSame function /// may have unified two different keys. - member TryPeekKeyValue: 'Token * key: 'Key -> ('Key * 'Value) option + member TryPeekKeyValue: 'Token * key: 'Key -> ('Key * 'Value) voption /// Lookup a value and make it the most recent. /// Returns the original key value because the areSame function /// may have unified two different keys. - member TryGetKeyValue: 'Token * key: 'Key -> ('Key * 'Value) option + member TryGetKeyValue: 'Token * key: 'Key -> ('Key * 'Value) voption /// Lookup a value and make it the most recent. Return None if it wasn't there. - member TryGet: 'Token * key: 'Key -> 'Value option + member TryGet: 'Token * key: 'Key -> 'Value voption /// Add an element to the collection. Make it the most recent. member Put: 'Token * 'Key * 'Value -> unit @@ -63,16 +63,16 @@ type internal MruCache<'Token, 'Key, 'Value when 'Value: not struct> = member ContainsSimilarKey: 'Token * key: 'Key -> bool /// Get the value for the given key or None if not still valid. - member TryGetAny: 'Token * key: 'Key -> 'Value option + member TryGetAny: 'Token * key: 'Key -> 'Value voption /// Get the value for the given key or None, but only if entry is still valid - member TryGet: 'Token * key: 'Key -> 'Value option + member TryGet: 'Token * key: 'Key -> 'Value voption /// Get the value for the given key or None if not still valid. Skips `areSame` checking unless `areSimilar` is not provided. - member TryGetSimilarAny: 'Token * key: 'Key -> 'Value option + member TryGetSimilarAny: 'Token * key: 'Key -> 'Value voption /// Get the value for the given key or None, but only if entry is still valid. Skips `areSame` checking unless `areSimilar` is not provided. - member TryGetSimilar: 'Token * key: 'Key -> 'Value option + member TryGetSimilar: 'Token * key: 'Key -> 'Value voption /// Remove the given value from the mru cache. member RemoveAnySimilar: 'Token * key: 'Key -> unit diff --git a/src/Compiler/Utilities/lib.fs b/src/Compiler/Utilities/lib.fs index 87e50acd74a..90936762a24 100755 --- a/src/Compiler/Utilities/lib.fs +++ b/src/Compiler/Utilities/lib.fs @@ -449,4 +449,40 @@ module ListParallel = |> ArrayParallel.map f |> Array.toList - \ No newline at end of file +[] +module Array = + let inline tryPickV ([] chooser) (array: _[]) = + if isNull array then + raise (new ArgumentNullException(nameof(array))) + let rec loop i = + if i >= array.Length then + ValueNone + else + match chooser array.[i] with + | ValueNone -> loop (i + 1) + | res -> res + + loop 0 + +[] +module List = + let rec tryFindV predicate list = + match list with + | [] -> ValueNone + | h :: t -> if predicate h then ValueSome h else tryFindV predicate t + + let rec tryPickV chooser list = + match list with + | [] -> ValueNone + | h :: t -> + match chooser h with + | ValueNone -> tryPickV chooser t + | r -> r + + +[] +module ValueOption = + let inline defaultArg arg defaultValue = match arg with ValueNone -> defaultValue | ValueSome v -> v + let inline toOption arg = match arg with ValueNone -> None | ValueSome v -> Some v + let inline ofOption arg = match arg with None -> ValueNone | Some v -> ValueSome v + \ No newline at end of file diff --git a/src/Compiler/Utilities/lib.fsi b/src/Compiler/Utilities/lib.fsi index c7bccd4211d..03cea8d02c9 100644 --- a/src/Compiler/Utilities/lib.fsi +++ b/src/Compiler/Utilities/lib.fsi @@ -291,3 +291,18 @@ module ListParallel = val map: ('T -> 'U) -> 'T list -> 'U list //val inline mapi: (int -> 'T -> 'U) -> 'T list -> 'U list + +[] +module Array = + val inline tryPickV: ('T -> 'U voption) -> 'T[] -> 'U voption + +[] +module List = + val tryFindV: ('T -> bool) -> 'T list -> 'T voption + val tryPickV: ('T -> 'U voption) -> 'T list -> 'U voption + +[] +module ValueOption = + val inline defaultArg: 'T voption -> 'T -> 'T + val inline toOption: 'T voption -> 'T option + val inline ofOption: 'T option -> 'T voption diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDoc.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDoc.fs index 6a1927ffd84..3fb69696742 100644 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDoc.fs +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/XmlDoc.fs @@ -37,11 +37,11 @@ let ``Can extract XML docs from a file for a signature`` signature = let docInfo = XmlDocumentationInfo.TryCreateFromFile(xmlFileName) - |> Option.defaultWith (fun () -> failwith "Couldn't create XmlDoc from file") + |> ValueOption.defaultWith (fun () -> failwith "Couldn't create XmlDoc from file") match docInfo.TryGetXmlDocBySig(signature) with - | None -> failwith "Got no doc" - | Some doc -> Assert.Equal(memberDoc, doc.UnprocessedLines |> String.concat "\n") + | ValueNone -> failwith "Got no doc" + | ValueSome doc -> Assert.Equal(memberDoc, doc.UnprocessedLines |> String.concat "\n") finally File.Delete xmlFileName diff --git a/vsintegration/tests/UnitTests/Tests.InternalCollections.fs b/vsintegration/tests/UnitTests/Tests.InternalCollections.fs index 55a4bb1f34e..c0e6e73f771 100644 --- a/vsintegration/tests/UnitTests/Tests.InternalCollections.fs +++ b/vsintegration/tests/UnitTests/Tests.InternalCollections.fs @@ -127,18 +127,18 @@ type AgedLookup() = let AssertCached(i,o:byte array) = match al.TryPeekKeyValue(atok,i) with - | Some(_,x) -> Assert.IsTrue(obj.ReferenceEquals(o,x), sprintf "Object in cache (%d) does not agree with expectation (%d)" x.[0] i) - | None -> Assert.IsTrue(false, "Object fell out of cache") + | ValueSome(_,x) -> Assert.IsTrue(obj.ReferenceEquals(o,x), sprintf "Object in cache (%d) does not agree with expectation (%d)" x.[0] i) + | ValueNone -> Assert.IsTrue(false, "Object fell out of cache") let AssertExistsInCached(i) = match al.TryPeekKeyValue(atok,i) with - | Some _ -> () - | None -> Assert.IsTrue(false, "Object fell out of cache") + | ValueSome _ -> () + | ValueNone -> Assert.IsTrue(false, "Object fell out of cache") let AssertNotCached(i) = match al.TryPeekKeyValue(atok,i) with - | Some _ -> Assert.IsTrue(false, "Expected key to have fallen out of cache") - | None -> () + | ValueSome _ -> Assert.IsTrue(false, "Expected key to have fallen out of cache") + | ValueNone -> () let f() = try