diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index ff38a6038813c171393721d80d2a26d3a159e387..cd71181110a382aea1adb4ccdf562078b99e4329 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -99,134 +99,134 @@ exception HashLoadedScriptConsideredSource of range let GetRangeOfDiagnostic(err:PhasedDiagnostic) = let rec RangeFromException = function - | ErrorFromAddingConstraint(_,err2,_) -> RangeFromException err2 + | ErrorFromAddingConstraint(_, err2, _) -> RangeFromException err2 #if EXTENSIONTYPING | ExtensionTyping.ProvidedTypeResolutionNoRange(e) -> RangeFromException e - | ExtensionTyping.ProvidedTypeResolution(m,_) + | ExtensionTyping.ProvidedTypeResolution(m, _) #endif - | ReservedKeyword(_,m) - | IndentationProblem(_,m) - | ErrorFromAddingTypeEquation(_,_,_,_,_,m) - | ErrorFromApplyingDefault(_,_,_,_,_,m) - | ErrorsFromAddingSubsumptionConstraint(_,_,_,_,_,_,m) - | FunctionExpected(_,_,m) - | BakedInMemberConstraintName(_,m) - | StandardOperatorRedefinitionWarning(_,m) + | ReservedKeyword(_, m) + | IndentationProblem(_, m) + | ErrorFromAddingTypeEquation(_, _, _, _, _, m) + | ErrorFromApplyingDefault(_, _, _, _, _, m) + | ErrorsFromAddingSubsumptionConstraint(_, _, _, _, _, _, m) + | FunctionExpected(_, _, m) + | BakedInMemberConstraintName(_, m) + | StandardOperatorRedefinitionWarning(_, m) | BadEventTransformation(m) | ParameterlessStructCtor(m) - | FieldNotMutable (_,_,m) - | Recursion (_,_,_,_,m) - | InvalidRuntimeCoercion(_,_,_,m) - | IndeterminateRuntimeCoercion(_,_,_,m) - | IndeterminateStaticCoercion (_,_,_,m) - | StaticCoercionShouldUseBox (_,_,_,m) - | CoercionTargetSealed(_,_,m) + | FieldNotMutable (_, _, m) + | Recursion (_, _, _, _, m) + | InvalidRuntimeCoercion(_, _, _, m) + | IndeterminateRuntimeCoercion(_, _, _, m) + | IndeterminateStaticCoercion (_, _, _, m) + | StaticCoercionShouldUseBox (_, _, _, m) + | CoercionTargetSealed(_, _, m) | UpcastUnnecessary(m) - | QuotationTranslator.IgnoringPartOfQuotedTermWarning (_,m) + | QuotationTranslator.IgnoringPartOfQuotedTermWarning (_, m) | TypeTestUnnecessary(m) - | RuntimeCoercionSourceSealed(_,_,m) - | OverrideDoesntOverride(_,_,_,_,_,m) + | RuntimeCoercionSourceSealed(_, _, m) + | OverrideDoesntOverride(_, _, _, _, _, m) | UnionPatternsBindDifferentNames m - | UnionCaseWrongArguments (_,_,_,m) + | UnionCaseWrongArguments (_, _, _, m) | TypeIsImplicitlyAbstract m - | RequiredButNotSpecified (_,_,_,_,m) - | FunctionValueUnexpected (_,_,m) - | UnitTypeExpected (_,_,m) - | UnitTypeExpectedWithEquality (_,_,m) - | UnitTypeExpectedWithPossiblePropertySetter (_,_,_,_,m) - | UnitTypeExpectedWithPossibleAssignment (_,_,_,_,m) + | RequiredButNotSpecified (_, _, _, _, m) + | FunctionValueUnexpected (_, _, m) + | UnitTypeExpected (_, _, m) + | UnitTypeExpectedWithEquality (_, _, m) + | UnitTypeExpectedWithPossiblePropertySetter (_, _, _, _, m) + | UnitTypeExpectedWithPossibleAssignment (_, _, _, _, m) | UseOfAddressOfOperator m | DeprecatedThreadStaticBindingWarning(m) - | NonUniqueInferredAbstractSlot (_,_,_,_,_,m) - | DefensiveCopyWarning (_,m) + | NonUniqueInferredAbstractSlot (_, _, _, _, _, m) + | DefensiveCopyWarning (_, m) | LetRecCheckedAtRuntime m | UpperCaseIdentifierInPattern m | NotUpperCaseConstructor m - | RecursiveUseCheckedAtRuntime (_,_,m) - | LetRecEvaluatedOutOfOrder (_,_,_,m) - | Error (_,m) - | ErrorWithSuggestions (_,m,_,_) - | NumberedError (_,m) - | SyntaxError (_,m) - | InternalError (_,m) - | FullAbstraction(_,m) - | InterfaceNotRevealed(_,_,m) - | WrappedError (_,m) - | PatternMatchCompilation.MatchIncomplete (_,_,m) + | RecursiveUseCheckedAtRuntime (_, _, m) + | LetRecEvaluatedOutOfOrder (_, _, _, m) + | Error (_, m) + | ErrorWithSuggestions (_, m, _, _) + | NumberedError (_, m) + | SyntaxError (_, m) + | InternalError (_, m) + | FullAbstraction(_, m) + | InterfaceNotRevealed(_, _, m) + | WrappedError (_, m) + | PatternMatchCompilation.MatchIncomplete (_, _, m) | PatternMatchCompilation.RuleNeverMatched m - | ValNotMutable(_,_,m) - | ValNotLocal(_,_,m) - | MissingFields(_,m) + | ValNotMutable(_, _, m) + | ValNotLocal(_, _, m) + | MissingFields(_, m) | OverrideInIntrinsicAugmentation(m) | IntfImplInIntrinsicAugmentation(m) | OverrideInExtrinsicAugmentation(m) | IntfImplInExtrinsicAugmentation(m) - | ValueRestriction(_,_,_,_,m) - | LetRecUnsound (_,_,m) - | ObsoleteError (_,m) - | ObsoleteWarning (_,m) - | Experimental (_,m) + | ValueRestriction(_, _, _, _, m) + | LetRecUnsound (_, _, m) + | ObsoleteError (_, m) + | ObsoleteWarning (_, m) + | Experimental (_, m) | PossibleUnverifiableCode m - | UserCompilerMessage (_,_,m) - | Deprecated(_,m) + | UserCompilerMessage (_, _, m) + | Deprecated(_, m) | LibraryUseOnly(m) - | FieldsFromDifferentTypes (_,_,_,m) + | FieldsFromDifferentTypes (_, _, _, m) | IndeterminateType(m) - | TyconBadArgs(_,_,_,m) -> + | TyconBadArgs(_, _, _, m) -> Some m - | FieldNotContained(_,arf,_,_) -> Some arf.Range - | ValueNotContained(_,_,aval,_,_) -> Some aval.Range - | ConstrNotContained(_,aval,_,_) -> Some aval.Id.idRange - | ExnconstrNotContained(_,aexnc,_,_) -> Some aexnc.Range + | FieldNotContained(_, arf, _, _) -> Some arf.Range + | ValueNotContained(_, _, aval, _, _) -> Some aval.Range + | ConstrNotContained(_, aval, _, _) -> Some aval.Id.idRange + | ExnconstrNotContained(_, aexnc, _, _) -> Some aexnc.Range | VarBoundTwice(id) - | UndefinedName(_,_,id,_) -> + | UndefinedName(_, _, id, _) -> Some id.idRange - | Duplicate(_,_,m) - | NameClash(_,_,_,m,_,_,_) - | UnresolvedOverloading(_,_,_,m) - | UnresolvedConversionOperator (_,_,_,m) - | PossibleOverload(_,_,_, m) + | Duplicate(_, _, m) + | NameClash(_, _, _, m, _, _, _) + | UnresolvedOverloading(_, _, _, m) + | UnresolvedConversionOperator (_, _, _, m) + | PossibleOverload(_, _, _, m) | VirtualAugmentationOnNullValuedType(m) | NonVirtualAugmentationOnNullValuedType(m) - | NonRigidTypar(_,_,_,_,_,m) - | ConstraintSolverTupleDiffLengths(_,_,_,m,_) - | ConstraintSolverInfiniteTypes(_,_,_,_,m,_) - | ConstraintSolverMissingConstraint(_,_,_,m,_) - | ConstraintSolverTypesNotInEqualityRelation(_,_,_,m,_,_) - | ConstraintSolverError(_,m,_) - | ConstraintSolverTypesNotInSubsumptionRelation(_,_,_,m,_) - | ConstraintSolverRelatedInformation(_,m,_) - | SelfRefObjCtor(_,m) -> + | NonRigidTypar(_, _, _, _, _, m) + | ConstraintSolverTupleDiffLengths(_, _, _, m, _) + | ConstraintSolverInfiniteTypes(_, _, _, _, m, _) + | ConstraintSolverMissingConstraint(_, _, _, m, _) + | ConstraintSolverTypesNotInEqualityRelation(_, _, _, m, _, _) + | ConstraintSolverError(_, m, _) + | ConstraintSolverTypesNotInSubsumptionRelation(_, _, _, m, _) + | ConstraintSolverRelatedInformation(_, m, _) + | SelfRefObjCtor(_, m) -> Some m - | NotAFunction(_,_,mfun,_) -> + | NotAFunction(_, _, mfun, _) -> Some mfun - | NotAFunctionButIndexer(_,_,_,mfun,_) -> + | NotAFunctionButIndexer(_, _, _, mfun, _) -> Some mfun | IllegalFileNameChar(_) -> Some rangeCmdArgs - | UnresolvedReferenceError(_,m) - | UnresolvedPathReference(_,_,m) - | DeprecatedCommandLineOptionFull(_,m) - | DeprecatedCommandLineOptionForHtmlDoc(_,m) - | DeprecatedCommandLineOptionSuggestAlternative(_,_,m) - | DeprecatedCommandLineOptionNoDescription(_,m) - | InternalCommandLineOption(_,m) + | UnresolvedReferenceError(_, m) + | UnresolvedPathReference(_, _, m) + | DeprecatedCommandLineOptionFull(_, m) + | DeprecatedCommandLineOptionForHtmlDoc(_, m) + | DeprecatedCommandLineOptionSuggestAlternative(_, _, m) + | DeprecatedCommandLineOptionNoDescription(_, m) + | InternalCommandLineOption(_, m) | HashIncludeNotAllowedInNonScript(m) | HashReferenceNotAllowedInNonScript(m) | HashDirectiveNotAllowedInNonScript(m) - | FileNameNotResolved(_,_,m) - | LoadedSourceNotFoundIgnoring(_,m) - | MSBuildReferenceResolutionWarning(_,_,m) - | MSBuildReferenceResolutionError(_,_,m) - | AssemblyNotResolved(_,m) - | HashLoadedSourceHasIssues(_,_,m) + | FileNameNotResolved(_, _, m) + | LoadedSourceNotFoundIgnoring(_, m) + | MSBuildReferenceResolutionWarning(_, _, m) + | MSBuildReferenceResolutionError(_, _, m) + | AssemblyNotResolved(_, m) + | HashLoadedSourceHasIssues(_, _, m) | HashLoadedScriptConsideredSource(m) -> Some m // Strip TargetInvocationException wrappers @@ -308,7 +308,7 @@ let GetDiagnosticNumber(err:PhasedDiagnostic) = | CoercionTargetSealed _ -> 59 | OverrideInIntrinsicAugmentation _ -> 60 | NonVirtualAugmentationOnNullValuedType _ -> 61 - | UserCompilerMessage (_,n,_) -> n + | UserCompilerMessage (_, n, _) -> n | ExnconstrNotContained _ -> 63 | NonRigidTypar _ -> 64 // 65 cannot be reused @@ -361,17 +361,17 @@ let GetDiagnosticNumber(err:PhasedDiagnostic) = | :? System.Reflection.TargetInvocationException as e -> GetFromException e.InnerException - | WrappedError(e,_) -> GetFromException e + | WrappedError(e, _) -> GetFromException e - | Error ((n,_),_) -> n - | ErrorWithSuggestions ((n,_),_,_,_) -> n + | Error ((n, _), _) -> n + | ErrorWithSuggestions ((n, _), _, _, _) -> n | Failure _ -> 192 - | NumberedError((n,_),_) -> n - | IllegalFileNameChar(fileName,invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName,string invalidChar)) + | NumberedError((n, _), _) -> n + | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)) #if EXTENSIONTYPING | :? TypeProviderError as e -> e.Number #endif - | ErrorsFromAddingSubsumptionConstraint (_,_,_,_,_,ContextInfo.DowncastUsedInsteadOfUpcast _,_) -> fst (FSComp.SR.considerUpcast("","")) + | ErrorsFromAddingSubsumptionConstraint (_, _, _, _, _, ContextInfo.DowncastUsedInsteadOfUpcast _, _) -> fst (FSComp.SR.considerUpcast("", "")) | _ -> 193 GetFromException err.Exception @@ -382,13 +382,13 @@ let GetWarningLevel err = | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ | FullAbstraction _ -> 5 - | NumberedError((n,_),_) - | ErrorWithSuggestions((n,_),_,_,_) - | Error((n,_),_) -> - // 1178,tcNoComparisonNeeded1,"The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint. Consider adding the 'NoComparison' attribute to this type to clarify that the type is not comparable" - // 1178,tcNoComparisonNeeded2,"The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint. Consider adding the 'NoComparison' attribute to this type to clarify that the type is not comparable" - // 1178,tcNoEqualityNeeded1,"The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint. Consider adding the 'NoEquality' attribute to this type to clarify that the type does not support structural equality" - // 1178,tcNoEqualityNeeded2,"The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint. Consider adding the 'NoEquality' attribute to this type to clarify that the type does not support structural equality" + | NumberedError((n, _), _) + | ErrorWithSuggestions((n, _), _, _, _) + | Error((n, _), _) -> + // 1178, tcNoComparisonNeeded1, "The struct, record or union type '%s' is not structurally comparable because the type parameter %s does not satisfy the 'comparison' constraint. Consider adding the 'NoComparison' attribute to this type to clarify that the type is not comparable" + // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint. Consider adding the 'NoComparison' attribute to this type to clarify that the type is not comparable" + // 1178, tcNoEqualityNeeded1, "The struct, record or union type '%s' does not support structural equality because the type parameter %s does not satisfy the 'equality' constraint. Consider adding the 'NoEquality' attribute to this type to clarify that the type does not support structural equality" + // 1178, tcNoEqualityNeeded2, "The struct, record or union type '%s' does not support structural equality because the type '%s' does not satisfy the 'equality' constraint. Consider adding the 'NoEquality' attribute to this type to clarify that the type does not support structural equality" if (n = 1178) then 5 else 2 // Level 2 | _ -> 2 @@ -405,27 +405,27 @@ let warningOn err level specificWarnOn = let SplitRelatedDiagnostics(err:PhasedDiagnostic) = let ToPhased(e) = {Exception=e; Phase = err.Phase} let rec SplitRelatedException = function - | UnresolvedOverloading(a,overloads,b,c) -> + | UnresolvedOverloading(a, overloads, b, c) -> let related = overloads |> List.map ToPhased - UnresolvedOverloading(a,[],b,c)|>ToPhased, related - | ConstraintSolverRelatedInformation(fopt,m2,e) -> - let e,related = SplitRelatedException e - ConstraintSolverRelatedInformation(fopt,m2,e.Exception)|>ToPhased, related - | ErrorFromAddingTypeEquation(g,denv,t1,t2,e,m) -> - let e,related = SplitRelatedException e - ErrorFromAddingTypeEquation(g,denv,t1,t2,e.Exception,m)|>ToPhased, related - | ErrorFromApplyingDefault(g,denv,tp,defaultType,e,m) -> - let e,related = SplitRelatedException e - ErrorFromApplyingDefault(g,denv,tp,defaultType,e.Exception,m)|>ToPhased, related - | ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,contextInfo,m) -> - let e,related = SplitRelatedException e - ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e.Exception,contextInfo,m)|>ToPhased, related - | ErrorFromAddingConstraint(x,e,m) -> - let e,related = SplitRelatedException e - ErrorFromAddingConstraint(x,e.Exception,m)|>ToPhased, related - | WrappedError (e,m) -> - let e,related = SplitRelatedException e - WrappedError(e.Exception,m)|>ToPhased, related + UnresolvedOverloading(a, [], b, c)|>ToPhased, related + | ConstraintSolverRelatedInformation(fopt, m2, e) -> + let e, related = SplitRelatedException e + ConstraintSolverRelatedInformation(fopt, m2, e.Exception)|>ToPhased, related + | ErrorFromAddingTypeEquation(g, denv, t1, t2, e, m) -> + let e, related = SplitRelatedException e + ErrorFromAddingTypeEquation(g, denv, t1, t2, e.Exception, m)|>ToPhased, related + | ErrorFromApplyingDefault(g, denv, tp, defaultType, e, m) -> + let e, related = SplitRelatedException e + ErrorFromApplyingDefault(g, denv, tp, defaultType, e.Exception, m)|>ToPhased, related + | ErrorsFromAddingSubsumptionConstraint(g, denv, t1, t2, e, contextInfo, m) -> + let e, related = SplitRelatedException e + ErrorsFromAddingSubsumptionConstraint(g, denv, t1, t2, e.Exception, contextInfo, m)|>ToPhased, related + | ErrorFromAddingConstraint(x, e, m) -> + let e, related = SplitRelatedException e + ErrorFromAddingConstraint(x, e.Exception, m)|>ToPhased, related + | WrappedError (e, m) -> + let e, related = SplitRelatedException e + WrappedError(e.Exception, m)|>ToPhased, related // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> SplitRelatedException e.InnerException @@ -437,177 +437,180 @@ let SplitRelatedDiagnostics(err:PhasedDiagnostic) = let DeclareMesssage = Microsoft.FSharp.Compiler.DiagnosticMessage.DeclareResourceString do FSComp.SR.RunStartupValidation() -let SeeAlsoE() = DeclareResourceString("SeeAlso","%s") -let ConstraintSolverTupleDiffLengthsE() = DeclareResourceString("ConstraintSolverTupleDiffLengths","%d%d") +let SeeAlsoE() = DeclareResourceString("SeeAlso", "%s") +let ConstraintSolverTupleDiffLengthsE() = DeclareResourceString("ConstraintSolverTupleDiffLengths", "%d%d") let ConstraintSolverInfiniteTypesE() = DeclareResourceString("ConstraintSolverInfiniteTypes", "%s%s") -let ConstraintSolverMissingConstraintE() = DeclareResourceString("ConstraintSolverMissingConstraint","%s") -let ConstraintSolverTypesNotInEqualityRelation1E() = DeclareResourceString("ConstraintSolverTypesNotInEqualityRelation1","%s%s") +let ConstraintSolverMissingConstraintE() = DeclareResourceString("ConstraintSolverMissingConstraint", "%s") +let ConstraintSolverTypesNotInEqualityRelation1E() = DeclareResourceString("ConstraintSolverTypesNotInEqualityRelation1", "%s%s") let ConstraintSolverTypesNotInEqualityRelation2E() = DeclareResourceString("ConstraintSolverTypesNotInEqualityRelation2", "%s%s") -let ConstraintSolverTypesNotInSubsumptionRelationE() = DeclareResourceString("ConstraintSolverTypesNotInSubsumptionRelation","%s%s%s") -let ErrorFromAddingTypeEquation1E() = DeclareResourceString("ErrorFromAddingTypeEquation1","%s%s%s") -let ErrorFromAddingTypeEquation2E() = DeclareResourceString("ErrorFromAddingTypeEquation2","%s%s%s") -let ErrorFromApplyingDefault1E() = DeclareResourceString("ErrorFromApplyingDefault1","%s") -let ErrorFromApplyingDefault2E() = DeclareResourceString("ErrorFromApplyingDefault2","") -let ErrorsFromAddingSubsumptionConstraintE() = DeclareResourceString("ErrorsFromAddingSubsumptionConstraint","%s%s%s") -let UpperCaseIdentifierInPatternE() = DeclareResourceString("UpperCaseIdentifierInPattern","") -let NotUpperCaseConstructorE() = DeclareResourceString("NotUpperCaseConstructor","") -let PossibleOverloadE() = DeclareResourceString("PossibleOverload","%s%s") -let FunctionExpectedE() = DeclareResourceString("FunctionExpected","") -let BakedInMemberConstraintNameE() = DeclareResourceString("BakedInMemberConstraintName","%s") -let BadEventTransformationE() = DeclareResourceString("BadEventTransformation","") -let ParameterlessStructCtorE() = DeclareResourceString("ParameterlessStructCtor","") -let InterfaceNotRevealedE() = DeclareResourceString("InterfaceNotRevealed","%s") -let TyconBadArgsE() = DeclareResourceString("TyconBadArgs","%s%d%d") -let IndeterminateTypeE() = DeclareResourceString("IndeterminateType","") -let NameClash1E() = DeclareResourceString("NameClash1","%s%s") -let NameClash2E() = DeclareResourceString("NameClash2","%s%s%s%s%s") -let Duplicate1E() = DeclareResourceString("Duplicate1","%s") -let Duplicate2E() = DeclareResourceString("Duplicate2","%s%s") -let UndefinedName2E() = DeclareResourceString("UndefinedName2","") -let FieldNotMutableE() = DeclareResourceString("FieldNotMutable","") -let FieldsFromDifferentTypesE() = DeclareResourceString("FieldsFromDifferentTypes","%s%s") -let VarBoundTwiceE() = DeclareResourceString("VarBoundTwice","%s") -let RecursionE() = DeclareResourceString("Recursion","%s%s%s%s") -let InvalidRuntimeCoercionE() = DeclareResourceString("InvalidRuntimeCoercion","%s%s%s") -let IndeterminateRuntimeCoercionE() = DeclareResourceString("IndeterminateRuntimeCoercion","%s%s") -let IndeterminateStaticCoercionE() = DeclareResourceString("IndeterminateStaticCoercion","%s%s") -let StaticCoercionShouldUseBoxE() = DeclareResourceString("StaticCoercionShouldUseBox","%s%s") -let TypeIsImplicitlyAbstractE() = DeclareResourceString("TypeIsImplicitlyAbstract","") -let NonRigidTypar1E() = DeclareResourceString("NonRigidTypar1","%s%s") -let NonRigidTypar2E() = DeclareResourceString("NonRigidTypar2","%s%s") -let NonRigidTypar3E() = DeclareResourceString("NonRigidTypar3","%s%s") -let OBlockEndSentenceE() = DeclareResourceString("BlockEndSentence","") -let UnexpectedEndOfInputE() = DeclareResourceString("UnexpectedEndOfInput","") -let UnexpectedE() = DeclareResourceString("Unexpected","%s") -let NONTERM_interactionE() = DeclareResourceString("NONTERM.interaction","") -let NONTERM_hashDirectiveE() = DeclareResourceString("NONTERM.hashDirective","") -let NONTERM_fieldDeclE() = DeclareResourceString("NONTERM.fieldDecl","") -let NONTERM_unionCaseReprE() = DeclareResourceString("NONTERM.unionCaseRepr","") -let NONTERM_localBindingE() = DeclareResourceString("NONTERM.localBinding","") -let NONTERM_hardwhiteLetBindingsE() = DeclareResourceString("NONTERM.hardwhiteLetBindings","") -let NONTERM_classDefnMemberE() = DeclareResourceString("NONTERM.classDefnMember","") -let NONTERM_defnBindingsE() = DeclareResourceString("NONTERM.defnBindings","") -let NONTERM_classMemberSpfnE() = DeclareResourceString("NONTERM.classMemberSpfn","") -let NONTERM_valSpfnE() = DeclareResourceString("NONTERM.valSpfn","") -let NONTERM_tyconSpfnE() = DeclareResourceString("NONTERM.tyconSpfn","") -let NONTERM_anonLambdaExprE() = DeclareResourceString("NONTERM.anonLambdaExpr","") -let NONTERM_attrUnionCaseDeclE() = DeclareResourceString("NONTERM.attrUnionCaseDecl","") -let NONTERM_cPrototypeE() = DeclareResourceString("NONTERM.cPrototype","") -let NONTERM_objectImplementationMembersE() = DeclareResourceString("NONTERM.objectImplementationMembers","") -let NONTERM_ifExprCasesE() = DeclareResourceString("NONTERM.ifExprCases","") -let NONTERM_openDeclE() = DeclareResourceString("NONTERM.openDecl","") -let NONTERM_fileModuleSpecE() = DeclareResourceString("NONTERM.fileModuleSpec","") -let NONTERM_patternClausesE() = DeclareResourceString("NONTERM.patternClauses","") -let NONTERM_beginEndExprE() = DeclareResourceString("NONTERM.beginEndExpr","") -let NONTERM_recdExprE() = DeclareResourceString("NONTERM.recdExpr","") -let NONTERM_tyconDefnE() = DeclareResourceString("NONTERM.tyconDefn","") -let NONTERM_exconCoreE() = DeclareResourceString("NONTERM.exconCore","") -let NONTERM_typeNameInfoE() = DeclareResourceString("NONTERM.typeNameInfo","") -let NONTERM_attributeListE() = DeclareResourceString("NONTERM.attributeList","") -let NONTERM_quoteExprE() = DeclareResourceString("NONTERM.quoteExpr","") -let NONTERM_typeConstraintE() = DeclareResourceString("NONTERM.typeConstraint","") -let NONTERM_Category_ImplementationFileE() = DeclareResourceString("NONTERM.Category.ImplementationFile","") -let NONTERM_Category_DefinitionE() = DeclareResourceString("NONTERM.Category.Definition","") -let NONTERM_Category_SignatureFileE() = DeclareResourceString("NONTERM.Category.SignatureFile","") -let NONTERM_Category_PatternE() = DeclareResourceString("NONTERM.Category.Pattern","") -let NONTERM_Category_ExprE() = DeclareResourceString("NONTERM.Category.Expr","") -let NONTERM_Category_TypeE() = DeclareResourceString("NONTERM.Category.Type","") -let NONTERM_typeArgsActualE() = DeclareResourceString("NONTERM.typeArgsActual","") -let TokenName1E() = DeclareResourceString("TokenName1","%s") -let TokenName1TokenName2E() = DeclareResourceString("TokenName1TokenName2","%s%s") -let TokenName1TokenName2TokenName3E() = DeclareResourceString("TokenName1TokenName2TokenName3","%s%s%s") -let RuntimeCoercionSourceSealed1E() = DeclareResourceString("RuntimeCoercionSourceSealed1","%s") -let RuntimeCoercionSourceSealed2E() = DeclareResourceString("RuntimeCoercionSourceSealed2","%s") -let CoercionTargetSealedE() = DeclareResourceString("CoercionTargetSealed","%s") -let UpcastUnnecessaryE() = DeclareResourceString("UpcastUnnecessary","") -let TypeTestUnnecessaryE() = DeclareResourceString("TypeTestUnnecessary","") -let OverrideDoesntOverride1E() = DeclareResourceString("OverrideDoesntOverride1","%s") -let OverrideDoesntOverride2E() = DeclareResourceString("OverrideDoesntOverride2","%s") -let OverrideDoesntOverride3E() = DeclareResourceString("OverrideDoesntOverride3","%s") -let OverrideDoesntOverride4E() = DeclareResourceString("OverrideDoesntOverride4","%s") -let UnionCaseWrongArgumentsE() = DeclareResourceString("UnionCaseWrongArguments","%d%d") -let UnionPatternsBindDifferentNamesE() = DeclareResourceString("UnionPatternsBindDifferentNames","") -let RequiredButNotSpecifiedE() = DeclareResourceString("RequiredButNotSpecified","%s%s%s") -let UseOfAddressOfOperatorE() = DeclareResourceString("UseOfAddressOfOperator","") -let DefensiveCopyWarningE() = DeclareResourceString("DefensiveCopyWarning","%s") -let DeprecatedThreadStaticBindingWarningE() = DeclareResourceString("DeprecatedThreadStaticBindingWarning","") -let FunctionValueUnexpectedE() = DeclareResourceString("FunctionValueUnexpected","%s") -let UnitTypeExpectedE() = DeclareResourceString("UnitTypeExpected","") -let UnitTypeExpectedWithEqualityE() = DeclareResourceString("UnitTypeExpectedWithEquality","") -let UnitTypeExpectedWithPossiblePropertySetterE() = DeclareResourceString("UnitTypeExpectedWithPossiblePropertySetter","%s%s") -let UnitTypeExpectedWithPossibleAssignmentE() = DeclareResourceString("UnitTypeExpectedWithPossibleAssignment","%s") -let UnitTypeExpectedWithPossibleAssignmentToMutableE() = DeclareResourceString("UnitTypeExpectedWithPossibleAssignmentToMutable","%s") -let RecursiveUseCheckedAtRuntimeE() = DeclareResourceString("RecursiveUseCheckedAtRuntime","") -let LetRecUnsound1E() = DeclareResourceString("LetRecUnsound1","%s") -let LetRecUnsound2E() = DeclareResourceString("LetRecUnsound2","%s%s") -let LetRecUnsoundInnerE() = DeclareResourceString("LetRecUnsoundInner","%s") -let LetRecEvaluatedOutOfOrderE() = DeclareResourceString("LetRecEvaluatedOutOfOrder","") -let LetRecCheckedAtRuntimeE() = DeclareResourceString("LetRecCheckedAtRuntime","") -let SelfRefObjCtor1E() = DeclareResourceString("SelfRefObjCtor1","") -let SelfRefObjCtor2E() = DeclareResourceString("SelfRefObjCtor2","") -let VirtualAugmentationOnNullValuedTypeE() = DeclareResourceString("VirtualAugmentationOnNullValuedType","") -let NonVirtualAugmentationOnNullValuedTypeE() = DeclareResourceString("NonVirtualAugmentationOnNullValuedType","") -let NonUniqueInferredAbstractSlot1E() = DeclareResourceString("NonUniqueInferredAbstractSlot1","%s") -let NonUniqueInferredAbstractSlot2E() = DeclareResourceString("NonUniqueInferredAbstractSlot2","") -let NonUniqueInferredAbstractSlot3E() = DeclareResourceString("NonUniqueInferredAbstractSlot3","%s%s") -let NonUniqueInferredAbstractSlot4E() = DeclareResourceString("NonUniqueInferredAbstractSlot4","") -let Failure3E() = DeclareResourceString("Failure3","%s") -let Failure4E() = DeclareResourceString("Failure4","%s") -let FullAbstractionE() = DeclareResourceString("FullAbstraction","%s") -let MatchIncomplete1E() = DeclareResourceString("MatchIncomplete1","") -let MatchIncomplete2E() = DeclareResourceString("MatchIncomplete2","%s") -let MatchIncomplete3E() = DeclareResourceString("MatchIncomplete3","%s") -let MatchIncomplete4E() = DeclareResourceString("MatchIncomplete4","") -let RuleNeverMatchedE() = DeclareResourceString("RuleNeverMatched","") -let ValNotMutableE() = DeclareResourceString("ValNotMutable","%s") -let ValNotLocalE() = DeclareResourceString("ValNotLocal","") -let Obsolete1E() = DeclareResourceString("Obsolete1","") -let Obsolete2E() = DeclareResourceString("Obsolete2","%s") -let ExperimentalE() = DeclareResourceString("Experimental","%s") -let PossibleUnverifiableCodeE() = DeclareResourceString("PossibleUnverifiableCode","") -let DeprecatedE() = DeclareResourceString("Deprecated","%s") -let LibraryUseOnlyE() = DeclareResourceString("LibraryUseOnly","") -let MissingFieldsE() = DeclareResourceString("MissingFields","%s") -let ValueRestriction1E() = DeclareResourceString("ValueRestriction1","%s%s%s") -let ValueRestriction2E() = DeclareResourceString("ValueRestriction2","%s%s%s") -let ValueRestriction3E() = DeclareResourceString("ValueRestriction3","%s") -let ValueRestriction4E() = DeclareResourceString("ValueRestriction4","%s%s%s") -let ValueRestriction5E() = DeclareResourceString("ValueRestriction5","%s%s%s") -let RecoverableParseErrorE() = DeclareResourceString("RecoverableParseError","") -let ReservedKeywordE() = DeclareResourceString("ReservedKeyword","%s") -let IndentationProblemE() = DeclareResourceString("IndentationProblem","%s") -let OverrideInIntrinsicAugmentationE() = DeclareResourceString("OverrideInIntrinsicAugmentation","") -let OverrideInExtrinsicAugmentationE() = DeclareResourceString("OverrideInExtrinsicAugmentation","") -let IntfImplInIntrinsicAugmentationE() = DeclareResourceString("IntfImplInIntrinsicAugmentation","") -let IntfImplInExtrinsicAugmentationE() = DeclareResourceString("IntfImplInExtrinsicAugmentation","") -let UnresolvedReferenceNoRangeE() = DeclareResourceString("UnresolvedReferenceNoRange","%s") -let UnresolvedPathReferenceNoRangeE() = DeclareResourceString("UnresolvedPathReferenceNoRange","%s%s") -let HashIncludeNotAllowedInNonScriptE() = DeclareResourceString("HashIncludeNotAllowedInNonScript","") -let HashReferenceNotAllowedInNonScriptE() = DeclareResourceString("HashReferenceNotAllowedInNonScript","") -let HashDirectiveNotAllowedInNonScriptE() = DeclareResourceString("HashDirectiveNotAllowedInNonScript","") -let FileNameNotResolvedE() = DeclareResourceString("FileNameNotResolved","%s%s") -let AssemblyNotResolvedE() = DeclareResourceString("AssemblyNotResolved","%s") -let HashLoadedSourceHasIssues1E() = DeclareResourceString("HashLoadedSourceHasIssues1","") -let HashLoadedSourceHasIssues2E() = DeclareResourceString("HashLoadedSourceHasIssues2","") -let HashLoadedScriptConsideredSourceE() = DeclareResourceString("HashLoadedScriptConsideredSource","") -let InvalidInternalsVisibleToAssemblyName1E() = DeclareResourceString("InvalidInternalsVisibleToAssemblyName1","%s%s") -let InvalidInternalsVisibleToAssemblyName2E() = DeclareResourceString("InvalidInternalsVisibleToAssemblyName2","%s") -let LoadedSourceNotFoundIgnoringE() = DeclareResourceString("LoadedSourceNotFoundIgnoring","%s") -let MSBuildReferenceResolutionErrorE() = DeclareResourceString("MSBuildReferenceResolutionError","%s%s") -let TargetInvocationExceptionWrapperE() = DeclareResourceString("TargetInvocationExceptionWrapper","%s") +let ConstraintSolverTypesNotInSubsumptionRelationE() = DeclareResourceString("ConstraintSolverTypesNotInSubsumptionRelation", "%s%s%s") +let ErrorFromAddingTypeEquation1E() = DeclareResourceString("ErrorFromAddingTypeEquation1", "%s%s%s") +let ErrorFromAddingTypeEquation2E() = DeclareResourceString("ErrorFromAddingTypeEquation2", "%s%s%s") +let ErrorFromApplyingDefault1E() = DeclareResourceString("ErrorFromApplyingDefault1", "%s") +let ErrorFromApplyingDefault2E() = DeclareResourceString("ErrorFromApplyingDefault2", "") +let ErrorsFromAddingSubsumptionConstraintE() = DeclareResourceString("ErrorsFromAddingSubsumptionConstraint", "%s%s%s") +let UpperCaseIdentifierInPatternE() = DeclareResourceString("UpperCaseIdentifierInPattern", "") +let NotUpperCaseConstructorE() = DeclareResourceString("NotUpperCaseConstructor", "") +let PossibleOverloadE() = DeclareResourceString("PossibleOverload", "%s%s") +let FunctionExpectedE() = DeclareResourceString("FunctionExpected", "") +let BakedInMemberConstraintNameE() = DeclareResourceString("BakedInMemberConstraintName", "%s") +let BadEventTransformationE() = DeclareResourceString("BadEventTransformation", "") +let ParameterlessStructCtorE() = DeclareResourceString("ParameterlessStructCtor", "") +let InterfaceNotRevealedE() = DeclareResourceString("InterfaceNotRevealed", "%s") +let TyconBadArgsE() = DeclareResourceString("TyconBadArgs", "%s%d%d") +let IndeterminateTypeE() = DeclareResourceString("IndeterminateType", "") +let NameClash1E() = DeclareResourceString("NameClash1", "%s%s") +let NameClash2E() = DeclareResourceString("NameClash2", "%s%s%s%s%s") +let Duplicate1E() = DeclareResourceString("Duplicate1", "%s") +let Duplicate2E() = DeclareResourceString("Duplicate2", "%s%s") +let UndefinedName2E() = DeclareResourceString("UndefinedName2", "") +let FieldNotMutableE() = DeclareResourceString("FieldNotMutable", "") +let FieldsFromDifferentTypesE() = DeclareResourceString("FieldsFromDifferentTypes", "%s%s") +let VarBoundTwiceE() = DeclareResourceString("VarBoundTwice", "%s") +let RecursionE() = DeclareResourceString("Recursion", "%s%s%s%s") +let InvalidRuntimeCoercionE() = DeclareResourceString("InvalidRuntimeCoercion", "%s%s%s") +let IndeterminateRuntimeCoercionE() = DeclareResourceString("IndeterminateRuntimeCoercion", "%s%s") +let IndeterminateStaticCoercionE() = DeclareResourceString("IndeterminateStaticCoercion", "%s%s") +let StaticCoercionShouldUseBoxE() = DeclareResourceString("StaticCoercionShouldUseBox", "%s%s") +let TypeIsImplicitlyAbstractE() = DeclareResourceString("TypeIsImplicitlyAbstract", "") +let NonRigidTypar1E() = DeclareResourceString("NonRigidTypar1", "%s%s") +let NonRigidTypar2E() = DeclareResourceString("NonRigidTypar2", "%s%s") +let NonRigidTypar3E() = DeclareResourceString("NonRigidTypar3", "%s%s") +let OBlockEndSentenceE() = DeclareResourceString("BlockEndSentence", "") +let UnexpectedEndOfInputE() = DeclareResourceString("UnexpectedEndOfInput", "") +let UnexpectedE() = DeclareResourceString("Unexpected", "%s") +let NONTERM_interactionE() = DeclareResourceString("NONTERM.interaction", "") +let NONTERM_hashDirectiveE() = DeclareResourceString("NONTERM.hashDirective", "") +let NONTERM_fieldDeclE() = DeclareResourceString("NONTERM.fieldDecl", "") +let NONTERM_unionCaseReprE() = DeclareResourceString("NONTERM.unionCaseRepr", "") +let NONTERM_localBindingE() = DeclareResourceString("NONTERM.localBinding", "") +let NONTERM_hardwhiteLetBindingsE() = DeclareResourceString("NONTERM.hardwhiteLetBindings", "") +let NONTERM_classDefnMemberE() = DeclareResourceString("NONTERM.classDefnMember", "") +let NONTERM_defnBindingsE() = DeclareResourceString("NONTERM.defnBindings", "") +let NONTERM_classMemberSpfnE() = DeclareResourceString("NONTERM.classMemberSpfn", "") +let NONTERM_valSpfnE() = DeclareResourceString("NONTERM.valSpfn", "") +let NONTERM_tyconSpfnE() = DeclareResourceString("NONTERM.tyconSpfn", "") +let NONTERM_anonLambdaExprE() = DeclareResourceString("NONTERM.anonLambdaExpr", "") +let NONTERM_attrUnionCaseDeclE() = DeclareResourceString("NONTERM.attrUnionCaseDecl", "") +let NONTERM_cPrototypeE() = DeclareResourceString("NONTERM.cPrototype", "") +let NONTERM_objectImplementationMembersE() = DeclareResourceString("NONTERM.objectImplementationMembers", "") +let NONTERM_ifExprCasesE() = DeclareResourceString("NONTERM.ifExprCases", "") +let NONTERM_openDeclE() = DeclareResourceString("NONTERM.openDecl", "") +let NONTERM_fileModuleSpecE() = DeclareResourceString("NONTERM.fileModuleSpec", "") +let NONTERM_patternClausesE() = DeclareResourceString("NONTERM.patternClauses", "") +let NONTERM_beginEndExprE() = DeclareResourceString("NONTERM.beginEndExpr", "") +let NONTERM_recdExprE() = DeclareResourceString("NONTERM.recdExpr", "") +let NONTERM_tyconDefnE() = DeclareResourceString("NONTERM.tyconDefn", "") +let NONTERM_exconCoreE() = DeclareResourceString("NONTERM.exconCore", "") +let NONTERM_typeNameInfoE() = DeclareResourceString("NONTERM.typeNameInfo", "") +let NONTERM_attributeListE() = DeclareResourceString("NONTERM.attributeList", "") +let NONTERM_quoteExprE() = DeclareResourceString("NONTERM.quoteExpr", "") +let NONTERM_typeConstraintE() = DeclareResourceString("NONTERM.typeConstraint", "") +let NONTERM_Category_ImplementationFileE() = DeclareResourceString("NONTERM.Category.ImplementationFile", "") +let NONTERM_Category_DefinitionE() = DeclareResourceString("NONTERM.Category.Definition", "") +let NONTERM_Category_SignatureFileE() = DeclareResourceString("NONTERM.Category.SignatureFile", "") +let NONTERM_Category_PatternE() = DeclareResourceString("NONTERM.Category.Pattern", "") +let NONTERM_Category_ExprE() = DeclareResourceString("NONTERM.Category.Expr", "") +let NONTERM_Category_TypeE() = DeclareResourceString("NONTERM.Category.Type", "") +let NONTERM_typeArgsActualE() = DeclareResourceString("NONTERM.typeArgsActual", "") +let TokenName1E() = DeclareResourceString("TokenName1", "%s") +let TokenName1TokenName2E() = DeclareResourceString("TokenName1TokenName2", "%s%s") +let TokenName1TokenName2TokenName3E() = DeclareResourceString("TokenName1TokenName2TokenName3", "%s%s%s") +let RuntimeCoercionSourceSealed1E() = DeclareResourceString("RuntimeCoercionSourceSealed1", "%s") +let RuntimeCoercionSourceSealed2E() = DeclareResourceString("RuntimeCoercionSourceSealed2", "%s") +let CoercionTargetSealedE() = DeclareResourceString("CoercionTargetSealed", "%s") +let UpcastUnnecessaryE() = DeclareResourceString("UpcastUnnecessary", "") +let TypeTestUnnecessaryE() = DeclareResourceString("TypeTestUnnecessary", "") +let OverrideDoesntOverride1E() = DeclareResourceString("OverrideDoesntOverride1", "%s") +let OverrideDoesntOverride2E() = DeclareResourceString("OverrideDoesntOverride2", "%s") +let OverrideDoesntOverride3E() = DeclareResourceString("OverrideDoesntOverride3", "%s") +let OverrideDoesntOverride4E() = DeclareResourceString("OverrideDoesntOverride4", "%s") +let UnionCaseWrongArgumentsE() = DeclareResourceString("UnionCaseWrongArguments", "%d%d") +let UnionPatternsBindDifferentNamesE() = DeclareResourceString("UnionPatternsBindDifferentNames", "") +let RequiredButNotSpecifiedE() = DeclareResourceString("RequiredButNotSpecified", "%s%s%s") +let UseOfAddressOfOperatorE() = DeclareResourceString("UseOfAddressOfOperator", "") +let DefensiveCopyWarningE() = DeclareResourceString("DefensiveCopyWarning", "%s") +let DeprecatedThreadStaticBindingWarningE() = DeclareResourceString("DeprecatedThreadStaticBindingWarning", "") +let FunctionValueUnexpectedE() = DeclareResourceString("FunctionValueUnexpected", "%s") +let UnitTypeExpectedE() = DeclareResourceString("UnitTypeExpected", "") +let UnitTypeExpectedWithEqualityE() = DeclareResourceString("UnitTypeExpectedWithEquality", "") +let UnitTypeExpectedWithPossiblePropertySetterE() = DeclareResourceString("UnitTypeExpectedWithPossiblePropertySetter", "%s%s") +let UnitTypeExpectedWithPossibleAssignmentE() = DeclareResourceString("UnitTypeExpectedWithPossibleAssignment", "%s") +let UnitTypeExpectedWithPossibleAssignmentToMutableE() = DeclareResourceString("UnitTypeExpectedWithPossibleAssignmentToMutable", "%s") +let RecursiveUseCheckedAtRuntimeE() = DeclareResourceString("RecursiveUseCheckedAtRuntime", "") +let LetRecUnsound1E() = DeclareResourceString("LetRecUnsound1", "%s") +let LetRecUnsound2E() = DeclareResourceString("LetRecUnsound2", "%s%s") +let LetRecUnsoundInnerE() = DeclareResourceString("LetRecUnsoundInner", "%s") +let LetRecEvaluatedOutOfOrderE() = DeclareResourceString("LetRecEvaluatedOutOfOrder", "") +let LetRecCheckedAtRuntimeE() = DeclareResourceString("LetRecCheckedAtRuntime", "") +let SelfRefObjCtor1E() = DeclareResourceString("SelfRefObjCtor1", "") +let SelfRefObjCtor2E() = DeclareResourceString("SelfRefObjCtor2", "") +let VirtualAugmentationOnNullValuedTypeE() = DeclareResourceString("VirtualAugmentationOnNullValuedType", "") +let NonVirtualAugmentationOnNullValuedTypeE() = DeclareResourceString("NonVirtualAugmentationOnNullValuedType", "") +let NonUniqueInferredAbstractSlot1E() = DeclareResourceString("NonUniqueInferredAbstractSlot1", "%s") +let NonUniqueInferredAbstractSlot2E() = DeclareResourceString("NonUniqueInferredAbstractSlot2", "") +let NonUniqueInferredAbstractSlot3E() = DeclareResourceString("NonUniqueInferredAbstractSlot3", "%s%s") +let NonUniqueInferredAbstractSlot4E() = DeclareResourceString("NonUniqueInferredAbstractSlot4", "") +let Failure3E() = DeclareResourceString("Failure3", "%s") +let Failure4E() = DeclareResourceString("Failure4", "%s") +let FullAbstractionE() = DeclareResourceString("FullAbstraction", "%s") +let MatchIncomplete1E() = DeclareResourceString("MatchIncomplete1", "") +let MatchIncomplete2E() = DeclareResourceString("MatchIncomplete2", "%s") +let MatchIncomplete3E() = DeclareResourceString("MatchIncomplete3", "%s") +let MatchIncomplete4E() = DeclareResourceString("MatchIncomplete4", "") +let RuleNeverMatchedE() = DeclareResourceString("RuleNeverMatched", "") +let ValNotMutableE() = DeclareResourceString("ValNotMutable", "%s") +let ValNotLocalE() = DeclareResourceString("ValNotLocal", "") +let Obsolete1E() = DeclareResourceString("Obsolete1", "") +let Obsolete2E() = DeclareResourceString("Obsolete2", "%s") +let ExperimentalE() = DeclareResourceString("Experimental", "%s") +let PossibleUnverifiableCodeE() = DeclareResourceString("PossibleUnverifiableCode", "") +let DeprecatedE() = DeclareResourceString("Deprecated", "%s") +let LibraryUseOnlyE() = DeclareResourceString("LibraryUseOnly", "") +let MissingFieldsE() = DeclareResourceString("MissingFields", "%s") +let ValueRestriction1E() = DeclareResourceString("ValueRestriction1", "%s%s%s") +let ValueRestriction2E() = DeclareResourceString("ValueRestriction2", "%s%s%s") +let ValueRestriction3E() = DeclareResourceString("ValueRestriction3", "%s") +let ValueRestriction4E() = DeclareResourceString("ValueRestriction4", "%s%s%s") +let ValueRestriction5E() = DeclareResourceString("ValueRestriction5", "%s%s%s") +let RecoverableParseErrorE() = DeclareResourceString("RecoverableParseError", "") +let ReservedKeywordE() = DeclareResourceString("ReservedKeyword", "%s") +let IndentationProblemE() = DeclareResourceString("IndentationProblem", "%s") +let OverrideInIntrinsicAugmentationE() = DeclareResourceString("OverrideInIntrinsicAugmentation", "") +let OverrideInExtrinsicAugmentationE() = DeclareResourceString("OverrideInExtrinsicAugmentation", "") +let IntfImplInIntrinsicAugmentationE() = DeclareResourceString("IntfImplInIntrinsicAugmentation", "") +let IntfImplInExtrinsicAugmentationE() = DeclareResourceString("IntfImplInExtrinsicAugmentation", "") +let UnresolvedReferenceNoRangeE() = DeclareResourceString("UnresolvedReferenceNoRange", "%s") +let UnresolvedPathReferenceNoRangeE() = DeclareResourceString("UnresolvedPathReferenceNoRange", "%s%s") +let HashIncludeNotAllowedInNonScriptE() = DeclareResourceString("HashIncludeNotAllowedInNonScript", "") +let HashReferenceNotAllowedInNonScriptE() = DeclareResourceString("HashReferenceNotAllowedInNonScript", "") +let HashDirectiveNotAllowedInNonScriptE() = DeclareResourceString("HashDirectiveNotAllowedInNonScript", "") +let FileNameNotResolvedE() = DeclareResourceString("FileNameNotResolved", "%s%s") +let AssemblyNotResolvedE() = DeclareResourceString("AssemblyNotResolved", "%s") +let HashLoadedSourceHasIssues1E() = DeclareResourceString("HashLoadedSourceHasIssues1", "") +let HashLoadedSourceHasIssues2E() = DeclareResourceString("HashLoadedSourceHasIssues2", "") +let HashLoadedScriptConsideredSourceE() = DeclareResourceString("HashLoadedScriptConsideredSource", "") +let InvalidInternalsVisibleToAssemblyName1E() = DeclareResourceString("InvalidInternalsVisibleToAssemblyName1", "%s%s") +let InvalidInternalsVisibleToAssemblyName2E() = DeclareResourceString("InvalidInternalsVisibleToAssemblyName2", "%s") +let LoadedSourceNotFoundIgnoringE() = DeclareResourceString("LoadedSourceNotFoundIgnoring", "%s") +let MSBuildReferenceResolutionErrorE() = DeclareResourceString("MSBuildReferenceResolutionError", "%s%s") +let TargetInvocationExceptionWrapperE() = DeclareResourceString("TargetInvocationExceptionWrapper", "%s") let getErrorString key = SR.GetString key let (|InvalidArgument|_|) (exn:exn) = match exn with :? ArgumentException as e -> Some e.Message | _ -> None let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = + let rec OutputExceptionR (os:StringBuilder) error = + match error with - | ConstraintSolverTupleDiffLengths(_,tl1,tl2,m,m2) -> + | ConstraintSolverTupleDiffLengths(_, tl1, tl2, m, m2) -> os.Append(ConstraintSolverTupleDiffLengthsE().Format tl1.Length tl2.Length) |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore - | ConstraintSolverInfiniteTypes(contextInfo,denv,t1,t2,m,m2) -> + + | ConstraintSolverInfiniteTypes(contextInfo, denv, t1, t2, m, m2) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 os.Append(ConstraintSolverInfiniteTypesE().Format t1 t2) |> ignore @@ -621,11 +624,13 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore - | ConstraintSolverMissingConstraint(denv,tpr,tpc,m,m2) -> - os.Append(ConstraintSolverMissingConstraintE().Format (NicePrint.stringOfTyparConstraint denv (tpr,tpc))) |> ignore + + | ConstraintSolverMissingConstraint(denv, tpr, tpc, m, m2) -> + os.Append(ConstraintSolverMissingConstraintE().Format (NicePrint.stringOfTyparConstraint denv (tpr, tpc))) |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore - | ConstraintSolverTypesNotInEqualityRelation(denv,(TType_measure _ as t1),(TType_measure _ as t2),m,m2,_) -> + + | ConstraintSolverTypesNotInEqualityRelation(denv, (TType_measure _ as t1), (TType_measure _ as t2), m, m2, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 @@ -633,53 +638,58 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore - | ConstraintSolverTypesNotInEqualityRelation(denv,t1,t2,m,m2,contextInfo) -> + + | ConstraintSolverTypesNotInEqualityRelation(denv, t1, t2, m, m2, contextInfo) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 match contextInfo with - | ContextInfo.IfExpression range when range = m -> os.Append(FSComp.SR.ifExpression(t1,t2)) |> ignore - | ContextInfo.CollectionElement (isArray,range) when range = m -> + | ContextInfo.IfExpression range when range = m -> os.Append(FSComp.SR.ifExpression(t1, t2)) |> ignore + | ContextInfo.CollectionElement (isArray, range) when range = m -> if isArray then - os.Append(FSComp.SR.arrayElementHasWrongType(t1,t2)) |> ignore + os.Append(FSComp.SR.arrayElementHasWrongType(t1, t2)) |> ignore else - os.Append(FSComp.SR.listElementHasWrongType(t1,t2)) |> ignore + os.Append(FSComp.SR.listElementHasWrongType(t1, t2)) |> ignore | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore - | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1,t2)) |> ignore - | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1,t2)) |> ignore + | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1, t2)) |> ignore + | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1, t2)) |> ignore | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool(t2)) |> ignore | _ -> os.Append(ConstraintSolverTypesNotInEqualityRelation2E().Format t1 t2) |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore - | ConstraintSolverTypesNotInSubsumptionRelation(denv,t1,t2,m,m2) -> + + | ConstraintSolverTypesNotInSubsumptionRelation(denv, t1, t2, m, m2) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 os.Append(ConstraintSolverTypesNotInSubsumptionRelationE().Format t2 t1 cxs) |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m2)) |> ignore - | ConstraintSolverError(msg,m,m2) -> + + | ConstraintSolverError(msg, m, m2) -> os.Append msg |> ignore if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m2)) |> ignore - | ConstraintSolverRelatedInformation(fopt,_,e) -> + + | ConstraintSolverRelatedInformation(fopt, _, e) -> match e with | ConstraintSolverError _ -> OutputExceptionR os e | _ -> () fopt |> Option.iter (Printf.bprintf os " %s") - | ErrorFromAddingTypeEquation(g,denv,t1,t2,ConstraintSolverTypesNotInEqualityRelation(_, t1', t2',m ,_ , contextInfo),_) + + | ErrorFromAddingTypeEquation(g, denv, t1, t2, ConstraintSolverTypesNotInEqualityRelation(_, t1', t2', m , _ , contextInfo), _) when typeEquiv g t1 t1' && typeEquiv g t2 t2' -> - let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 + let t1, t2, tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 match contextInfo with - | ContextInfo.IfExpression range when range = m -> os.Append(FSComp.SR.ifExpression(t1,t2)) |> ignore - | ContextInfo.CollectionElement (isArray,range) when range = m -> + | ContextInfo.IfExpression range when range = m -> os.Append(FSComp.SR.ifExpression(t1, t2)) |> ignore + | ContextInfo.CollectionElement (isArray, range) when range = m -> if isArray then - os.Append(FSComp.SR.arrayElementHasWrongType(t1,t2)) |> ignore + os.Append(FSComp.SR.arrayElementHasWrongType(t1, t2)) |> ignore else - os.Append(FSComp.SR.listElementHasWrongType(t1,t2)) |> ignore + os.Append(FSComp.SR.listElementHasWrongType(t1, t2)) |> ignore | ContextInfo.OmittedElseBranch range when range = m -> os.Append(FSComp.SR.missingElseBranch(t2)) |> ignore - | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1,t2)) |> ignore - | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1,t2)) |> ignore + | ContextInfo.ElseBranchResult range when range = m -> os.Append(FSComp.SR.elseBranchHasWrongType(t1, t2)) |> ignore + | ContextInfo.FollowingPatternMatchClause range when range = m -> os.Append(FSComp.SR.followingPatternMatchClauseHasWrongType(t1, t2)) |> ignore | ContextInfo.PatternMatchGuard range when range = m -> os.Append(FSComp.SR.patternMatchGuardIsNotBool(t2)) |> ignore | ContextInfo.TupleInRecordFields -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore @@ -688,140 +698,179 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore os.Append(System.Environment.NewLine + FSComp.SR.derefInsteadOfNot()) |> ignore | _ -> os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore - | ErrorFromAddingTypeEquation(_,_,_,_,((ConstraintSolverTypesNotInEqualityRelation (_,_,_,_,_,contextInfo) ) as e), _) when contextInfo <> ContextInfo.NoContext -> + + | ErrorFromAddingTypeEquation(_, _, _, _, ((ConstraintSolverTypesNotInEqualityRelation (_, _, _, _, _, contextInfo) ) as e), _) when contextInfo <> ContextInfo.NoContext -> OutputExceptionR os e - | ErrorFromAddingTypeEquation(_,_,_,_,((ConstraintSolverTypesNotInSubsumptionRelation _ | ConstraintSolverError _ ) as e), _) -> + + | ErrorFromAddingTypeEquation(_, _, _, _, ((ConstraintSolverTypesNotInSubsumptionRelation _ | ConstraintSolverError _ ) as e), _) -> OutputExceptionR os e - | ErrorFromAddingTypeEquation(g,denv,t1,t2,e,_) -> + + | ErrorFromAddingTypeEquation(g, denv, t1, t2, e, _) -> if not (typeEquiv g t1 t2) then - let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 + let t1, t2, tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 if t1<>t2 + tpcs then os.Append(ErrorFromAddingTypeEquation2E().Format t1 t2 tpcs) |> ignore OutputExceptionR os e - | ErrorFromApplyingDefault(_,denv,_,defaultType,e,_) -> + + | ErrorFromApplyingDefault(_, denv, _, defaultType, e, _) -> let defaultType = NicePrint.minimalStringOfType denv defaultType os.Append(ErrorFromApplyingDefault1E().Format defaultType) |> ignore OutputExceptionR os e os.Append(ErrorFromApplyingDefault2E().Format) |> ignore - | ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e,contextInfo,_) -> + + | ErrorsFromAddingSubsumptionConstraint(g, denv, t1, t2, e, contextInfo, _) -> match contextInfo with | ContextInfo.DowncastUsedInsteadOfUpcast isOperator -> - let t1,t2,_ = NicePrint.minimalStringsOfTwoTypes denv t1 t2 + let t1, t2, _ = NicePrint.minimalStringsOfTwoTypes denv t1 t2 if isOperator then - os.Append(FSComp.SR.considerUpcastOperator(t1,t2) |> snd) |> ignore + os.Append(FSComp.SR.considerUpcastOperator(t1, t2) |> snd) |> ignore else - os.Append(FSComp.SR.considerUpcast(t1,t2) |> snd) |> ignore + os.Append(FSComp.SR.considerUpcast(t1, t2) |> snd) |> ignore | _ -> if not (typeEquiv g t1 t2) then - let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 + let t1, t2, tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2 if t1 <> (t2 + tpcs) then os.Append(ErrorsFromAddingSubsumptionConstraintE().Format t2 t1 tpcs) |> ignore else OutputExceptionR os e else OutputExceptionR os e + | UpperCaseIdentifierInPattern(_) -> os.Append(UpperCaseIdentifierInPatternE().Format) |> ignore + | NotUpperCaseConstructor(_) -> os.Append(NotUpperCaseConstructorE().Format) |> ignore - | ErrorFromAddingConstraint(_,e,_) -> + + | ErrorFromAddingConstraint(_, e, _) -> OutputExceptionR os e + #if EXTENSIONTYPING | ExtensionTyping.ProvidedTypeResolutionNoRange(e) - | ExtensionTyping.ProvidedTypeResolution(_,e) -> + + | ExtensionTyping.ProvidedTypeResolution(_, e) -> OutputExceptionR os e + | :? TypeProviderError as e -> os.Append(e.ContextualErrorMessage) |> ignore #endif - | UnresolvedOverloading(_,_,mtext,_) -> + + | UnresolvedOverloading(_, _, mtext, _) -> os.Append(mtext) |> ignore - | UnresolvedConversionOperator(denv,fromTy,toTy,_) -> - let t1,t2,_tpcs = NicePrint.minimalStringsOfTwoTypes denv fromTy toTy - os.Append(FSComp.SR.csTypeDoesNotSupportConversion(t1,t2)) |> ignore - | PossibleOverload(_,minfo, originalError, _) -> + + | UnresolvedConversionOperator(denv, fromTy, toTy, _) -> + let t1, t2, _tpcs = NicePrint.minimalStringsOfTwoTypes denv fromTy toTy + os.Append(FSComp.SR.csTypeDoesNotSupportConversion(t1, t2)) |> ignore + + | PossibleOverload(_, minfo, originalError, _) -> // print original error that describes reason why this overload was rejected let buf = new StringBuilder() OutputExceptionR buf originalError os.Append(PossibleOverloadE().Format minfo (buf.ToString())) |> ignore - //| PossibleBestOverload(_,minfo,m) -> + + //| PossibleBestOverload(_, minfo, m) -> // Printf.bprintf os "\n\nPossible best overload: '%s'." minfo + | FunctionExpected _ -> os.Append(FunctionExpectedE().Format) |> ignore - | BakedInMemberConstraintName(nm,_) -> + + | BakedInMemberConstraintName(nm, _) -> os.Append(BakedInMemberConstraintNameE().Format nm) |> ignore - | StandardOperatorRedefinitionWarning(msg,_) -> + + | StandardOperatorRedefinitionWarning(msg, _) -> os.Append(msg) |> ignore + | BadEventTransformation(_) -> os.Append(BadEventTransformationE().Format) |> ignore + | ParameterlessStructCtor(_) -> os.Append(ParameterlessStructCtorE().Format) |> ignore - | InterfaceNotRevealed(denv,ity,_) -> + + | InterfaceNotRevealed(denv, ity, _) -> os.Append(InterfaceNotRevealedE().Format (NicePrint.minimalStringOfType denv ity)) |> ignore - | NotAFunctionButIndexer(_,_,name,_,_) -> + + | NotAFunctionButIndexer(_, _, name, _, _) -> match name with | Some name -> os.Append(FSComp.SR.notAFunctionButMaybeIndexerWithName name) |> ignore | _ -> os.Append(FSComp.SR.notAFunctionButMaybeIndexer()) |> ignore - | NotAFunction(_,_,_,marg) -> + + | NotAFunction(_, _, _, marg) -> if marg.StartColumn = 0 then os.Append(FSComp.SR.notAFunctionButMaybeDeclaration()) |> ignore else os.Append(FSComp.SR.notAFunction()) |> ignore - | TyconBadArgs(_,tcref,d,_) -> + + | TyconBadArgs(_, tcref, d, _) -> let exp = tcref.TyparsNoRange.Length if exp = 0 then os.Append(FSComp.SR.buildUnexpectedTypeArgs(fullDisplayTextOfTyconRef tcref, d)) |> ignore else os.Append(TyconBadArgsE().Format (fullDisplayTextOfTyconRef tcref) exp d) |> ignore + | IndeterminateType(_) -> os.Append(IndeterminateTypeE().Format) |> ignore - | NameClash(nm,k1,nm1,_,k2,nm2,_) -> + + | NameClash(nm, k1, nm1, _, k2, nm2, _) -> if nm = nm1 && nm1 = nm2 && k1 = k2 then os.Append(NameClash1E().Format k1 nm1) |> ignore else os.Append(NameClash2E().Format k1 nm1 nm k2 nm2) |> ignore - | Duplicate(k,s,_) -> + + | Duplicate(k, s, _) -> if k = "member" then os.Append(Duplicate1E().Format (DecompileOpName s)) |> ignore else os.Append(Duplicate2E().Format k (DecompileOpName s)) |> ignore - | UndefinedName(_,k,id,suggestionsF) -> + + | UndefinedName(_, k, id, suggestionsF) -> os.Append(k (DecompileOpName id.idText)) |> ignore let filtered = ErrorResolutionHints.FilterPredictions id.idText suggestionsF if List.isEmpty filtered |> not then os.Append(ErrorResolutionHints.FormatPredictions DecompileOpName filtered) |> ignore - | InternalUndefinedItemRef(f,smr,ccuName,s) -> + + | InternalUndefinedItemRef(f, smr, ccuName, s) -> let _, errs = f(smr, ccuName, s) os.Append(errs) |> ignore + | FieldNotMutable _ -> os.Append(FieldNotMutableE().Format) |> ignore - | FieldsFromDifferentTypes (_,fref1,fref2,_) -> + + | FieldsFromDifferentTypes (_, fref1, fref2, _) -> os.Append(FieldsFromDifferentTypesE().Format fref1.FieldName fref2.FieldName) |> ignore + | VarBoundTwice(id) -> os.Append(VarBoundTwiceE().Format (DecompileOpName id.idText)) |> ignore - | Recursion (denv,id,ty1,ty2,_) -> - let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 + + | Recursion (denv, id, ty1, ty2, _) -> + let t1, t2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(RecursionE().Format (DecompileOpName id.idText) t1 t2 tpcs) |> ignore - | InvalidRuntimeCoercion(denv,ty1,ty2,_) -> - let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 + + | InvalidRuntimeCoercion(denv, ty1, ty2, _) -> + let t1, t2, tpcs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(InvalidRuntimeCoercionE().Format t1 t2 tpcs) |> ignore - | IndeterminateRuntimeCoercion(denv,ty1,ty2,_) -> + + | IndeterminateRuntimeCoercion(denv, ty1, ty2, _) -> let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(IndeterminateRuntimeCoercionE().Format t1 t2) |> ignore - | IndeterminateStaticCoercion(denv,ty1,ty2,_) -> + + | IndeterminateStaticCoercion(denv, ty1, ty2, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(IndeterminateStaticCoercionE().Format t1 t2) |> ignore - | StaticCoercionShouldUseBox(denv,ty1,ty2,_) -> + + | StaticCoercionShouldUseBox(denv, ty1, ty2, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2 os.Append(StaticCoercionShouldUseBoxE().Format t1 t2) |> ignore + | TypeIsImplicitlyAbstract(_) -> os.Append(TypeIsImplicitlyAbstractE().Format) |> ignore - | NonRigidTypar(denv,tpnmOpt,typarRange,ty1,ty,_) -> + + | NonRigidTypar(denv, tpnmOpt, typarRange, ty1, ty, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) - let (ty1,ty), _cxs = PrettyTypes.PrettifyTypePair denv.g (ty1,ty) + let (ty1, ty), _cxs = PrettyTypes.PrettifyTypePair denv.g (ty1, ty) match tpnmOpt with | None -> os.Append(NonRigidTypar1E().Format (stringOfRange typarRange) (NicePrint.stringOfTy denv ty)) |> ignore @@ -831,7 +880,8 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = os.Append(NonRigidTypar2E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore | _ -> os.Append(NonRigidTypar3E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore - | SyntaxError (ctxt,_) -> + + | SyntaxError (ctxt, _) -> let ctxt = unbox>(ctxt) let (|EndOfStructuredConstructToken|_|) token = @@ -1025,7 +1075,7 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = | Parser.TOKEN_CONST -> getErrorString("Parser.TOKEN.CONST") | Parser.TOKEN_FIXED -> getErrorString("Parser.TOKEN.FIXED") | unknown -> - System.Diagnostics.Debug.Assert(false,"unknown token tag") + System.Diagnostics.Debug.Assert(false, "unknown token tag") let result = sprintf "%+A" unknown System.Diagnostics.Debug.Assert(false, result) result @@ -1034,9 +1084,9 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = | None -> os.Append(UnexpectedEndOfInputE().Format) |> ignore | Some token -> match (token |> Parser.tagOfToken |> Parser.tokenTagToTokenId), token with - | EndOfStructuredConstructToken,_ -> os.Append(OBlockEndSentenceE().Format) |> ignore + | EndOfStructuredConstructToken, _ -> os.Append(OBlockEndSentenceE().Format) |> ignore | Parser.TOKEN_LEX_FAILURE, Parser.LEX_FAILURE str -> Printf.bprintf os "%s" str (* Fix bug://2431 *) - | token,_ -> os.Append(UnexpectedE().Format (token |> tokenIdToText)) |> ignore + | token, _ -> os.Append(UnexpectedE().Format (token |> tokenIdToText)) |> ignore (* Search for a state producing a single recognized non-terminal in the states on the stack *) let foundInContext = @@ -1139,7 +1189,7 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = #else foundInContext |> ignore // suppress unused variable warning in RELEASE #endif - let fix (s:string) = s.Replace(SR.GetString("FixKeyword"),"").Replace(SR.GetString("FixSymbol"),"").Replace(SR.GetString("FixReplace"),"") + let fix (s:string) = s.Replace(SR.GetString("FixKeyword"), "").Replace(SR.GetString("FixSymbol"), "").Replace(SR.GetString("FixReplace"), "") match (ctxt.ShiftTokens |> List.map Parser.tokenTagToTokenId |> List.filter (function Parser.TOKEN_error | Parser.TOKEN_EOF -> false | _ -> true) @@ -1159,23 +1209,29 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = ctxt.ReducibleProductions (List.mapSquared Parser.prodIdxToNonTerminal ctxt.ReducibleProductions) *) - | RuntimeCoercionSourceSealed(denv,ty,_) -> + + | RuntimeCoercionSourceSealed(denv, ty, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let ty, _cxs = PrettyTypes.PrettifyType denv.g ty if isTyparTy denv.g ty then os.Append(RuntimeCoercionSourceSealed1E().Format (NicePrint.stringOfTy denv ty)) |> ignore else os.Append(RuntimeCoercionSourceSealed2E().Format (NicePrint.stringOfTy denv ty)) |> ignore - | CoercionTargetSealed(denv,ty,_) -> + + | CoercionTargetSealed(denv, ty, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let ty, _cxs= PrettyTypes.PrettifyType denv.g ty os.Append(CoercionTargetSealedE().Format (NicePrint.stringOfTy denv ty)) |> ignore + | UpcastUnnecessary(_) -> os.Append(UpcastUnnecessaryE().Format) |> ignore + | TypeTestUnnecessary(_) -> os.Append(TypeTestUnnecessaryE().Format) |> ignore - | QuotationTranslator.IgnoringPartOfQuotedTermWarning (msg,_) -> + + | QuotationTranslator.IgnoringPartOfQuotedTermWarning (msg, _) -> Printf.bprintf os "%s" msg - | OverrideDoesntOverride(denv,impl,minfoVirtOpt,g,amap,m) -> + + | OverrideDoesntOverride(denv, impl, minfoVirtOpt, g, amap, m) -> let sig1 = DispatchSlotChecking.FormatOverride denv impl match minfoVirtOpt with | None -> @@ -1203,69 +1259,93 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = if sig1 <> sig2 then os.Append(OverrideDoesntOverride3E().Format sig2) |> ignore - | UnionCaseWrongArguments (_,n1,n2,_) -> + | UnionCaseWrongArguments (_, n1, n2, _) -> os.Append(UnionCaseWrongArgumentsE().Format n2 n1) |> ignore + | UnionPatternsBindDifferentNames _ -> os.Append(UnionPatternsBindDifferentNamesE().Format) |> ignore - | ValueNotContained (denv,mref,implVal,sigVal,f) -> - let text1,text2 = NicePrint.minimalStringsOfTwoValues denv implVal sigVal + + | ValueNotContained (denv, mref, implVal, sigVal, f) -> + let text1, text2 = NicePrint.minimalStringsOfTwoValues denv implVal sigVal os.Append(f((fullDisplayTextOfModRef mref), text1, text2)) |> ignore - | ConstrNotContained (denv,v1,v2,f) -> + + | ConstrNotContained (denv, v1, v2, f) -> os.Append(f((NicePrint.stringOfUnionCase denv v1), (NicePrint.stringOfUnionCase denv v2))) |> ignore - | ExnconstrNotContained (denv,v1,v2,f) -> + + | ExnconstrNotContained (denv, v1, v2, f) -> os.Append(f((NicePrint.stringOfExnDef denv v1), (NicePrint.stringOfExnDef denv v2))) |> ignore - | FieldNotContained (denv,v1,v2,f) -> + + | FieldNotContained (denv, v1, v2, f) -> os.Append(f((NicePrint.stringOfRecdField denv v1), (NicePrint.stringOfRecdField denv v2))) |> ignore - | RequiredButNotSpecified (_,mref,k,name,_) -> + + | RequiredButNotSpecified (_, mref, k, name, _) -> let nsb = new System.Text.StringBuilder() name nsb; os.Append(RequiredButNotSpecifiedE().Format (fullDisplayTextOfModRef mref) k (nsb.ToString())) |> ignore + | UseOfAddressOfOperator _ -> os.Append(UseOfAddressOfOperatorE().Format) |> ignore - | DefensiveCopyWarning(s,_) -> os.Append(DefensiveCopyWarningE().Format s) |> ignore + + | DefensiveCopyWarning(s, _) -> os.Append(DefensiveCopyWarningE().Format s) |> ignore + | DeprecatedThreadStaticBindingWarning(_) -> os.Append(DeprecatedThreadStaticBindingWarningE().Format) |> ignore - | FunctionValueUnexpected (denv,ty,_) -> + + | FunctionValueUnexpected (denv, ty, _) -> // REVIEW: consider if we need to show _cxs (the type parameter constraints) let ty, _cxs = PrettyTypes.PrettifyType denv.g ty os.Append(FunctionValueUnexpectedE().Format (NicePrint.stringOfTy denv ty)) |> ignore - | UnitTypeExpected (_,_,_) -> + + | UnitTypeExpected (_, _, _) -> let warningText = UnitTypeExpectedE().Format os.Append warningText |> ignore + | UnitTypeExpectedWithEquality (_) -> let warningText = UnitTypeExpectedWithEqualityE().Format os.Append warningText |> ignore - | UnitTypeExpectedWithPossiblePropertySetter (_,_,bindingName,propertyName,_) -> + + | UnitTypeExpectedWithPossiblePropertySetter (_, _, bindingName, propertyName, _) -> let warningText = UnitTypeExpectedWithPossiblePropertySetterE().Format bindingName propertyName os.Append warningText |> ignore - | UnitTypeExpectedWithPossibleAssignment (_,_,isAlreadyMutable,bindingName,_) -> + + | UnitTypeExpectedWithPossibleAssignment (_, _, isAlreadyMutable, bindingName, _) -> let warningText = if isAlreadyMutable then UnitTypeExpectedWithPossibleAssignmentToMutableE().Format bindingName else UnitTypeExpectedWithPossibleAssignmentE().Format bindingName os.Append warningText |> ignore + | RecursiveUseCheckedAtRuntime _ -> os.Append(RecursiveUseCheckedAtRuntimeE().Format) |> ignore - | LetRecUnsound (_,[v],_) -> + + | LetRecUnsound (_, [v], _) -> os.Append(LetRecUnsound1E().Format v.DisplayName) |> ignore - | LetRecUnsound (_,path,_) -> + + | LetRecUnsound (_, path, _) -> let bos = new System.Text.StringBuilder() (path.Tail @ [path.Head]) |> List.iter (fun (v:ValRef) -> bos.Append(LetRecUnsoundInnerE().Format v.DisplayName) |> ignore) os.Append(LetRecUnsound2E().Format (List.head path).DisplayName (bos.ToString())) |> ignore - | LetRecEvaluatedOutOfOrder (_,_,_,_) -> + + | LetRecEvaluatedOutOfOrder (_, _, _, _) -> os.Append(LetRecEvaluatedOutOfOrderE().Format) |> ignore + | LetRecCheckedAtRuntime _ -> os.Append(LetRecCheckedAtRuntimeE().Format) |> ignore - | SelfRefObjCtor(false,_) -> + + | SelfRefObjCtor(false, _) -> os.Append(SelfRefObjCtor1E().Format) |> ignore - | SelfRefObjCtor(true,_) -> + + | SelfRefObjCtor(true, _) -> os.Append(SelfRefObjCtor2E().Format) |> ignore + | VirtualAugmentationOnNullValuedType(_) -> os.Append(VirtualAugmentationOnNullValuedTypeE().Format) |> ignore + | NonVirtualAugmentationOnNullValuedType(_) -> os.Append(NonVirtualAugmentationOnNullValuedTypeE().Format) |> ignore - | NonUniqueInferredAbstractSlot(_,denv,bindnm,bvirt1,bvirt2,_) -> + + | NonUniqueInferredAbstractSlot(_, denv, bindnm, bvirt1, bvirt2, _) -> os.Append(NonUniqueInferredAbstractSlot1E().Format bindnm) |> ignore let ty1 = bvirt1.EnclosingType let ty2 = bvirt2.EnclosingType @@ -1275,15 +1355,21 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = if t1 <> t2 then os.Append(NonUniqueInferredAbstractSlot3E().Format t1 t2) |> ignore os.Append(NonUniqueInferredAbstractSlot4E().Format) |> ignore - | Error ((_,s),_) -> os.Append(s) |> ignore - | ErrorWithSuggestions ((_,s),_,idText,suggestionF) -> + + | Error ((_, s), _) -> os.Append(s) |> ignore + + | ErrorWithSuggestions ((_, s), _, idText, suggestionF) -> os.Append(DecompileOpName s) |> ignore let filtered = ErrorResolutionHints.FilterPredictions idText suggestionF if List.isEmpty filtered |> not then os.Append(ErrorResolutionHints.FormatPredictions DecompileOpName filtered) |> ignore - | NumberedError ((_,s),_) -> os.Append(s) |> ignore - | InternalError (s,_) + + | NumberedError ((_, s), _) -> os.Append(s) |> ignore + + | InternalError (s, _) + | InvalidArgument s + | Failure s as exn -> ignore exn // use the argument, even in non DEBUG let f1 = SR.GetString("Failure1") @@ -1295,32 +1381,47 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = #if DEBUG Printf.bprintf os "\nStack Trace\n%s\n" (exn.ToString()) if !showAssertForUnexpectedException then - System.Diagnostics.Debug.Assert(false,sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString())) + System.Diagnostics.Debug.Assert(false, sprintf "Unexpected exception seen in compiler: %s\n%s" s (exn.ToString())) #endif - | FullAbstraction(s,_) -> os.Append(FullAbstractionE().Format s) |> ignore - | WrappedError (exn,_) -> OutputExceptionR os exn - | PatternMatchCompilation.MatchIncomplete (isComp,cexOpt,_) -> + + | FullAbstraction(s, _) -> os.Append(FullAbstractionE().Format s) |> ignore + + | WrappedError (exn, _) -> OutputExceptionR os exn + + | PatternMatchCompilation.MatchIncomplete (isComp, cexOpt, _) -> os.Append(MatchIncomplete1E().Format) |> ignore match cexOpt with | None -> () - | Some (cex,false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore - | Some (cex,true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore + | Some (cex, false) -> os.Append(MatchIncomplete2E().Format cex) |> ignore + | Some (cex, true) -> os.Append(MatchIncomplete3E().Format cex) |> ignore if isComp then os.Append(MatchIncomplete4E().Format) |> ignore + | PatternMatchCompilation.RuleNeverMatched _ -> os.Append(RuleNeverMatchedE().Format) |> ignore - | ValNotMutable(_,valRef,_) -> os.Append(ValNotMutableE().Format(valRef.DisplayName)) |> ignore + + | ValNotMutable(_, valRef, _) -> os.Append(ValNotMutableE().Format(valRef.DisplayName)) |> ignore + | ValNotLocal _ -> os.Append(ValNotLocalE().Format) |> ignore + | ObsoleteError (s, _) + | ObsoleteWarning (s, _) -> os.Append(Obsolete1E().Format) |> ignore if s <> "" then os.Append(Obsolete2E().Format s) |> ignore + | Experimental (s, _) -> os.Append(ExperimentalE().Format s) |> ignore + | PossibleUnverifiableCode _ -> os.Append(PossibleUnverifiableCodeE().Format) |> ignore + | UserCompilerMessage (msg, _, _) -> os.Append(msg) |> ignore + | Deprecated(s, _) -> os.Append(DeprecatedE().Format s) |> ignore + | LibraryUseOnly(_) -> os.Append(LibraryUseOnlyE().Format) |> ignore - | MissingFields(sl,_) -> os.Append(MissingFieldsE().Format (String.concat "," sl + ".")) |> ignore - | ValueRestriction(denv,hassig,v,_,_) -> + + | MissingFields(sl, _) -> os.Append(MissingFieldsE().Format (String.concat "," sl + ".")) |> ignore + + | ValueRestriction(denv, hassig, v, _, _) -> let denv = { denv with showImperativeTyparAnnotations=true } let tau = v.TauType if hassig then @@ -1356,42 +1457,65 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = (NicePrint.stringOfQualifiedValOrMember denv v) v.DisplayName) |> ignore + | Parsing.RecoverableParseError -> os.Append(RecoverableParseErrorE().Format) |> ignore - | ReservedKeyword (s,_) -> os.Append(ReservedKeywordE().Format s) |> ignore - | IndentationProblem (s,_) -> os.Append(IndentationProblemE().Format s) |> ignore + + | ReservedKeyword (s, _) -> os.Append(ReservedKeywordE().Format s) |> ignore + + | IndentationProblem (s, _) -> os.Append(IndentationProblemE().Format s) |> ignore + | OverrideInIntrinsicAugmentation(_) -> os.Append(OverrideInIntrinsicAugmentationE().Format) |> ignore + | OverrideInExtrinsicAugmentation(_) -> os.Append(OverrideInExtrinsicAugmentationE().Format) |> ignore + | IntfImplInIntrinsicAugmentation(_) -> os.Append(IntfImplInIntrinsicAugmentationE().Format) |> ignore + | IntfImplInExtrinsicAugmentation(_) -> os.Append(IntfImplInExtrinsicAugmentationE().Format) |> ignore - | UnresolvedReferenceError(assemblyname,_) + + | UnresolvedReferenceError(assemblyname, _) + | UnresolvedReferenceNoRange(assemblyname) -> os.Append(UnresolvedReferenceNoRangeE().Format assemblyname) |> ignore - | UnresolvedPathReference(assemblyname,pathname,_) - | UnresolvedPathReferenceNoRange(assemblyname,pathname) -> + + | UnresolvedPathReference(assemblyname, pathname, _) + + | UnresolvedPathReferenceNoRange(assemblyname, pathname) -> os.Append(UnresolvedPathReferenceNoRangeE().Format pathname assemblyname) |> ignore - | DeprecatedCommandLineOptionFull(fullText,_) -> + + | DeprecatedCommandLineOptionFull(fullText, _) -> os.Append(fullText) |> ignore - | DeprecatedCommandLineOptionForHtmlDoc(optionName,_) -> + + | DeprecatedCommandLineOptionForHtmlDoc(optionName, _) -> os.Append(FSComp.SR.optsDCLOHtmlDoc(optionName)) |> ignore - | DeprecatedCommandLineOptionSuggestAlternative(optionName,altOption,_) -> + + | DeprecatedCommandLineOptionSuggestAlternative(optionName, altOption, _) -> os.Append(FSComp.SR.optsDCLODeprecatedSuggestAlternative(optionName, altOption)) |> ignore - | InternalCommandLineOption(optionName,_) -> + + | InternalCommandLineOption(optionName, _) -> os.Append(FSComp.SR.optsInternalNoDescription(optionName)) |> ignore - | DeprecatedCommandLineOptionNoDescription(optionName,_) -> + + | DeprecatedCommandLineOptionNoDescription(optionName, _) -> os.Append(FSComp.SR.optsDCLONoDescription(optionName)) |> ignore + | HashIncludeNotAllowedInNonScript(_) -> os.Append(HashIncludeNotAllowedInNonScriptE().Format) |> ignore + | HashReferenceNotAllowedInNonScript(_) -> os.Append(HashReferenceNotAllowedInNonScriptE().Format) |> ignore + | HashDirectiveNotAllowedInNonScript(_) -> os.Append(HashDirectiveNotAllowedInNonScriptE().Format) |> ignore - | FileNameNotResolved(filename,locations,_) -> + + | FileNameNotResolved(filename, locations, _) -> os.Append(FileNameNotResolvedE().Format filename locations) |> ignore - | AssemblyNotResolved(originalName,_) -> + + | AssemblyNotResolved(originalName, _) -> os.Append(AssemblyNotResolvedE().Format originalName) |> ignore - | IllegalFileNameChar(fileName,invalidChar) -> - os.Append(FSComp.SR.buildUnexpectedFileNameCharacter(fileName,string invalidChar)|>snd) |> ignore - | HashLoadedSourceHasIssues(warnings,errors,_) -> + + | IllegalFileNameChar(fileName, invalidChar) -> + os.Append(FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)|>snd) |> ignore + + | HashLoadedSourceHasIssues(warnings, errors, _) -> let Emit(l:exn list) = OutputExceptionR os (List.head l) if errors=[] then @@ -1400,25 +1524,37 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = else os.Append(HashLoadedSourceHasIssues2E().Format) |> ignore Emit(errors) + | HashLoadedScriptConsideredSource(_) -> os.Append(HashLoadedScriptConsideredSourceE().Format) |> ignore - | InvalidInternalsVisibleToAssemblyName(badName,fileNameOption) -> + + | InvalidInternalsVisibleToAssemblyName(badName, fileNameOption) -> match fileNameOption with | Some file -> os.Append(InvalidInternalsVisibleToAssemblyName1E().Format badName file) |> ignore | None -> os.Append(InvalidInternalsVisibleToAssemblyName2E().Format badName) |> ignore - | LoadedSourceNotFoundIgnoring(filename,_) -> + + | LoadedSourceNotFoundIgnoring(filename, _) -> os.Append(LoadedSourceNotFoundIgnoringE().Format filename) |> ignore - | MSBuildReferenceResolutionWarning(code,message,_) - | MSBuildReferenceResolutionError(code,message,_) -> + + | MSBuildReferenceResolutionWarning(code, message, _) + + | MSBuildReferenceResolutionError(code, message, _) -> os.Append(MSBuildReferenceResolutionErrorE().Format message code) |> ignore + // Strip TargetInvocationException wrappers | :? System.Reflection.TargetInvocationException as e -> OutputExceptionR os e.InnerException + | :? FileNotFoundException as e -> Printf.bprintf os "%s" e.Message + | :? DirectoryNotFoundException as e -> Printf.bprintf os "%s" e.Message + | :? System.ArgumentException as e -> Printf.bprintf os "%s" e.Message + | :? System.NotSupportedException as e -> Printf.bprintf os "%s" e.Message + | :? IOException as e -> Printf.bprintf os "%s" e.Message + | :? System.UnauthorizedAccessException as e -> Printf.bprintf os "%s" e.Message | e -> @@ -1426,8 +1562,9 @@ let OutputPhasedErrorR (os:StringBuilder) (err:PhasedDiagnostic) = #if DEBUG Printf.bprintf os "\nStack Trace\n%s\n" (e.ToString()) if !showAssertForUnexpectedException then - System.Diagnostics.Debug.Assert(false,sprintf "Unknown exception seen in compiler: %s" (e.ToString())) + System.Diagnostics.Debug.Assert(false, sprintf "Unknown exception seen in compiler: %s" (e.ToString())) #endif + OutputExceptionR os (err.Exception) @@ -1456,7 +1593,7 @@ let SanitizeFileName fileName implicitIncludeDir = fullPath // if the file name is rooted in the current directory, return the relative path else - fullPath.Replace(currentDir+"\\","") + fullPath.Replace(currentDir+"\\", "") with _ -> fileName @@ -1485,8 +1622,8 @@ type Diagnostic = | Long of bool * DiagnosticDetailedInfo /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle,isError, err:PhasedDiagnostic) = - let outputWhere (showFullPaths,errorStyle) m : DiagnosticLocation = +let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError, err:PhasedDiagnostic) = + let outputWhere (showFullPaths, errorStyle) m : DiagnosticLocation = if m = rangeStartup || m = rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } else @@ -1498,23 +1635,23 @@ let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle let text, m, file = match errorStyle with | ErrorStyle.EmacsErrors -> - let file = file.Replace("\\","/") + let file = file.Replace("\\", "/") (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output | ErrorStyle.DefaultErrors -> - let file = file.Replace('/',System.IO.Path.DirectorySeparatorChar) + let file = file.Replace('/', System.IO.Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file // We may also want to change TestErrors to be 1-based | ErrorStyle.TestErrors -> - let file = file.Replace("/","\\") + let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file | ErrorStyle.GccErrors -> - let file = file.Replace('/',System.IO.Path.DirectorySeparatorChar) + let file = file.Replace('/', System.IO.Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file @@ -1523,7 +1660,7 @@ let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle // Show prefix only for real files. Otherwise, we just want a truncated error like: // parse error FS0031 : blah blah if m<>range0 && m<>rangeStartup && m<>rangeCmdArgs then - let file = file.Replace("/","\\") + let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s(%d,%d,%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file else @@ -1542,7 +1679,7 @@ let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle let report err = let OutputWhere(err) = match GetRangeOfDiagnostic err with - | Some m -> Some(outputWhere (showFullPaths,errorStyle) m) + | Some m -> Some(outputWhere (showFullPaths, errorStyle) m) | None -> None let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = @@ -1553,9 +1690,9 @@ let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle | _ -> sprintf "%s FS%04d: " (if isError then "error" else "warning") errorNumber { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} - let mainError,relatedErrors = SplitRelatedDiagnostics err + let mainError, relatedErrors = SplitRelatedDiagnostics err let where = OutputWhere(mainError) - let canonical = OutputCanonicalInformation(err.Subcategory(),GetDiagnosticNumber mainError) + let canonical = OutputCanonicalInformation(err.Subcategory(), GetDiagnosticNumber mainError) let message = let os = System.Text.StringBuilder() OutputPhasedDiagnostic os mainError flattenErrors @@ -1570,7 +1707,7 @@ let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle // Give a canonical string when --vserror. | ErrorStyle.VSErrors -> let relWhere = OutputWhere(mainError) // mainError? - let relCanonical = OutputCanonicalInformation(err.Subcategory(),GetDiagnosticNumber mainError) // Use main error for code + let relCanonical = OutputCanonicalInformation(err.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code let relMessage = let os = System.Text.StringBuilder() OutputPhasedDiagnostic os err flattenErrors @@ -1600,9 +1737,9 @@ let CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder -let rec OutputDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle,isError) os (err:PhasedDiagnostic) = +let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError) os (err:PhasedDiagnostic) = - let errors = CollectDiagnostic (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle,isError, err) + let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, isError, err) for e in errors do Printf.bprintf os "\n" match e with @@ -1643,7 +1780,7 @@ let GetDefaultSystemValueTupleReference() = None // TODO, right now FCS doesn't add this reference automatically #else try - let asm = typeof>.Assembly + let asm = typeof>.Assembly if asm.FullName.StartsWith "System.ValueTuple" then Some asm.Location else None @@ -1692,7 +1829,7 @@ let DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) = yield "System.Windows.Forms" yield "System.Numerics" else - yield Path.Combine(Path.GetDirectoryName(typeof.Assembly.Location),"mscorlib.dll"); // mscorlib + yield Path.Combine(Path.GetDirectoryName(typeof.Assembly.Location), "mscorlib.dll"); // mscorlib yield typeof.Assembly.Location; // System.Console yield typeof.Assembly.Location; // System.Runtime yield typeof.Assembly.Location; // System.ObjectModel @@ -1824,7 +1961,7 @@ let BasicReferencesForScriptLoadClosure(useFsiAuxLib, assumeDotNetFramework) = if assumeDotNetFramework then #if COMPILER_SERVICE_ASSUMES_DOTNETCORE_COMPILATION - yield Path.Combine(Path.GetDirectoryName(typeof.Assembly.Location),"mscorlib.dll"); // mscorlib + yield Path.Combine(Path.GetDirectoryName(typeof.Assembly.Location), "mscorlib.dll"); // mscorlib #else yield "mscorlib" #endif @@ -1841,10 +1978,10 @@ let (++) x s = x @ [s] //-------------------------------------------------------------------------- /// Will return None if the filename is not found. -let TryResolveFileUsingPaths(paths,m,name) = +let TryResolveFileUsingPaths(paths, m, name) = let () = try FileSystem.IsPathRootedShim(name) |> ignore - with :? System.ArgumentException as e -> error(Error(FSComp.SR.buildProblemWithFilename(name,e.Message),m)) + with :? System.ArgumentException as e -> error(Error(FSComp.SR.buildProblemWithFilename(name, e.Message), m)) if FileSystem.IsPathRootedShim(name) && FileSystem.SafeExists name then Some name else @@ -1855,24 +1992,24 @@ let TryResolveFileUsingPaths(paths,m,name) = res /// Will raise FileNameNotResolved if the filename was not found -let ResolveFileUsingPaths(paths,m,name) = - match TryResolveFileUsingPaths(paths,m,name) with +let ResolveFileUsingPaths(paths, m, name) = + match TryResolveFileUsingPaths(paths, m, name) with | Some(res) -> res | None -> let searchMessage = String.concat "\n " paths - raise (FileNameNotResolved(name,searchMessage,m)) + raise (FileNameNotResolved(name, searchMessage, m)) -let GetWarningNumber(m,s:string) = +let GetWarningNumber(m, s:string) = try Some (int32 s) with err -> - warning(Error(FSComp.SR.buildInvalidWarningNumber(s),m)) + warning(Error(FSComp.SR.buildInvalidWarningNumber(s), m)) None let ComputeMakePathAbsolute implicitIncludeDir (path : string) = try // remove any quotation marks from the path first - let path = path.Replace("\"","") + let path = path.Replace("\"", "") if not (FileSystem.IsPathRootedShim(path)) then Path.Combine (implicitIncludeDir, path) else path @@ -1901,15 +2038,15 @@ type VersionFlag = let vstr = x.GetVersionString(implicitIncludeDir) try IL.parseILVersion vstr - with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString(vstr),rangeStartup)); IL.parseILVersion "0.0.0.0" + with _ -> errorR(Error(FSComp.SR.buildInvalidVersionString(vstr), rangeStartup)); IL.parseILVersion "0.0.0.0" member x.GetVersionString(implicitIncludeDir) = match x with | VersionString s -> s | VersionFile s -> - let s = if FileSystem.IsPathRootedShim(s) then s else Path.Combine(implicitIncludeDir,s) + let s = if FileSystem.IsPathRootedShim(s) then s else Path.Combine(implicitIncludeDir, s) if not(FileSystem.SafeExists(s)) then - errorR(Error(FSComp.SR.buildInvalidVersionFile(s),rangeStartup)); "0.0.0.0" + errorR(Error(FSComp.SR.buildInvalidVersionFile(s), rangeStartup)); "0.0.0.0" else use is = System.IO.File.OpenText s is.ReadLine() @@ -1941,8 +2078,8 @@ type IRawFSharpAssemblyData = /// Cache of time stamps as we traverse a project description type TimeStampCache(defaultTimeStamp: DateTime) = - let files = Dictionary() - let projects = Dictionary(HashIdentity.Reference) + let files = Dictionary() + let projects = Dictionary(HashIdentity.Reference) member cache.GetFileTimeStamp fileName = let ok, v = files.TryGetValue(fileName) if ok then v else @@ -1980,9 +2117,9 @@ and IProjectReference = type AssemblyReference = | AssemblyReference of range * string * IProjectReference option - member x.Range = (let (AssemblyReference(m,_,_)) = x in m) - member x.Text = (let (AssemblyReference(_,text,_)) = x in text) - member x.ProjectReference = (let (AssemblyReference(_,_,contents)) = x in contents) + member x.Range = (let (AssemblyReference(m, _, _)) = x in m) + member x.Text = (let (AssemblyReference(_, text, _)) = x in text) + member x.ProjectReference = (let (AssemblyReference(_, _, contents)) = x in contents) member x.SimpleAssemblyNameIs(name) = (String.Compare(fileNameWithoutExtensionWithValidate false x.Text, name, StringComparison.OrdinalIgnoreCase) = 0) || (let text = x.Text.ToLowerInvariant() @@ -2186,7 +2323,7 @@ type TcConfigBuilder = mutable shadowCopyReferences : bool } - static member CreateNew (legacyReferenceResolver,defaultFSharpBinariesDir,optimizeForMemory,implicitIncludeDir,isInteractive,isInvalidationSupported, defaultCopyFSharpCore) = + static member CreateNew (legacyReferenceResolver, defaultFSharpBinariesDir, optimizeForMemory, implicitIncludeDir, isInteractive, isInvalidationSupported, defaultCopyFSharpCore) = System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(implicitIncludeDir), sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir) if (String.IsNullOrEmpty(defaultFSharpBinariesDir)) then failwith "Expected a valid defaultFSharpBinariesDir" @@ -2229,7 +2366,7 @@ type TcConfigBuilder = embedResources = [] inputCodePage=None optimizeForMemory=optimizeForMemory - subsystemVersion = 4,0 // per spec for 357994 + subsystemVersion = 4, 0 // per spec for 357994 useHighEntropyVA = false mlCompatibility=false checkOverflow=false @@ -2337,22 +2474,22 @@ type TcConfigBuilder = member tcConfigB.ResolveSourceFile(m, nm, pathLoadedFrom) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - ResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom],m,nm) + ResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom], m, nm) /// Decide names of output file, pdb and assembly member tcConfigB.DecideNames (sourceFiles) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - if sourceFiles = [] then errorR(Error(FSComp.SR.buildNoInputsSpecified(),rangeCmdArgs)) + if sourceFiles = [] then errorR(Error(FSComp.SR.buildNoInputsSpecified(), rangeCmdArgs)) let ext() = match tcConfigB.target with Dll -> ".dll" | Module -> ".netmodule" | ConsoleExe | WinExe -> ".exe" let implFiles = sourceFiles |> List.filter (fun lower -> List.exists (Filename.checkSuffix (String.lowercase lower)) FSharpImplFileSuffixes) let outfile = match tcConfigB.outputFile, List.rev implFiles with - | None,[] -> "out" + ext() + | None, [] -> "out" + ext() | None, h :: _ -> let basic = fileNameOfPath h let modname = try Filename.chopExtension basic with _ -> basic modname+(ext()) - | Some f,_ -> f + | Some f, _ -> f let assemblyName = let baseName = fileNameOfPath outfile (fileNameWithoutExtension baseName) @@ -2364,20 +2501,20 @@ type TcConfigBuilder = #if ENABLE_MONO_SUPPORT | Some _ when runningOnMono -> // On Mono, the name of the debug file has to be ".mdb" so specifying it explicitly is an error - warning(Error(FSComp.SR.ilwriteMDBFileNameCannotBeChangedWarning(),rangeCmdArgs)) + warning(Error(FSComp.SR.ilwriteMDBFileNameCannotBeChangedWarning(), rangeCmdArgs)) Microsoft.FSharp.Compiler.AbstractIL.ILPdbWriter.getDebugFileName outfile tcConfigB.portablePDB #endif | Some f -> f) elif (tcConfigB.debugSymbolFile <> None) && (not (tcConfigB.debuginfo)) then - error(Error(FSComp.SR.buildPdbRequiresDebug(),rangeStartup)) + error(Error(FSComp.SR.buildPdbRequiresDebug(), rangeStartup)) else None tcConfigB.outputFile <- Some(outfile) outfile, pdbfile, assemblyName - member tcConfigB.TurnWarningOff(m,s:string) = + member tcConfigB.TurnWarningOff(m, s:string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - match GetWarningNumber(m,s) with + match GetWarningNumber(m, s) with | None -> () | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus @@ -2386,39 +2523,39 @@ type TcConfigBuilder = member tcConfigB.TurnWarningOn(m, s:string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - match GetWarningNumber(m,s) with + match GetWarningNumber(m, s) with | None -> () | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- false tcConfigB.specificWarnOn <- ListSet.insert (=) n tcConfigB.specificWarnOn - member tcConfigB.AddIncludePath (m,path,pathIncludedFrom) = + member tcConfigB.AddIncludePath (m, path, pathIncludedFrom) = let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path let ok = let existsOpt = try Some(Directory.Exists(absolutePath)) - with e -> warning(Error(FSComp.SR.buildInvalidSearchDirectory(path),m)); None + with e -> warning(Error(FSComp.SR.buildInvalidSearchDirectory(path), m)); None match existsOpt with | Some(exists) -> - if not exists then warning(Error(FSComp.SR.buildSearchDirectoryNotFound(absolutePath),m)) + if not exists then warning(Error(FSComp.SR.buildSearchDirectoryNotFound(absolutePath), m)) exists | None -> false if ok && not (List.contains absolutePath tcConfigB.includes) then tcConfigB.includes <- tcConfigB.includes ++ absolutePath - member tcConfigB.AddLoadedSource(m,path,pathLoadedFrom) = + member tcConfigB.AddLoadedSource(m, path, pathLoadedFrom) = if FileSystem.IsInvalidPathShim(path) then - warning(Error(FSComp.SR.buildInvalidFilename(path),m)) + warning(Error(FSComp.SR.buildInvalidFilename(path), m)) else let path = - match TryResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom],m,path) with + match TryResolveFileUsingPaths(tcConfigB.includes @ [pathLoadedFrom], m, path) with | Some(path) -> path | None -> // File doesn't exist in the paths. Assume it will be in the load-ed from directory. ComputeMakePathAbsolute pathLoadedFrom path if not (List.contains path (List.map snd tcConfigB.loadedSources)) then - tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m,path) + tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m, path) member tcConfigB.AddEmbeddedSourceFile (file) = tcConfigB.embedSourceList <- tcConfigB.embedSourceList ++ file @@ -2426,14 +2563,14 @@ type TcConfigBuilder = member tcConfigB.AddEmbeddedResource filename = tcConfigB.embedResources <- tcConfigB.embedResources ++ filename - member tcConfigB.AddReferencedAssemblyByPath (m,path) = + member tcConfigB.AddReferencedAssemblyByPath (m, path) = if FileSystem.IsInvalidPathShim(path) then - warning(Error(FSComp.SR.buildInvalidAssemblyName(path),m)) + warning(Error(FSComp.SR.buildInvalidAssemblyName(path), m)) elif not (tcConfigB.referencedDLLs |> List.exists (fun ar2 -> m=ar2.Range && path=ar2.Text)) then // NOTE: We keep same paths if range is different. let projectReference = tcConfigB.projectReferences |> List.tryPick (fun pr -> if pr.FileName = path then Some pr else None) - tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m,path,projectReference) + tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m, path, projectReference) - member tcConfigB.RemoveReferencedAssemblyByPath (m,path) = + member tcConfigB.RemoveReferencedAssemblyByPath (m, path) = tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs |> List.filter (fun ar-> ar.Range <> m || ar.Text <> path) static member SplitCommandLineResourceInfo ri = @@ -2445,16 +2582,16 @@ type TcConfigBuilder = let p = String.index rest ',' let name = String.sub rest 0 p+".resources" let pubpri = String.sub rest (p+1) (rest.Length - p - 1) - if pubpri = "public" then file,name,ILResourceAccess.Public - elif pubpri = "private" then file,name,ILResourceAccess.Private - else error(Error(FSComp.SR.buildInvalidPrivacy(pubpri),rangeStartup)) + if pubpri = "public" then file, name, ILResourceAccess.Public + elif pubpri = "private" then file, name, ILResourceAccess.Private + else error(Error(FSComp.SR.buildInvalidPrivacy(pubpri), rangeStartup)) else - file,rest,ILResourceAccess.Public + file, rest, ILResourceAccess.Public else - ri,fileNameOfPath ri,ILResourceAccess.Public + ri, fileNameOfPath ri, ILResourceAccess.Public -let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt, pdbPathOption, shadowCopyReferences) = +let OpenILBinary(filename, optimizeForMemory, openBinariesInMemory, ilGlobalsOpt, pdbPathOption, shadowCopyReferences) = let ilGlobals = // ILScopeRef.Local can be used only for primary assembly (mscorlib or System.Runtime) itself // Remaining assemblies should be opened using existing ilGlobals (so they can properly locate fundamental types) @@ -2568,7 +2705,7 @@ let GetInternalsVisibleToAttributes ilg ilModule = [] /// This type is immutable and must be kept as such. Do not extract or mutate the underlying data except by cloning it. -type TcConfig private (data : TcConfigBuilder,validate:bool) = +type TcConfig private (data : TcConfigBuilder, validate:bool) = // Validate the inputs - this helps ensure errors in options are shown in visual studio rather than only when built // However we only validate a minimal number of options at the moment @@ -2578,11 +2715,11 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = let data = { data with pause = data.pause } let computeKnownDllReference(libraryName) = - let defaultCoreLibraryReference = AssemblyReference(range0,libraryName+".dll",None) + let defaultCoreLibraryReference = AssemblyReference(range0, libraryName+".dll", None) let nameOfDll(r:AssemblyReference) = let filename = ComputeMakePathAbsolute data.implicitIncludeDir r.Text if FileSystem.SafeExists(filename) then - r,Some(filename) + r, Some(filename) else // If the file doesn't exist, let reference resolution logic report the error later... defaultCoreLibraryReference, if r.Range =rangeStartup then Some(filename) else None @@ -2592,12 +2729,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = defaultCoreLibraryReference, None | r:: _ -> // Recover by picking the first one. - errorR(Error(FSComp.SR.buildMultipleReferencesNotAllowed(libraryName),rangeCmdArgs)) + errorR(Error(FSComp.SR.buildMultipleReferencesNotAllowed(libraryName), rangeCmdArgs)) nameOfDll(r) // Look for an explicit reference to mscorlib and use that to compute clrRoot and targetFrameworkVersion let primaryAssemblyReference, primaryAssemblyExplicitFilenameOpt = computeKnownDllReference(data.primaryAssembly.Name) - let fslibReference,fslibExplicitFilenameOpt = + let fslibReference, fslibExplicitFilenameOpt = let (_, fileNameOpt) as res = computeKnownDllReference(GetFSharpCoreLibraryName()) match fileNameOpt with | None -> @@ -2609,17 +2746,17 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // The reason is that some non-default frameworks may not have the default dlls. For example, Client profile does // not have System.Web.dll. do if ((primaryAssemblyExplicitFilenameOpt.IsSome || fslibExplicitFilenameOpt.IsSome) && data.framework) then - error(Error(FSComp.SR.buildExplicitCoreLibRequiresNoFramework("--noframework"),rangeStartup)) + error(Error(FSComp.SR.buildExplicitCoreLibRequiresNoFramework("--noframework"), rangeStartup)) let clrRootValue, targetFrameworkVersionValue = match primaryAssemblyExplicitFilenameOpt with | Some(primaryAssemblyFilename) -> let filename = ComputeMakePathAbsolute data.implicitIncludeDir primaryAssemblyFilename try - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.shadowCopyReferences) + use ilReader = OpenILBinary(filename, data.optimizeForMemory, data.openBinariesInMemory, None, None, data.shadowCopyReferences) let ilModule = ilReader.ILModuleDef match ilModule.ManifestOfAssembly.Version with - | Some(v1,v2,_,_) -> + | Some(v1, v2, _, _) -> let clrRoot = Some(Path.GetDirectoryName(FileSystem.GetFullPathShim(filename))) clrRoot, (sprintf "v%d.%d" v1 v2) | _ -> @@ -2648,7 +2785,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = let filename = ComputeMakePathAbsolute data.implicitIncludeDir fslibFilename if fslibReference.ProjectReference.IsNone then try - use ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None, data.shadowCopyReferences) + use ilReader = OpenILBinary(filename, data.optimizeForMemory, data.openBinariesInMemory, None, None, data.shadowCopyReferences) () with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), rangeStartup)) @@ -2786,9 +2923,9 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member x.sqmSessionStartedTime = data.sqmSessionStartedTime member x.copyFSharpCore = data.copyFSharpCore member x.shadowCopyReferences = data.shadowCopyReferences - static member Create(builder,validate) = + static member Create(builder, validate) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - TcConfig(builder,validate) + TcConfig(builder, validate) member x.legacyReferenceResolver = data.legacyReferenceResolver member tcConfig.CloneOfOriginalBuilder = @@ -2796,7 +2933,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.ComputeCanContainEntryPoint(sourceFiles:string list) = let n = sourceFiles.Length in - (sourceFiles |> List.mapi (fun i _ -> (i = n-1)), tcConfig.target.IsExe) + (sourceFiles |> List.mapi (fun i _ -> (i = n-1)), tcConfig.target.IsExe) // This call can fail if no CLR is found (this is the path to mscorlib) member tcConfig.GetTargetFrameworkDirectories() = @@ -2854,7 +2991,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // // This is the normal case for "fsc.exe a.fs". We refer to the reference assemblies folder. let frameworkRoot = tcConfig.legacyReferenceResolver.DotNetFrameworkReferenceAssembliesRootDirectory - let frameworkRootVersion = Path.Combine(frameworkRoot,tcConfig.targetFrameworkVersion) + let frameworkRootVersion = Path.Combine(frameworkRoot, tcConfig.targetFrameworkVersion) yield frameworkRootVersion let facades = Path.Combine(frameworkRootVersion, "Facades") if Directory.Exists(facades) then @@ -2871,12 +3008,12 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = member tcConfig.GetAvailableLoadedSources() = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter - let resolveLoadedSource (m,path) = + let resolveLoadedSource (m, path) = try if not(FileSystem.SafeExists(path)) then - error(LoadedSourceNotFoundIgnoring(path,m)) + error(LoadedSourceNotFoundIgnoring(path, m)) None - else Some(m,path) + else Some(m, path) with e -> errorRecovery e m; None tcConfig.loadedSources |> List.choose resolveLoadedSource @@ -2912,14 +3049,14 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = result member tcConfig.TryResolveLibWithDirectories (r:AssemblyReference) = - let m,nm = r.Range, r.Text + let m, nm = r.Range, r.Text use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter // Only want to resolve certain extensions (otherwise, 'System.Xml' is ambiguous). // MSBuild resolution is limited to .exe and .dll so do the same here. let ext = System.IO.Path.GetExtension(nm) - let isNetModule = String.Compare(ext,".netmodule",StringComparison.OrdinalIgnoreCase)=0 + let isNetModule = String.Compare(ext, ".netmodule", StringComparison.OrdinalIgnoreCase)=0 - let unknownToolTip (resolvedPath,resolved) = + let unknownToolTip (resolvedPath, resolved) = let line(append:string) = append.Trim([|' '|])+"\n" line(resolvedPath) + line(resolved) @@ -2936,8 +3073,8 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = ilAssemblyRef = ref None } | None -> - if String.Compare(ext,".dll",StringComparison.OrdinalIgnoreCase)=0 - || String.Compare(ext,".exe",StringComparison.OrdinalIgnoreCase)=0 + if String.Compare(ext, ".dll", StringComparison.OrdinalIgnoreCase)=0 + || String.Compare(ext, ".exe", StringComparison.OrdinalIgnoreCase)=0 || isNetModule then let searchPaths = @@ -2950,7 +3087,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = else tcConfig.GetSearchPathsForLibraryFiles() - let resolved = TryResolveFileUsingPaths(searchPaths,m,nm) + let resolved = TryResolveFileUsingPaths(searchPaths, m, nm) match resolved with | Some(resolved) -> let sysdir = tcConfig.IsSystemAssembly resolved @@ -2967,26 +3104,26 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = Some { originalReference = r resolvedPath = resolved - prepareToolTip = (fun () -> unknownToolTip (resolved,fusionName)) + prepareToolTip = (fun () -> unknownToolTip (resolved, fusionName)) sysdir = sysdir ilAssemblyRef = ref None } | None -> None else None member tcConfig.ResolveLibWithDirectories (ccuLoadFaulureAction, r:AssemblyReference) = - let m,nm = r.Range, r.Text + let m, nm = r.Range, r.Text use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter // test for both libraries and executables let ext = System.IO.Path.GetExtension(nm) - let isExe = (String.Compare(ext,".exe",StringComparison.OrdinalIgnoreCase) = 0) - let isDLL = (String.Compare(ext,".dll",StringComparison.OrdinalIgnoreCase) = 0) - let isNetModule = (String.Compare(ext,".netmodule",StringComparison.OrdinalIgnoreCase) = 0) + let isExe = (String.Compare(ext, ".exe", StringComparison.OrdinalIgnoreCase) = 0) + let isDLL = (String.Compare(ext, ".dll", StringComparison.OrdinalIgnoreCase) = 0) + let isNetModule = (String.Compare(ext, ".netmodule", StringComparison.OrdinalIgnoreCase) = 0) let rs = if isExe || isDLL || isNetModule then [r] else - [AssemblyReference(m,nm+".dll",None);AssemblyReference(m,nm+".exe",None);AssemblyReference(m,nm+".netmodule",None)] + [AssemblyReference(m, nm+".dll", None);AssemblyReference(m, nm+".exe", None);AssemblyReference(m, nm+".netmodule", None)] match rs |> List.tryPick (fun r -> tcConfig.TryResolveLibWithDirectories r) with | Some(res) -> Some res @@ -2994,7 +3131,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = match ccuLoadFaulureAction with | CcuLoadFailureAction.RaiseError -> let searchMessage = String.concat "\n " (tcConfig.GetSearchPathsForLibraryFiles()) - raise (FileNameNotResolved(nm,searchMessage,m)) + raise (FileNameNotResolved(nm, searchMessage, m)) | CcuLoadFailureAction.ReturnNone -> None member tcConfig.ResolveSourceFile(m, nm, pathLoadedFrom) = @@ -3004,11 +3141,11 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // it must return warnings and errors as data // // NOTE!! if mode=ReportErrors then this method must not raise exceptions. It must just report the errors and recover - static member TryResolveLibsUsingMSBuildRules (tcConfig:TcConfig,originalReferences:AssemblyReference list, errorAndWarningRange:range, mode:ResolveAssemblyReferenceMode) : AssemblyResolution list * UnresolvedAssemblyReference list = + static member TryResolveLibsUsingMSBuildRules (tcConfig:TcConfig, originalReferences:AssemblyReference list, errorAndWarningRange:range, mode:ResolveAssemblyReferenceMode) : AssemblyResolution list * UnresolvedAssemblyReference list = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter if tcConfig.useSimpleResolution then failwith "MSBuild resolution is not supported." - if originalReferences=[] then [],[] + if originalReferences=[] then [], [] else // Group references by name with range values in the grouped value list. // In the grouped reference, store the index of the last use of the reference. @@ -3016,7 +3153,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = originalReferences |> List.indexed |> Seq.groupBy(fun (_, reference) -> reference.Text) - |> Seq.map(fun (assemblyName,assemblyAndIndexGroup)-> + |> Seq.map(fun (assemblyName, assemblyAndIndexGroup)-> let assemblyAndIndexGroup = assemblyAndIndexGroup |> List.ofSeq let highestPosition = assemblyAndIndexGroup |> List.maxBy fst |> fst let assemblyGroup = assemblyAndIndexGroup |> List.map snd @@ -3031,7 +3168,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = (fun isError code message-> if showMessages && mode = ReportErrors then if isError then - errorR(MSBuildReferenceResolutionError(code,message,errorAndWarningRange)) + errorR(MSBuildReferenceResolutionError(code, message, errorAndWarningRange)) else match code with // These are warnings that mean 'not resolved' for some assembly. @@ -3042,9 +3179,9 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = -> () | _ -> if code = "MSB3245" then - errorR(MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange)) + errorR(MSBuildReferenceResolutionWarning(code, message, errorAndWarningRange)) else - warning(MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange))) + warning(MSBuildReferenceResolutionWarning(code, message, errorAndWarningRange))) let targetProcessorArchitecture = match tcConfig.platform with @@ -3056,19 +3193,19 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // First, try to resolve everything as a file using simple resolution let resolvedAsFile = groupedReferences - |> Array.map(fun (_filename,maxIndexOfReference,references)-> + |> Array.map(fun (_filename, maxIndexOfReference, references)-> let assemblyResolution = references |> List.choose (fun r -> tcConfig.TryResolveLibWithDirectories r) (maxIndexOfReference, assemblyResolution)) - |> Array.filter(fun (_,refs)->refs |> isNil |> not) + |> Array.filter(fun (_, refs)->refs |> isNil |> not) // Whatever is left, pass to MSBuild. - let Resolve(references,showMessages) = + let Resolve(references, showMessages) = try tcConfig.legacyReferenceResolver.Resolve - (tcConfig.resolutionEnvironment, - references, - tcConfig.targetFrameworkVersion, + (tcConfig.resolutionEnvironment, + references, + tcConfig.targetFrameworkVersion, tcConfig.GetTargetFrameworkDirectories(), targetProcessorArchitecture, tcConfig.fsharpBinariesDir, // FSharp binaries directory @@ -3076,21 +3213,21 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = tcConfig.implicitIncludeDir, // Implicit include directory (likely the project directory) logMessage showMessages, logDiagnostic showMessages) with - ReferenceResolver.ResolutionFailure -> error(Error(FSComp.SR.buildAssemblyResolutionFailed(),errorAndWarningRange)) + ReferenceResolver.ResolutionFailure -> error(Error(FSComp.SR.buildAssemblyResolutionFailed(), errorAndWarningRange)) let toMsBuild = [|0..groupedReferences.Length-1|] - |> Array.map(fun i->(p13 groupedReferences.[i]),(p23 groupedReferences.[i]),i) - |> Array.filter (fun (_,i0,_)->resolvedAsFile|>Array.exists(fun (i1,_) -> i0=i1)|>not) - |> Array.map(fun (ref,_,i)->ref,string i) + |> Array.map(fun i->(p13 groupedReferences.[i]), (p23 groupedReferences.[i]), i) + |> Array.filter (fun (_, i0, _)->resolvedAsFile|>Array.exists(fun (i1, _) -> i0=i1)|>not) + |> Array.map(fun (ref, _, i)->ref, string i) - let resolutions = Resolve(toMsBuild,(*showMessages*)true) + let resolutions = Resolve(toMsBuild, (*showMessages*)true) // Map back to original assembly resolutions. let resolvedByMsbuild = resolutions |> Array.map(fun resolvedFile -> let i = int resolvedFile.baggage - let _,maxIndexOfReference,ms = groupedReferences.[i] + let _, maxIndexOfReference, ms = groupedReferences.[i] let assemblyResolutions = ms|>List.map(fun originalReference -> System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(resolvedFile.itemSpec), sprintf "msbuild-resolved path is not absolute: '%s'" resolvedFile.itemSpec) @@ -3118,7 +3255,7 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = else // MSBuild resolution may have unified the result of two duplicate references. Try to re-resolve now. // If re-resolution worked then this was a removed duplicate. - Resolve([|originalName,""|],(*showMessages*)false).Length<>0 + Resolve([|originalName, ""|], (*showMessages*)false).Length<>0 let unresolvedReferences = groupedReferences @@ -3129,9 +3266,9 @@ type TcConfig private (data : TcConfigBuilder,validate:bool) = // If mode=Speculative, then we haven't reported any errors. // We report the error condition by returning an empty list of resolutions if mode = Speculative && (List.length unresolvedReferences) > 0 then - [],(List.ofArray groupedReferences) |> List.map (fun (name, _, r) -> (name, r)) |> List.map UnresolvedAssemblyReference + [], (List.ofArray groupedReferences) |> List.map (fun (name, _, r) -> (name, r)) |> List.map UnresolvedAssemblyReference else - resultingResolutions,unresolvedReferences |> List.map (fun (name, _, r) -> (name, r)) |> List.map UnresolvedAssemblyReference + resultingResolutions, unresolvedReferences |> List.map (fun (name, _, r) -> (name, r)) |> List.map UnresolvedAssemblyReference member tcConfig.PrimaryAssemblyDllReference() = primaryAssemblyReference @@ -3154,11 +3291,11 @@ let ReportWarningAsError (globalWarnLevel : int, specificWarnOff : int list, spe let GetScopedPragmasForHashDirective hd = [ match hd with - | ParsedHashDirective("nowarn",numbers,m) -> + | ParsedHashDirective("nowarn", numbers, m) -> for s in numbers do - match GetWarningNumber(m,s) with + match GetWarningNumber(m, s) with | None -> () - | Some n -> yield ScopedPragma.WarningOff(m,n) + | Some n -> yield ScopedPragma.WarningOff(m, n) | _ -> () ] @@ -3181,9 +3318,9 @@ let GetScopedPragmasForInput input = type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, errorLogger:ErrorLogger) = inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas") - override x.DiagnosticSink (phasedError,isError) = + override x.DiagnosticSink (phasedError, isError) = if isError then - errorLogger.DiagnosticSink (phasedError,isError) + errorLogger.DiagnosticSink (phasedError, isError) else let report = let warningNum = GetDiagnosticNumber phasedError @@ -3191,17 +3328,17 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, errorLogger: | Some m -> not (scopedPragmas |> List.exists (fun pragma -> match pragma with - | ScopedPragma.WarningOff(pragmaRange,warningNumFromPragma) -> + | ScopedPragma.WarningOff(pragmaRange, warningNumFromPragma) -> warningNum = warningNumFromPragma && (not checkFile || m.FileIndex = pragmaRange.FileIndex) && Range.posGeq m.Start pragmaRange.Start)) | None -> true - if report then errorLogger.DiagnosticSink(phasedError,false) + if report then errorLogger.DiagnosticSink(phasedError, false) override x.ErrorCount = errorLogger.ErrorCount -let GetErrorLoggerFilteringByScopedPragmas(checkFile,scopedPragmas,errorLogger) = - (ErrorLoggerFilteringByScopedPragmas(checkFile,scopedPragmas,errorLogger) :> ErrorLogger) +let GetErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, errorLogger) = + (ErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, errorLogger) :> ErrorLogger) //---------------------------------------------------------------------------- @@ -3227,30 +3364,30 @@ let ComputeQualifiedNameOfFileFromUniquePath (m, p: string list) = QualifiedName let QualFileNameOfSpecs filename specs = match specs with - | [SynModuleOrNamespaceSig(modname,_,true,_,_,_,_,m)] -> QualFileNameOfModuleName m filename modname - | [SynModuleOrNamespaceSig(_,_,false,_,_,_,_,m)] -> QualFileNameOfFilename m filename + | [SynModuleOrNamespaceSig(modname, _, true, _, _, _, _, m)] -> QualFileNameOfModuleName m filename modname + | [SynModuleOrNamespaceSig(_, _, false, _, _, _, _, m)] -> QualFileNameOfFilename m filename | _ -> QualFileNameOfFilename (mkRange filename pos0 pos0) filename let QualFileNameOfImpls filename specs = match specs with - | [SynModuleOrNamespace(modname,_,true,_,_,_,_,m)] -> QualFileNameOfModuleName m filename modname - | [SynModuleOrNamespace(_,_,false,_,_,_,_,m)] -> QualFileNameOfFilename m filename + | [SynModuleOrNamespace(modname, _, true, _, _, _, _, m)] -> QualFileNameOfModuleName m filename modname + | [SynModuleOrNamespace(_, _, false, _, _, _, _, m)] -> QualFileNameOfFilename m filename | _ -> QualFileNameOfFilename (mkRange filename pos0 pos0) filename -let PrepandPathToQualFileName x (QualifiedNameOfFile(q)) = ComputeQualifiedNameOfFileFromUniquePath (q.idRange,pathOfLid x@[q.idText]) -let PrepandPathToImpl x (SynModuleOrNamespace(p,b,c,d,e,f,g,h)) = SynModuleOrNamespace(x@p,b,c,d,e,f,g,h) -let PrepandPathToSpec x (SynModuleOrNamespaceSig(p,b,c,d,e,f,g,h)) = SynModuleOrNamespaceSig(x@p,b,c,d,e,f,g,h) +let PrepandPathToQualFileName x (QualifiedNameOfFile(q)) = ComputeQualifiedNameOfFileFromUniquePath (q.idRange, pathOfLid x@[q.idText]) +let PrepandPathToImpl x (SynModuleOrNamespace(p, b, c, d, e, f, g, h)) = SynModuleOrNamespace(x@p, b, c, d, e, f, g, h) +let PrepandPathToSpec x (SynModuleOrNamespaceSig(p, b, c, d, e, f, g, h)) = SynModuleOrNamespaceSig(x@p, b, c, d, e, f, g, h) let PrependPathToInput x inp = match inp with - | ParsedInput.ImplFile (ParsedImplFileInput(b,c,q,d,hd,impls,e)) -> ParsedInput.ImplFile (ParsedImplFileInput(b,c,PrepandPathToQualFileName x q,d,hd,List.map (PrepandPathToImpl x) impls,e)) - | ParsedInput.SigFile (ParsedSigFileInput(b,q,d,hd,specs)) -> ParsedInput.SigFile(ParsedSigFileInput(b,PrepandPathToQualFileName x q,d,hd,List.map (PrepandPathToSpec x) specs)) + | ParsedInput.ImplFile (ParsedImplFileInput(b, c, q, d, hd, impls, e)) -> ParsedInput.ImplFile (ParsedImplFileInput(b, c, PrepandPathToQualFileName x q, d, hd, List.map (PrepandPathToImpl x) impls, e)) + | ParsedInput.SigFile (ParsedSigFileInput(b, q, d, hd, specs)) -> ParsedInput.SigFile(ParsedSigFileInput(b, PrepandPathToQualFileName x q, d, hd, List.map (PrepandPathToSpec x) specs)) let ComputeAnonModuleName check defaultNamespace filename (m: range) = let modname = CanonicalizeFilename filename if check && not (modname |> String.forall (fun c -> System.Char.IsLetterOrDigit(c) || c = '_')) then - if not (filename.EndsWith("fsx",StringComparison.OrdinalIgnoreCase) || filename.EndsWith("fsscript",StringComparison.OrdinalIgnoreCase)) then - warning(Error(FSComp.SR.buildImplicitModuleIsNotLegalIdentifier(modname,(fileNameOfPath filename)),m)) + if not (filename.EndsWith("fsx", StringComparison.OrdinalIgnoreCase) || filename.EndsWith("fsscript", StringComparison.OrdinalIgnoreCase)) then + warning(Error(FSComp.SR.buildImplicitModuleIsNotLegalIdentifier(modname, (fileNameOfPath filename)), m)) let combined = match defaultNamespace with | None -> modname @@ -3261,68 +3398,68 @@ let ComputeAnonModuleName check defaultNamespace filename (m: range) = mkRange filename pos0 pos0 pathToSynLid anonymousModuleNameRange (splitNamespace combined) -let PostParseModuleImpl (_i,defaultNamespace,isLastCompiland,filename,impl) = +let PostParseModuleImpl (_i, defaultNamespace, isLastCompiland, filename, impl) = match impl with - | ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid,isRec,isModule,decls,xmlDoc,attribs,access,m)) -> + | ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, isRec, isModule, decls, xmlDoc, attribs, access, m)) -> let lid = match lid with - | [id] when isModule && id.idText = MangledGlobalName -> error(Error(FSComp.SR.buildInvalidModuleOrNamespaceName(),id.idRange)) + | [id] when isModule && id.idText = MangledGlobalName -> error(Error(FSComp.SR.buildInvalidModuleOrNamespaceName(), id.idRange)) | id :: rest when id.idText = MangledGlobalName -> rest | _ -> lid - SynModuleOrNamespace(lid,isRec,isModule,decls,xmlDoc,attribs,access,m) + SynModuleOrNamespace(lid, isRec, isModule, decls, xmlDoc, attribs, access, m) - | ParsedImplFileFragment.AnonModule (defs,m)-> + | ParsedImplFileFragment.AnonModule (defs, m)-> let isLast, isExe = isLastCompiland let lower = String.lowercase filename if not (isLast && isExe) && not (doNotRequireNamespaceOrModuleSuffixes |> List.exists (Filename.checkSuffix lower)) then match defs with - | SynModuleDecl.NestedModule(_) :: _ -> errorR(Error(FSComp.SR.noEqualSignAfterModule(),trimRangeToLine m)) - | _ -> errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(),trimRangeToLine m)) + | SynModuleDecl.NestedModule(_) :: _ -> errorR(Error(FSComp.SR.noEqualSignAfterModule(), trimRangeToLine m)) + | _ -> errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(), trimRangeToLine m)) let modname = ComputeAnonModuleName (not (isNil defs)) defaultNamespace filename (trimRangeToLine m) - SynModuleOrNamespace(modname,false,true,defs,PreXmlDoc.Empty,[],None,m) + SynModuleOrNamespace(modname, false, true, defs, PreXmlDoc.Empty, [], None, m) - | ParsedImplFileFragment.NamespaceFragment (lid,a,b,c,d,e,m)-> + | ParsedImplFileFragment.NamespaceFragment (lid, a, b, c, d, e, m)-> let lid = match lid with | id :: rest when id.idText = MangledGlobalName -> rest | _ -> lid - SynModuleOrNamespace(lid,a,b,c,d,e,None,m) + SynModuleOrNamespace(lid, a, b, c, d, e, None, m) -let PostParseModuleSpec (_i,defaultNamespace,isLastCompiland,filename,intf) = +let PostParseModuleSpec (_i, defaultNamespace, isLastCompiland, filename, intf) = match intf with - | ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid,isRec,isModule,decls,xmlDoc,attribs,access,m)) -> + | ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, isRec, isModule, decls, xmlDoc, attribs, access, m)) -> let lid = match lid with - | [id] when isModule && id.idText = MangledGlobalName -> error(Error(FSComp.SR.buildInvalidModuleOrNamespaceName(),id.idRange)) + | [id] when isModule && id.idText = MangledGlobalName -> error(Error(FSComp.SR.buildInvalidModuleOrNamespaceName(), id.idRange)) | id :: rest when id.idText = MangledGlobalName -> rest | _ -> lid - SynModuleOrNamespaceSig(lid,isRec,isModule,decls,xmlDoc,attribs,access,m) + SynModuleOrNamespaceSig(lid, isRec, isModule, decls, xmlDoc, attribs, access, m) - | ParsedSigFileFragment.AnonModule (defs,m) -> + | ParsedSigFileFragment.AnonModule (defs, m) -> let isLast, isExe = isLastCompiland let lower = String.lowercase filename if not (isLast && isExe) && not (doNotRequireNamespaceOrModuleSuffixes |> List.exists (Filename.checkSuffix lower)) then match defs with - | SynModuleSigDecl.NestedModule(_) :: _ -> errorR(Error(FSComp.SR.noEqualSignAfterModule(),m)) - | _ -> errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(),m)) + | SynModuleSigDecl.NestedModule(_) :: _ -> errorR(Error(FSComp.SR.noEqualSignAfterModule(), m)) + | _ -> errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(), m)) let modname = ComputeAnonModuleName (not (isNil defs)) defaultNamespace filename (trimRangeToLine m) - SynModuleOrNamespaceSig(modname,false,true,defs,PreXmlDoc.Empty,[],None,m) + SynModuleOrNamespaceSig(modname, false, true, defs, PreXmlDoc.Empty, [], None, m) - | ParsedSigFileFragment.NamespaceFragment (lid,a,b,c,d,e,m)-> + | ParsedSigFileFragment.NamespaceFragment (lid, a, b, c, d, e, m)-> let lid = match lid with | id :: rest when id.idText = MangledGlobalName -> rest | _ -> lid - SynModuleOrNamespaceSig(lid,a,b,c,d,e,None,m) + SynModuleOrNamespaceSig(lid, a, b, c, d, e, None, m) -let PostParseModuleImpls (defaultNamespace,filename,isLastCompiland,ParsedImplFile(hashDirectives,impls)) = - match impls |> List.rev |> List.tryPick (function ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid,_,_,_,_,_,_,_)) -> Some(lid) | _ -> None) with +let PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, ParsedImplFile(hashDirectives, impls)) = + match impls |> List.rev |> List.tryPick (function ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid, _, _, _, _, _, _, _)) -> Some(lid) | _ -> None) with | Some lid when impls.Length > 1 -> - errorR(Error(FSComp.SR.buildMultipleToplevelModules(),rangeOfLid lid)) + errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid)) | _ -> () let impls = impls |> List.mapi (fun i x -> PostParseModuleImpl (i, defaultNamespace, isLastCompiland, filename, x)) @@ -3330,65 +3467,65 @@ let PostParseModuleImpls (defaultNamespace,filename,isLastCompiland,ParsedImplFi let isScript = IsScript filename let scopedPragmas = - [ for (SynModuleOrNamespace(_,_,_,decls,_,_,_,_)) in impls do + [ for (SynModuleOrNamespace(_, _, _, decls, _, _, _, _)) in impls do for d in decls do match d with - | SynModuleDecl.HashDirective (hd,_) -> yield! GetScopedPragmasForHashDirective hd + | SynModuleDecl.HashDirective (hd, _) -> yield! GetScopedPragmasForHashDirective hd | _ -> () for hd in hashDirectives do yield! GetScopedPragmasForHashDirective hd ] - ParsedInput.ImplFile(ParsedImplFileInput(filename,isScript,qualName,scopedPragmas,hashDirectives,impls,isLastCompiland)) + ParsedInput.ImplFile(ParsedImplFileInput(filename, isScript, qualName, scopedPragmas, hashDirectives, impls, isLastCompiland)) -let PostParseModuleSpecs (defaultNamespace,filename,isLastCompiland,ParsedSigFile(hashDirectives,specs)) = - match specs |> List.rev |> List.tryPick (function ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid,_,_,_,_,_,_,_)) -> Some(lid) | _ -> None) with +let PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, ParsedSigFile(hashDirectives, specs)) = + match specs |> List.rev |> List.tryPick (function ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid, _, _, _, _, _, _, _)) -> Some(lid) | _ -> None) with | Some lid when specs.Length > 1 -> - errorR(Error(FSComp.SR.buildMultipleToplevelModules(),rangeOfLid lid)) + errorR(Error(FSComp.SR.buildMultipleToplevelModules(), rangeOfLid lid)) | _ -> () - let specs = specs |> List.mapi (fun i x -> PostParseModuleSpec(i,defaultNamespace,isLastCompiland,filename,x)) + let specs = specs |> List.mapi (fun i x -> PostParseModuleSpec(i, defaultNamespace, isLastCompiland, filename, x)) let qualName = QualFileNameOfSpecs filename specs let scopedPragmas = - [ for (SynModuleOrNamespaceSig(_,_,_,decls,_,_,_,_)) in specs do + [ for (SynModuleOrNamespaceSig(_, _, _, decls, _, _, _, _)) in specs do for d in decls do match d with - | SynModuleSigDecl.HashDirective(hd,_) -> yield! GetScopedPragmasForHashDirective hd + | SynModuleSigDecl.HashDirective(hd, _) -> yield! GetScopedPragmasForHashDirective hd | _ -> () for hd in hashDirectives do yield! GetScopedPragmasForHashDirective hd ] - ParsedInput.SigFile(ParsedSigFileInput(filename,qualName,scopedPragmas,hashDirectives,specs)) + ParsedInput.SigFile(ParsedSigFileInput(filename, qualName, scopedPragmas, hashDirectives, specs)) /// Checks if a module name is already given and deduplicates the name if needed. -let DeduplicateModuleName (moduleNamesDict:Dictionary>) (paths: Set) path (qualifiedNameOfFile: QualifiedNameOfFile) = +let DeduplicateModuleName (moduleNamesDict:Dictionary>) (paths: Set) path (qualifiedNameOfFile: QualifiedNameOfFile) = let count = if paths.Contains path then paths.Count else paths.Count + 1 moduleNamesDict.[qualifiedNameOfFile.Text] <- Set.add path paths let id = qualifiedNameOfFile.Id - if count = 1 then qualifiedNameOfFile else QualifiedNameOfFile(Ident(id.idText + "___" + count.ToString(),id.idRange)) + if count = 1 then qualifiedNameOfFile else QualifiedNameOfFile(Ident(id.idText + "___" + count.ToString(), id.idRange)) /// Checks if a ParsedInput is using a module name that was already given and deduplicates the name if needed. -let DeduplicateParsedInputModuleName (moduleNamesDict:Dictionary>) input = +let DeduplicateParsedInputModuleName (moduleNamesDict:Dictionary>) input = match input with - | ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput(fileName,isScript,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules,(isLastCompiland,isExe))) -> + | ParsedInput.ImplFile (ParsedImplFileInput.ParsedImplFileInput(fileName, isScript, qualifiedNameOfFile, scopedPragmas, hashDirectives, modules, (isLastCompiland, isExe))) -> let path = Path.GetDirectoryName fileName match moduleNamesDict.TryGetValue qualifiedNameOfFile.Text with | true, paths -> let qualifiedNameOfFile = DeduplicateModuleName moduleNamesDict paths path qualifiedNameOfFile - ParsedInput.ImplFile(ParsedImplFileInput.ParsedImplFileInput(fileName,isScript,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules,(isLastCompiland,isExe))) + ParsedInput.ImplFile(ParsedImplFileInput.ParsedImplFileInput(fileName, isScript, qualifiedNameOfFile, scopedPragmas, hashDirectives, modules, (isLastCompiland, isExe))) | _ -> - moduleNamesDict.Add(qualifiedNameOfFile.Text,Set.singleton path) + moduleNamesDict.Add(qualifiedNameOfFile.Text, Set.singleton path) input - | ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules)) -> + | ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName, qualifiedNameOfFile, scopedPragmas, hashDirectives, modules)) -> let path = Path.GetDirectoryName fileName match moduleNamesDict.TryGetValue qualifiedNameOfFile.Text with | true, paths -> let qualifiedNameOfFile = DeduplicateModuleName moduleNamesDict paths path qualifiedNameOfFile - ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName,qualifiedNameOfFile,scopedPragmas,hashDirectives,modules)) + ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput(fileName, qualifiedNameOfFile, scopedPragmas, hashDirectives, modules)) | _ -> - moduleNamesDict.Add(qualifiedNameOfFile.Text,Set.singleton path) + moduleNamesDict.Add(qualifiedNameOfFile.Text, Set.singleton path) input -let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaultNamespace,filename,isLastCompiland) = +let ParseInput (lexer, errorLogger:ErrorLogger, lexbuf:UnicodeLexing.Lexbuf, defaultNamespace, filename, isLastCompiland) = // The assert below is almost ok, but it fires in two cases: // - fsi.exe sometimes passes "stdin" as a dummy filename // - if you have a #line directive, e.g. @@ -3409,32 +3546,32 @@ let ParseInput (lexer,errorLogger:ErrorLogger,lexbuf:UnicodeLexing.Lexbuf,defaul if FSharpImplFileSuffixes |> List.exists (Filename.checkSuffix lower) then let impl = Parser.implementationFile lexer lexbuf - PostParseModuleImpls (defaultNamespace,filename,isLastCompiland,impl) + PostParseModuleImpls (defaultNamespace, filename, isLastCompiland, impl) elif FSharpSigFileSuffixes |> List.exists (Filename.checkSuffix lower) then let intfs = Parser.signatureFile lexer lexbuf - PostParseModuleSpecs (defaultNamespace,filename,isLastCompiland,intfs) + PostParseModuleSpecs (defaultNamespace, filename, isLastCompiland, intfs) else - delayLogger.Error(Error(FSComp.SR.buildInvalidSourceFileExtension(filename),Range.rangeStartup)) + delayLogger.Error(Error(FSComp.SR.buildInvalidSourceFileExtension(filename), Range.rangeStartup)) scopedPragmas <- GetScopedPragmasForInput input input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped - let filteringErrorLogger = ErrorLoggerFilteringByScopedPragmas(false,scopedPragmas,errorLogger) + let filteringErrorLogger = ErrorLoggerFilteringByScopedPragmas(false, scopedPragmas, errorLogger) delayLogger.CommitDelayedDiagnostics(filteringErrorLogger) //---------------------------------------------------------------------------- // parsing - ParseOneInputFile // Filename is (ml/mli/fs/fsi source). Parse it to AST. //---------------------------------------------------------------------------- -let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompilationDefines,lexbuf,filename,isLastCompiland,errorLogger) = +let ParseOneInputLexbuf (tcConfig:TcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) = use unwindbuildphase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse try let skip = true in (* don't report whitespace from lexer *) - let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus(filename),true) - let lexargs = mkLexargs (filename,conditionalCompilationDefines@tcConfig.conditionalCompilationDefines,lightSyntaxStatus,lexResourceManager, ref [],errorLogger) + let lightSyntaxStatus = LightSyntaxStatus (tcConfig.ComputeLightSyntaxInitialStatus(filename), true) + let lexargs = mkLexargs (filename, conditionalCompilationDefines@tcConfig.conditionalCompilationDefines, lightSyntaxStatus, lexResourceManager, ref [], errorLogger) let shortFilename = SanitizeFileName filename tcConfig.implicitIncludeDir let input = - Lexhelp.usingLexbufForParsing (lexbuf,filename) (fun lexbuf -> + Lexhelp.usingLexbufForParsing (lexbuf, filename) (fun lexbuf -> if verbose then dprintn ("Parsing... "+shortFilename) let tokenizer = LexFilter.LexFilter(lightSyntaxStatus, tcConfig.compilingFslib, Lexer.token lexargs skip, lexbuf) @@ -3449,22 +3586,22 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila if tcConfig.testInteractionParser then while true do match (Parser.interaction tokenizer.Lexer lexbuf) with - | IDefns(l,m) -> dprintf "Parsed OK, got %d defs @ %a\n" l.Length outputRange m - | IHash (_,m) -> dprintf "Parsed OK, got hash @ %a\n" outputRange m + | IDefns(l, m) -> dprintf "Parsed OK, got %d defs @ %a\n" l.Length outputRange m + | IHash (_, m) -> dprintf "Parsed OK, got hash @ %a\n" outputRange m exit 0 - let res = ParseInput(tokenizer.Lexer,errorLogger,lexbuf,None,filename,isLastCompiland) + let res = ParseInput(tokenizer.Lexer, errorLogger, lexbuf, None, filename, isLastCompiland) if tcConfig.reportNumDecls then let rec flattenSpecs specs = - specs |> List.collect (function (SynModuleSigDecl.NestedModule (_,_,subDecls,_)) -> flattenSpecs subDecls | spec -> [spec]) + specs |> List.collect (function (SynModuleSigDecl.NestedModule (_, _, subDecls, _)) -> flattenSpecs subDecls | spec -> [spec]) let rec flattenDefns specs = - specs |> List.collect (function (SynModuleDecl.NestedModule (_,_,subDecls,_,_)) -> flattenDefns subDecls | defn -> [defn]) + specs |> List.collect (function (SynModuleDecl.NestedModule (_, _, subDecls, _, _)) -> flattenDefns subDecls | defn -> [defn]) - let flattenModSpec (SynModuleOrNamespaceSig(_,_,_,decls,_,_,_,_)) = flattenSpecs decls - let flattenModImpl (SynModuleOrNamespace(_,_,_,decls,_,_,_,_)) = flattenDefns decls + let flattenModSpec (SynModuleOrNamespaceSig(_, _, _, decls, _, _, _, _)) = flattenSpecs decls + let flattenModImpl (SynModuleOrNamespace(_, _, _, decls, _, _, _, _)) = flattenDefns decls match res with - | ParsedInput.SigFile(ParsedSigFileInput(_,_,_,_,specs)) -> + | ParsedInput.SigFile(ParsedSigFileInput(_, _, _, _, specs)) -> dprintf "parsing yielded %d specs" (List.collect flattenModSpec specs).Length | ParsedInput.ImplFile(ParsedImplFileInput(modules = impls)) -> dprintf "parsing yielded %d definitions" (List.collect flattenModImpl impls).Length @@ -3475,24 +3612,24 @@ let ParseOneInputLexbuf (tcConfig:TcConfig,lexResourceManager,conditionalCompila with e -> (* errorR(Failure("parse failed")); *) errorRecovery e rangeStartup; None -let ParseOneInputFile (tcConfig:TcConfig,lexResourceManager,conditionalCompilationDefines,filename,isLastCompiland,errorLogger,retryLocked) = +let ParseOneInputFile (tcConfig:TcConfig, lexResourceManager, conditionalCompilationDefines, filename, isLastCompiland, errorLogger, retryLocked) = try let lower = String.lowercase filename if List.exists (Filename.checkSuffix lower) (FSharpSigFileSuffixes@FSharpImplFileSuffixes) then if not(FileSystem.SafeExists(filename)) then - error(Error(FSComp.SR.buildCouldNotFindSourceFile(filename),rangeStartup)) + error(Error(FSComp.SR.buildCouldNotFindSourceFile(filename), rangeStartup)) // bug 3155: if the file name is indirect, use a full path - let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(filename,tcConfig.inputCodePage,retryLocked) - ParseOneInputLexbuf(tcConfig,lexResourceManager,conditionalCompilationDefines,lexbuf,filename,isLastCompiland,errorLogger) - else error(Error(FSComp.SR.buildInvalidSourceFileExtension(SanitizeFileName filename tcConfig.implicitIncludeDir),rangeStartup)) + let lexbuf = UnicodeLexing.UnicodeFileAsLexbuf(filename, tcConfig.inputCodePage, retryLocked) + ParseOneInputLexbuf(tcConfig, lexResourceManager, conditionalCompilationDefines, lexbuf, filename, isLastCompiland, errorLogger) + else error(Error(FSComp.SR.buildInvalidSourceFileExtension(SanitizeFileName filename tcConfig.implicitIncludeDir), rangeStartup)) with e -> (* errorR(Failure("parse failed")); *) errorRecovery e rangeStartup; None [] type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : UnresolvedAssemblyReference list) = - let originalReferenceToResolution = results |> List.map (fun r -> r.originalReference.Text,r) |> Map.ofList - let resolvedPathToResolution = results |> List.map (fun r -> r.resolvedPath,r) |> Map.ofList + let originalReferenceToResolution = results |> List.map (fun r -> r.originalReference.Text, r) |> Map.ofList + let resolvedPathToResolution = results |> List.map (fun r -> r.resolvedPath, r) |> Map.ofList /// Add some resolutions to the map of resolution results. member tcResolutions.AddResolutionResults(newResults) = TcAssemblyResolutions(results @ newResults, unresolved) @@ -3520,8 +3657,8 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres member tcResolutions.TryFindByResolvedPath nm = resolvedPathToResolution.TryFind nm member tcResolutions.TryFindByOriginalReferenceText nm = originalReferenceToResolution.TryFind nm - static member ResolveAssemblyReferences (ctok, tcConfig:TcConfig,assemblyList:AssemblyReference list, knownUnresolved:UnresolvedAssemblyReference list) : TcAssemblyResolutions = - let resolved,unresolved = + static member ResolveAssemblyReferences (ctok, tcConfig:TcConfig, assemblyList:AssemblyReference list, knownUnresolved:UnresolvedAssemblyReference list) : TcAssemblyResolutions = + let resolved, unresolved = if tcConfig.useSimpleResolution then let resolutions = assemblyList @@ -3532,12 +3669,12 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres errorRecovery e assemblyReference.Range Choice2Of2 assemblyReference) let successes = resolutions |> List.choose (function Choice1Of2 x -> Some x | _ -> None) - let failures = resolutions |> List.choose (function Choice2Of2 x -> Some (UnresolvedAssemblyReference(x.Text,[x])) | _ -> None) + let failures = resolutions |> List.choose (function Choice2Of2 x -> Some (UnresolvedAssemblyReference(x.Text, [x])) | _ -> None) successes, failures else RequireCompilationThread ctok // we don't want to do assembly resolution concurrently, we assume MSBuild doesn't handle this TcConfig.TryResolveLibsUsingMSBuildRules (tcConfig, assemblyList, rangeStartup, ReportErrors) - TcAssemblyResolutions(resolved,unresolved @ knownUnresolved) + TcAssemblyResolutions(resolved, unresolved @ knownUnresolved) static member GetAllDllReferences (tcConfig:TcConfig) = @@ -3551,25 +3688,25 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres let assumeDotNetFramework = primaryReference.SimpleAssemblyNameIs("mscorlib") if tcConfig.framework then for s in DefaultReferencesForScriptsAndOutOfProjectSources(assumeDotNetFramework) do - yield AssemblyReference(rangeStartup,(if s.EndsWith(".dll",StringComparison.OrdinalIgnoreCase) then s else s+".dll"),None) + yield AssemblyReference(rangeStartup, (if s.EndsWith(".dll", StringComparison.OrdinalIgnoreCase) then s else s+".dll"), None) if tcConfig.useFsiAuxLib then let name = Path.Combine(tcConfig.fsharpBinariesDir, GetFsiLibraryName() + ".dll") - yield AssemblyReference(rangeStartup,name,None) + yield AssemblyReference(rangeStartup, name, None) yield! tcConfig.referencedDLLs ] - static member SplitNonFoundationalResolutions (ctok,tcConfig:TcConfig) = + static member SplitNonFoundationalResolutions (ctok, tcConfig:TcConfig) = let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig - let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok,tcConfig,assemblyList,tcConfig.knownUnresolvedReferences) - let frameworkDLLs,nonFrameworkReferences = resolutions.GetAssemblyResolutions() |> List.partition (fun r -> r.sysdir) + let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig, assemblyList, tcConfig.knownUnresolvedReferences) + let frameworkDLLs, nonFrameworkReferences = resolutions.GetAssemblyResolutions() |> List.partition (fun r -> r.sysdir) let unresolved = resolutions.GetUnresolvedReferences() #if DEBUG let itFailed = ref false let addedText = "\nIf you want to debug this right now, attach a debugger, and put a breakpoint in 'CompileOps.fs' near the text '!itFailed', and you can re-step through the assembly resolution logic." unresolved - |> List.iter (fun (UnresolvedAssemblyReference(referenceText,_ranges)) -> + |> List.iter (fun (UnresolvedAssemblyReference(referenceText, _ranges)) -> if referenceText.Contains("mscorlib") then System.Diagnostics.Debug.Assert(false, sprintf "whoops, did not resolve mscorlib: '%s'%s" referenceText addedText) itFailed := true) @@ -3586,15 +3723,15 @@ type TcAssemblyResolutions(results : AssemblyResolution list, unresolved : Unres if !itFailed then // idea is, put a breakpoint here and then step through let assemblyList = TcAssemblyResolutions.GetAllDllReferences tcConfig - let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig,assemblyList,[]) - let _frameworkDLLs,_nonFrameworkReferences = resolutions.GetAssemblyResolutions() |> List.partition (fun r -> r.sysdir) + let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig, assemblyList, []) + let _frameworkDLLs, _nonFrameworkReferences = resolutions.GetAssemblyResolutions() |> List.partition (fun r -> r.sysdir) () #endif - frameworkDLLs,nonFrameworkReferences,unresolved + frameworkDLLs, nonFrameworkReferences, unresolved - static member BuildFromPriorResolutions (ctok,tcConfig:TcConfig,resolutions,knownUnresolved) = + static member BuildFromPriorResolutions (ctok, tcConfig:TcConfig, resolutions, knownUnresolved) = let references = resolutions |> List.map (fun r -> r.originalReference) - TcAssemblyResolutions.ResolveAssemblyReferences (ctok,tcConfig,references,knownUnresolved) + TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig, references, knownUnresolved) //---------------------------------------------------------------------------- @@ -3630,7 +3767,7 @@ type ILResource with member r.GetByteReader(m) = match r.Location with | ILResourceLocation.Local b -> b - | _-> error(InternalError("UnpickleFromResource",m)) + | _-> error(InternalError("UnpickleFromResource", m)) let MakeILResource rname bytes = { Name = rname @@ -3676,7 +3813,7 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR member __.GetAutoOpenAttributes(ilg) = GetAutoOpenAttributes ilg ilModule member __.GetInternalsVisibleToAttributes(ilg) = GetInternalsVisibleToAttributes ilg ilModule member __.TryGetRawILModule() = Some ilModule - member __.GetRawFSharpSignatureData(m,ilShortAssemName,filename) = + member __.GetRawFSharpSignatureData(m, ilShortAssemName, filename) = let resources = ilModule.Resources.AsList let sigDataReaders = [ for iresource in resources do @@ -3694,17 +3831,17 @@ type RawFSharpAssemblyDataBackedByFileOnDisk (ilModule: ILModuleDef, ilAssemblyR else sigDataReaders sigDataReaders - member __.GetRawFSharpOptimizationData(m,ilShortAssemName,filename) = + member __.GetRawFSharpOptimizationData(m, ilShortAssemName, filename) = let optDataReaders = ilModule.Resources.AsList - |> List.choose (fun r -> if IsOptimizationDataResource r then Some(GetOptimizationDataResourceName r,r.GetByteReader(m)) else None) + |> List.choose (fun r -> if IsOptimizationDataResource r then Some(GetOptimizationDataResourceName r, r.GetByteReader(m)) else None) // Look for optimization data in a file let optDataReaders = if optDataReaders.IsEmpty && List.contains ilShortAssemName externalSigAndOptData then let optDataFile = Path.ChangeExtension(filename, "optdata") if not (FileSystem.SafeExists optDataFile) then - error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile,FileSystem.GetFullPathShim optDataFile),m)) + error(Error(FSComp.SR.buildExpectedFileAlongSideFSharpCore(optDataFile, FileSystem.GetFullPathShim optDataFile), m)) [ (ilShortAssemName, (fun () -> FileSystem.ReadAllBytesShim optDataFile))] else optDataReaders @@ -3737,7 +3874,7 @@ let availableToOptionalCcu = function // TcConfigProvider //-------------------------------------------------------------------------- -/// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, +/// Represents a computation to return a TcConfig. Normally this is just a constant immutable TcConfig, /// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder. type TcConfigProvider = | TcConfigProvider of (CompilationThreadToken -> TcConfig) @@ -3748,7 +3885,7 @@ type TcConfigProvider = /// Get a TcConfigProvider which will continue to respect changes in the underlying /// TcConfigBuilder rather than delivering snapshots. - static member BasedOnMutableBuilder(tcConfigB) = TcConfigProvider(fun _ctok -> TcConfig.Create(tcConfigB,validate=false)) + static member BasedOnMutableBuilder(tcConfigB) = TcConfigProvider(fun _ctok -> TcConfig.Create(tcConfigB, validate=false)) //---------------------------------------------------------------------------- @@ -3840,7 +3977,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.FindDllInfo (ctok, m, assemblyName) = match tcImports.TryFindDllInfo (ctok, m, assemblyName, lookupOnly=false) with | Some res -> res - | None -> error(Error(FSComp.SR.buildCouldNotResolveAssembly(assemblyName),m)) + | None -> error(Error(FSComp.SR.buildCouldNotResolveAssembly(assemblyName), m)) member tcImports.GetImportedAssemblies() = CheckDisposed() @@ -3876,7 +4013,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | None -> UnresolvedImportedAssembly(assemblyName) - member tcImports.FindCcu (ctok, m, assemblyName,lookupOnly) = + member tcImports.FindCcu (ctok, m, assemblyName, lookupOnly) = CheckDisposed() match tcImports.FindCcuInfo(ctok, m, assemblyName, lookupOnly) with | ResolvedImportedAssembly(importedAssembly) -> ResolvedCcu(importedAssembly.FSharpViewOfMetadata) @@ -3899,7 +4036,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match tcImports.FindCcu (ctok, m, ilShortAssemName, lookupOnly=true) with | ResolvedCcu ccu -> if ccu.IsProviderGenerated then - let dllinfo = tcImports.FindDllInfo(ctok,m,ilShortAssemName) + let dllinfo = tcImports.FindDllInfo(ctok, m, ilShortAssemName) true, dllinfo.ProviderGeneratedStaticLinkMap else false, None @@ -3908,15 +4045,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let g = tcImports.GetTcGlobals() let ilScopeRef = ILScopeRef.Assembly (ILAssemblyRef.FromAssemblyName aname) let fileName = aname.Name + ".dll" - let bytes = assembly.PApplyWithProvider((fun (assembly,provider) -> assembly.GetManifestModuleContents(provider)), m).PUntaint(id,m) - let ilModule,ilAssemblyRefs = + let bytes = assembly.PApplyWithProvider((fun (assembly, provider) -> assembly.GetManifestModuleContents(provider)), m).PUntaint(id, m) + let ilModule, ilAssemblyRefs = let opts = { ILBinaryReader.mkDefault g.ilg with ILBinaryReader.optimizeForMemory=true ILBinaryReader.pdbPath = None } let reader = ILBinaryReader.OpenILModuleReaderFromBytes fileName bytes opts reader.ILModuleDef, reader.ILAssemblyRefs - let theActualAssembly = assembly.PUntaint((fun x -> x.Handle),m) + let theActualAssembly = assembly.PUntaint((fun x -> x.Handle), m) let dllinfo = { RawMetadata= RawFSharpAssemblyDataBackedByFileOnDisk (ilModule, ilAssemblyRefs) FileName=fileName @@ -3941,7 +4078,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti ImportProvidedType = (fun ty -> Import.ImportProvidedType (tcImports.GetImportMap()) m ty) TypeForwarders = Map.empty } - let ccu = CcuThunk.Create(ilShortAssemName,ccuData) + let ccu = CcuThunk.Create(ilShortAssemName, ccuData) let ccuinfo = { FSharpViewOfMetadata=ccu ILScopeRef = ilScopeRef @@ -3959,7 +4096,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let (ProviderGeneratedType(_, ilTyRef, _)) = root let index = match generatedTypeRoots.TryGetValue ilTyRef with - | true,(index, _) -> index + | true, (index, _) -> index | false, _ -> generatedTypeRoots.Count generatedTypeRoots.[ilTyRef] <- (index, root) @@ -3985,7 +4122,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Note: the returned binary reader is associated with the tcImports, i.e. when the tcImports are closed // then the reader is closed. - member tcImports.OpenILBinaryModule(ctok,filename,m) = + member tcImports.OpenILBinaryModule(ctok, filename, m) = try CheckDisposed() let tcConfig = tcConfigP.Get(ctok) @@ -4002,11 +4139,11 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti None else None - let ilILBinaryReader = OpenILBinary(filename,tcConfig.optimizeForMemory,tcConfig.openBinariesInMemory,ilGlobalsOpt,pdbPathOption, tcConfig.shadowCopyReferences) + let ilILBinaryReader = OpenILBinary(filename, tcConfig.optimizeForMemory, tcConfig.openBinariesInMemory, ilGlobalsOpt, pdbPathOption, tcConfig.shadowCopyReferences) tcImports.AttachDisposeAction(fun _ -> (ilILBinaryReader :> IDisposable).Dispose()) ilILBinaryReader.ILModuleDef, ilILBinaryReader.ILAssemblyRefs with e -> - error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message),m)) + error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), m)) (* auxModTable is used for multi-module assemblies *) member tcImports.MkLoaderForMultiModuleILAssemblies ctok m = @@ -4019,13 +4156,13 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | ILScopeRef.Module modref -> let key = modref.Name if not (auxModTable.ContainsKey(key)) then - let resolution = tcConfig.ResolveLibWithDirectories (CcuLoadFailureAction.RaiseError, AssemblyReference(m,key,None)) |> Option.get - let ilModule,_ = tcImports.OpenILBinaryModule(ctok,resolution.resolvedPath,m) + let resolution = tcConfig.ResolveLibWithDirectories (CcuLoadFailureAction.RaiseError, AssemblyReference(m, key, None)) |> Option.get + let ilModule, _ = tcImports.OpenILBinaryModule(ctok, resolution.resolvedPath, m) auxModTable.[key] <- ilModule auxModTable.[key] | _ -> - error(InternalError("Unexpected ILScopeRef.Local or ILScopeRef.Assembly in exported type table",m)) + error(InternalError("Unexpected ILScopeRef.Local or ILScopeRef.Assembly in exported type table", m)) member tcImports.IsAlreadyRegistered nm = CheckDisposed() @@ -4039,7 +4176,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let loaderInterface = { new Import.AssemblyLoader with member x.FindCcuFromAssemblyRef (ctok, m, ilAssemblyRef) = - tcImports.FindCcuFromAssemblyRef (ctok, m,ilAssemblyRef) + tcImports.FindCcuFromAssemblyRef (ctok, m, ilAssemblyRef) #if EXTENSIONTYPING member x.GetProvidedAssemblyInfo (ctok, m, assembly) = tcImports.GetProvidedAssemblyInfo (ctok, m, assembly) member x.RecordGeneratedTypeRoot root = tcImports.RecordGeneratedTypeRoot root @@ -4075,9 +4212,9 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti #if EXTENSIONTYPING member private tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, - tcConfig:TcConfig, - m,entity:Entity, - injectedNamspace,remainingNamespace, + tcConfig:TcConfig, + m, entity:Entity, + injectedNamspace, remainingNamespace, provider, st:Tainted option) = match remainingNamespace with @@ -4088,8 +4225,8 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, childEntity, next::injectedNamspace, rest, provider, st) | None -> // Build up the artificial namespace if there is not a real one. - let cpath = CompPath(ILScopeRef.Local, injectedNamspace |> List.rev |> List.map (fun n -> (n,ModuleOrNamespaceKind.Namespace)) ) - let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next,rangeStartup)) XmlDoc.Empty [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType Namespace)) + let cpath = CompPath(ILScopeRef.Local, injectedNamspace |> List.rev |> List.map (fun n -> (n, ModuleOrNamespaceKind.Namespace)) ) + let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next, rangeStartup)) XmlDoc.Empty [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType Namespace)) entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newNamespace) tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, newNamespace, next::injectedNamspace, rest, provider, st) | [] -> @@ -4100,7 +4237,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Generated types get properly injected into the provided (i.e. generated) assembly CCU in tc.fs let importProvidedType t = Import.ImportProvidedType (tcImports.GetImportMap()) m t - let isSuppressRelocate = tcConfig.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate),m) + let isSuppressRelocate = tcConfig.isInteractive || st.PUntaint((fun st -> st.IsSuppressRelocate), m) let newEntity = Construct.NewProvidedTycon(typeProviderEnvironment, st, importProvidedType, isSuppressRelocate, m) entity.ModuleOrNamespaceType.AddProvidedTypeEntity(newEntity) | None -> () @@ -4123,7 +4260,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti member tcImports.ImportTypeProviderExtensions (ctok, tcConfig:TcConfig, fileNameOfRuntimeAssembly, - ilScopeRefOfRuntimeAssembly, + ilScopeRefOfRuntimeAssembly, runtimeAssemblyAttributes:ILAttribute list, entityToInjectInto, invalidateCcu:Event<_>, m) = @@ -4188,7 +4325,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match providers with | [] -> - warning(Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts(fileNameOfRuntimeAssembly,typeof.FullName),m)) + warning(Error(FSComp.SR.etHostingAssemblyFoundWithoutHosts(fileNameOfRuntimeAssembly, typeof.FullName), m)) | _ -> #if DEBUG @@ -4202,8 +4339,8 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // Inject an entity for the namespace, or if one already exists, then record this as a provider // for that namespace. let rec loop (providedNamespace: Tainted) = - let path = ExtensionTyping.GetProvidedNamespaceAsPath(m,provider,providedNamespace.PUntaint((fun r -> r.NamespaceName), m)) - tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, entityToInjectInto, [],path, provider, None) + let path = ExtensionTyping.GetProvidedNamespaceAsPath(m, provider, providedNamespace.PUntaint((fun r -> r.NamespaceName), m)) + tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, entityToInjectInto, [], path, provider, None) // Inject entities for the types returned by provider.GetTypes(). // @@ -4227,7 +4364,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti errorRecovery e m if startingErrorCount aref - | _ -> error(InternalError("PrepareToImportReferencedILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead",m)) + | _ -> error(InternalError("PrepareToImportReferencedILAssembly: cannot reference .NET netmodules directly, reference the containing assembly instead", m)) let nm = aref.Name if verbose then dprintn ("Converting IL assembly to F# data structures "+nm) let auxModuleLoader = tcImports.MkLoaderForMultiModuleILAssemblies ctok m let invalidateCcu = new Event<_>() - let ccu = Import.ImportILAssembly(tcImports.GetImportMap,m,auxModuleLoader,ilScopeRef,tcConfig.implicitIncludeDir, Some filename,ilModule,invalidateCcu.Publish) + let ccu = Import.ImportILAssembly(tcImports.GetImportMap, m, auxModuleLoader, ilScopeRef, tcConfig.implicitIncludeDir, Some filename, ilModule, invalidateCcu.Publish) let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals @@ -4337,7 +4474,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti None | Some info -> let data = GetOptimizationData (filename, ilScopeRef, ilModule.TryGetRawILModule(), info) - let res = data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(ctok,m,nm,lookupOnly=false))) + let res = data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(ctok, m, nm, lookupOnly=false))) if verbose then dprintf "found optimization data for CCU %s\n" ccuName Some res) let ilg = defaultArg ilGlobalsOpt EcmaMscorlibILGlobals @@ -4360,16 +4497,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti #else () #endif - data,ccuinfo,phase2) + data, ccuinfo, phase2) // Register all before relinking to cope with mutually-referential ccus ccuRawDataAndInfos |> List.iter (p23 >> tcImports.RegisterCcu) let phase2 () = (* Relink *) (* dprintf "Phase2: %s\n" filename; REMOVE DIAGNOSTICS *) - ccuRawDataAndInfos |> List.iter (fun (data,_,_) -> data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(ctok,m,nm,lookupOnly=false))) |> ignore) + ccuRawDataAndInfos |> List.iter (fun (data, _, _) -> data.OptionalFixup(fun nm -> availableToOptionalCcu(tcImports.FindCcu(ctok, m, nm, lookupOnly=false))) |> ignore) #if EXTENSIONTYPING - ccuRawDataAndInfos |> List.iter (fun (_,_,phase2) -> phase2()) + ccuRawDataAndInfos |> List.iter (fun (_, _, phase2) -> phase2()) #endif ccuRawDataAndInfos |> List.map p23 |> List.map ResolvedImportedAssembly phase2 @@ -4392,16 +4529,16 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match contentsOpt with | Some ilb -> ilb | None -> - let ilModule,ilAssemblyRefs = tcImports.OpenILBinaryModule(ctok, filename, m) + let ilModule, ilAssemblyRefs = tcImports.OpenILBinaryModule(ctok, filename, m) RawFSharpAssemblyDataBackedByFileOnDisk (ilModule, ilAssemblyRefs) :> IRawFSharpAssemblyData let ilShortAssemName = assemblyData.ShortAssemblyName let ilScopeRef = assemblyData.ILScopeRef if tcImports.IsAlreadyRegistered ilShortAssemName then - let dllinfo = tcImports.FindDllInfo(ctok,m,ilShortAssemName) - let phase2() = [tcImports.FindCcuInfo(ctok,m,ilShortAssemName,lookupOnly=true)] - return dllinfo,phase2 + let dllinfo = tcImports.FindDllInfo(ctok, m, ilShortAssemName) + let phase2() = [tcImports.FindCcuInfo(ctok, m, ilShortAssemName, lookupOnly=true)] + return dllinfo, phase2 else let dllinfo = { RawMetadata=assemblyData @@ -4418,15 +4555,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let phase2 = if assemblyData.HasAnyFSharpSignatureDataAttribute then if not (assemblyData.HasMatchingFSharpSignatureDataAttribute(ilg)) then - errorR(Error(FSComp.SR.buildDifferentVersionMustRecompile(filename),m)) + errorR(Error(FSComp.SR.buildDifferentVersionMustRecompile(filename), m)) tcImports.PrepareToImportReferencedILAssembly (ctok, m, filename, dllinfo) else try tcImports.PrepareToImportReferencedFSharpAssembly (ctok, m, filename, dllinfo) - with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message),m)) + with e -> error(Error(FSComp.SR.buildErrorOpeningBinaryFile(filename, e.Message), m)) else tcImports.PrepareToImportReferencedILAssembly (ctok, m, filename, dllinfo) - return dllinfo,phase2 + return dllinfo, phase2 } // NOTE: When used in the Language Service this can cause the transitive checking of projects. Hence it must be cancellable. @@ -4441,13 +4578,13 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let! res = tcImports.RegisterAndPrepareToImportReferencedDll (ctok, nm) return Some res with e -> - errorR(Error(FSComp.SR.buildProblemReadingAssembly(nm.resolvedPath, e.Message),nm.originalReference.Range)) + errorR(Error(FSComp.SR.buildProblemReadingAssembly(nm.resolvedPath, e.Message), nm.originalReference.Range)) return None }) - let dllinfos,phase2s = results |> List.choose id |> List.unzip + let dllinfos, phase2s = results |> List.choose id |> List.unzip let ccuinfos = (List.collect (fun phase2 -> phase2()) phase2s) - return dllinfos,ccuinfos + return dllinfos, ccuinfos } /// Note that implicit loading is not used for compilations from MSBuild, which passes ``--noframework`` @@ -4464,7 +4601,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match foundFile with | OkResult (warns, res) -> ReportWarnings warns - tcImports.RegisterAndImportReferencedAssemblies(ctok,res) |> Cancellable.runWithoutCancellation |> ignore + tcImports.RegisterAndImportReferencedAssemblies(ctok, res) |> Cancellable.runWithoutCancellation |> ignore true | ErrorResult (_warns, _err) -> // Throw away warnings and errors - this is speculative loading @@ -4519,28 +4656,28 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti resolutions <- resolutions.AddResolutionResults [resolved] ResultD [resolved] | None -> - ErrorD(AssemblyNotResolved(assemblyReference.Text,assemblyReference.Range)) + ErrorD(AssemblyNotResolved(assemblyReference.Text, assemblyReference.Range)) else // This is a previously unencounterd assembly. Resolve it and add it to the list. // But don't cache resolution failures because the assembly may appear on the disk later. - let resolved,unresolved = TcConfig.TryResolveLibsUsingMSBuildRules(tcConfig, [ assemblyReference ], assemblyReference.Range, mode) - match resolved,unresolved with - | (assemblyResolution::_,_) -> + let resolved, unresolved = TcConfig.TryResolveLibsUsingMSBuildRules(tcConfig, [ assemblyReference ], assemblyReference.Range, mode) + match resolved, unresolved with + | (assemblyResolution::_, _) -> resolutions <- resolutions.AddResolutionResults resolved ResultD [assemblyResolution] - | (_,_::_) -> + | (_, _::_) -> resolutions <- resolutions.AddUnresolvedReferences unresolved - ErrorD(AssemblyNotResolved(assemblyReference.Text,assemblyReference.Range)) - | [],[] -> + ErrorD(AssemblyNotResolved(assemblyReference.Text, assemblyReference.Range)) + | [], [] -> // Note, if mode=ResolveAssemblyReferenceMode.Speculative and the resolution failed then TryResolveLibsUsingMSBuildRules returns // the empty list and we convert the failure into an AssemblyNotResolved here. - ErrorD(AssemblyNotResolved(assemblyReference.Text,assemblyReference.Range)) + ErrorD(AssemblyNotResolved(assemblyReference.Text, assemblyReference.Range)) #endif member tcImports.ResolveAssemblyReference(ctok, assemblyReference, mode) : AssemblyResolution list = - CommitOperationResult(tcImports.TryResolveAssemblyReference(ctok, assemblyReference,mode)) + CommitOperationResult(tcImports.TryResolveAssemblyReference(ctok, assemblyReference, mode)) // Note: This returns a TcImports object. However, framework TcImports are not currently disposed. The only reason // we dispose TcImports is because we need to dispose type providers, and type providers are never included in the framework DLL set. @@ -4555,7 +4692,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let tcAltResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, nonFrameworkDLLs, []) // Note: TcImports are disposable - the caller owns this object and must dispose - let frameworkTcImports = new TcImports(tcConfigP,tcResolutions,None,None) + let frameworkTcImports = new TcImports(tcConfigP, tcResolutions, None, None) let primaryAssemblyReference = tcConfig.PrimaryAssemblyDllReference() let primaryAssemblyResolution = frameworkTcImports.ResolveAssemblyReference(ctok, primaryAssemblyReference, ResolveAssemblyReferenceMode.ReportErrors) @@ -4605,20 +4742,20 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti match frameworkTcImports.RegisterAndImportReferencedAssemblies(ctok, [coreLibraryResolution]) |> Cancellable.runWithoutCancellation with | (_, [ResolvedImportedAssembly(fslibCcuInfo) ]) -> fslibCcuInfo | _ -> - error(InternalError("BuildFrameworkTcImports: no successful import of "+coreLibraryResolution.resolvedPath,coreLibraryResolution.originalReference.Range)) + error(InternalError("BuildFrameworkTcImports: no successful import of "+coreLibraryResolution.resolvedPath, coreLibraryResolution.originalReference.Range)) | None -> - error(InternalError(sprintf "BuildFrameworkTcImports: no resolution of '%s'" coreLibraryReference.Text,rangeStartup)) + error(InternalError(sprintf "BuildFrameworkTcImports: no resolution of '%s'" coreLibraryReference.Text, rangeStartup)) IlxSettings.ilxFsharpCoreLibAssemRef := (let scoref = fslibCcuInfo.ILScopeRef match scoref with | ILScopeRef.Assembly aref -> Some aref - | ILScopeRef.Local | ILScopeRef.Module _ -> error(InternalError("not ILScopeRef.Assembly",rangeStartup))) + | ILScopeRef.Local | ILScopeRef.Module _ -> error(InternalError("not ILScopeRef.Assembly", rangeStartup))) fslibCcuInfo.FSharpViewOfMetadata // OK, now we have both mscorlib.dll and FSharp.Core.dll we can create TcGlobals - let tcGlobals = TcGlobals(tcConfig.compilingFslib,ilGlobals,fslibCcu, - tcConfig.implicitIncludeDir,tcConfig.mlCompatibility, - tcConfig.isInteractive,tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, tcConfig.noDebugData ) + let tcGlobals = TcGlobals(tcConfig.compilingFslib, ilGlobals, fslibCcu, + tcConfig.implicitIncludeDir, tcConfig.mlCompatibility, + tcConfig.isInteractive, tryFindSysTypeCcu, tcConfig.emitDebugInfoInQuotations, tcConfig.noDebugData ) #if DEBUG // the global_g reference cell is used only for debug printing @@ -4629,15 +4766,15 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti Microsoft.FSharp.Compiler.AbstractIL.Internal.AsciiConstants.parseILGlobals := tcGlobals.ilg #endif frameworkTcImports.SetTcGlobals(tcGlobals) - return tcGlobals,frameworkTcImports + return tcGlobals, frameworkTcImports } member tcImports.ReportUnresolvedAssemblyReferences(knownUnresolved) = // Report that an assembly was not resolved. - let reportAssemblyNotResolved(file,originalReferences:AssemblyReference list) = - originalReferences |> List.iter(fun originalReference -> errorR(AssemblyNotResolved(file,originalReference.Range))) + let reportAssemblyNotResolved(file, originalReferences:AssemblyReference list) = + originalReferences |> List.iter(fun originalReference -> errorR(AssemblyNotResolved(file, originalReference.Range))) knownUnresolved - |> List.map (function UnresolvedAssemblyReference(file,originalReferences) -> file,originalReferences) + |> List.map (function UnresolvedAssemblyReference(file, originalReferences) -> file, originalReferences) |> List.iter reportAssemblyNotResolved // Note: This returns a TcImports object. TcImports are disposable - the caller owns the returned TcImports object @@ -4647,7 +4784,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti let tcConfig = tcConfigP.Get(ctok) let tcResolutions = TcAssemblyResolutions.BuildFromPriorResolutions(ctok, tcConfig, nonFrameworkReferences, knownUnresolved) let references = tcResolutions.GetAssemblyResolutions() - let tcImports = new TcImports(tcConfigP,tcResolutions,Some baseTcImports, Some tcGlobals.ilg) + let tcImports = new TcImports(tcConfigP, tcResolutions, Some baseTcImports, Some tcGlobals.ilg) let! _assemblies = tcImports.RegisterAndImportReferencedAssemblies(ctok, references) tcImports.ReportUnresolvedAssemblyReferences(knownUnresolved) return tcImports @@ -4657,14 +4794,14 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti // and if hosted in Visual Studio or another long-running process must dispose this object. However this // function is currently only used from fsi.exe. If we move to a long-running hosted evaluation service API then // we should start disposing these objects. - static member BuildTcImports(ctok,tcConfigP:TcConfigProvider) = + static member BuildTcImports(ctok, tcConfigP:TcConfigProvider) = cancellable { let tcConfig = tcConfigP.Get(ctok) - //let foundationalTcImports,tcGlobals = TcImports.BuildFoundationalTcImports(tcConfigP) - let frameworkDLLs,nonFrameworkReferences,knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok,tcConfig) - let! tcGlobals,frameworkTcImports = TcImports.BuildFrameworkTcImports (ctok, tcConfigP, frameworkDLLs, nonFrameworkReferences) + //let foundationalTcImports, tcGlobals = TcImports.BuildFoundationalTcImports(tcConfigP) + let frameworkDLLs, nonFrameworkReferences, knownUnresolved = TcAssemblyResolutions.SplitNonFoundationalResolutions(ctok, tcConfig) + let! tcGlobals, frameworkTcImports = TcImports.BuildFrameworkTcImports (ctok, tcConfigP, frameworkDLLs, nonFrameworkReferences) let! tcImports = TcImports.BuildNonFrameworkTcImports(ctok, tcConfigP, tcGlobals, frameworkTcImports, nonFrameworkReferences, knownUnresolved) - return tcGlobals,tcImports + return tcGlobals, tcImports } interface System.IDisposable with @@ -4681,24 +4818,24 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti /// Process #r in F# Interactive. /// Adds the reference to the tcImports and add the ccu to the type checking environment. let RequireDLL (ctok, tcImports:TcImports, tcEnv, thisAssemblyName, m, file) = - let resolutions = CommitOperationResult(tcImports.TryResolveAssemblyReference(ctok, AssemblyReference(m,file,None),ResolveAssemblyReferenceMode.ReportErrors)) - let dllinfos,ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) |> Cancellable.runWithoutCancellation + let resolutions = CommitOperationResult(tcImports.TryResolveAssemblyReference(ctok, AssemblyReference(m, file, None), ResolveAssemblyReferenceMode.ReportErrors)) + let dllinfos, ccuinfos = tcImports.RegisterAndImportReferencedAssemblies(ctok, resolutions) |> Cancellable.runWithoutCancellation let asms = ccuinfos |> List.map (function | ResolvedImportedAssembly(asm) -> asm - | UnresolvedImportedAssembly(assemblyName) -> error(Error(FSComp.SR.buildCouldNotResolveAssemblyRequiredByFile(assemblyName,file),m))) + | UnresolvedImportedAssembly(assemblyName) -> error(Error(FSComp.SR.buildCouldNotResolveAssemblyRequiredByFile(assemblyName, file), m))) let g = tcImports.GetTcGlobals() let amap = tcImports.GetImportMap() - let tcEnv = (tcEnv, asms) ||> List.fold (fun tcEnv asm -> AddCcuToTcEnv(g,amap,m,tcEnv,thisAssemblyName,asm.FSharpViewOfMetadata,asm.AssemblyAutoOpenAttributes,asm.AssemblyInternalsVisibleToAttributes)) - tcEnv,(dllinfos,asms) + let tcEnv = (tcEnv, asms) ||> List.fold (fun tcEnv asm -> AddCcuToTcEnv(g, amap, m, tcEnv, thisAssemblyName, asm.FSharpViewOfMetadata, asm.AssemblyAutoOpenAttributes, asm.AssemblyInternalsVisibleToAttributes)) + tcEnv, (dllinfos, asms) let ProcessMetaCommandsFromInput - (nowarnF: 'state -> range * string -> 'state, - dllRequireF: 'state -> range * string -> 'state, + (nowarnF: 'state -> range * string -> 'state, + dllRequireF: 'state -> range * string -> 'state, loadSourceF: 'state -> range * string -> unit) (tcConfig:TcConfigBuilder, inp, pathOfMetaCommandSource, state0) = @@ -4713,40 +4850,40 @@ let ProcessMetaCommandsFromInput let mutable matchedm = range0 try match hash with - | ParsedHashDirective("I",args,m) -> + | ParsedHashDirective("I", args, m) -> if not canHaveScriptMetaCommands then errorR(HashIncludeNotAllowedInNonScript(m)) match args with | [path] -> matchedm<-m - tcConfig.AddIncludePath(m,path,pathOfMetaCommandSource) + tcConfig.AddIncludePath(m, path, pathOfMetaCommandSource) state | _ -> - errorR(Error(FSComp.SR.buildInvalidHashIDirective(),m)) + errorR(Error(FSComp.SR.buildInvalidHashIDirective(), m)) state - | ParsedHashDirective("nowarn",numbers,m) -> - List.fold (fun state d -> nowarnF state (m,d)) state numbers - | ParsedHashDirective(("reference" | "r"),args,m) -> + | ParsedHashDirective("nowarn", numbers, m) -> + List.fold (fun state d -> nowarnF state (m, d)) state numbers + | ParsedHashDirective(("reference" | "r"), args, m) -> if not canHaveScriptMetaCommands then errorR(HashReferenceNotAllowedInNonScript(m)) match args with | [path] -> matchedm<-m - dllRequireF state (m,path) + dllRequireF state (m, path) | _ -> - errorR(Error(FSComp.SR.buildInvalidHashrDirective(),m)) + errorR(Error(FSComp.SR.buildInvalidHashrDirective(), m)) state - | ParsedHashDirective("load",args,m) -> + | ParsedHashDirective("load", args, m) -> if not canHaveScriptMetaCommands then errorR(HashDirectiveNotAllowedInNonScript(m)) match args with | _ :: _ -> matchedm<-m - args |> List.iter (fun path -> loadSourceF state (m,path)) + args |> List.iter (fun path -> loadSourceF state (m, path)) | _ -> - errorR(Error(FSComp.SR.buildInvalidHashloadDirective(),m)) + errorR(Error(FSComp.SR.buildInvalidHashloadDirective(), m)) state - | ParsedHashDirective("time",args,m) -> + | ParsedHashDirective("time", args, m) -> if not canHaveScriptMetaCommands then errorR(HashDirectiveNotAllowedInNonScript(m)) match args with @@ -4755,53 +4892,53 @@ let ProcessMetaCommandsFromInput | ["on" | "off"] -> () | _ -> - errorR(Error(FSComp.SR.buildInvalidHashtimeDirective(),m)) + errorR(Error(FSComp.SR.buildInvalidHashtimeDirective(), m)) state | _ -> - (* warning(Error("This meta-command has been ignored",m)) *) + (* warning(Error("This meta-command has been ignored", m)) *) state with e -> errorRecovery e matchedm; state let rec WarnOnIgnoredSpecDecls decls = decls |> List.iter (fun d -> match d with - | SynModuleSigDecl.HashDirective (_,m) -> warning(Error(FSComp.SR.buildDirectivesInModulesAreIgnored(),m)) - | SynModuleSigDecl.NestedModule (_,_,subDecls,_) -> WarnOnIgnoredSpecDecls subDecls + | SynModuleSigDecl.HashDirective (_, m) -> warning(Error(FSComp.SR.buildDirectivesInModulesAreIgnored(), m)) + | SynModuleSigDecl.NestedModule (_, _, subDecls, _) -> WarnOnIgnoredSpecDecls subDecls | _ -> ()) let rec WarnOnIgnoredImplDecls decls = decls |> List.iter (fun d -> match d with - | SynModuleDecl.HashDirective (_,m) -> warning(Error(FSComp.SR.buildDirectivesInModulesAreIgnored(),m)) - | SynModuleDecl.NestedModule (_,_,subDecls,_,_) -> WarnOnIgnoredImplDecls subDecls + | SynModuleDecl.HashDirective (_, m) -> warning(Error(FSComp.SR.buildDirectivesInModulesAreIgnored(), m)) + | SynModuleDecl.NestedModule (_, _, subDecls, _, _) -> WarnOnIgnoredImplDecls subDecls | _ -> ()) - let ProcessMetaCommandsFromModuleSpec state (SynModuleOrNamespaceSig(_,_,_,decls,_,_,_,_)) = + let ProcessMetaCommandsFromModuleSpec state (SynModuleOrNamespaceSig(_, _, _, decls, _, _, _, _)) = List.fold (fun s d -> match d with - | SynModuleSigDecl.HashDirective (h,_) -> ProcessMetaCommand s h - | SynModuleSigDecl.NestedModule (_,_,subDecls,_) -> WarnOnIgnoredSpecDecls subDecls; s + | SynModuleSigDecl.HashDirective (h, _) -> ProcessMetaCommand s h + | SynModuleSigDecl.NestedModule (_, _, subDecls, _) -> WarnOnIgnoredSpecDecls subDecls; s | _ -> s) state decls - let ProcessMetaCommandsFromModuleImpl state (SynModuleOrNamespace(_,_,_,decls,_,_,_,_)) = + let ProcessMetaCommandsFromModuleImpl state (SynModuleOrNamespace(_, _, _, decls, _, _, _, _)) = List.fold (fun s d -> match d with - | SynModuleDecl.HashDirective (h,_) -> ProcessMetaCommand s h - | SynModuleDecl.NestedModule (_,_,subDecls,_,_) -> WarnOnIgnoredImplDecls subDecls; s + | SynModuleDecl.HashDirective (h, _) -> ProcessMetaCommand s h + | SynModuleDecl.NestedModule (_, _, subDecls, _, _) -> WarnOnIgnoredImplDecls subDecls; s | _ -> s) state decls match inp with - | ParsedInput.SigFile(ParsedSigFileInput(_,_,_,hashDirectives,specs)) -> + | ParsedInput.SigFile(ParsedSigFileInput(_, _, _, hashDirectives, specs)) -> let state = List.fold ProcessMetaCommand state0 hashDirectives let state = List.fold ProcessMetaCommandsFromModuleSpec state specs state - | ParsedInput.ImplFile(ParsedImplFileInput(_,_,_,_,hashDirectives,impls,_)) -> + | ParsedInput.ImplFile(ParsedImplFileInput(_, _, _, _, hashDirectives, impls, _)) -> let state = List.fold ProcessMetaCommand state0 hashDirectives let state = List.fold ProcessMetaCommandsFromModuleImpl state impls state @@ -4809,9 +4946,9 @@ let ProcessMetaCommandsFromInput let ApplyNoWarnsToTcConfig (tcConfig:TcConfig, inp:ParsedInput, pathOfMetaCommandSource) = // Clone let tcConfigB = tcConfig.CloneOfOriginalBuilder - let addNoWarn = fun () (m,s) -> tcConfigB.TurnWarningOff(m, s) - let addReferencedAssemblyByPath = fun () (_m,_s) -> () - let addLoadedSource = fun () (_m,_s) -> () + let addNoWarn = fun () (m, s) -> tcConfigB.TurnWarningOff(m, s) + let addReferencedAssemblyByPath = fun () (_m, _s) -> () + let addLoadedSource = fun () (_m, _s) -> () ProcessMetaCommandsFromInput (addNoWarn, addReferencedAssemblyByPath, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) TcConfig.Create(tcConfigB, validate=false) @@ -4819,8 +4956,8 @@ let ApplyMetaCommandsFromInputToTcConfig (tcConfig:TcConfig, inp:ParsedInput, pa // Clone let tcConfigB = tcConfig.CloneOfOriginalBuilder let getWarningNumber = fun () _ -> () - let addReferencedAssemblyByPath = fun () (m,s) -> tcConfigB.AddReferencedAssemblyByPath(m,s) - let addLoadedSource = fun () (m,s) -> tcConfigB.AddLoadedSource(m,s,pathOfMetaCommandSource) + let addReferencedAssemblyByPath = fun () (m, s) -> tcConfigB.AddReferencedAssemblyByPath(m, s) + let addLoadedSource = fun () (m, s) -> tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource) ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) TcConfig.Create(tcConfigB, validate=false) @@ -4832,7 +4969,7 @@ let GetAssemblyResolutionInformation(ctok, tcConfig : TcConfig) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter let assemblyList = TcAssemblyResolutions.GetAllDllReferences(tcConfig) let resolutions = TcAssemblyResolutions.ResolveAssemblyReferences (ctok, tcConfig, assemblyList, []) - resolutions.GetAssemblyResolutions(),resolutions.GetUnresolvedReferences() + resolutions.GetAssemblyResolutions(), resolutions.GetUnresolvedReferences() [] @@ -4881,10 +5018,10 @@ module private ScriptPreprocessClosure = type ClosureFile = ClosureFile of string * range * ParsedInput option * (PhasedDiagnostic * bool) list * (PhasedDiagnostic * bool) list * (string * range) list // filename, range, errors, warnings, nowarns type Observed() = - let seen = System.Collections.Generic.Dictionary<_,bool>() + let seen = System.Collections.Generic.Dictionary<_, bool>() member ob.SetSeen(check) = if not(seen.ContainsKey(check)) then - seen.Add(check,true) + seen.Add(check, true) member ob.HaveSeen(check) = seen.ContainsKey(check) @@ -4905,7 +5042,7 @@ module private ScriptPreprocessClosure = let lexbuf = UnicodeLexing.StringAsLexbuf source let isLastCompiland = (IsScript filename), tcConfig.target.IsExe // The root compiland is last in the list of compilands. - ParseOneInputLexbuf (tcConfig,lexResourceManager,defines,lexbuf,filename,isLastCompiland,errorLogger) + ParseOneInputLexbuf (tcConfig, lexResourceManager, defines, lexbuf, filename, isLastCompiland, errorLogger) /// Create a TcConfig for load closure starting from a single .fsx file let CreateScriptSourceTcConfig (legacyReferenceResolver, defaultFSharpBinariesDir, filename:string, codeContext, useSimpleResolution, useFsiAuxLib, basicReferences, applyCommandLineArgs, assumeDotNetFramework) = @@ -4915,8 +5052,8 @@ module private ScriptPreprocessClosure = let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir, true (* optimize for memory *), projectDir, isInteractive, isInvalidationSupported, defaultCopyFSharpCore=false) applyCommandLineArgs tcConfigB match basicReferences with - | None -> BasicReferencesForScriptLoadClosure(useFsiAuxLib, assumeDotNetFramework) |> List.iter(fun f->tcConfigB.AddReferencedAssemblyByPath(range0,f)) // Add script references - | Some rs -> for m,r in rs do tcConfigB.AddReferencedAssemblyByPath(m,r) + | None -> BasicReferencesForScriptLoadClosure(useFsiAuxLib, assumeDotNetFramework) |> List.iter(fun f->tcConfigB.AddReferencedAssemblyByPath(range0, f)) // Add script references + | Some rs -> for m, r in rs do tcConfigB.AddReferencedAssemblyByPath(m, r) tcConfigB.resolutionEnvironment <- match codeContext with @@ -4934,18 +5071,18 @@ module private ScriptPreprocessClosure = // Indicates that there are some references not in BasicReferencesForScriptLoadClosure which should // be added conditionally once the relevant version of mscorlib.dll has been detected. tcConfigB.implicitlyResolveAssemblies <- false - TcConfig.Create(tcConfigB,validate=true) + TcConfig.Create(tcConfigB, validate=true) - let ClosureSourceOfFilename(filename,m,inputCodePage,parseRequired) = + let ClosureSourceOfFilename(filename, m, inputCodePage, parseRequired) = try let filename = FileSystem.GetFullPathShim(filename) use stream = FileSystem.FileStreamReadShim filename use reader = match inputCodePage with - | None -> new StreamReader(stream,true) - | Some n -> new StreamReader(stream,Encoding.GetEncodingShim(n)) + | None -> new StreamReader(stream, true) + | Some n -> new StreamReader(stream, Encoding.GetEncodingShim(n)) let source = reader.ReadToEnd() - [ClosureSource(filename,m,source,parseRequired)] + [ClosureSource(filename, m, source, parseRequired)] with e -> errorRecovery e m [] @@ -4953,9 +5090,9 @@ module private ScriptPreprocessClosure = let ApplyMetaCommandsFromInputToTcConfigAndGatherNoWarn (tcConfig:TcConfig, inp:ParsedInput, pathOfMetaCommandSource) = let tcConfigB = tcConfig.CloneOfOriginalBuilder let nowarns = ref [] - let getWarningNumber = fun () (m,s) -> nowarns := (s,m) :: !nowarns - let addReferencedAssemblyByPath = fun () (m,s) -> tcConfigB.AddReferencedAssemblyByPath(m,s) - let addLoadedSource = fun () (m,s) -> tcConfigB.AddLoadedSource(m,s,pathOfMetaCommandSource) + let getWarningNumber = fun () (m, s) -> nowarns := (s, m) :: !nowarns + let addReferencedAssemblyByPath = fun () (m, s) -> tcConfigB.AddReferencedAssemblyByPath(m, s) + let addLoadedSource = fun () (m, s) -> tcConfigB.AddLoadedSource(m, s, pathOfMetaCommandSource) try ProcessMetaCommandsFromInput (getWarningNumber, addReferencedAssemblyByPath, addLoadedSource) (tcConfigB, inp, pathOfMetaCommandSource, ()) with ReportedError _ -> @@ -4963,17 +5100,17 @@ module private ScriptPreprocessClosure = () try - TcConfig.Create(tcConfigB, validate=false),nowarns + TcConfig.Create(tcConfigB, validate=false), nowarns with ReportedError _ -> // Recover by using a default TcConfig. let tcConfigB = tcConfig.CloneOfOriginalBuilder - TcConfig.Create(tcConfigB, validate=false),nowarns + TcConfig.Create(tcConfigB, validate=false), nowarns let FindClosureFiles(closureSources, tcConfig:TcConfig, codeContext, lexResourceManager:Lexhelp.LexResourceManager) = let tcConfig = ref tcConfig let observedSources = Observed() - let rec loop (ClosureSource(filename,m,source,parseRequired)) = + let rec loop (ClosureSource(filename, m, source, parseRequired)) = [ if not (observedSources.HaveSeen(filename)) then observedSources.SetSeen(filename) //printfn "visiting %s" filename @@ -4997,12 +5134,12 @@ module private ScriptPreprocessClosure = let postSources = (!tcConfig).GetAvailableLoadedSources() let sources = if preSources.Length < postSources.Length then postSources.[preSources.Length..] else [] - //for (_,subFile) in sources do + //for (_, subFile) in sources do // printfn "visiting %s - has subsource of %s " filename subFile - for (m,subFile) in sources do + for (m, subFile) in sources do if IsScript(subFile) then - for subSource in ClosureSourceOfFilename(subFile,m,tcConfigResult.inputCodePage,false) do + for subSource in ClosureSourceOfFilename(subFile, m, tcConfigResult.inputCodePage, false) do yield! loop subSource else yield ClosureFile(subFile, m, None, [], [], []) @@ -5012,7 +5149,7 @@ module private ScriptPreprocessClosure = | None -> //printfn "yielding source %s (failed parse)" filename - yield ClosureFile(filename, m, None, parseDiagnostics, [], []) + yield ClosureFile(filename, m, None, parseDiagnostics, [], []) else // Don't traverse into .fs leafs. //printfn "yielding non-script source %s" filename @@ -5029,29 +5166,29 @@ module private ScriptPreprocessClosure = closureFiles else match List.frontAndBack closureFiles with - | rest, ClosureFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,_))), parseDiagnostics, metaDiagnostics, nowarns) -> - rest @ [ClosureFile(filename,m,Some(ParsedInput.ImplFile(ParsedImplFileInput(name,isScript,qualNameOfFile,scopedPragmas,hashDirectives,implFileFlags,(true, tcConfig.target.IsExe)))),parseDiagnostics, metaDiagnostics, nowarns)] + | rest, ClosureFile(filename, m, Some(ParsedInput.ImplFile(ParsedImplFileInput(name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, _))), parseDiagnostics, metaDiagnostics, nowarns) -> + rest @ [ClosureFile(filename, m, Some(ParsedInput.ImplFile(ParsedImplFileInput(name, isScript, qualNameOfFile, scopedPragmas, hashDirectives, implFileFlags, (true, tcConfig.target.IsExe)))), parseDiagnostics, metaDiagnostics, nowarns)] | _ -> closureFiles // Get all source files. - let sourceFiles = [ for (ClosureFile(filename,m,_,_,_,_)) in closureFiles -> (filename,m) ] - let sourceInputs = [ for (ClosureFile(filename,_,input,parseDiagnostics,metaDiagnostics,_nowarns)) in closureFiles -> ({ FileName=filename; SyntaxTree=input; ParseDiagnostics=parseDiagnostics; MetaCommandDiagnostics=metaDiagnostics }: LoadClosureInput) ] - let globalNoWarns = closureFiles |> List.collect (fun (ClosureFile(_,_,_,_,_,noWarns)) -> noWarns) + let sourceFiles = [ for (ClosureFile(filename, m, _, _, _, _)) in closureFiles -> (filename, m) ] + let sourceInputs = [ for (ClosureFile(filename, _, input, parseDiagnostics, metaDiagnostics, _nowarns)) in closureFiles -> ({ FileName=filename; SyntaxTree=input; ParseDiagnostics=parseDiagnostics; MetaCommandDiagnostics=metaDiagnostics }: LoadClosureInput) ] + let globalNoWarns = closureFiles |> List.collect (fun (ClosureFile(_, _, _, _, _, noWarns)) -> noWarns) // Resolve all references. let references, unresolvedReferences, resolutionDiagnostics = let errorLogger = CapturingErrorLogger("GetLoadClosure") use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) - let references,unresolvedReferences = GetAssemblyResolutionInformation(ctok, tcConfig) - let references = references |> List.map (fun ar -> ar.resolvedPath,ar) + let references, unresolvedReferences = GetAssemblyResolutionInformation(ctok, tcConfig) + let references = references |> List.map (fun ar -> ar.resolvedPath, ar) references, unresolvedReferences, errorLogger.Diagnostics // Root errors and warnings - look at the last item in the closureFiles list let loadClosureRootDiagnostics, allRootDiagnostics = match List.rev closureFiles with - | ClosureFile(_,_,_,parseDiagnostics,metaDiagnostics,_) :: _ -> - (metaDiagnostics @ resolutionDiagnostics), + | ClosureFile(_, _, _, parseDiagnostics, metaDiagnostics, _) :: _ -> + (metaDiagnostics @ resolutionDiagnostics), (parseDiagnostics @ metaDiagnostics @ resolutionDiagnostics) | _ -> [], [] // When no file existed. @@ -5081,36 +5218,36 @@ module private ScriptPreprocessClosure = result /// Given source text, find the full load closure. Used from service.fs, when editing a script file - let GetFullClosureOfScriptSource(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename, source, codeContext, useSimpleResolution,useFsiAuxLib, lexResourceManager:Lexhelp.LexResourceManager, applyCommmandLineArgs, assumeDotNetFramework) = + let GetFullClosureOfScriptSource(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename, source, codeContext, useSimpleResolution, useFsiAuxLib, lexResourceManager:Lexhelp.LexResourceManager, applyCommmandLineArgs, assumeDotNetFramework) = // Resolve the basic references such as FSharp.Core.dll first, before processing any #I directives in the script // // This is tries to mimic the action of running the script in F# Interactive - the initial context for scripting is created // first, then #I and other directives are processed. let references0 = let tcConfig = CreateScriptSourceTcConfig(legacyReferenceResolver, defaultFSharpBinariesDir, filename, codeContext, useSimpleResolution, useFsiAuxLib, None, applyCommmandLineArgs, assumeDotNetFramework) - let resolutions0,_unresolvedReferences = GetAssemblyResolutionInformation(ctok, tcConfig) - let references0 = resolutions0 |> List.map (fun r->r.originalReference.Range,r.resolvedPath) |> Seq.distinct |> List.ofSeq + let resolutions0, _unresolvedReferences = GetAssemblyResolutionInformation(ctok, tcConfig) + let references0 = resolutions0 |> List.map (fun r->r.originalReference.Range, r.resolvedPath) |> Seq.distinct |> List.ofSeq references0 let tcConfig = CreateScriptSourceTcConfig(legacyReferenceResolver, defaultFSharpBinariesDir, filename, codeContext, useSimpleResolution, useFsiAuxLib, Some references0, applyCommmandLineArgs, assumeDotNetFramework) - let closureSources = [ClosureSource(filename,range0,source,true)] - let closureFiles,tcConfig = FindClosureFiles(closureSources, tcConfig, codeContext, lexResourceManager) + let closureSources = [ClosureSource(filename, range0, source, true)] + let closureFiles, tcConfig = FindClosureFiles(closureSources, tcConfig, codeContext, lexResourceManager) GetLoadClosure(ctok, filename, closureFiles, tcConfig, codeContext) /// Given source filename, find the full load closure /// Used from fsi.fs and fsc.fs, for #load and command line - let GetFullClosureOfScriptFiles(ctok, tcConfig:TcConfig,files:(string*range) list,codeContext,lexResourceManager:Lexhelp.LexResourceManager) = + let GetFullClosureOfScriptFiles(ctok, tcConfig:TcConfig, files:(string*range) list, codeContext, lexResourceManager:Lexhelp.LexResourceManager) = let mainFile = fst (List.last files) - let closureSources = files |> List.collect (fun (filename,m) -> ClosureSourceOfFilename(filename,m,tcConfig.inputCodePage,true)) - let closureFiles,tcConfig = FindClosureFiles(closureSources, tcConfig, codeContext, lexResourceManager) + let closureSources = files |> List.collect (fun (filename, m) -> ClosureSourceOfFilename(filename, m, tcConfig.inputCodePage, true)) + let closureFiles, tcConfig = FindClosureFiles(closureSources, tcConfig, codeContext, lexResourceManager) GetLoadClosure(ctok, mainFile, closureFiles, tcConfig, codeContext) type LoadClosure with // Used from service.fs, when editing a script file static member ComputeClosureOfSourceText(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename:string, source:string, codeContext, useSimpleResolution:bool, useFsiAuxLib, lexResourceManager:Lexhelp.LexResourceManager, applyCommmandLineArgs, assumeDotNetFramework) : LoadClosure = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - ScriptPreprocessClosure.GetFullClosureOfScriptSource(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename, source, codeContext, useSimpleResolution, useFsiAuxLib, lexResourceManager, applyCommmandLineArgs,assumeDotNetFramework) + ScriptPreprocessClosure.GetFullClosureOfScriptSource(ctok, legacyReferenceResolver, defaultFSharpBinariesDir, filename, source, codeContext, useSimpleResolution, useFsiAuxLib, lexResourceManager, applyCommmandLineArgs, assumeDotNetFramework) /// Used from fsi.fs and fsc.fs, for #load and command line. /// The resulting references are then added to a TcConfig. @@ -5198,7 +5335,7 @@ type TcState = member x.CreatesGeneratedProvidedTypes = x.tcsCreatesGeneratedProvidedTypes member x.PartialAssemblySignature = - let (RootSigsAndImpls(_rootSigs,_rootImpls,_allSigModulTyp,allImplementedSigModulTyp)) = x.tcsRootSigsAndImpls + let (RootSigsAndImpls(_rootSigs, _rootImpls, _allSigModulTyp, allImplementedSigModulTyp)) = x.tcsRootSigsAndImpls allImplementedSigModulTyp member x.NextStateAfterIncrementalFragment(tcEnvAtEndOfLastInput) = @@ -5207,7 +5344,7 @@ type TcState = /// Create the initial type checking state for compiling an assembly -let GetInitialTcState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports,niceNameGen,tcEnv0) = +let GetInitialTcState(m, ccuName, tcConfig:TcConfig, tcGlobals, tcImports:TcImports, niceNameGen, tcEnv0) = ignore tcImports // Create a ccu to hold all the results of compilation @@ -5230,7 +5367,7 @@ let GetInitialTcState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports, MemberSignatureEquality= (Tastops.typeEquivAux EraseAll tcGlobals) TypeForwarders=Map.empty } - let ccu = CcuThunk.Create(ccuName,ccuData) + let ccu = CcuThunk.Create(ccuName, ccuData) // OK, is this is the FSharp.Core CCU then fix it up. if tcConfig.compilingFslib then @@ -5251,7 +5388,7 @@ let GetInitialTcState(m,ccuName,tcConfig:TcConfig,tcGlobals,tcImports:TcImports, /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInputEventually - (checkForErrors, tcConfig:TcConfig, tcImports:TcImports, + (checkForErrors, tcConfig:TcConfig, tcImports:TcImports, tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = eventually { try @@ -5259,25 +5396,25 @@ let TypeCheckOneInputEventually RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST CheckSimulateException(tcConfig) - let (RootSigsAndImpls(rootSigs,rootImpls,allSigModulTyp,allImplementedSigModulTyp)) = tcState.tcsRootSigsAndImpls + let (RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp)) = tcState.tcsRootSigsAndImpls let m = inp.Range let amap = tcImports.GetImportMap() - let! (topAttrs, implFiles,tcEnvAtEnd,tcSigEnv,tcImplEnv,topSigsAndImpls,ccuType,createsGeneratedProvidedTypes) = + let! (topAttrs, implFiles, tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) = eventually { match inp with | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> // Check if we've seen this top module signature before. if Zmap.mem qualNameOfFile rootSigs then - errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text),m.StartRange)) + errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text), m.StartRange)) // Check if the implementation came first in compilation order if Zset.contains qualNameOfFile rootImpls then - errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text),m)) + errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text), m)) // Typecheck the signature file - let! (tcEnv,sigFileType,createsGeneratedProvidedTypes) = - TypeCheckOneSigFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcState.tcsTcSigEnv file + let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = + TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcState.tcsTcSigEnv file let rootSigs = Zmap.add qualNameOfFile sigFileType rootSigs @@ -5292,7 +5429,7 @@ let TypeCheckOneInputEventually let res = (EmptyTopAttrs, [], tcEnv, tcEnv, tcState.tcsTcImplEnv, RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp), tcState.tcsCcuType, createsGeneratedProvidedTypes) return res - | ParsedInput.ImplFile (ParsedImplFileInput(filename,_,qualNameOfFile,_,_,_,_) as file) -> + | ParsedInput.ImplFile (ParsedImplFileInput(filename, _, qualNameOfFile, _, _, _, _) as file) -> // Check if we've got an interface for this fragment let rootSigOpt = rootSigs.TryFind(qualNameOfFile) @@ -5301,13 +5438,13 @@ let TypeCheckOneInputEventually // Check if we've already seen an implementation for this fragment if Zset.contains qualNameOfFile rootImpls then - errorR(Error(FSComp.SR.buildImplementationAlreadyGiven(qualNameOfFile.Text),m)) + errorR(Error(FSComp.SR.buildImplementationAlreadyGiven(qualNameOfFile.Text), m)) let tcImplEnv = tcState.tcsTcImplEnv // Typecheck the implementation file let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = - TypeCheckOneImplFile (tcGlobals,tcState.tcsNiceNameGen,amap,tcState.tcsCcu,checkForErrors,tcConfig.conditionalCompilationDefines,tcSink) tcImplEnv rootSigOpt file + TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcImplEnv rootSigOpt file let hadSig = Option.isSome rootSigOpt let implFileSigType = SigTypeOfImplFile implFile @@ -5348,11 +5485,11 @@ let TypeCheckOneInputEventually if verbose then dprintf "done TypeCheckOneInputEventually...\n" - let topSigsAndImpls = RootSigsAndImpls(rootSigs,rootImpls,allSigModulTyp,allImplementedSigModulTyp) - let res = (topAttrs,[implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) + let topSigsAndImpls = RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) + let res = (topAttrs, [implFile], tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) return res } - return (tcEnvAtEnd,topAttrs,implFiles), + return (tcEnvAtEnd, topAttrs, implFiles), { tcState with tcsCcuType=ccuType tcsTcSigEnv=tcSigEnv @@ -5361,37 +5498,37 @@ let TypeCheckOneInputEventually tcsRootSigsAndImpls = topSigsAndImpls } with e -> errorRecovery e range0 - return (tcState.TcEnvFromSignatures,EmptyTopAttrs,[]),tcState + return (tcState.TcEnvFromSignatures, EmptyTopAttrs, []), tcState } /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end - use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false,GetScopedPragmasForInput(inp),oldLogger) ) + use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput(inp), oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck TypeCheckOneInputEventually (checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, TcResultsSink.NoSink, tcState, inp) |> Eventually.force ctok /// Finish checking multiple files (or one interactive entry into F# Interactive) -let TypeCheckMultipleInputsFinish(results,tcState: TcState) = - let tcEnvsAtEndFile,topAttrs,implFiles = List.unzip3 results +let TypeCheckMultipleInputsFinish(results, tcState: TcState) = + let tcEnvsAtEndFile, topAttrs, implFiles = List.unzip3 results let topAttrs = List.foldBack CombineTopAttrs topAttrs EmptyTopAttrs let implFiles = List.concat implFiles // This is the environment required by fsi.exe when incrementally adding definitions let tcEnvAtEndOfLastFile = (match tcEnvsAtEndFile with h :: _ -> h | _ -> tcState.TcEnvFromSignatures) - (tcEnvAtEndOfLastFile,topAttrs,implFiles),tcState + (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState /// Check multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = - let results,tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) - TypeCheckMultipleInputsFinish(results,tcState) + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + TypeCheckMultipleInputsFinish(results, tcState) let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = eventually { - let! results,tcState = TypeCheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) - return TypeCheckMultipleInputsFinish([results],tcState) + let! results, tcState = TypeCheckOneInputEventually(checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) + return TypeCheckMultipleInputsFinish([results], tcState) } let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = @@ -5399,7 +5536,7 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = tcState.tcsCcu.Deref.Contents <- tcState.tcsCcuType // Check all interfaces have implementations - let (RootSigsAndImpls(rootSigs,rootImpls,_,_)) = tcState.tcsRootSigsAndImpls + let (RootSigsAndImpls(rootSigs, rootImpls, _, _)) = tcState.tcsRootSigsAndImpls rootSigs |> Zmap.iter (fun qualNameOfFile _ -> if not (Zset.contains qualNameOfFile rootImpls) then errorR(Error(FSComp.SR.buildSignatureWithoutImplementation(qualNameOfFile.Text), qualNameOfFile.Range))) @@ -5408,7 +5545,7 @@ let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let (tcEnvAtEndOfLastFile, topAttrs, implFiles),tcState = TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) + let (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState = TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index b8e9715913a087dbb622091144a91b1b26b4059f..7a88d2e56042845825eb1b049f4e1ff7841ae3a4 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -8,12 +8,12 @@ module internal Microsoft.FSharp.Compiler.ConstraintSolver // Primary constraints are: // - type equations ty1 = ty2 // - subtype inequations ty1 :> ty2 -// - trait constraints tyname : (static member op_Addition : 'a * 'b -> 'c) +// - trait constraints tyname: (static member op_Addition: 'a * 'b -> 'c) // // Plus some other constraints inherited from .NET generics. // // The constraints are immediately processed into a normal form, in particular -// - type equations on inference parameters: 'tp = ty +// - type equations on inference parameters: 'tp = ty // - type inequations on inference parameters: 'tp :> ty // - other constraints on inference paramaters // @@ -60,22 +60,22 @@ open Microsoft.FSharp.Compiler.TypeRelations let compgen_id = mkSynId range0 unassignedTyparName -let NewCompGenTypar (kind,rigid,staticReq,dynamicReq,error) = - NewTypar(kind,rigid,Typar(compgen_id,staticReq,true),error,dynamicReq,[],false,false) +let NewCompGenTypar (kind, rigid, staticReq, dynamicReq, error) = + NewTypar(kind, rigid, Typar(compgen_id, staticReq, true), error, dynamicReq, [], false, false) let anon_id m = mkSynId m unassignedTyparName -let NewAnonTypar (kind,m,rigid,var,dyn) = - NewTypar (kind,rigid,Typar(anon_id m,var,true),false,dyn,[],false,false) +let NewAnonTypar (kind, m, rigid, var, dyn) = + NewTypar (kind, rigid, Typar(anon_id m, var, true), false, dyn, [], false, false) -let NewNamedInferenceMeasureVar (_m,rigid,var,id) = - NewTypar(TyparKind.Measure,rigid,Typar(id,var,false),false,TyparDynamicReq.No,[],false,false) +let NewNamedInferenceMeasureVar (_m, rigid, var, id) = + NewTypar(TyparKind.Measure, rigid, Typar(id, var, false), false, TyparDynamicReq.No, [], false, false) -let NewInferenceMeasurePar () = NewCompGenTypar (TyparKind.Measure,TyparRigidity.Flexible,NoStaticReq,TyparDynamicReq.No,false) +let NewInferenceMeasurePar () = NewCompGenTypar (TyparKind.Measure, TyparRigidity.Flexible, NoStaticReq, TyparDynamicReq.No, false) -let NewErrorTypar () = NewCompGenTypar (TyparKind.Type,TyparRigidity.Flexible,NoStaticReq,TyparDynamicReq.No,true) -let NewErrorMeasureVar () = NewCompGenTypar (TyparKind.Measure,TyparRigidity.Flexible,NoStaticReq,TyparDynamicReq.No,true) -let NewInferenceType () = mkTyparTy (NewTypar (TyparKind.Type,TyparRigidity.Flexible,Typar(compgen_id,NoStaticReq,true),false,TyparDynamicReq.No,[],false,false)) +let NewErrorTypar () = NewCompGenTypar (TyparKind.Type, TyparRigidity.Flexible, NoStaticReq, TyparDynamicReq.No, true) +let NewErrorMeasureVar () = NewCompGenTypar (TyparKind.Measure, TyparRigidity.Flexible, NoStaticReq, TyparDynamicReq.No, true) +let NewInferenceType () = mkTyparTy (NewTypar (TyparKind.Type, TyparRigidity.Flexible, Typar(compgen_id, NoStaticReq, true), false, TyparDynamicReq.No, [], false, false)) let NewErrorType () = mkTyparTy (NewErrorTypar ()) let NewErrorMeasure () = Measure.Var (NewErrorMeasureVar ()) @@ -87,10 +87,10 @@ let NewInferenceTypes l = l |> List.map (fun _ -> NewInferenceType ()) // condition anyway, so we could get away with a non-rigid typar. This // would sort of be cleaner, though give errors later. let FreshenAndFixupTypars m rigid fctps tinst tpsorig = - let copy_tyvar (tp:Typar) = NewCompGenTypar (tp.Kind,rigid,tp.StaticReq,(if rigid=TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No),false) + let copy_tyvar (tp:Typar) = NewCompGenTypar (tp.Kind, rigid, tp.StaticReq, (if rigid=TyparRigidity.Rigid then TyparDynamicReq.Yes else TyparDynamicReq.No), false) let tps = tpsorig |> List.map copy_tyvar - let renaming,tinst = FixupNewTypars m fctps tinst tpsorig tps - tps,renaming,tinst + let renaming, tinst = FixupNewTypars m fctps tinst tpsorig tps + tps, renaming, tinst let FreshenTypeInst m tpsorig = FreshenAndFixupTypars m TyparRigidity.Flexible [] [] tpsorig let FreshMethInst m fctps tinst tpsorig = FreshenAndFixupTypars m TyparRigidity.Flexible fctps tinst tpsorig @@ -99,11 +99,11 @@ let FreshenTypars m tpsorig = match tpsorig with | [] -> [] | _ -> - let _,_,tptys = FreshenTypeInst m tpsorig + let _, _, tptys = FreshenTypeInst m tpsorig tptys let FreshenMethInfo m (minfo:MethInfo) = - let _,_,tptys = FreshMethInst m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars + let _, _, tptys = FreshMethInst m (minfo.GetFormalTyparsOfDeclaringType m) minfo.DeclaringTypeInst minfo.FormalMethodTypars tptys @@ -159,7 +159,7 @@ exception UnresolvedOverloading of DisplayEnv * exn list * string * range exception UnresolvedConversionOperator of DisplayEnv * TType * TType * range let GetPossibleOverloads amap m denv (calledMethGroup: (CalledMeth<_> * exn) list) = - calledMethGroup |> List.map (fun (cmeth, e) -> PossibleOverload(denv,NicePrint.stringOfMethInfo amap m denv cmeth.Method, e, m)) + calledMethGroup |> List.map (fun (cmeth, e) -> PossibleOverload(denv, NicePrint.stringOfMethInfo amap m denv cmeth.Method, e, m)) type TcValF = (ValRef -> ValUseFlag -> TType list -> range -> Expr * TType) @@ -167,16 +167,16 @@ type ConstraintSolverState = { g: TcGlobals amap: Import.ImportMap - InfoReader : InfoReader - TcVal : TcValF + InfoReader: InfoReader + TcVal: TcValF /// This table stores all unsolved, ungeneralized trait constraints, indexed by free type variable. /// That is, there will be one entry in this table for each free type variable in /// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved /// each time a solution to an index variable is found. - mutable ExtraCxs: HashMultiMap + mutable ExtraCxs: HashMultiMap } - static member New(g,amap,infoReader, tcVal) = + static member New(g, amap, infoReader, tcVal) = { g = g amap = amap ExtraCxs = HashMultiMap(10, HashIdentity.Structural) @@ -188,10 +188,10 @@ type ConstraintSolverEnv = { SolverState: ConstraintSolverState eContextInfo: ContextInfo - MatchingOnly : bool + MatchingOnly: bool m: range EquivEnv: TypeEquivEnv - DisplayEnv : DisplayEnv + DisplayEnv: DisplayEnv } member csenv.InfoReader = csenv.SolverState.InfoReader member csenv.g = csenv.SolverState.g @@ -216,12 +216,12 @@ let MakeConstraintSolverEnv contextInfo css m denv = /// 'a = list<'a> let rec occursCheck g un ty = match stripTyEqns g ty with - | TType_ucase(_,l) - | TType_app (_,l) - | TType_tuple (_,l) -> List.exists (occursCheck g un) l - | TType_fun (d,r) -> occursCheck g un d || occursCheck g un r + | TType_ucase(_, l) + | TType_app (_, l) + | TType_tuple (_, l) -> List.exists (occursCheck g un) l + | TType_fun (d, r) -> occursCheck g un d || occursCheck g un r | TType_var r -> typarEq un r - | TType_forall (_,tau) -> occursCheck g un tau + | TType_forall (_, tau) -> occursCheck g un tau | _ -> false @@ -279,9 +279,9 @@ let IsRelationalType g ty = IsNumericType g ty || isStringTy g ty || isCharTy g // Get measure of type, float<_> or float32<_> or decimal<_> but not float=float<1> or float32=float32<1> or decimal=decimal<1> let GetMeasureOfType g ty = match ty with - | AppTy g (tcref,[tyarg]) -> + | AppTy g (tcref, [tyarg]) -> match stripTyEqns g tyarg with - | TType_measure ms when not (measureEquiv g ms Measure.One) -> Some (tcref,ms) + | TType_measure ms when not (measureEquiv g ms Measure.One) -> Some (tcref, ms) | _ -> None | _ -> None @@ -309,7 +309,7 @@ let BakedInTraitConstraintNames = // Run the constraint solver with undo (used during method overload resolution) type Trace = - { mutable actions: ((unit -> unit) * (unit -> unit)) list } + { mutable actions: ((unit -> unit) * (unit -> unit)) list } static member New () = { actions = [] } @@ -356,12 +356,12 @@ let FilterEachThenUndo f meths = trace.Undo() match CheckNoErrorsAndGetWarnings res with | None -> None - | Some warns -> Some (calledMeth,warns.Length,trace)) + | Some warns -> Some (calledMeth, warns.Length, trace)) let ShowAccessDomain ad = match ad with | AccessibleFromEverywhere -> "public" - | AccessibleFrom(_,_) -> "accessible" + | AccessibleFrom(_, _) -> "accessible" | AccessibleFromSomeFSharpCode -> "public, protected or internal" | AccessibleFromSomewhere -> "" @@ -375,75 +375,75 @@ let localAbortD = ErrorD LocallyAbortOperationThatLosesAbbrevs /// Return true if we would rather unify this variable v1 := v2 than vice versa let PreferUnifyTypar (v1:Typar) (v2:Typar) = - match v1.Rigidity,v2.Rigidity with + match v1.Rigidity, v2.Rigidity with // Rigid > all - | TyparRigidity.Rigid,_ -> false + | TyparRigidity.Rigid, _ -> false // Prefer to unify away WillBeRigid in favour of Rigid - | TyparRigidity.WillBeRigid,TyparRigidity.Rigid -> true - | TyparRigidity.WillBeRigid,TyparRigidity.WillBeRigid -> true - | TyparRigidity.WillBeRigid,TyparRigidity.WarnIfNotRigid -> false - | TyparRigidity.WillBeRigid,TyparRigidity.Anon -> false - | TyparRigidity.WillBeRigid,TyparRigidity.Flexible -> false + | TyparRigidity.WillBeRigid, TyparRigidity.Rigid -> true + | TyparRigidity.WillBeRigid, TyparRigidity.WillBeRigid -> true + | TyparRigidity.WillBeRigid, TyparRigidity.WarnIfNotRigid -> false + | TyparRigidity.WillBeRigid, TyparRigidity.Anon -> false + | TyparRigidity.WillBeRigid, TyparRigidity.Flexible -> false // Prefer to unify away WarnIfNotRigid in favour of Rigid - | TyparRigidity.WarnIfNotRigid,TyparRigidity.Rigid -> true - | TyparRigidity.WarnIfNotRigid,TyparRigidity.WillBeRigid -> true - | TyparRigidity.WarnIfNotRigid,TyparRigidity.WarnIfNotRigid -> true - | TyparRigidity.WarnIfNotRigid,TyparRigidity.Anon -> false - | TyparRigidity.WarnIfNotRigid,TyparRigidity.Flexible -> false + | TyparRigidity.WarnIfNotRigid, TyparRigidity.Rigid -> true + | TyparRigidity.WarnIfNotRigid, TyparRigidity.WillBeRigid -> true + | TyparRigidity.WarnIfNotRigid, TyparRigidity.WarnIfNotRigid -> true + | TyparRigidity.WarnIfNotRigid, TyparRigidity.Anon -> false + | TyparRigidity.WarnIfNotRigid, TyparRigidity.Flexible -> false // Prefer to unify away anonymous variables in favour of Rigid, WarnIfNotRigid - | TyparRigidity.Anon,TyparRigidity.Rigid -> true - | TyparRigidity.Anon,TyparRigidity.WillBeRigid -> true - | TyparRigidity.Anon,TyparRigidity.WarnIfNotRigid -> true - | TyparRigidity.Anon,TyparRigidity.Anon -> true - | TyparRigidity.Anon,TyparRigidity.Flexible -> false + | TyparRigidity.Anon, TyparRigidity.Rigid -> true + | TyparRigidity.Anon, TyparRigidity.WillBeRigid -> true + | TyparRigidity.Anon, TyparRigidity.WarnIfNotRigid -> true + | TyparRigidity.Anon, TyparRigidity.Anon -> true + | TyparRigidity.Anon, TyparRigidity.Flexible -> false // Prefer to unify away Flexible in favour of Rigid, WarnIfNotRigid or Anon - | TyparRigidity.Flexible,TyparRigidity.Rigid -> true - | TyparRigidity.Flexible,TyparRigidity.WillBeRigid -> true - | TyparRigidity.Flexible,TyparRigidity.WarnIfNotRigid -> true - | TyparRigidity.Flexible,TyparRigidity.Anon -> true - | TyparRigidity.Flexible,TyparRigidity.Flexible -> + | TyparRigidity.Flexible, TyparRigidity.Rigid -> true + | TyparRigidity.Flexible, TyparRigidity.WillBeRigid -> true + | TyparRigidity.Flexible, TyparRigidity.WarnIfNotRigid -> true + | TyparRigidity.Flexible, TyparRigidity.Anon -> true + | TyparRigidity.Flexible, TyparRigidity.Flexible -> // Prefer to unify away compiler generated type vars match v1.IsCompilerGenerated, v2.IsCompilerGenerated with - | true,false -> true - | false,true -> false + | true, false -> true + | false, true -> false | _ -> // Prefer to unify away non-error vars - gives better error recovery since we keep // error vars lying around, and can avoid giving errors about illegal polymorphism // if they occur match v1.IsFromError, v2.IsFromError with - | true,false -> false + | true, false -> false | _ -> true -/// Reorder a list of (variable,exponent) pairs so that a variable that is Preferred +/// Reorder a list of (variable, exponent) pairs so that a variable that is Preferred /// is at the head of the list, if possible let FindPreferredTypar vs = let rec find vs = match vs with | [] -> vs - | (v:Typar,e)::vs -> + | (v:Typar, e)::vs -> match find vs with - | [] -> [(v,e)] - | (v',e')::vs' -> + | [] -> [(v, e)] + | (v', e')::vs' -> if PreferUnifyTypar v v' then (v, e) :: vs - else (v',e') :: (v,e) :: vs' + else (v', e') :: (v, e) :: vs' find vs let SubstMeasure (r:Typar) ms = - if r.Rigidity = TyparRigidity.Rigid then error(InternalError("SubstMeasure: rigid",r.Range)); - if r.Kind = TyparKind.Type then error(InternalError("SubstMeasure: kind=type",r.Range)); + if r.Rigidity = TyparRigidity.Rigid then error(InternalError("SubstMeasure: rigid", r.Range)); + if r.Kind = TyparKind.Type then error(InternalError("SubstMeasure: kind=type", r.Range)); match r.typar_solution with | None -> r.typar_solution <- Some (TType_measure ms) - | Some _ -> error(InternalError("already solved",r.Range)); + | Some _ -> error(InternalError("already solved", r.Range)); let rec TransactStaticReq (csenv:ConstraintSolverEnv) (trace:OptionalTrace) (tpr:Typar) req = let m = csenv.m if tpr.Rigidity.ErrorIfUnified && tpr.StaticReq <> req then - ErrorD(ConstraintSolverError(FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name),m,m)) + ErrorD(ConstraintSolverError(FSComp.SR.csTypeCannotBeResolvedAtCompileTime(tpr.Name), m, m)) else let orig = tpr.StaticReq trace.Exec (fun () -> tpr.SetStaticReq req) (fun () -> tpr.SetStaticReq orig) @@ -462,7 +462,7 @@ and SolveTypStaticReq (csenv:ConstraintSolverEnv) trace req ty = match stripTyparEqns ty with | TType_measure ms -> let vs = ListMeasureVarOccsWithNonZeroExponents ms - IterateD (fun ((tpr:Typar),_) -> SolveTypStaticReqTypar csenv trace req tpr) vs + IterateD (fun ((tpr:Typar), _) -> SolveTypStaticReqTypar csenv trace req tpr) vs | _ -> match tryAnyParTy csenv.g ty with | Some tpr -> SolveTypStaticReqTypar csenv trace req tpr @@ -488,13 +488,13 @@ let SubstMeasureWarnIfRigid (csenv:ConstraintSolverEnv) trace (v:Typar) ms = let tpnmOpt = if v.IsCompilerGenerated then None else Some v.Name SolveTypStaticReq csenv trace v.StaticReq (TType_measure ms) ++ (fun () -> SubstMeasure v ms - WarnD(NonRigidTypar(csenv.DisplayEnv,tpnmOpt,v.Range,TType_measure (Measure.Var v), TType_measure ms,csenv.m))) + WarnD(NonRigidTypar(csenv.DisplayEnv, tpnmOpt, v.Range, TType_measure (Measure.Var v), TType_measure ms, csenv.m))) else // Propagate static requirements from 'tp' to 'ty' SolveTypStaticReq csenv trace v.StaticReq (TType_measure ms) ++ (fun () -> SubstMeasure v ms if v.Rigidity = TyparRigidity.Anon && measureEquiv csenv.g ms Measure.One then - WarnD(Error(FSComp.SR.csCodeLessGeneric(),v.Range)) + WarnD(Error(FSComp.SR.csCodeLessGeneric(), v.Range)) else CompleteD) /// Imperatively unify the unit-of-measure expression ms against 1. @@ -505,16 +505,16 @@ let SubstMeasureWarnIfRigid (csenv:ConstraintSolverEnv) trace (v:Typar) ms = /// the most general unifier is then simply v := ms' ^ -(1/e) let UnifyMeasureWithOne (csenv:ConstraintSolverEnv) trace ms = // Gather the rigid and non-rigid unit variables in this measure expression together with their exponents - let rigidVars,nonRigidVars = + let rigidVars, nonRigidVars = ListMeasureVarOccsWithNonZeroExponents ms - |> List.partition (fun (v,_) -> v.Rigidity = TyparRigidity.Rigid) + |> List.partition (fun (v, _) -> v.Rigidity = TyparRigidity.Rigid) // If there is at least one non-rigid variable v with exponent e, then we can unify match FindPreferredTypar nonRigidVars with - | (v,e)::vs -> + | (v, e)::vs -> let unexpandedCons = ListMeasureConOccsWithNonZeroExponents csenv.g false ms - let newms = ProdMeasures (List.map (fun (c,e') -> Measure.RationalPower (Measure.Con c, NegRational (DivRational e' e))) unexpandedCons - @ List.map (fun (v,e') -> Measure.RationalPower (Measure.Var v, NegRational (DivRational e' e))) (vs @ rigidVars)) + let newms = ProdMeasures (List.map (fun (c, e') -> Measure.RationalPower (Measure.Con c, NegRational (DivRational e' e))) unexpandedCons + @ List.map (fun (v, e') -> Measure.RationalPower (Measure.Var v, NegRational (DivRational e' e))) (vs @ rigidVars)) SubstMeasureWarnIfRigid csenv trace v newms @@ -523,24 +523,24 @@ let UnifyMeasureWithOne (csenv:ConstraintSolverEnv) trace ms = /// Imperatively unify unit-of-measure expression ms1 against ms2 let UnifyMeasures (csenv:ConstraintSolverEnv) trace ms1 ms2 = - UnifyMeasureWithOne csenv trace (Measure.Prod(ms1,Measure.Inv ms2)) + UnifyMeasureWithOne csenv trace (Measure.Prod(ms1, Measure.Inv ms2)) /// Simplify a unit-of-measure expression ms that forms part of a type scheme. /// We make substitutions for vars, which are the (remaining) bound variables /// in the scheme that we wish to simplify. let SimplifyMeasure g vars ms = let rec simp vars = - match FindPreferredTypar (List.filter (fun (_,e) -> SignRational e<>0) (List.map (fun v -> (v, MeasureVarExponent v ms)) vars)) with + match FindPreferredTypar (List.filter (fun (_, e) -> SignRational e<>0) (List.map (fun v -> (v, MeasureVarExponent v ms)) vars)) with | [] -> (vars, None) - | (v,e)::vs -> - let newvar = if v.IsCompilerGenerated then NewAnonTypar (TyparKind.Measure,v.Range,TyparRigidity.Flexible,v.StaticReq,v.DynamicReq) - else NewNamedInferenceMeasureVar (v.Range,TyparRigidity.Flexible,v.StaticReq,v.Id) + | (v, e)::vs -> + let newvar = if v.IsCompilerGenerated then NewAnonTypar (TyparKind.Measure, v.Range, TyparRigidity.Flexible, v.StaticReq, v.DynamicReq) + else NewNamedInferenceMeasureVar (v.Range, TyparRigidity.Flexible, v.StaticReq, v.Id) let remainingvars = ListSet.remove typarEq v vars let newvarExpr = if SignRational e < 0 then Measure.Inv (Measure.Var newvar) else Measure.Var newvar - let newms = (ProdMeasures (List.map (fun (c,e') -> Measure.RationalPower (Measure.Con c, NegRational (DivRational e' e))) (ListMeasureConOccsWithNonZeroExponents g false ms) - @ List.map (fun (v',e') -> if typarEq v v' then newvarExpr else Measure.RationalPower (Measure.Var v', NegRational (DivRational e' e))) (ListMeasureVarOccsWithNonZeroExponents ms))); + let newms = (ProdMeasures (List.map (fun (c, e') -> Measure.RationalPower (Measure.Con c, NegRational (DivRational e' e))) (ListMeasureConOccsWithNonZeroExponents g false ms) + @ List.map (fun (v', e') -> if typarEq v v' then newvarExpr else Measure.RationalPower (Measure.Var v', NegRational (DivRational e' e))) (ListMeasureVarOccsWithNonZeroExponents ms))); SubstMeasure v newms match vs with | [] -> (remainingvars, Some newvar) @@ -552,13 +552,13 @@ let SimplifyMeasure g vars ms = // is a list of unit-of-measure variables that have already been generalized. let rec SimplifyMeasuresInType g resultFirst ((generalizable, generalized) as param) ty = match stripTyparEqns ty with - | TType_ucase(_,l) - | TType_app (_,l) - | TType_tuple (_,l) -> SimplifyMeasuresInTypes g param l + | TType_ucase(_, l) + | TType_app (_, l) + | TType_tuple (_, l) -> SimplifyMeasuresInTypes g param l - | TType_fun (d,r) -> if resultFirst then SimplifyMeasuresInTypes g param [r;d] else SimplifyMeasuresInTypes g param [d;r] + | TType_fun (d, r) -> if resultFirst then SimplifyMeasuresInTypes g param [r;d] else SimplifyMeasuresInTypes g param [d;r] | TType_var _ -> param - | TType_forall (_,tau) -> SimplifyMeasuresInType g resultFirst param tau + | TType_forall (_, tau) -> SimplifyMeasuresInType g resultFirst param tau | TType_measure unt -> let generalizable', newlygeneralized = SimplifyMeasure g generalizable unt match newlygeneralized with @@ -574,10 +574,10 @@ and SimplifyMeasuresInTypes g param tys = let SimplifyMeasuresInConstraint g param c = match c with - | TyparConstraint.DefaultsTo (_,ty,_) - | TyparConstraint.CoercesTo(ty,_) -> SimplifyMeasuresInType g false param ty - | TyparConstraint.SimpleChoice (tys,_) -> SimplifyMeasuresInTypes g param tys - | TyparConstraint.IsDelegate (ty1,ty2,_) -> SimplifyMeasuresInTypes g param [ty1;ty2] + | TyparConstraint.DefaultsTo (_, ty, _) + | TyparConstraint.CoercesTo(ty, _) -> SimplifyMeasuresInType g false param ty + | TyparConstraint.SimpleChoice (tys, _) -> SimplifyMeasuresInTypes g param tys + | TyparConstraint.IsDelegate (ty1, ty2, _) -> SimplifyMeasuresInTypes g param [ty1;ty2] | _ -> param let rec SimplifyMeasuresInConstraints g param cs = @@ -589,13 +589,13 @@ let rec SimplifyMeasuresInConstraints g param cs = let rec GetMeasureVarGcdInType v ty = match stripTyparEqns ty with - | TType_ucase(_,l) - | TType_app (_,l) - | TType_tuple (_,l) -> GetMeasureVarGcdInTypes v l + | TType_ucase(_, l) + | TType_app (_, l) + | TType_tuple (_, l) -> GetMeasureVarGcdInTypes v l - | TType_fun (d,r) -> GcdRational (GetMeasureVarGcdInType v d) (GetMeasureVarGcdInType v r) + | TType_fun (d, r) -> GcdRational (GetMeasureVarGcdInType v d) (GetMeasureVarGcdInType v r) | TType_var _ -> ZeroRational - | TType_forall (_,tau) -> GetMeasureVarGcdInType v tau + | TType_forall (_, tau) -> GetMeasureVarGcdInType v tau | TType_measure unt -> MeasureVarExponent v unt and GetMeasureVarGcdInTypes v tys = @@ -613,7 +613,7 @@ let NormalizeExponentsInTypeScheme uvars ty = if expGcd = OneRational || expGcd = ZeroRational then v else - let v' = NewAnonTypar (TyparKind.Measure,v.Range,TyparRigidity.Flexible,v.StaticReq,v.DynamicReq) + let v' = NewAnonTypar (TyparKind.Measure, v.Range, TyparRigidity.Flexible, v.StaticReq, v.DynamicReq) SubstMeasure v (Measure.RationalPower (Measure.Var v', DivRational OneRational expGcd)) v') @@ -624,7 +624,7 @@ let NormalizeExponentsInTypeScheme uvars ty = // (2) so that we can compute equivalence of type schemes in signature matching // (3) in order to produce a list of type parameters ordered as they appear in the (normalized) scheme. // -// Representing the normal form as a matrix, with a row for each variable or base unit, +// Representing the normal form as a matrix, with a row for each variable or base unit, // and a column for each unit-of-measure expression in the "skeleton" of the type. // Entries for generalizable variables are integers; other rows may contain non-integer exponents. // @@ -675,7 +675,7 @@ let CheckWarnIfRigid (csenv:ConstraintSolverEnv) ty1 (r:Typar) ty = if needsWarning then // NOTE: we grab the name eagerly to make sure the type variable prints as a type variable let tpnmOpt = if r.IsCompilerGenerated then None else Some r.Name - WarnD(NonRigidTypar(denv,tpnmOpt,r.Range,ty1,ty,csenv.m)) + WarnD(NonRigidTypar(denv, tpnmOpt, r.Range, ty1, ty, csenv.m)) else CompleteD @@ -691,7 +691,7 @@ let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace:Optional if typeEquiv csenv.g ty1 ty then CompleteD else // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/Microsoft/visualfsharp/issues/1170 - if occursCheck csenv.g r ty then ErrorD (ConstraintSolverInfiniteTypes(csenv.eContextInfo,csenv.DisplayEnv,ty1,ty,m,m2)) else + if occursCheck csenv.g r ty then ErrorD (ConstraintSolverInfiniteTypes(csenv.eContextInfo, csenv.DisplayEnv, ty1, ty, m, m2)) else // Note: warn _and_ continue! CheckWarnIfRigid csenv ty1 r ty ++ (fun () -> @@ -714,13 +714,13 @@ let rec SolveTyparEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace:Optional CompleteD) ++ (fun _ -> // Re-solve the other constraints associated with this type variable - solveTypMeetsTyparConstraints csenv ndeep m2 trace ty (r.DynamicReq,r.StaticReq,r.Constraints))) + solveTypMeetsTyparConstraints csenv ndeep m2 trace ty (r.DynamicReq, r.StaticReq, r.Constraints))) | _ -> failwith "SolveTyparEqualsTyp") /// Given a type 'ty' and a set of constraints on that type, solve those constraints. -and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty (dreq,sreq,cs) = +and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty (dreq, sreq, cs) = let g = csenv.g // Propagate dynamic requirements from 'tp' to 'ty' SolveTypDynamicReq csenv trace dreq ty ++ (fun () -> @@ -729,27 +729,27 @@ and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty // Solve constraints on 'tp' w.r.t. 'ty' cs |> IterateD (function - | TyparConstraint.DefaultsTo (priority,dty,m) -> + | TyparConstraint.DefaultsTo (priority, dty, m) -> if typeEquiv g ty dty then CompleteD else match tryDestTyparTy g ty with | None -> CompleteD | Some destTypar -> - AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.DefaultsTo(priority,dty,m)) + AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.DefaultsTo(priority, dty, m)) | TyparConstraint.SupportsNull m2 -> SolveTypSupportsNull csenv ndeep m2 trace ty | TyparConstraint.IsEnum(underlying, m2) -> SolveTypIsEnum csenv ndeep m2 trace ty underlying | TyparConstraint.SupportsComparison(m2) -> SolveTypeSupportsComparison csenv ndeep m2 trace ty | TyparConstraint.SupportsEquality(m2) -> SolveTypSupportsEquality csenv ndeep m2 trace ty - | TyparConstraint.IsDelegate(aty,bty, m2) -> SolveTypIsDelegate csenv ndeep m2 trace ty aty bty + | TyparConstraint.IsDelegate(aty, bty, m2) -> SolveTypIsDelegate csenv ndeep m2 trace ty aty bty | TyparConstraint.IsNonNullableStruct m2 -> SolveTypIsNonNullableValueType csenv ndeep m2 trace ty | TyparConstraint.IsUnmanaged m2 -> SolveTypIsUnmanaged csenv ndeep m2 trace ty | TyparConstraint.IsReferenceType m2 -> SolveTypIsReferenceType csenv ndeep m2 trace ty | TyparConstraint.RequiresDefaultConstructor m2 -> SolveTypRequiresDefaultConstructor csenv ndeep m2 trace ty - | TyparConstraint.SimpleChoice(tys,m2) -> SolveTypChoice csenv ndeep m2 trace ty tys - | TyparConstraint.CoercesTo(ty2,m2) -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m2 trace None ty2 ty - | TyparConstraint.MayResolveMember(traitInfo,m2) -> + | TyparConstraint.SimpleChoice(tys, m2) -> SolveTypChoice csenv ndeep m2 trace ty tys + | TyparConstraint.CoercesTo(ty2, m2) -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m2 trace None ty2 ty + | TyparConstraint.MayResolveMember(traitInfo, m2) -> SolveMemberConstraint csenv false false ndeep m2 trace traitInfo ++ (fun _ -> CompleteD) ))) @@ -784,26 +784,26 @@ and SolveTypEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace | _, TType_var r when (r.Rigidity <> TyparRigidity.Rigid) && not csenv.MatchingOnly -> SolveTyparEqualsTyp csenv ndeep m2 trace sty2 ty1 // Catch float<_>=float<1>, float32<_>=float32<1> and decimal<_>=decimal<1> - | (_, TType_app (tc2,[ms])) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) + | (_, TType_app (tc2, [ms])) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) -> SolveTypEqualsTyp csenv ndeep m2 trace None ms (TType_measure Measure.One) - | (TType_app (tc2,[ms]), _) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) + | (TType_app (tc2, [ms]), _) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) -> SolveTypEqualsTyp csenv ndeep m2 trace None ms (TType_measure Measure.One) - | TType_app (tc1,l1) ,TType_app (tc2,l2) when tyconRefEq g tc1 tc2 -> SolveTypEqualsTypEqns csenv ndeep m2 trace None l1 l2 - | TType_app (_,_) ,TType_app (_,_) -> localAbortD - | TType_tuple (tupInfo1,l1) ,TType_tuple (tupInfo2,l2) -> - if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m,m2)) else + | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> SolveTypEqualsTypEqns csenv ndeep m2 trace None l1 l2 + | TType_app (_, _) , TType_app (_, _) -> localAbortD + | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypEqualsTypEqns csenv ndeep m2 trace None l1 l2 - | TType_fun (d1,r1) ,TType_fun (d2,r2) -> SolveFunTypEqn csenv ndeep m2 trace None d1 d2 r1 r2 - | TType_measure ms1 ,TType_measure ms2 -> UnifyMeasures csenv trace ms1 ms2 - | TType_forall(tps1,rty1), TType_forall(tps2,rty2) -> + | TType_fun (d1, r1) , TType_fun (d2, r2) -> SolveFunTypEqn csenv ndeep m2 trace None d1 d2 r1 r2 + | TType_measure ms1 , TType_measure ms2 -> UnifyMeasures csenv trace ms1 ms2 + | TType_forall(tps1, rty1), TType_forall(tps2, rty2) -> if tps1.Length <> tps2.Length then localAbortD else let aenv = aenv.BindEquivTypars tps1 tps2 let csenv = {csenv with EquivEnv = aenv } if not (typarsAEquiv g aenv tps1 tps2) then localAbortD else SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty1 rty2 - | TType_ucase (uc1,l1) ,TType_ucase (uc2,l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypEqualsTypEqns csenv ndeep m2 trace None l1 l2 + | TType_ucase (uc1, l1) , TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypEqualsTypEqns csenv ndeep m2 trace None l1 l2 | _ -> localAbortD @@ -813,21 +813,21 @@ and private SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ty1 // Back out of expansions of type abbreviations to give improved error messages. // Note: any "normalization" of equations on type variables must respect the trace parameter TryD (fun () -> SolveTypEqualsTyp csenv ndeep m2 trace cxsln ty1 ty2) - (function LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv,ty1,ty2,csenv.m,m2,csenv.eContextInfo)) + (function LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInEqualityRelation(csenv.DisplayEnv, ty1, ty2, csenv.m, m2, csenv.eContextInfo)) | err -> ErrorD err) and SolveTypEqualsTypEqns csenv ndeep m2 trace cxsln origl1 origl2 = - match origl1,origl2 with - | [],[] -> CompleteD + match origl1, origl2 with + | [], [] -> CompleteD | _ -> // We unwind Iterate2D by hand here for performance reasons. let rec loop l1 l2 = - match l1,l2 with - | [],[] -> CompleteD + match l1, l2 with + | [], [] -> CompleteD | h1::t1, h2::t2 -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln h1 h2 ++ (fun () -> loop t1 t2) | _ -> - ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv,origl1,origl2,csenv.m,m2)) + ErrorD(ConstraintSolverTupleDiffLengths(csenv.DisplayEnv, origl1, origl2, csenv.m, m2)) loop origl1 origl2 and SolveFunTypEqn csenv ndeep m2 trace cxsln d1 d2 r1 r2 = @@ -853,22 +853,22 @@ and SolveTypSubsumesTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace: OptionalTra | TType_var r1, TType_var r2 when typarEq r1 r2 -> CompleteD | _, TType_var r when not csenv.MatchingOnly -> SolveTyparSubtypeOfType csenv ndeep m2 trace r ty1 | TType_var _ , _ -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ty1 ty2 - | TType_tuple (tupInfo1,l1) ,TType_tuple (tupInfo2,l2) -> - if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m,m2)) else + | TType_tuple (tupInfo1, l1) , TType_tuple (tupInfo2, l2) -> + if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypEqualsTypEqns csenv ndeep m2 trace cxsln l1 l2 (* nb. can unify since no variance *) - | TType_fun (d1,r1) ,TType_fun (d2,r2) -> SolveFunTypEqn csenv ndeep m2 trace cxsln d1 d2 r1 r2 (* nb. can unify since no variance *) + | TType_fun (d1, r1) , TType_fun (d2, r2) -> SolveFunTypEqn csenv ndeep m2 trace cxsln d1 d2 r1 r2 (* nb. can unify since no variance *) | TType_measure ms1, TType_measure ms2 -> UnifyMeasures csenv trace ms1 ms2 // Enforce the identities float=float<1>, float32=float32<1> and decimal=decimal<1> - | (_, TType_app (tc2,[ms])) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) + | (_, TType_app (tc2, [ms])) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty1 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms (TType_measure Measure.One) - | (TType_app (tc2,[ms]), _) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) + | (TType_app (tc2, [ms]), _) when (tc2.IsMeasureableReprTycon && typeEquiv csenv.g sty2 (reduceTyconRefMeasureableOrProvided csenv.g tc2 [ms])) -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ms (TType_measure Measure.One) - | TType_app (tc1,l1) ,TType_app (tc2,l2) when tyconRefEq g tc1 tc2 -> + | TType_app (tc1, l1) , TType_app (tc2, l2) when tyconRefEq g tc1 tc2 -> SolveTypEqualsTypEqns csenv ndeep m2 trace cxsln l1 l2 - | TType_ucase (uc1,l1) ,TType_ucase (uc2,l2) when g.unionCaseRefEq uc1 uc2 -> + | TType_ucase (uc1, l1) , TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypEqualsTypEqns csenv ndeep m2 trace cxsln l1 l2 | _ -> @@ -887,7 +887,7 @@ and SolveTypSubsumesTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace: OptionalTra // Note we don't support co-variance on array types nor // the special .NET conversions for these types match ty1 with - | AppTy g (tcr1,tinst) when + | AppTy g (tcr1, tinst) when isArray1DTy g ty2 && (tyconRefEq g tcr1 g.tcref_System_Collections_Generic_IList || tyconRefEq g tcr1 g.tcref_System_Collections_Generic_ICollection || @@ -898,19 +898,19 @@ and SolveTypSubsumesTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace: OptionalTra | [ty1arg] -> let ty2arg = destArrayTy g ty2 SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ty1arg ty2arg - | _ -> error(InternalError("destArrayTy",m)) + | _ -> error(InternalError("destArrayTy", m)) | _ -> // D :> Head<_> --> C :> Head<_> for the // first interface or super-class C supported by D which // may feasibly convert to Head. match FindUniqueFeasibleSupertype g amap m ty1 ty2 with - | None -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv,ty1,ty2,m,m2)) + | None -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, m, m2)) | Some t -> SolveTypSubsumesTyp csenv ndeep m2 trace cxsln ty1 t and SolveTypSubsumesTypKeepAbbrevs csenv ndeep m2 trace cxsln ty1 ty2 = let denv = csenv.DisplayEnv TryD (fun () -> SolveTypSubsumesTyp csenv ndeep m2 trace cxsln ty1 ty2) - (function LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv,ty1,ty2,csenv.m,m2)) + (function LocallyAbortOperationThatLosesAbbrevs -> ErrorD(ConstraintSolverTypesNotInSubsumptionRelation(denv, ty1, ty2, csenv.m, m2)) | err -> ErrorD err) //------------------------------------------------------------------------- @@ -925,10 +925,10 @@ and SolveTyparSubtypeOfType (csenv:ConstraintSolverEnv) ndeep m2 trace tp ty1 = elif isSealedTy g ty1 then SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace (mkTyparTy tp) ty1 else - AddConstraint csenv ndeep m2 trace tp (TyparConstraint.CoercesTo(ty1,csenv.m)) + AddConstraint csenv ndeep m2 trace tp (TyparConstraint.CoercesTo(ty1, csenv.m)) and DepthCheck ndeep m = - if ndeep > 300 then error(Error(FSComp.SR.csTypeInferenceMaxDepth(),m)) else CompleteD + if ndeep > 300 then error(Error(FSComp.SR.csTypeInferenceMaxDepth(), m)) else CompleteD // 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 = @@ -942,7 +942,7 @@ and SolveDimensionlessNumericType (csenv:ConstraintSolverEnv) ndeep m2 trace ty /// We pretend int and other types support a number of operators. In the actual IL for mscorlib they /// don't, however the type-directed static optimization rules in the library code that makes use of this /// will deal with the problem. -and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace (TTrait(tys,nm,memFlags,argtys,rty,sln)) : OperationResult = +and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace (TTrait(tys, nm, memFlags, argtys, rty, sln)): OperationResult = // Do not re-solve if already solved if sln.Value.IsSome then ResultD true else let g = csenv.g @@ -956,14 +956,14 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p // Remove duplicates from the set of types in the support let tys = ListSet.setify (typeAEquiv g aenv) tys // Rebuild the trait info after removing duplicates - let traitInfo = TTrait(tys,nm,memFlags,argtys,rty,sln) + let traitInfo = TTrait(tys, nm, memFlags, argtys, rty, sln) let rty = GetFSharpViewOfReturnType g rty // Assert the object type if the constraint is for an instance member if memFlags.IsInstance then match tys, argtys with | [ty], (h :: _) -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace h ty - | _ -> ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m,m2)) + | _ -> ErrorD (ConstraintSolverError(FSComp.SR.csExpectedArguments(), m, m2)) else CompleteD ++ (fun () -> @@ -974,8 +974,8 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p let minfos = GetRelevantMethodsForTrait csenv permitWeakResolution nm traitInfo - match minfos,tys,memFlags.IsInstance,nm,argtys with - | _,_,false,("op_Division" | "op_Multiply"),[argty1;argty2] + match minfos, tys, memFlags.IsInstance, nm, argtys with + | _, _, false, ("op_Division" | "op_Multiply"), [argty1;argty2] when // This simulates the existence of // float * float -> float @@ -1003,7 +1003,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p (let checkRuleAppliesInPreferenceToMethods argty1 argty2 = // Check that at least one of the argument types is numeric (IsNumericOrIntegralEnumType g argty1) && - // Check that the support of type variables is empty. That is, + // Check that the support of type variables is empty. That is, // if we're canonicalizing, then having one of the types nominal is sufficient. // If not, then both must be nominal (i.e. not a type variable). (permitWeakResolution || not (isTyparTy g argty2)) && @@ -1017,14 +1017,14 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p checkRuleAppliesInPreferenceToMethods argty2 argty1) -> match GetMeasureOfType g argty1 with - | Some (tcref,ms1) -> + | Some (tcref, ms1) -> let ms2 = freshMeasure () SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty2 (mkAppTy tcref [TType_measure ms2]) ++ (fun () -> - SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty (mkAppTy tcref [TType_measure (Measure.Prod(ms1,if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) ++ (fun () -> + SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) ++ (fun () -> ResultD TTraitBuiltIn)) | _ -> match GetMeasureOfType g argty2 with - | Some (tcref,ms2) -> + | Some (tcref, ms2) -> let ms1 = freshMeasure () SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty1 (mkAppTy tcref [TType_measure ms1]) ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty (mkAppTy tcref [TType_measure (Measure.Prod(ms1, if nm = "op_Multiply" then ms2 else Measure.Inv ms2))]) ++ (fun () -> @@ -1034,7 +1034,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty1 ++ (fun () -> ResultD TTraitBuiltIn)) - | _,_,false,("op_Addition" | "op_Subtraction" | "op_Modulus"),[argty1;argty2] + | _, _, false, ("op_Addition" | "op_Subtraction" | "op_Modulus"), [argty1;argty2] when // Ignore any explicit +/- overloads from any basic integral types (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.EnclosingType ) && ( (IsNumericOrIntegralEnumType g argty1 || (nm = "op_Addition" && (isCharTy g argty1 || isStringTy g argty1))) && (permitWeakResolution || not (isTyparTy g argty2)) @@ -1043,7 +1043,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty1 ++ (fun () -> ResultD TTraitBuiltIn)) - | _,_,false,("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ),[argty1;argty2] + | _, _, false, ("op_LessThan" | "op_LessThanOrEqual" | "op_GreaterThan" | "op_GreaterThanOrEqual" | "op_Equality" | "op_Inequality" ), [argty1;argty2] when // Ignore any explicit overloads from any basic integral types (minfos |> List.forall (fun minfo -> isIntegerTy g minfo.EnclosingType ) && ( (IsRelationalType g argty1 && (permitWeakResolution || not (isTyparTy g argty2))) @@ -1054,51 +1054,51 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p // We pretend for uniformity that the numeric types have a static property called Zero and One // As with constants, only zero is polymorphic in its units - | [],[ty],false,"get_Zero",[] + | [], [ty], false, "get_Zero", [] when IsNumericType g ty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty ty ++ (fun () -> ResultD TTraitBuiltIn) - | [],[ty],false,"get_One",[] + | [], [ty], false, "get_One", [] when IsNumericType g ty || isCharTy g ty -> SolveDimensionlessNumericType csenv ndeep m2 trace ty ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty ty ++ (fun () -> ResultD TTraitBuiltIn)) - | [],_,false,("DivideByInt"),[argty1;argty2] + | [], _, false, ("DivideByInt"), [argty1;argty2] when isFpTy g argty1 || isDecimalTy g argty1 -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty2 g.int_ty ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty1 ++ (fun () -> ResultD TTraitBuiltIn)) // We pretend for uniformity that the 'string' and 'array' types have an indexer property called 'Item' - | [], [ty],true,("get_Item"),[argty1] + | [], [ty], true, ("get_Item"), [argty1] when isStringTy g ty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty1 g.int_ty ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty g.char_ty ++ (fun () -> ResultD TTraitBuiltIn)) - | [], [ty],true,("get_Item"),argtys + | [], [ty], true, ("get_Item"), argtys when isArrayTy g ty -> - (if rankOfArrayTy g ty <> argtys.Length then ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argtys.Length),m,m2)) else CompleteD) ++ (fun () -> + (if rankOfArrayTy g ty <> argtys.Length then ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), argtys.Length), m, m2)) else CompleteD) ++ (fun () -> (argtys |> IterateD (fun argty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty g.int_ty)) ++ (fun () -> let ety = destArrayTy g ty SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty ety ++ (fun () -> ResultD TTraitBuiltIn))) - | [], [ty],true,("set_Item"),argtys + | [], [ty], true, ("set_Item"), argtys when isArrayTy g ty -> - (if rankOfArrayTy g ty <> argtys.Length - 1 then ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argtys.Length - 1)),m,m2)) else CompleteD) ++ (fun () -> - let argtys,ety = List.frontAndBack argtys + (if rankOfArrayTy g ty <> argtys.Length - 1 then ErrorD(ConstraintSolverError(FSComp.SR.csIndexArgumentMismatch((rankOfArrayTy g ty), (argtys.Length - 1)), m, m2)) else CompleteD) ++ (fun () -> + let argtys, ety = List.frontAndBack argtys (argtys |> IterateD (fun argty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty g.int_ty)) ++ (fun () -> let etys = destArrayTy g ty SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace ety etys ++ (fun () -> ResultD TTraitBuiltIn))) - | [],_,false,("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"),[argty1;argty2] + | [], _, false, ("op_BitwiseAnd" | "op_BitwiseOr" | "op_ExclusiveOr"), [argty1;argty2] when (isIntegerOrIntegerEnumTy g argty1 || (isEnumTy g argty1)) && (permitWeakResolution || not (isTyparTy g argty2)) || (isIntegerOrIntegerEnumTy g argty2 || (isEnumTy g argty2)) && (permitWeakResolution || not (isTyparTy g argty1)) -> @@ -1107,7 +1107,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p SolveDimensionlessNumericType csenv ndeep m2 trace argty1 ++ (fun () -> ResultD TTraitBuiltIn))); - | [], _,false,("op_LeftShift" | "op_RightShift"),[argty1;argty2] + | [], _, false, ("op_LeftShift" | "op_RightShift"), [argty1;argty2] when isIntegerOrIntegerEnumTy g argty1 -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty2 g.int_ty ++ (fun () -> @@ -1115,57 +1115,57 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p SolveDimensionlessNumericType csenv ndeep m2 trace argty1 ++ (fun () -> ResultD TTraitBuiltIn))) - | _,_,false,("op_UnaryPlus"),[argty] + | _, _, false, ("op_UnaryPlus"), [argty] when IsNumericOrIntegralEnumType g argty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty ++ (fun () -> ResultD TTraitBuiltIn) - | _,_,false,("op_UnaryNegation"),[argty] + | _, _, false, ("op_UnaryNegation"), [argty] when isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty ++ (fun () -> ResultD TTraitBuiltIn) - | _,_,true,("get_Sign"),[] + | _, _, true, ("get_Sign"), [] when (let argty = tys.Head in isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty) -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty g.int32_ty ++ (fun () -> ResultD TTraitBuiltIn) - | _,_,false,("op_LogicalNot" | "op_OnesComplement"),[argty] + | _, _, false, ("op_LogicalNot" | "op_OnesComplement"), [argty] when isIntegerOrIntegerEnumTy g argty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty ++ (fun () -> SolveDimensionlessNumericType csenv ndeep m2 trace argty ++ (fun () -> ResultD TTraitBuiltIn)) - | _,_,false,("Abs"),[argty] + | _, _, false, ("Abs"), [argty] when isSignedIntegerTy g argty || isFpTy g argty || isDecimalTy g argty -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty ++ (fun () -> ResultD TTraitBuiltIn) - | _,_,false,"Sqrt",[argty1] + | _, _, false, "Sqrt", [argty1] when isFpTy g argty1 -> match GetMeasureOfType g argty1 with | Some (tcref, _) -> let ms1 = freshMeasure () - SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty1 (mkAppTy tcref [TType_measure (Measure.Prod (ms1,ms1))]) ++ (fun () -> + SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty1 (mkAppTy tcref [TType_measure (Measure.Prod (ms1, ms1))]) ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty (mkAppTy tcref [TType_measure ms1]) ++ (fun () -> ResultD TTraitBuiltIn)) | None -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty1 ++ (fun () -> ResultD TTraitBuiltIn) - | _,_,false,("Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10" | "Log" | "Sqrt"),[argty] + | _, _, false, ("Sin" | "Cos" | "Tan" | "Sinh" | "Cosh" | "Tanh" | "Atan" | "Acos" | "Asin" | "Exp" | "Ceiling" | "Floor" | "Round" | "Truncate" | "Log10" | "Log" | "Sqrt"), [argty] when isFpTy g argty -> SolveDimensionlessNumericType csenv ndeep m2 trace argty ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty ++ (fun () -> ResultD TTraitBuiltIn)) - | _,_,false,("op_Explicit"),[argty] + | _, _, false, ("op_Explicit"), [argty] when (// The input type. (IsNonDecimalNumericOrIntegralEnumType g argty || isStringTy g argty || isCharTy g argty) && // The output type @@ -1178,7 +1178,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p ResultD TTraitBuiltIn - | _,_,false,("op_Explicit"),[argty] + | _, _, false, ("op_Explicit"), [argty] when (// The input type. (IsNumericOrIntegralEnumType g argty || isStringTy g argty) && // The output type @@ -1186,7 +1186,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p ResultD TTraitBuiltIn - | [],_,false,"Pow",[argty1; argty2] + | [], _, false, "Pow", [argty1; argty2] when isFpTy g argty1 -> SolveDimensionlessNumericType csenv ndeep m2 trace argty1 ++ (fun () -> @@ -1194,7 +1194,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty argty1 ++ (fun () -> ResultD TTraitBuiltIn))) - | _,_,false,("Atan2"),[argty1; argty2] + | _, _, false, ("Atan2"), [argty1; argty2] when isFpTy g argty1 -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace argty2 argty1 ++ (fun () -> match GetMeasureOfType g argty1 with @@ -1214,7 +1214,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p let propName = nm.[4..] let props = tys |> List.choose (fun ty -> - match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName,AccessibleFromEverywhere) FindMemberFlag.IgnoreOverrides m ty with + match TryFindIntrinsicNamedItemOfType csenv.InfoReader (propName, AccessibleFromEverywhere) FindMemberFlag.IgnoreOverrides m ty with | Some (RecdFieldItem rfinfo) when (isGetProp || rfinfo.RecdField.IsMutable) && (rfinfo.IsStatic = not memFlags.IsInstance) && @@ -1233,12 +1233,12 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p match minfos, recdPropSearch with | [], None when not (tys |> List.exists (isAnyParTy g)) -> if tys |> List.exists (isFunTy g) then - ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(DecompileOpName nm),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenFunction(DecompileOpName nm), m, m2)) elif tys |> List.exists (isAnyTupleTy g) then - ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(DecompileOpName nm),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csExpectTypeWithOperatorButGivenTuple(DecompileOpName nm), m, m2)) else match nm, argtys with - | "op_Explicit", [argty] -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion((NicePrint.prettyStringOfTy denv argty), (NicePrint.prettyStringOfTy denv rty)),m,m2)) + | "op_Explicit", [argty] -> ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportConversion((NicePrint.prettyStringOfTy denv argty), (NicePrint.prettyStringOfTy denv rty)), m, m2)) | _ -> let tyString = match tys with @@ -1250,12 +1250,12 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p | "?>=" | "?>" | "?<=" | "?<" | "?=" | "?<>" | ">=?" | ">?" | "<=?" | "?" | "?>=?" | "?>?" | "?<=?" | "??" -> - if tys.Length = 1 then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString,opName) - else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString,opName) + if tys.Length = 1 then FSComp.SR.csTypeDoesNotSupportOperatorNullable(tyString, opName) + else FSComp.SR.csTypesDoNotSupportOperatorNullable(tyString, opName) | _ -> - if tys.Length = 1 then FSComp.SR.csTypeDoesNotSupportOperator(tyString,opName) - else FSComp.SR.csTypesDoNotSupportOperator(tyString,opName) - ErrorD(ConstraintSolverError(err,m,m2)) + if tys.Length = 1 then FSComp.SR.csTypeDoesNotSupportOperator(tyString, opName) + else FSComp.SR.csTypesDoNotSupportOperator(tyString, opName) + ErrorD(ConstraintSolverError(err, m, m2)) | _ -> @@ -1265,13 +1265,13 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p // curried members may not be used to satisfy constraints |> List.choose (fun minfo -> if minfo.IsCurried then None else - let callerArgs = argtys |> List.map (fun argty -> CallerArg(argty,m,false,dummyExpr)) + let callerArgs = argtys |> List.map (fun argty -> CallerArg(argty, m, false, dummyExpr)) let minst = FreshenMethInfo m minfo let objtys = minfo.GetObjArgTypes(amap, m, minst) - Some(CalledMeth(csenv.InfoReader,None,false,FreshenMethInfo,m,AccessibleFromEverywhere,minfo,minst,minst,None,objtys,[(callerArgs,[])],false,false,None))) + Some(CalledMeth(csenv.InfoReader, None, false, FreshenMethInfo, m, AccessibleFromEverywhere, minfo, minst, minst, None, objtys, [(callerArgs, [])], false, false, None))) - let methOverloadResult,errors = - trace.CollectThenUndoOrCommit (fun (a, _) -> Option.isSome a) (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) (0,0) AccessibleFromEverywhere calledMethGroup false (Some rty)) + let methOverloadResult, errors = + trace.CollectThenUndoOrCommit (fun (a, _) -> Option.isSome a) (fun trace -> ResolveOverloading csenv (WithTrace trace) nm ndeep (Some traitInfo) (0, 0) AccessibleFromEverywhere calledMethGroup false (Some rty)) match recdPropSearch, methOverloadResult with | Some (rfinfo, isSetProp), None -> @@ -1287,12 +1287,12 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p let isInstance = minfo.IsInstance if isInstance <> memFlags.IsInstance then if isInstance then - ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsNotStatic((NicePrint.minimalStringOfType denv minfo.EnclosingType), (DecompileOpName nm), nm),m,m2 )) + ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsNotStatic((NicePrint.minimalStringOfType denv minfo.EnclosingType), (DecompileOpName nm), nm), m, m2 )) else - ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.EnclosingType), (DecompileOpName nm), nm),m,m2 )) + ErrorD(ConstraintSolverError(FSComp.SR.csMethodFoundButIsStatic((NicePrint.minimalStringOfType denv minfo.EnclosingType), (DecompileOpName nm), nm), m, m2 )) else CheckMethInfoAttributes g m None minfo ++ (fun () -> - ResultD (TTraitSolved (minfo,calledMeth.CalledTyArgs)))) + ResultD (TTraitSolved (minfo, calledMeth.CalledTyArgs)))) | _ -> let support = GetSupportOfMemberConstraint csenv traitInfo @@ -1303,7 +1303,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p // Otherwise re-record the trait waiting for canonicalization else AddMemberConstraint csenv ndeep m2 trace traitInfo support frees) ++ (fun () -> match errors with - | ErrorResult (_,UnresolvedOverloading _) when not ignoreUnresolvedOverload && (not (nm = "op_Explicit" || nm = "op_Implicit")) -> ErrorD LocallyAbortOperationThatFailsToResolveOverload + | ErrorResult (_, UnresolvedOverloading _) when not ignoreUnresolvedOverload && (not (nm = "op_Explicit" || nm = "op_Implicit")) -> ErrorD LocallyAbortOperationThatFailsToResolveOverload | _ -> ResultD TTraitUnsolved) ) ++ @@ -1317,7 +1317,7 @@ and RecordMemberConstraintSolution css m trace traitInfo res = | TTraitUnsolved -> ResultD false - | TTraitSolved (minfo,minst) -> + | TTraitSolved (minfo, minst) -> let sln = MemberConstraintSolutionOfMethInfo css m minfo minst TransactMemberConstraintSolution traitInfo trace sln; ResultD true @@ -1339,32 +1339,32 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = ignore css #endif match minfo with - | ILMeth(_,ilMeth,_) -> - let mref = IL.mkRefToILMethod (ilMeth.DeclaringTyconRef.CompiledRepresentationForNamedType,ilMeth.RawMetadata) + | ILMeth(_, ilMeth, _) -> + let mref = IL.mkRefToILMethod (ilMeth.DeclaringTyconRef.CompiledRepresentationForNamedType, ilMeth.RawMetadata) let iltref = ilMeth.DeclaringTyconRefOption |> Option.map (fun tcref -> tcref.CompiledRepresentationForNamedType) - ILMethSln(ilMeth.ApparentEnclosingType,iltref,mref,minst) - | FSMeth(_,typ,vref,_) -> - FSMethSln(typ,vref,minst) + ILMethSln(ilMeth.ApparentEnclosingType, iltref, mref, minst) + | FSMeth(_, typ, vref, _) -> + FSMethSln(typ, vref, minst) | MethInfo.DefaultStructCtor _ -> - error(InternalError("the default struct constructor was the unexpected solution to a trait constraint",m)) + error(InternalError("the default struct constructor was the unexpected solution to a trait constraint", m)) #if EXTENSIONTYPING - | ProvidedMeth(amap,mi,_,m) -> + | ProvidedMeth(amap, mi, _, m) -> let g = amap.g let minst = [] // GENERIC TYPE PROVIDERS: for generics, we would have an minst here let allArgVars, allArgs = minfo.GetParamTypes(amap, m, minst) |> List.concat |> List.mapi (fun i ty -> mkLocal m ("arg"+string i) ty) |> List.unzip let objArgVars, objArgs = (if minfo.IsInstance then [mkLocal m "this" minfo.EnclosingType] else []) |> List.unzip - let callMethInfoOpt, callExpr,callExprTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) + let callMethInfoOpt, callExpr, callExprTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall css.TcVal (g, amap, mi, objArgs, NeverMutates, false, ValUseFlag.NormalValUse, allArgs, m) let closedExprSln = ClosedExprSln (mkLambdas m [] (objArgVars@allArgVars) (callExpr, callExprTy) ) // If the call is a simple call to an IL method with all the arguments in the natural order, then revert to use ILMethSln. // This is important for calls to operators on generated provided types. There is an (unchecked) condition // that generative providers do not re=order arguments or insert any more information into operator calls. match callMethInfoOpt, callExpr with - | Some methInfo, Expr.Op(TOp.ILCall(_useCallVirt,_isProtected,_,_isNewObj,NormalValUse,_isProp,_noTailCall,ilMethRef,_actualTypeInst,actualMethInst,_ilReturnTys),[],args,m) - when (args, (objArgVars@allArgVars)) ||> List.lengthsEqAndForall2 (fun a b -> match a with Expr.Val(v,_,_) -> valEq v.Deref b | _ -> false) -> + | Some methInfo, Expr.Op(TOp.ILCall(_useCallVirt, _isProtected, _, _isNewObj, NormalValUse, _isProp, _noTailCall, ilMethRef, _actualTypeInst, actualMethInst, _ilReturnTys), [], args, m) + when (args, (objArgVars@allArgVars)) ||> List.lengthsEqAndForall2 (fun a b -> match a with Expr.Val(v, _, _) -> valEq v.Deref b | _ -> false) -> let declaringType = Import.ImportProvidedType amap m (methInfo.PApply((fun x -> x.DeclaringType), m)) if isILAppTy g declaringType then let extOpt = None // EXTENSION METHODS FROM TYPE PROVIDERS: for extension methods coming from the type providers we would have something here. - ILMethSln(declaringType,extOpt,ilMethRef,actualMethInst) + ILMethSln(declaringType, extOpt, ilMethRef, actualMethInst) else closedExprSln | _ -> @@ -1373,7 +1373,7 @@ and MemberConstraintSolutionOfMethInfo css m minfo minst = #endif and MemberConstraintSolutionOfRecdFieldInfo rfinfo isSet = - FSRecdFieldSln(rfinfo.TypeInst,rfinfo.RecdFieldRef,isSet) + FSRecdFieldSln(rfinfo.TypeInst, rfinfo.RecdFieldRef, isSet) /// Write into the reference cell stored in the TAST and add to the undo trace if necessary and TransactMemberConstraintSolution traitInfo (trace:OptionalTrace) sln = @@ -1382,7 +1382,7 @@ and TransactMemberConstraintSolution traitInfo (trace:OptionalTrace) sln = /// Only consider overload resolution if canonicalizing or all the types are now nominal. /// That is, don't perform resolution if more nominal information may influence the set of available overloads -and GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution nm (TTrait(tys,_,memFlags,argtys,rty,soln) as traitInfo) : MethInfo list = +and GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution nm (TTrait(tys, _, memFlags, argtys, rty, soln) as traitInfo): MethInfo list = let results = if permitWeakResolution || isNil (GetSupportOfMemberConstraint csenv traitInfo) then let m = csenv.m @@ -1391,7 +1391,7 @@ and GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution | MemberKind.Constructor -> tys |> List.map (GetIntrinsicConstructorInfosOfType csenv.SolverState.InfoReader m) | _ -> - tys |> List.map (GetIntrinsicMethInfosOfType csenv.SolverState.InfoReader (Some nm,AccessibleFromSomeFSharpCode,AllowMultiIntfInstantiations.Yes) IgnoreOverrides m) + tys |> List.map (GetIntrinsicMethInfosOfType csenv.SolverState.InfoReader (Some nm, AccessibleFromSomeFSharpCode, AllowMultiIntfInstantiations.Yes) IgnoreOverrides m) /// Merge the sets so we don't get the same minfo from each side /// We merge based on whether minfos use identical metadata or not. @@ -1405,17 +1405,17 @@ and GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution [] // The trait name "op_Explicit" also covers "op_Implicit", so look for that one too. if nm = "op_Explicit" then - results @ GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution "op_Implicit" (TTrait(tys,"op_Implicit",memFlags,argtys,rty,soln)) + results @ GetRelevantMethodsForTrait (csenv:ConstraintSolverEnv) permitWeakResolution "op_Implicit" (TTrait(tys, "op_Implicit", memFlags, argtys, rty, soln)) else results /// The nominal support of the member constraint -and GetSupportOfMemberConstraint (csenv:ConstraintSolverEnv) (TTrait(tys,_,_,_,_,_)) = +and GetSupportOfMemberConstraint (csenv:ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = tys |> List.choose (tryAnyParTy csenv.g) /// All the typars relevant to the member constraint *) -and GetFreeTyparsOfMemberConstraint (csenv:ConstraintSolverEnv) (TTrait(tys,_,_,argtys,rty,_)) = +and GetFreeTyparsOfMemberConstraint (csenv:ConstraintSolverEnv) (TTrait(tys, _, _, argtys, rty, _)) = freeInTypesLeftToRightSkippingConstraints csenv.g (tys@argtys@ Option.toList rty) /// Re-solve the global constraints involving any of the given type variables. @@ -1440,11 +1440,11 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per let cxs = cxst.FindAll tpn if isNil cxs then ResultD false else - trace.Exec (fun () -> cxs |> List.iter (fun _ -> cxst.Remove tpn)) (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn,cx))) + trace.Exec (fun () -> cxs |> List.iter (fun _ -> cxst.Remove tpn)) (fun () -> cxs |> List.iter (fun cx -> cxst.Add(tpn, cx))) assert (isNil (cxst.FindAll tpn)) cxs - |> AtLeastOneD (fun (traitInfo,m2) -> + |> AtLeastOneD (fun (traitInfo, m2) -> let csenv = { csenv with m = m2 } SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo) @@ -1456,7 +1456,7 @@ and AddMemberConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace traitInfo sup let aenv = csenv.EquivEnv let cxst = csenv.SolverState.ExtraCxs - // Write the constraint into the global table. That is, + // Write the constraint into the global table. That is, // associate the constraint with each type variable in the free variables of the constraint. // This will mean the constraint gets resolved whenever one of these free variables gets solved. frees @@ -1466,13 +1466,13 @@ and AddMemberConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace traitInfo sup let cxs = cxst.FindAll tpn // check the constraint is not already listed for this type variable - if not (cxs |> List.exists (fun (traitInfo2,_) -> traitsAEquiv g aenv traitInfo traitInfo2)) then - trace.Exec (fun () -> csenv.SolverState.ExtraCxs.Add (tpn,(traitInfo,m2))) (fun () -> csenv.SolverState.ExtraCxs.Remove tpn) + if not (cxs |> List.exists (fun (traitInfo2, _) -> traitsAEquiv g aenv traitInfo traitInfo2)) then + trace.Exec (fun () -> csenv.SolverState.ExtraCxs.Add (tpn, (traitInfo, m2))) (fun () -> csenv.SolverState.ExtraCxs.Remove tpn) ) // Associate the constraint with each type variable in the support, so if the type variable // gets generalized then this constraint is attached at the binding site. - support |> IterateD (fun tp -> AddConstraint csenv ndeep m2 trace tp (TyparConstraint.MayResolveMember(traitInfo,m2))) + support |> IterateD (fun tp -> AddConstraint csenv ndeep m2 trace tp (TyparConstraint.MayResolveMember(traitInfo, m2))) /// Record a constraint on an inference type variable. @@ -1489,9 +1489,9 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = // This results in limitations on generic code, especially "inline" code, which // may require type annotations. See FSharp 1.0 bug 6477. let consistent tpc1 tpc2 = - match tpc1,tpc2 with - | (TyparConstraint.MayResolveMember(TTrait(tys1,nm1,memFlags1,argtys1,rty1,_),_), - TyparConstraint.MayResolveMember(TTrait(tys2,nm2,memFlags2,argtys2,rty2,_),_)) + match tpc1, tpc2 with + | (TyparConstraint.MayResolveMember(TTrait(tys1, nm1, memFlags1, argtys1, rty1, _), _), + TyparConstraint.MayResolveMember(TTrait(tys2, nm2, memFlags2, argtys2, rty2, _), _)) when (memFlags1 = memFlags2 && nm1 = nm2 && // Multiple op_Explicit and op_Implicit constraints can exist for the same type variable. @@ -1506,8 +1506,8 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace rty1 rty2 ++ (fun () -> CompleteD)) - | (TyparConstraint.CoercesTo(ty1,_), - TyparConstraint.CoercesTo(ty2,_)) -> + | (TyparConstraint.CoercesTo(ty1, _), + TyparConstraint.CoercesTo(ty2, _)) -> // Record at most one subtype constraint for each head type. // That is, we forbid constraints by both I and I. // This works because the types on the r.h.s. of subtype @@ -1523,30 +1523,30 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = if not (HaveSameHeadType g ty1Parent ty2Parent) then CompleteD else SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace ty1Parent ty2Parent)) - | (TyparConstraint.IsEnum (u1,_), - TyparConstraint.IsEnum (u2,m2)) -> + | (TyparConstraint.IsEnum (u1, _), + TyparConstraint.IsEnum (u2, m2)) -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace u1 u2 - | (TyparConstraint.IsDelegate (aty1,bty1,_), - TyparConstraint.IsDelegate (aty2,bty2,m2)) -> + | (TyparConstraint.IsDelegate (aty1, bty1, _), + TyparConstraint.IsDelegate (aty2, bty2, m2)) -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace aty1 aty2 ++ (fun () -> SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace bty1 bty2) - | TyparConstraint.SupportsComparison _,TyparConstraint.IsDelegate _ + | TyparConstraint.SupportsComparison _, TyparConstraint.IsDelegate _ | TyparConstraint.IsDelegate _ , TyparConstraint.SupportsComparison _ - | TyparConstraint.IsNonNullableStruct _,TyparConstraint.IsReferenceType _ - | TyparConstraint.IsReferenceType _,TyparConstraint.IsNonNullableStruct _ -> - ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(),m)) - - - | TyparConstraint.SupportsComparison _,TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _,TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _,TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _,TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _,TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _,TyparConstraint.IsReferenceType _ - | TyparConstraint.RequiresDefaultConstructor _,TyparConstraint.RequiresDefaultConstructor _ - | TyparConstraint.SimpleChoice (_,_),TyparConstraint.SimpleChoice (_,_) -> + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsReferenceType _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsNonNullableStruct _ -> + ErrorD (Error(FSComp.SR.csStructConstraintInconsistent(), m)) + + + | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _, TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _, TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _, TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ + | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ + | TyparConstraint.SimpleChoice (_, _), TyparConstraint.SimpleChoice (_, _) -> CompleteD | _ -> CompleteD @@ -1556,17 +1556,17 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = // If it does occur, e.g. at instantiation T2, then the check above will have enforced that // T2 = ty2 let implies tpc1 tpc2 = - match tpc1,tpc2 with - | TyparConstraint.MayResolveMember(trait1,_), - TyparConstraint.MayResolveMember(trait2,_) -> + match tpc1, tpc2 with + | TyparConstraint.MayResolveMember(trait1, _), + TyparConstraint.MayResolveMember(trait2, _) -> traitsAEquiv g aenv trait1 trait2 - | TyparConstraint.CoercesTo(ty1,_), TyparConstraint.CoercesTo(ty2,_) -> + | TyparConstraint.CoercesTo(ty1, _), TyparConstraint.CoercesTo(ty2, _) -> ExistsSameHeadTypeInHierarchy g amap m ty1 ty2 - | TyparConstraint.IsEnum(u1,_), TyparConstraint.IsEnum(u2,_) -> typeEquiv g u1 u2 + | TyparConstraint.IsEnum(u1, _), TyparConstraint.IsEnum(u2, _) -> typeEquiv g u1 u2 - | TyparConstraint.IsDelegate(aty1,bty1,_), TyparConstraint.IsDelegate(aty2,bty2,_) -> + | TyparConstraint.IsDelegate(aty1, bty1, _), TyparConstraint.IsDelegate(aty2, bty2, _) -> typeEquiv g aty1 aty2 && typeEquiv g bty1 bty2 | TyparConstraint.SupportsComparison _, TyparConstraint.SupportsComparison _ @@ -1578,8 +1578,8 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = | TyparConstraint.IsUnmanaged _, TyparConstraint.IsUnmanaged _ | TyparConstraint.IsReferenceType _, TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true - | TyparConstraint.SimpleChoice (tys1,_), TyparConstraint.SimpleChoice (tys2,_) -> ListSet.isSubsetOf (typeEquiv g) tys1 tys2 - | TyparConstraint.DefaultsTo (priority1,dty1,_), TyparConstraint.DefaultsTo (priority2,dty2,_) -> + | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice (tys2, _) -> ListSet.isSubsetOf (typeEquiv g) tys1 tys2 + | TyparConstraint.DefaultsTo (priority1, dty1, _), TyparConstraint.DefaultsTo (priority2, dty2, _) -> (priority1 = priority2) && typeEquiv g dty1 dty2 | _ -> false @@ -1608,14 +1608,14 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint = | _ -> false) then CompleteD elif tp.Rigidity = TyparRigidity.Rigid then - ErrorD (ConstraintSolverMissingConstraint(denv,tp,newConstraint,m,m2)) + ErrorD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else (// It is important that we give a warning if a constraint is missing from a // will-be-made-rigid type variable. This is because the existence of these warnings // is relevant to the overload resolution rules (see 'candidateWarnCount' in the overload resolution // implementation). See also FSharp 1.0 bug 5461 (if tp.Rigidity.WarnIfMissingConstraint then - WarnD (ConstraintSolverMissingConstraint(denv,tp,newConstraint,m,m2)) + WarnD (ConstraintSolverMissingConstraint(denv, tp, newConstraint, m, m2)) else CompleteD) ++ (fun () -> @@ -1650,9 +1650,9 @@ and SolveTypSupportsNull (csenv:ConstraintSolverEnv) ndeep m2 trace ty = if TypeSatisfiesNullConstraint g m ty then CompleteD else match ty with | NullableTy g _ -> - ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty), m, m2)) and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty = let g = csenv.g @@ -1666,7 +1666,7 @@ and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty = // Check it isn't ruled out by the user match tryDestAppTy g ty with | Some tcref when HasFSharpAttribute g g.attrib_NoComparisonAttribute tcref.Attribs -> - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> match ty with | SpecialComparableHeadType g tinst -> @@ -1678,7 +1678,7 @@ and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty = then // The type is comparable because it implements IComparable match ty with - | AppTy g (tcref,tinst) -> + | AppTy g (tcref, tinst) -> // Check the (possibly inferred) structural dependencies (tinst, tcref.TyparsNoRange) ||> Iterate2D (fun ty tp -> if tp.ComparisonConditionalOn then @@ -1694,10 +1694,10 @@ and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty = AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tcref.Deref && Option.isNone tcref.GeneratedCompareToWithComparerValues) then - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty), m, m2)) else - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison2(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison2(NicePrint.minimalStringOfType denv ty), m, m2)) and SolveTypSupportsEquality (csenv:ConstraintSolverEnv) ndeep m2 trace ty = let g = csenv.g @@ -1709,22 +1709,22 @@ and SolveTypSupportsEquality (csenv:ConstraintSolverEnv) ndeep m2 trace ty = | None -> match tryDestAppTy g ty with | Some tcref when HasFSharpAttribute g g.attrib_NoEqualityAttribute tcref.Attribs -> - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> match ty with | SpecialEquatableHeadType g tinst -> tinst |> IterateD (SolveTypSupportsEquality (csenv:ConstraintSolverEnv) ndeep m2 trace) | SpecialNotEquatableHeadType g _ -> - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality2(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality2(NicePrint.minimalStringOfType denv ty), m, m2)) | _ -> // The type is equatable because it has Object.Equals(...) match ty with - | AppTy g (tcref,tinst) -> + | AppTy g (tcref, tinst) -> // Give a good error for structural types excluded from the equality relation because of their fields if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref && Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues then - ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty), m, m2)) else // Check the (possibly inferred) structural dependencies (tinst, tcref.TyparsNoRange) ||> Iterate2D (fun ty tp -> @@ -1742,13 +1742,13 @@ and SolveTypIsEnum (csenv:ConstraintSolverEnv) ndeep m2 trace ty underlying = let denv = csenv.DisplayEnv match tryDestTyparTy g ty with | Some destTypar -> - return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsEnum(underlying,m)) + return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsEnum(underlying, m)) | None -> if isEnumTy g ty then do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace underlying (underlyingTypeOfEnumTy g ty) return! CompleteD else - return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotEnumType(NicePrint.minimalStringOfType denv ty),m,m2)) + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotEnumType(NicePrint.minimalStringOfType denv ty), m, m2)) } and SolveTypIsDelegate (csenv:ConstraintSolverEnv) ndeep m2 trace ty aty bty = @@ -1758,17 +1758,17 @@ and SolveTypIsDelegate (csenv:ConstraintSolverEnv) ndeep m2 trace ty aty bty = let denv = csenv.DisplayEnv match tryDestTyparTy g ty with | Some destTypar -> - return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsDelegate(aty,bty,m)) + return! AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsDelegate(aty, bty, m)) | None -> if isDelegateTy g ty then match TryDestStandardDelegateTyp csenv.InfoReader m AccessibleFromSomewhere ty with - | Some (tupledArgTy,rty) -> + | Some (tupledArgTy, rty) -> do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace aty tupledArgTy do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace bty rty | None -> - return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty),m,m2)) + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty), m, m2)) else - return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty),m,m2)) + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty), m, m2)) } and SolveTypIsNonNullableValueType (csenv:ConstraintSolverEnv) ndeep m2 trace ty = @@ -1783,9 +1783,9 @@ and SolveTypIsNonNullableValueType (csenv:ConstraintSolverEnv) ndeep m2 trace ty let underlyingTy = stripTyEqnsAndMeasureEqns g ty if isStructTy g underlyingTy then if tyconRefEq g g.system_Nullable_tcref (tcrefOfAppTy g underlyingTy) then - return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeParameterCannotBeNullable(),m,m)) + return! ErrorD (ConstraintSolverError(FSComp.SR.csTypeParameterCannotBeNullable(), m, m)) else - return! ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresStructType(NicePrint.minimalStringOfType denv ty),m,m2)) + return! ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresStructType(NicePrint.minimalStringOfType denv ty), m, m2)) } and SolveTypIsUnmanaged (csenv:ConstraintSolverEnv) ndeep m2 trace ty = @@ -1799,7 +1799,7 @@ and SolveTypIsUnmanaged (csenv:ConstraintSolverEnv) ndeep m2 trace ty = if isUnmanagedTy g ty then CompleteD else - ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresUnmanagedType(NicePrint.minimalStringOfType denv ty), m, m2)) and SolveTypChoice (csenv:ConstraintSolverEnv) ndeep m2 trace ty tys = @@ -1808,10 +1808,10 @@ and SolveTypChoice (csenv:ConstraintSolverEnv) ndeep m2 trace ty tys = let denv = csenv.DisplayEnv match tryDestTyparTy g ty with | Some destTypar -> - AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(tys,m)) + AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.SimpleChoice(tys, m)) | None -> if List.exists (typeEquivAux Erasure.EraseMeasures g ty) tys then CompleteD - else ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf((NicePrint.minimalStringOfType denv ty), (String.concat "," (List.map (NicePrint.prettyStringOfTy denv) tys))),m,m2)) + else ErrorD (ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf((NicePrint.minimalStringOfType denv ty), (String.concat "," (List.map (NicePrint.prettyStringOfTy denv) tys))), m, m2)) and SolveTypIsReferenceType (csenv:ConstraintSolverEnv) ndeep m2 trace ty = @@ -1823,7 +1823,7 @@ and SolveTypIsReferenceType (csenv:ConstraintSolverEnv) ndeep m2 trace ty = AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.IsReferenceType m) | None -> if isRefTy g ty then CompleteD - else ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresReferenceSemantics(NicePrint.minimalStringOfType denv ty),m,m)) + else ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresReferenceSemantics(NicePrint.minimalStringOfType denv ty), m, m)) and SolveTypRequiresDefaultConstructor (csenv:ConstraintSolverEnv) ndeep m2 trace typ = let g = csenv.g @@ -1843,7 +1843,7 @@ and SolveTypRequiresDefaultConstructor (csenv:ConstraintSolverEnv) ndeep m2 trac then match tryDestAppTy g ty with | Some tcref when HasFSharpAttribute g g.attrib_AbstractClassAttribute tcref.Attribs -> - ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv typ),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv typ), m, m2)) | _ -> CompleteD else @@ -1854,7 +1854,7 @@ and SolveTypRequiresDefaultConstructor (csenv:ConstraintSolverEnv) ndeep m2 trac (tcref.IsRecordTycon && HasFSharpAttribute g g.attrib_CLIMutableAttribute tcref.Attribs) -> CompleteD | _ -> - ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv typ),m,m2)) + ErrorD (ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv typ), m, m2)) // Parameterized compatibility relation between member signatures. The real work // is done by "equateTypes" and "subsumeTypes" and "subsumeArg" @@ -1866,7 +1866,7 @@ and CanMemberSigsMatchUpToCheck subsumeTypes // used to compare the "obj" type (subsumeArg: CalledArg -> CallerArg<_> -> OperationResult) // used to compare the arguments for compatibility reqdRetTyOpt - (calledMeth:CalledMeth<_>) : ImperativeOperationResult = + (calledMeth:CalledMeth<_>): ImperativeOperationResult = let g = csenv.g let amap = csenv.amap @@ -1882,11 +1882,11 @@ and CanMemberSigsMatchUpToCheck let unnamedCalledOutArgs = calledMeth.UnnamedCalledOutArgs // First equate the method instantiation (if any) with the method type parameters - if minst.Length <> uminst.Length then ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(),m)) else + if minst.Length <> uminst.Length then ErrorD(Error(FSComp.SR.csTypeInstantiationLengthMismatch(), m)) else Iterate2D unifyTypes minst uminst ++ (fun () -> - if not (permitOptArgs || isNil unnamedCalledOptArgs) then ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(),m)) else + if not (permitOptArgs || isNil unnamedCalledOptArgs) then ErrorD(Error(FSComp.SR.csOptionalArgumentNotPermittedHere(), m)) else let calledObjArgTys = minfo.GetObjArgTypes(amap, m, minst) @@ -1895,35 +1895,35 @@ and CanMemberSigsMatchUpToCheck if calledObjArgTys.Length <> callerObjArgTys.Length then if (calledObjArgTys.Length <> 0) then - ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName),m)) + ErrorD(Error (FSComp.SR.csMemberIsNotStatic(minfo.LogicalName), m)) else - ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName),m)) + ErrorD(Error (FSComp.SR.csMemberIsNotInstance(minfo.LogicalName), m)) else Iterate2D subsumeTypes calledObjArgTys callerObjArgTys ++ (fun () -> (calledMeth.ArgSets |> IterateD (fun argSet -> - if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(),m)) else + if argSet.UnnamedCalledArgs.Length <> argSet.UnnamedCallerArgs.Length then ErrorD(Error(FSComp.SR.csArgumentLengthMismatch(), m)) else Iterate2D subsumeArg argSet.UnnamedCalledArgs argSet.UnnamedCallerArgs)) ++ (fun () -> (calledMeth.ParamArrayCalledArgOpt |> OptionD (fun calledArg -> if isArray1DTy g calledArg.CalledArgumentType then let paramArrayElemTy = destArrayTy g calledArg.CalledArgumentType let reflArgInfo = calledArg.ReflArgInfo // propgate the reflected-arg info to each param array argument - calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0,0),false,NotOptional,NoCallerInfo,false,None,reflArgInfo,paramArrayElemTy)) callerArg)) + calledMeth.ParamArrayCallerArgs |> OptionD (IterateD (fun callerArg -> subsumeArg (CalledArg((0, 0), false, NotOptional, NoCallerInfo, false, None, reflArgInfo, paramArrayElemTy)) callerArg)) else CompleteD) ) ++ (fun () -> (calledMeth.ArgSets |> IterateD (fun argSet -> argSet.AssignedNamedArgs |> IterateD (fun arg -> subsumeArg arg.CalledArg arg.CallerArg))) ++ (fun () -> - (assignedItemSetters |> IterateD (fun (AssignedItemSetter(_,item,caller)) -> + (assignedItemSetters |> IterateD (fun (AssignedItemSetter(_, item, caller)) -> let name, calledArgTy = match item with - | AssignedPropSetter(_,pminfo,pminst) -> + | AssignedPropSetter(_, pminfo, pminst) -> let calledArgTy = List.head (List.head (pminfo.GetParamTypes(amap, m, pminst))) pminfo.LogicalName, calledArgTy | AssignedILFieldSetter(finfo) -> (* Get or set instance IL field *) - let calledArgTy = finfo.FieldType(amap,m) + let calledArgTy = finfo.FieldType(amap, m) finfo.FieldName, calledArgTy | AssignedRecdFieldSetter(rfinfo) -> @@ -1968,15 +1968,15 @@ and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m tr | ContextInfo.RuntimeTypeTest isOperator -> // test if we can cast other way around match CollectThenUndo (fun newTrace -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) cxsln ty2 ty1) with - | OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,ContextInfo.DowncastUsedInsteadOfUpcast isOperator,m)) - | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,ContextInfo.NoContext,m)) - | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g,csenv.DisplayEnv,ty1,ty2,res,csenv.eContextInfo,m))) + | OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m)) + | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m)) + | _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m))) and private SolveTypEqualsTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 = TryD (fun () -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m trace cxsln ty1 ty2) (function | LocallyAbortOperationThatFailsToResolveOverload -> CompleteD - | res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g,csenv.DisplayEnv,ty1,ty2,res,m))) + | res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, ty1, ty2, res, m))) and ArgsMustSubsumeOrConvert (csenv:ConstraintSolverEnv) @@ -1993,7 +1993,7 @@ and ArgsMustSubsumeOrConvert SolveTypSubsumesTypWithReport csenv ndeep m trace cxsln calledArgTy callerArg.Type ++ (fun () -> if calledArg.IsParamArray && isArray1DTy g calledArgTy && not (isArray1DTy g callerArg.Type) then - ErrorD(Error(FSComp.SR.csMethodExpectsParams(),m)) + ErrorD(Error(FSComp.SR.csMethodExpectsParams(), m)) else CompleteD) @@ -2003,62 +2003,62 @@ and MustUnify csenv ndeep trace cxsln ty1 ty2 = and MustUnifyInsideUndo csenv ndeep trace cxsln ty1 ty2 = SolveTypEqualsTypWithReport csenv ndeep csenv.m (WithTrace trace) cxsln ty1 ty2 -and ArgsMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace cxsln isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) = +and ArgsMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace cxsln isConstraint calledArg (CallerArg(callerArgTy, m, _, _) as callerArg) = let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg SolveTypSubsumesTypWithReport csenv ndeep m (WithTrace trace) cxsln calledArgTy callerArgTy and TypesMustSubsumeOrConvertInsideUndo (csenv:ConstraintSolverEnv) ndeep trace cxsln m calledArgTy callerArgTy = SolveTypSubsumesTypWithReport csenv ndeep m trace cxsln calledArgTy callerArgTy -and ArgsEquivInsideUndo (csenv:ConstraintSolverEnv) isConstraint calledArg (CallerArg(callerArgTy,m,_,_) as callerArg) = +and ArgsEquivInsideUndo (csenv:ConstraintSolverEnv) isConstraint calledArg (CallerArg(callerArgTy, m, _, _) as callerArg) = let calledArgTy = AdjustCalledArgType csenv.InfoReader isConstraint calledArg callerArg - if typeEquiv csenv.g calledArgTy callerArgTy then CompleteD else ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(),m)) + if typeEquiv csenv.g calledArgTy callerArgTy then CompleteD else ErrorD(Error(FSComp.SR.csArgumentTypesDoNotMatch(), m)) -and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs,nNamedCallerArgs) methodName ad (calledMethGroup:CalledMeth<_> list) isSequential = +and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs, nNamedCallerArgs) methodName ad (calledMethGroup:CalledMeth<_> list) isSequential = let amap = csenv.amap let m = csenv.m let denv = csenv.DisplayEnv - match (calledMethGroup |> List.partition (CalledMeth.GetMethod >> IsMethInfoAccessible amap m ad)), - (calledMethGroup |> List.partition (fun cmeth -> cmeth.HasCorrectObjArgs(m))), - (calledMethGroup |> List.partition (fun cmeth -> cmeth.HasCorrectArity)), - (calledMethGroup |> List.partition (fun cmeth -> cmeth.HasCorrectGenericArity)), + match (calledMethGroup |> List.partition (CalledMeth.GetMethod >> IsMethInfoAccessible amap m ad)), + (calledMethGroup |> List.partition (fun cmeth -> cmeth.HasCorrectObjArgs(m))), + (calledMethGroup |> List.partition (fun cmeth -> cmeth.HasCorrectArity)), + (calledMethGroup |> List.partition (fun cmeth -> cmeth.HasCorrectGenericArity)), (calledMethGroup |> List.partition (fun cmeth -> cmeth.AssignsAllNamedArgs)) with // No version accessible - | ([],others),_,_,_,_ -> + | ([], others), _, _, _, _ -> if isNil others then Error (FSComp.SR.csMemberIsNotAccessible(methodName, (ShowAccessDomain ad)), m) else Error (FSComp.SR.csMemberIsNotAccessible2(methodName, (ShowAccessDomain ad)), m) - | _,([],(cmeth::_)),_,_,_ -> + | _, ([], (cmeth::_)), _, _, _ -> // Check all the argument types. if cmeth.CalledObjArgTys(m).Length <> 0 then - Error (FSComp.SR.csMethodIsNotAStaticMethod(methodName),m) + Error (FSComp.SR.csMethodIsNotAStaticMethod(methodName), m) else - Error (FSComp.SR.csMethodIsNotAnInstanceMethod(methodName),m) + Error (FSComp.SR.csMethodIsNotAnInstanceMethod(methodName), m) // One method, incorrect name/arg assignment - | _,_,_,_,([],[cmeth]) -> + | _, _, _, _, ([], [cmeth]) -> let minfo = cmeth.Method - let msgNum,msgText = FSComp.SR.csRequiredSignatureIs(NicePrint.stringOfMethInfo amap m denv minfo) + let msgNum, msgText = FSComp.SR.csRequiredSignatureIs(NicePrint.stringOfMethInfo amap m denv minfo) match cmeth.UnassignedNamedArgs with - | CallerNamedArg(id,_) :: _ -> + | CallerNamedArg(id, _) :: _ -> if minfo.IsConstructor then let predictFields() = minfo.DeclaringEntityRef.AllInstanceFieldsAsList - |> List.map (fun p -> p.Name.Replace("@","")) + |> List.map (fun p -> p.Name.Replace("@", "")) |> Set.ofList - ErrorWithSuggestions((msgNum,FSComp.SR.csCtorHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)),id.idRange,id.idText,predictFields) + ErrorWithSuggestions((msgNum, FSComp.SR.csCtorHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)), id.idRange, id.idText, predictFields) else - Error((msgNum,FSComp.SR.csMemberHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)),id.idRange) - | [] -> Error((msgNum,msgText),m) + Error((msgNum, FSComp.SR.csMemberHasNoArgumentOrReturnProperty(methodName, id.idText, msgText)), id.idRange) + | [] -> Error((msgNum, msgText), m) // One method, incorrect number of arguments provided by the user - | _,_,([],[cmeth]),_,_ when not cmeth.HasCorrectArity -> + | _, _, ([], [cmeth]), _, _ when not cmeth.HasCorrectArity -> let minfo = cmeth.Method let nReqd = cmeth.TotalNumUnnamedCalledArgs let nActual = cmeth.TotalNumUnnamedCallerArgs @@ -2104,16 +2104,16 @@ and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs,nNam Error (FSComp.SR.csMemberSignatureMismatchArityNamed(methodName, (nReqd+nReqdNamed), nActual, nReqdNamed, signature), m) // One or more accessible, all the same arity, none correct - | ((cmeth :: cmeths2),_),_,_,_,_ when not cmeth.HasCorrectArity && cmeths2 |> List.forall (fun cmeth2 -> cmeth.TotalNumUnnamedCalledArgs = cmeth2.TotalNumUnnamedCalledArgs) -> - Error (FSComp.SR.csMemberNotAccessible(methodName, nUnnamedCallerArgs, methodName, cmeth.TotalNumUnnamedCalledArgs),m) + | ((cmeth :: cmeths2), _), _, _, _, _ when not cmeth.HasCorrectArity && cmeths2 |> List.forall (fun cmeth2 -> cmeth.TotalNumUnnamedCalledArgs = cmeth2.TotalNumUnnamedCalledArgs) -> + Error (FSComp.SR.csMemberNotAccessible(methodName, nUnnamedCallerArgs, methodName, cmeth.TotalNumUnnamedCalledArgs), m) // Many methods, all with incorrect number of generic arguments - | _,_,_,([],(cmeth :: _)),_ -> + | _, _, _, ([], (cmeth :: _)), _ -> let msg = FSComp.SR.csIncorrectGenericInstantiation((ShowAccessDomain ad), methodName, cmeth.NumCallerTyArgs) - Error (msg,m) + Error (msg, m) // Many methods of different arities, all incorrect - | _,_,([],(cmeth :: _)),_,_ -> + | _, _, ([], (cmeth :: _)), _, _ -> let minfo = cmeth.Method - Error (FSComp.SR.csMemberOverloadArityMismatch(methodName, cmeth.TotalNumUnnamedCallerArgs, (List.sum minfo.NumArgs)),m) + Error (FSComp.SR.csMemberOverloadArityMismatch(methodName, cmeth.TotalNumUnnamedCallerArgs, (List.sum minfo.NumArgs)), m) | _ -> let msg = if nNamedCallerArgs = 0 then @@ -2125,15 +2125,15 @@ and ReportNoCandidatesError (csenv:ConstraintSolverEnv) (nUnnamedCallerArgs,nNam else let sample = s.MinimumElement FSComp.SR.csNoMemberTakesTheseArguments3((ShowAccessDomain ad), methodName, nUnnamedCallerArgs, sample) - Error (msg,m) + Error (msg, m) |> ErrorD and ReportNoCandidatesErrorExpr csenv callerArgCounts methodName ad calledMethGroup = - let isSequential e = match e with | Expr.Sequential (_,_,_,_,_) -> true | _ -> false + let isSequential e = match e with | Expr.Sequential (_, _, _, _, _) -> true | _ -> false ReportNoCandidatesError csenv callerArgCounts methodName ad calledMethGroup isSequential and ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMethGroup = - let isSequential e = match e with | SynExpr.Sequential (_,_,_,_,_) -> true | _ -> false + let isSequential e = match e with | SynExpr.Sequential (_, _, _, _, _) -> true | _ -> false ReportNoCandidatesError csenv callerArgCounts methodName ad calledMethGroup isSequential // Resolve the overloading of a method @@ -2156,20 +2156,20 @@ and ResolveOverloading let denv = csenv.DisplayEnv let isOpConversion = methodName = "op_Explicit" || methodName = "op_Implicit" // See what candidates we have based on name and arity - let candidates = calledMethGroup |> List.filter (fun cmeth -> cmeth.IsCandidate(m,ad)) + let candidates = calledMethGroup |> List.filter (fun cmeth -> cmeth.IsCandidate(m, ad)) let calledMethOpt, errors, calledMethTrace = - match calledMethGroup,candidates with - | _,[calledMeth] when not isOpConversion -> + match calledMethGroup, candidates with + | _, [calledMeth] when not isOpConversion -> Some calledMeth, CompleteD, NoTrace - | [],_ when not isOpConversion -> - None, ErrorD (Error (FSComp.SR.csMethodNotFound(methodName),m)), NoTrace + | [], _ when not isOpConversion -> + None, ErrorD (Error (FSComp.SR.csMethodNotFound(methodName), m)), NoTrace - | _,[] when not isOpConversion -> + | _, [] when not isOpConversion -> None, ReportNoCandidatesErrorExpr csenv callerArgCounts methodName ad calledMethGroup, NoTrace - | _,_ -> + | _, _ -> // - Always take the return type into account for // -- op_Explicit, op_Implicit @@ -2191,7 +2191,7 @@ and ResolveOverloading (ArgsEquivInsideUndo csenv cx.IsSome) reqdRetTyOpt calledMeth) with - | [(calledMeth,_,_)] -> + | [(calledMeth, _, _)] -> Some calledMeth, CompleteD, NoTrace // Can't re-play the trace since ArgsEquivInsideUndo was used | _ -> @@ -2209,7 +2209,7 @@ and ResolveOverloading reqdRetTyOpt candidate) - let failOverloading (msg : string) errors = + let failOverloading (msg: string) errors = // Try to extract information to give better error for ambiguous op_Explicit and op_Implicit let convOpData = if isOpConversion then @@ -2248,11 +2248,11 @@ and ResolveOverloading reqdRetTyOpt calledMeth) with | OkResult _ -> None - | ErrorResult(_,exn) -> Some (calledMeth, exn)) + | ErrorResult(_, exn) -> Some (calledMeth, exn)) - None,ErrorD (failOverloading (FSComp.SR.csNoOverloadsFound methodName) errors), NoTrace + None, ErrorD (failOverloading (FSComp.SR.csNoOverloadsFound methodName) errors), NoTrace - | [(calledMeth,_,t)] -> + | [(calledMeth, _, t)] -> Some calledMeth, CompleteD, WithTrace t | applicableMeths -> @@ -2263,12 +2263,12 @@ and ResolveOverloading /// Otherwise x1 = x2 // Note: Relies on 'compare' respecting true > false - let compareCond (p : 'T -> 'T -> bool) x1 x2 = + let compareCond (p: 'T -> 'T -> bool) x1 x2 = compare (p x1 x2) (p x2 x1) /// Compare types under the feasibly-subsumes ordering let compareTypes ty1 ty2 = - (ty1,ty2) ||> compareCond (fun x1 x2 -> TypeFeasiblySubsumesType ndeep csenv.g csenv.amap m x2 CanCoerce x1) + (ty1, ty2) ||> compareCond (fun x1 x2 -> TypeFeasiblySubsumesType ndeep csenv.g csenv.amap m x2 CanCoerce x1) /// Compare arguments under the feasibly-subsumes ordering and the adhoc Func-is-better-than-other-delegates rule let compareArg (calledArg1:CalledArg) (calledArg2:CalledArg) = @@ -2370,8 +2370,8 @@ and ResolveOverloading let bestMethods = let indexedApplicableMeths = applicableMeths |> List.indexed - indexedApplicableMeths |> List.choose (fun (i,candidate) -> - if indexedApplicableMeths |> List.forall (fun (j,other) -> + indexedApplicableMeths |> List.choose (fun (i, candidate) -> + if indexedApplicableMeths |> List.forall (fun (j, other) -> i = j || let res = better candidate other //eprintfn "\n-------\nCandidate: %s\nOther: %s\nResult: %d\n" (NicePrint.stringOfMethInfo amap m denv (fst candidate).Method) (NicePrint.stringOfMethInfo amap m denv (fst other).Method) res @@ -2380,7 +2380,7 @@ and ResolveOverloading else None) match bestMethods with - | [(calledMeth,_,t)] -> Some calledMeth, CompleteD, WithTrace t + | [(calledMeth, _, t)] -> Some calledMeth, CompleteD, WithTrace t | bestMethods -> let methodNames = let methods = @@ -2391,8 +2391,8 @@ and ResolveOverloading | [] -> match applicableMeths with | [] -> candidates - | m -> m |> List.map (fun (x,_,_) -> x) - | m -> m |> List.map (fun (x,_,_) -> x) + | m -> m |> List.map (fun (x, _, _) -> x) + | m -> m |> List.map (fun (x, _, _) -> x) methods |> List.map (fun cmeth -> NicePrint.stringOfMethInfo amap m denv cmeth.Method) @@ -2409,7 +2409,7 @@ and ResolveOverloading // Unify return types. match calledMethOpt with | Some calledMeth -> - calledMethOpt, + calledMethOpt, errors ++ (fun () -> let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs)) cx match calledMethTrace with @@ -2459,10 +2459,10 @@ let UnifyUniqueOverloading = let m = csenv.m // See what candidates we have based on name and arity - let candidates = calledMethGroup |> List.filter (fun cmeth -> cmeth.IsCandidate(m,ad)) + let candidates = calledMethGroup |> List.filter (fun cmeth -> cmeth.IsCandidate(m, ad)) let ndeep = 0 - match calledMethGroup,candidates with - | _,[calledMeth] -> + match calledMethGroup, candidates with + | _, [calledMeth] -> // Only one candidate found - we thus know the types we expect of arguments CanMemberSigsMatchUpToCheck csenv @@ -2475,9 +2475,9 @@ let UnifyUniqueOverloading calledMeth ++ (fun () -> ResultD true) - | [],_ -> - ErrorD (Error (FSComp.SR.csMethodNotFound(methodName),m)) - | _,[] -> + | [], _ -> + ErrorD (Error (FSComp.SR.csMethodNotFound(methodName), m)) + | _, [] -> ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMethGroup ++ (fun () -> ResultD false) | _ -> @@ -2490,7 +2490,7 @@ let EliminateConstraintsForGeneralizedTypars csenv (trace:OptionalTrace) (genera let tpn = tp.Stamp let cxst = csenv.SolverState.ExtraCxs let cxs = cxst.FindAll tpn - cxs |> List.iter (fun cx -> trace.Exec (fun () -> cxst.Remove tpn) (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn,cx)))) + cxs |> List.iter (fun cx -> trace.Exec (fun () -> cxst.Remove tpn) (fun () -> (csenv.SolverState.ExtraCxs.Add (tpn, cx)))) ) @@ -2498,7 +2498,7 @@ let EliminateConstraintsForGeneralizedTypars csenv (trace:OptionalTrace) (genera // Main entry points to constraint solver (some backdoors are used for // some constructs) // -// No error recovery here : we do that on a per-expression basis. +// No error recovery here: we do that on a per-expression basis. //------------------------------------------------------------------------- let AddCxTypeEqualsType contextInfo denv css m ty1 ty2 = @@ -2543,52 +2543,52 @@ let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 = let AddCxMethodConstraint denv css m trace traitInfo = TryD (fun () -> SolveMemberConstraint (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) true false 0 m trace traitInfo ++ (fun _ -> CompleteD)) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportNull denv css m trace ty = TryD (fun () -> SolveTypSupportsNull (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportComparison denv css m trace ty = TryD (fun () -> SolveTypeSupportsComparison (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportEquality denv css m trace ty = TryD (fun () -> SolveTypSupportsEquality (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportDefaultCtor denv css m trace ty = TryD (fun () -> SolveTypRequiresDefaultConstructor (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsReferenceType denv css m trace ty = TryD (fun () -> SolveTypIsReferenceType (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsValueType denv css m trace ty = TryD (fun () -> SolveTypIsNonNullableValueType (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsUnmanaged denv css m trace ty = TryD (fun () -> SolveTypIsUnmanaged (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsEnum denv css m trace ty underlying = TryD (fun () -> SolveTypIsEnum (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty underlying) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsDelegate denv css m trace ty aty bty = TryD (fun () -> SolveTypIsDelegate (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m trace ty aty bty) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = @@ -2597,7 +2597,7 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait amap = amap TcVal = tcVal ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - InfoReader = new InfoReader(g,amap) } + InfoReader = new InfoReader(g, amap) } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) SolveMemberConstraint csenv true true 0 m NoTrace traitInfo ++ (fun _res -> @@ -2606,26 +2606,26 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait | None -> Choice4Of4() | Some sln -> match sln with - | ILMethSln(typ,extOpt,mref,minst) -> - let tcref,_tinst = destAppTy g typ + | ILMethSln(typ, extOpt, mref, minst) -> + let tcref, _tinst = destAppTy g typ let mdef = IL.resolveILMethodRef tcref.ILTyconRawMetadata mref let ilMethInfo = match extOpt with - | None -> MethInfo.CreateILMeth(amap,m,typ,mdef) + | None -> MethInfo.CreateILMeth(amap, m, typ, mdef) | Some ilActualTypeRef -> let actualTyconRef = Import.ImportILTypeRef amap m ilActualTypeRef MethInfo.CreateILExtensionMeth(amap, m, typ, actualTyconRef, None, mdef) - Choice1Of4 (ilMethInfo,minst) - | FSMethSln(typ, vref,minst) -> - Choice1Of4 (FSMeth(g,typ,vref,None),minst) - | FSRecdFieldSln(tinst,rfref,isSetProp) -> - Choice2Of4 (tinst,rfref,isSetProp) + Choice1Of4 (ilMethInfo, minst) + | FSMethSln(typ, vref, minst) -> + Choice1Of4 (FSMeth(g, typ, vref, None), minst) + | FSRecdFieldSln(tinst, rfref, isSetProp) -> + Choice2Of4 (tinst, rfref, isSetProp) | BuiltInSln -> Choice4Of4 () | ClosedExprSln expr -> Choice3Of4 expr match sln with - | Choice1Of4(minfo,methArgTys) -> + | Choice1Of4(minfo, methArgTys) -> let argExprs = // FIX for #421894 - typechecker assumes that coercion can be applied for the trait calls arguments but codegen doesn't emit coercion operations // result - generation of non-verifyable code @@ -2647,16 +2647,16 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait | Some r -> r::convertedArgs | None -> convertedArgs - // Fix bug 1281: If we resolve to an instance method on a struct and we haven't yet taken + // 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 if minfo.IsStruct && minfo.IsInstance && (match argExprs with [] -> false | h :: _ -> not (isByrefTy g (tyOfExpr g h))) then - let h,t = List.headAndTail argExprs - let wrap,h' = mkExprAddrOfExpr g true false PossiblyMutates h None m + let h, t = List.headAndTail argExprs + let wrap, h' = mkExprAddrOfExpr g true false PossiblyMutates h None m ResultD (Some (wrap (Expr.Op(TOp.TraitCall(traitInfo), [], (h' :: t), m)))) else ResultD (Some (MakeMethInfoCall amap m minfo methArgTys argExprs )) - | Choice2Of4 (tinst,rfref,isSet) -> + | Choice2Of4 (tinst, rfref, isSet) -> let res = match isSet, rfref.RecdField.IsStatic, argExprs.Length with | true, true, 1 -> @@ -2666,7 +2666,7 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait // the address of the object then go do that if rfref.Tycon.IsStructOrEnumTycon && not (isByrefTy g (tyOfExpr g argExprs.[0])) then let h = List.head argExprs - let wrap,h' = mkExprAddrOfExpr g true false DefinitelyMutates h None m + let wrap, h' = mkExprAddrOfExpr g true false DefinitelyMutates h None m Some (wrap (mkRecdFieldSetViaExprAddr (h', rfref, tinst, argExprs.[1], m))) else Some (mkRecdFieldSetViaExprAddr (argExprs.[0], rfref, tinst, argExprs.[1], m)) @@ -2686,10 +2686,10 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait let ChooseTyparSolutionAndSolve css denv tp = let g = css.g let amap = css.amap - let max,m = ChooseTyparSolutionAndRange g amap tp + let max, m = ChooseTyparSolutionAndRange g amap tp let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv TryD (fun () -> SolveTyparEqualsTyp csenv 0 m NoTrace (mkTyparTy tp) max) - (fun err -> ErrorD(ErrorFromApplyingDefault(g,denv,tp,max,err,m))) + (fun err -> ErrorD(ErrorFromApplyingDefault(g, denv, tp, max, err, m))) |> RaiseOperationResult @@ -2699,7 +2699,7 @@ let CheckDeclaredTypars denv css m typars1 typars2 = SolveTypEqualsTypEqns (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) 0 m (WithTrace trace) None (List.map mkTyparTy typars1) (List.map mkTyparTy typars2))) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult /// An approximation used during name resolution for intellisense to eliminate extension members which will not @@ -2714,7 +2714,7 @@ let IsApplicableMethApprox g amap m (minfo:MethInfo) availObjTy = amap = amap TcVal = (fun _ -> failwith "should not be called") ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - InfoReader = new InfoReader(g,amap) } + InfoReader = new InfoReader(g, amap) } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) let minst = FreshenMethInfo m minfo match minfo.GetObjArgTypes(amap, m, minst) with diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index a06e0f72c6464d5ea424a60326dabcd167b838f7..3ea19645b6be5e82521645ffbf4c7a95ee57eb69 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -88,7 +88,7 @@ type ExprValueInfo = | ConstValue of Const * TType - /// CurriedLambdaValue(id,arity,sz,expr,typ) + /// CurriedLambdaValue(id, arity, sz, expr, typ) /// /// arities: The number of bunches of untupled args and type args, and /// the number of args in each bunch. NOTE: This include type arguments. @@ -124,8 +124,8 @@ type ValInfos(entries) = let valInfoTable = lazy (let t = ValHash.Create () - for (vref:ValRef,x) in entries do - t.Add (vref.Deref,(vref,x)) + for (vref:ValRef, x) in entries do + t.Add (vref.Deref, (vref, x)) t) // The compiler ValRef's into fslib stored in env.fs break certain invariants that hold elsewhere, @@ -133,9 +133,9 @@ type ValInfos(entries) = // Thus a backup alternative resolution technique is needed for these. let valInfosForFslib = lazy ( - let dict = Dictionary<_,_>() - for (vref,_x) as p in entries do - dict.Add(vref.Deref.LinkagePartialKey,p) |> ignore + let dict = Dictionary<_, _>() + for (vref, _x) as p in entries do + dict.Add(vref.Deref.LinkagePartialKey, p) |> ignore dict) member x.Entries = valInfoTable.Force().Values @@ -158,20 +158,20 @@ let seqL xL xs = Seq.fold (fun z x -> z @@ xL x) emptyL xs let namemapL xL xmap = NameMap.foldBack (fun nm x z -> xL nm x @@ z) xmap emptyL let rec exprValueInfoL g = function - | ConstValue (x,ty) -> NicePrint.layoutConst g ty x + | ConstValue (x, ty) -> NicePrint.layoutConst g ty x | UnknownValue -> wordL (tagText "?") - | SizeValue (_,vinfo) -> exprValueInfoL g vinfo - | ValValue (vr,vinfo) -> bracketL ((valRefL vr ^^ wordL (tagText "alias")) --- exprValueInfoL g vinfo) + | SizeValue (_, vinfo) -> exprValueInfoL g vinfo + | ValValue (vr, vinfo) -> bracketL ((valRefL vr ^^ wordL (tagText "alias")) --- exprValueInfoL g vinfo) | TupleValue vinfos -> bracketL (exprValueInfosL g vinfos) - | RecdValue (_,vinfos) -> braceL (exprValueInfosL g vinfos) - | UnionCaseValue (ucr,vinfos) -> unionCaseRefL ucr ^^ bracketL (exprValueInfosL g vinfos) - | CurriedLambdaValue(_lambdaId,_arities,_bsize,expr',_ety) -> wordL (tagText "lam") ++ exprL expr' (* (sprintf "lam(size=%d)" bsize) *) - | ConstExprValue (_size,x) -> exprL x + | RecdValue (_, vinfos) -> braceL (exprValueInfosL g vinfos) + | UnionCaseValue (ucr, vinfos) -> unionCaseRefL ucr ^^ bracketL (exprValueInfosL g vinfos) + | CurriedLambdaValue(_lambdaId, _arities, _bsize, expr', _ety) -> wordL (tagText "lam") ++ exprL expr' (* (sprintf "lam(size=%d)" bsize) *) + | ConstExprValue (_size, x) -> exprL x and exprValueInfosL g vinfos = commaListL (List.map (exprValueInfoL g) (Array.toList vinfos)) and moduleInfoL g (x:LazyModuleInfo) = let x = x.Force() braceL ((wordL (tagText "Modules: ") @@ (x.ModuleOrNamespaceInfos |> namemapL (fun nm x -> wordL (tagText nm) ^^ moduleInfoL g x) ) ) - @@ (wordL (tagText "Values:") @@ (x.ValInfos.Entries |> seqL (fun (vref,x) -> valRefL vref ^^ valInfoL g x) ))) + @@ (wordL (tagText "Values:") @@ (x.ValInfos.Entries |> seqL (fun (vref, x) -> valRefL vref ^^ valInfoL g x) ))) and valInfoL g (x:ValInfo) = braceL ((wordL (tagText "ValExprInfo: ") @@ exprValueInfoL g x.ValExprInfo) @@ -202,22 +202,22 @@ let rec SizeOfValueInfos (arr:_[]) = and SizeOfValueInfo x = match x with - | SizeValue (vdepth,_v) -> vdepth (* terminate recursion at CACHED size nodes *) - | ConstValue (_x,_) -> 1 + | SizeValue (vdepth, _v) -> vdepth (* terminate recursion at CACHED size nodes *) + | ConstValue (_x, _) -> 1 | UnknownValue -> 1 - | ValValue (_vr,vinfo) -> SizeOfValueInfo vinfo + 1 + | ValValue (_vr, vinfo) -> SizeOfValueInfo vinfo + 1 | TupleValue vinfos - | RecdValue (_,vinfos) - | UnionCaseValue (_,vinfos) -> 1 + SizeOfValueInfos vinfos - | CurriedLambdaValue(_lambdaId,_arities,_bsize,_expr',_ety) -> 1 - | ConstExprValue (_size,_) -> 1 + | RecdValue (_, vinfos) + | UnionCaseValue (_, vinfos) -> 1 + SizeOfValueInfos vinfos + | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr', _ety) -> 1 + | ConstExprValue (_size, _) -> 1 let [] minDepthForASizeNode = 5 (* for small vinfos do not record size info, save space *) let rec MakeValueInfoWithCachedSize vdepth v = match v with - | SizeValue(_,v) -> MakeValueInfoWithCachedSize vdepth v - | _ -> if vdepth > minDepthForASizeNode then SizeValue(vdepth,v) else v (* add nodes to stop recursion *) + | SizeValue(_, v) -> MakeValueInfoWithCachedSize vdepth v + | _ -> if vdepth > minDepthForASizeNode then SizeValue(vdepth, v) else v (* add nodes to stop recursion *) let MakeSizedValueInfo v = let vdepth = SizeOfValueInfo v @@ -229,15 +229,15 @@ let BoundValueInfoBySize vinfo = UnknownValue else match x with - | SizeValue (vdepth,vinfo) -> if vdepth < depth then x else MakeSizedValueInfo (bound depth vinfo) - | ValValue (vr,vinfo) -> ValValue (vr,bound (depth-1) vinfo) + | SizeValue (vdepth, vinfo) -> if vdepth < depth then x else MakeSizedValueInfo (bound depth vinfo) + | ValValue (vr, vinfo) -> ValValue (vr, bound (depth-1) vinfo) | TupleValue vinfos -> TupleValue (Array.map (bound (depth-1)) vinfos) - | RecdValue (tcref,vinfos) -> RecdValue (tcref,Array.map (bound (depth-1)) vinfos) - | UnionCaseValue (ucr,vinfos) -> UnionCaseValue (ucr,Array.map (bound (depth-1)) vinfos) + | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map (bound (depth-1)) vinfos) + | UnionCaseValue (ucr, vinfos) -> UnionCaseValue (ucr, Array.map (bound (depth-1)) vinfos) | ConstValue _ -> x | UnknownValue -> x - | CurriedLambdaValue(_lambdaId,_arities,_bsize,_expr',_ety) -> x - | ConstExprValue (_size,_) -> x + | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr', _ety) -> x + | ConstExprValue (_size, _) -> x let maxDepth = 6 (* beware huge constants! *) let trimDepth = 3 let vdepth = SizeOfValueInfo vinfo @@ -309,7 +309,7 @@ type OptimizationSettings = member x.EliminatUnionCaseFieldGet () = x.localOpt () /// eliminate non-compiler generated immediate bindings member x.EliminateImmediatelyConsumedLocals() = x.localOpt () - /// expand "let x = (exp1,exp2,...)" bind fields as prior tmps + /// expand "let x = (exp1, exp2, ...)" bind fields as prior tmps member x.ExpandStructrualValues() = x.localOpt () type cenv = @@ -318,11 +318,11 @@ type cenv = amap: Import.ImportMap optimizing: bool scope: CcuThunk - localInternalVals: System.Collections.Generic.Dictionary + localInternalVals: System.Collections.Generic.Dictionary settings: OptimizationSettings emitTailcalls: bool // cache methods with SecurityAttribute applied to them, to prevent unnecessary calls to ExistsInEntireHierarchyOfType - casApplied : Dictionary} + casApplied : Dictionary} @@ -340,8 +340,8 @@ type IncrementalOptimizationEnv = /// The Val for the function binding being generated, if any. functionVal: (Val * Tast.ValReprInfo) option typarInfos: (Typar * TypeValueInfo) list - localExternalVals: LayeredMap - globalModuleInfos: LayeredMap } + localExternalVals: LayeredMap + globalModuleInfos: LayeredMap } static member Empty = { latestBoundId = None @@ -360,19 +360,19 @@ type IncrementalOptimizationEnv = let rec IsPartialExprVal x = (* IsPartialExprVal can not rebuild to an expr *) match x with | UnknownValue -> true - | TupleValue args | RecdValue (_,args) | UnionCaseValue (_,args) -> Array.exists IsPartialExprVal args + | TupleValue args | RecdValue (_, args) | UnionCaseValue (_, args) -> Array.exists IsPartialExprVal args | ConstValue _ | CurriedLambdaValue _ | ConstExprValue _ -> false - | ValValue (_,a) - | SizeValue(_,a) -> IsPartialExprVal a + | ValValue (_, a) + | SizeValue(_, a) -> IsPartialExprVal a let CheckInlineValueIsComplete (v:Val) res = if v.MustInline && IsPartialExprVal res then errorR(Error(FSComp.SR.optValueMarkedInlineButIncomplete(v.DisplayName), v.Range)) - //System.Diagnostics.Debug.Assert(false,sprintf "Break for incomplete inline value %s" v.DisplayName) + //System.Diagnostics.Debug.Assert(false, sprintf "Break for incomplete inline value %s" v.DisplayName) let check (vref: ValRef) (res:ValInfo) = CheckInlineValueIsComplete vref.Deref res.ValExprInfo - (vref,res) + (vref, res) //------------------------------------------------------------------------- // Bind information about values @@ -385,12 +385,12 @@ let rec UnionOptimizationInfos (minfos : seq) = { ValInfos = ValInfos(seq { for minfo in minfos do yield! minfo.Force().ValInfos.Entries }) ModuleOrNamespaceInfos = minfos |> Seq.map (fun m -> m.Force().ModuleOrNamespaceInfos) |> NameMap.union UnionOptimizationInfos } -let FindOrCreateModuleInfo n (ss: Map<_,_>) = +let FindOrCreateModuleInfo n (ss: Map<_, _>) = match ss.TryFind n with | Some res -> res | None -> EmptyModuleInfo -let FindOrCreateGlobalModuleInfo n (ss: LayeredMap<_,_>) = +let FindOrCreateGlobalModuleInfo n (ss: LayeredMap<_, _>) = match ss.TryFind n with | Some res -> res | None -> EmptyModuleInfo @@ -400,13 +400,13 @@ let rec BindValueInSubModuleFSharpCore (mp:string[]) i (v:Val) vval ss = {ss with ModuleOrNamespaceInfos = BindValueInModuleForFslib mp.[i] mp (i+1) v vval ss.ModuleOrNamespaceInfos } else // REVIEW: this line looks quadratic for performance when compiling FSharp.Core - {ss with ValInfos = ValInfos(Seq.append ss.ValInfos.Entries (Seq.singleton (mkLocalValRef v,vval))) } + {ss with ValInfos = ValInfos(Seq.append ss.ValInfos.Entries (Seq.singleton (mkLocalValRef v, vval))) } and BindValueInModuleForFslib n mp i v vval (ss: NameMap<_>) = let old = FindOrCreateModuleInfo n ss Map.add n (notlazy (BindValueInSubModuleFSharpCore mp i v vval (old.Force()))) ss -and BindValueInGlobalModuleForFslib n mp i v vval (ss: LayeredMap<_,_>) = +and BindValueInGlobalModuleForFslib n mp i v vval (ss: LayeredMap<_, _>) = let old = FindOrCreateGlobalModuleInfo n ss ss.Add(n, notlazy (BindValueInSubModuleFSharpCore mp i v vval (old.Force()))) @@ -463,7 +463,7 @@ let BindExternalLocalVal cenv (v:Val) vval env = let rec BindValsInModuleOrNamespace cenv (mval:LazyModuleInfo) env = let mval = mval.Force() // do all the sub modules - let env = (mval.ModuleOrNamespaceInfos,env) ||> NameMap.foldBackRange (BindValsInModuleOrNamespace cenv) + let env = (mval.ModuleOrNamespaceInfos, env) ||> NameMap.foldBackRange (BindValsInModuleOrNamespace cenv) let env = (env, mval.ValInfos.Entries) ||> Seq.fold (fun env (v:ValRef, vval) -> BindExternalLocalVal cenv v.Deref vval env) env @@ -484,21 +484,21 @@ let inline BindInternalValsToUnknown cenv vs env = env #endif -let BindTypeVar tyv typeinfo env = { env with typarInfos= (tyv,typeinfo)::env.typarInfos } +let BindTypeVar tyv typeinfo env = { env with typarInfos= (tyv, typeinfo)::env.typarInfos } let BindTypeVarsToUnknown (tps:Typar list) env = if isNil tps then env else // The optimizer doesn't use the type values it could track. // However here we mutate to provide better names for generalized type parameters // The names chosen are 'a', 'b' etc. These are also the compiled names in the IL code - let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) (env.typarInfos |> List.map (fun (tp,_) -> tp.Name) ) tps - (tps,nms) ||> List.iter2 (fun tp nm -> + let nms = PrettyTypes.PrettyTyparNames (fun _ -> true) (env.typarInfos |> List.map (fun (tp, _) -> tp.Name) ) tps + (tps, nms) ||> List.iter2 (fun tp nm -> if PrettyTypes.NeedsPrettyTyparName tp then - tp.typar_id <- ident (nm,tp.Range)) + tp.typar_id <- ident (nm, tp.Range)) List.fold (fun sofar arg -> BindTypeVar arg UnknownTypeValue sofar) env tps let BindCcu (ccu:Tast.CcuThunk) mval env (_g:TcGlobals) = - { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName,mval) } + { env with globalModuleInfos=env.globalModuleInfos.Add(ccu.AssemblyName, mval) } @@ -520,7 +520,7 @@ let GetInfoForLocalValue cenv env (v:Val) m = if v.MustInline then errorR(Error(FSComp.SR.optValueMarkedInlineButWasNotBoundInTheOptEnv(fullDisplayTextOfValRef (mkLocalValRef v)), m)) #if CHECKED - warning(Error(FSComp.SR.optLocalValueNotFoundDuringOptimization(v.DisplayName),m)) + warning(Error(FSComp.SR.optLocalValueNotFoundDuringOptimization(v.DisplayName), m)) #endif UnknownValInfo @@ -552,8 +552,8 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) = match structInfo.ValInfos.TryFind(vref) with | Some ninfo -> snd ninfo | None -> - //dprintn ("\n\n*** Optimization info for value "+n+" from module "+(full_name_of_nlpath smv)+" not found, module contains values: "+String.concat "," (NameMap.domainL structInfo.ValInfos)) - //System.Diagnostics.Debug.Assert(false,sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n) + //dprintn ("\n\n*** Optimization info for value "+n+" from module "+(full_name_of_nlpath smv)+" not found, module contains values: "+String.concat ", " (NameMap.domainL structInfo.ValInfos)) + //System.Diagnostics.Debug.Assert(false, sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n) if cenv.g.compilingFslib then match structInfo.ValInfos.TryFindForFslib(vref) with | true, ninfo -> snd ninfo @@ -562,7 +562,7 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) = UnknownValInfo | None -> //dprintf "\n\n*** Optimization info for module %s from ccu %s not found." (full_name_of_nlpath smv) (ccu_of_nlpath smv).AssemblyName - //System.Diagnostics.Debug.Assert(false,sprintf "Break for module %s, ccu %s" (full_name_of_nlpath smv) (ccu_of_nlpath smv).AssemblyName) + //System.Diagnostics.Debug.Assert(false, sprintf "Break for module %s, ccu %s" (full_name_of_nlpath smv) (ccu_of_nlpath smv).AssemblyName) UnknownValInfo else UnknownValInfo @@ -582,18 +582,18 @@ let GetInfoForVal cenv env m (vref:ValRef) = //------------------------------------------------------------------------- let rec stripValue = function - | ValValue(_,details) -> stripValue details (* step through ValValue "aliases" *) - | SizeValue(_,details) -> stripValue details (* step through SizeValue "aliases" *) + | ValValue(_, details) -> stripValue details (* step through ValValue "aliases" *) + | SizeValue(_, details) -> stripValue details (* step through SizeValue "aliases" *) | vinfo -> vinfo let (|StripConstValue|_|) ev = match stripValue ev with - | ConstValue(c,_) -> Some c + | ConstValue(c, _) -> Some c | _ -> None let (|StripLambdaValue|_|) ev = match stripValue ev with - | CurriedLambdaValue (id,arity,sz,expr,typ) -> Some (id,arity,sz,expr,typ) + | CurriedLambdaValue (id, arity, sz, expr, typ) -> Some (id, arity, sz, expr, typ) | _ -> None let destTupleValue ev = @@ -603,12 +603,12 @@ let destTupleValue ev = let destRecdValue ev = match stripValue ev with - | RecdValue (_tcref,info) -> Some info + | RecdValue (_tcref, info) -> Some info | _ -> None let (|StripUnionCaseValue|_|) ev = match stripValue ev with - | UnionCaseValue (c,info) -> Some (c,info) + | UnionCaseValue (c, info) -> Some (c, info) | _ -> None let mkBoolVal (g: TcGlobals) n = ConstValue(Const.Bool n, g.bool_ty) @@ -631,19 +631,19 @@ let MakeValueInfoForValue g m vref vinfo = #if DEBUG let rec check x = match x with - | ValValue (vref2,detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)),m)) else check detail - | SizeValue (_n,detail) -> check detail + | ValValue (vref2, detail) -> if valRefEq g vref vref2 then error(Error(FSComp.SR.optRecursiveValValue(showL(exprValueInfoL g vinfo)), m)) else check detail + | SizeValue (_n, detail) -> check detail | _ -> () check vinfo #else ignore g; ignore m #endif - ValValue (vref,vinfo) |> BoundValueInfoBySize + ValValue (vref, vinfo) |> BoundValueInfoBySize -let MakeValueInfoForRecord tcref argvals = RecdValue (tcref,argvals) |> BoundValueInfoBySize +let MakeValueInfoForRecord tcref argvals = RecdValue (tcref, argvals) |> BoundValueInfoBySize let MakeValueInfoForTuple argvals = TupleValue argvals |> BoundValueInfoBySize -let MakeValueInfoForUnionCase cspec argvals = UnionCaseValue (cspec,argvals) |> BoundValueInfoBySize -let MakeValueInfoForConst c ty = ConstValue(c,ty) +let MakeValueInfoForUnionCase cspec argvals = UnionCaseValue (cspec, argvals) |> BoundValueInfoBySize +let MakeValueInfoForConst c ty = ConstValue(c, ty) // Helper to evaluate a unary integer operation over known values let inline IntegerUnaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a = @@ -676,18 +676,18 @@ let inline SignedIntegerUnaryOp g f8 f16 f32 f64 a = // Helper to evaluate a binary integer operation over known values let inline IntegerBinaryOp g f8 f16 f32 f64 fu8 fu16 fu32 fu64 a b = - match a,b with - | StripConstValue(c1),StripConstValue(c2) -> - match c1,c2 with - | (Const.Bool a),(Const.Bool b) -> Some(mkBoolVal g (f32 (if a then 1 else 0) (if b then 1 else 0) <> 0)) - | (Const.Int32 a),(Const.Int32 b) -> Some(mkInt32Val g (f32 a b)) - | (Const.Int64 a),(Const.Int64 b) -> Some(mkInt64Val g (f64 a b)) - | (Const.Int16 a),(Const.Int16 b) -> Some(mkInt16Val g (f16 a b)) - | (Const.SByte a),(Const.SByte b) -> Some(mkInt8Val g (f8 a b)) - | (Const.Byte a),(Const.Byte b) -> Some(mkUInt8Val g (fu8 a b)) - | (Const.UInt16 a),(Const.UInt16 b) -> Some(mkUInt16Val g (fu16 a b)) - | (Const.UInt32 a),(Const.UInt32 b) -> Some(mkUInt32Val g (fu32 a b)) - | (Const.UInt64 a),(Const.UInt64 b) -> Some(mkUInt64Val g (fu64 a b)) + match a, b with + | StripConstValue(c1), StripConstValue(c2) -> + match c1, c2 with + | (Const.Bool a), (Const.Bool b) -> Some(mkBoolVal g (f32 (if a then 1 else 0) (if b then 1 else 0) <> 0)) + | (Const.Int32 a), (Const.Int32 b) -> Some(mkInt32Val g (f32 a b)) + | (Const.Int64 a), (Const.Int64 b) -> Some(mkInt64Val g (f64 a b)) + | (Const.Int16 a), (Const.Int16 b) -> Some(mkInt16Val g (f16 a b)) + | (Const.SByte a), (Const.SByte b) -> Some(mkInt8Val g (f8 a b)) + | (Const.Byte a), (Const.Byte b) -> Some(mkUInt8Val g (fu8 a b)) + | (Const.UInt16 a), (Const.UInt16 b) -> Some(mkUInt16Val g (fu16 a b)) + | (Const.UInt32 a), (Const.UInt32 b) -> Some(mkUInt32Val g (fu32 a b)) + | (Const.UInt64 a), (Const.UInt64 b) -> Some(mkUInt64Val g (fu64 a b)) | _ -> None | _ -> None @@ -700,190 +700,190 @@ module Unchecked = Microsoft.FSharp.Core.Operators // in the core library used by the F# compiler will propagate to be a mistake in optimization. // The IL instructions appear in the tree through inlining. let mkAssemblyCodeValueInfo g instrs argvals tys = - match instrs,argvals,tys with - | [ AI_add ],[t1;t2],_ -> + match instrs, argvals, tys with + | [ AI_add ], [t1;t2], _ -> // Note: each use of Unchecked.(+) gets instantiated at a different type and inlined match IntegerBinaryOp g Unchecked.(+) Unchecked.(+) Unchecked.(+) Unchecked.(+) Unchecked.(+) Unchecked.(+) Unchecked.(+) Unchecked.(+) t1 t2 with | Some res -> res | _ -> UnknownValue - | [ AI_sub ],[t1;t2],_ -> + | [ AI_sub ], [t1;t2], _ -> // Note: each use of Unchecked.(+) gets instantiated at a different type and inlined match IntegerBinaryOp g Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) Unchecked.(-) t1 t2 with | Some res -> res | _ -> UnknownValue - | [ AI_mul ],[a;b],_ -> (match IntegerBinaryOp g Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) a b with Some res -> res | None -> UnknownValue) - | [ AI_and ],[a;b],_ -> (match IntegerBinaryOp g (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) a b with Some res -> res | None -> UnknownValue) - | [ AI_or ],[a;b],_ -> (match IntegerBinaryOp g (|||) (|||) (|||) (|||) (|||) (|||) (|||) (|||) a b with Some res -> res | None -> UnknownValue) - | [ AI_xor ],[a;b],_ -> (match IntegerBinaryOp g (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) a b with Some res -> res | None -> UnknownValue) - | [ AI_not ],[a],_ -> (match IntegerUnaryOp g (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) a with Some res -> res | None -> UnknownValue) - | [ AI_neg ],[a],_ -> (match SignedIntegerUnaryOp g (~-) (~-) (~-) (~-) a with Some res -> res | None -> UnknownValue) - - | [ AI_ceq ],[a;b],_ -> + | [ AI_mul ], [a;b], _ -> (match IntegerBinaryOp g Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) Unchecked.( * ) a b with Some res -> res | None -> UnknownValue) + | [ AI_and ], [a;b], _ -> (match IntegerBinaryOp g (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) (&&&) a b with Some res -> res | None -> UnknownValue) + | [ AI_or ], [a;b], _ -> (match IntegerBinaryOp g (|||) (|||) (|||) (|||) (|||) (|||) (|||) (|||) a b with Some res -> res | None -> UnknownValue) + | [ AI_xor ], [a;b], _ -> (match IntegerBinaryOp g (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) (^^^) a b with Some res -> res | None -> UnknownValue) + | [ AI_not ], [a], _ -> (match IntegerUnaryOp g (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) (~~~) a with Some res -> res | None -> UnknownValue) + | [ AI_neg ], [a], _ -> (match SignedIntegerUnaryOp g (~-) (~-) (~-) (~-) a with Some res -> res | None -> UnknownValue) + + | [ AI_ceq ], [a;b], _ -> match stripValue a, stripValue b with - | ConstValue(Const.Bool a1,_),ConstValue(Const.Bool a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.SByte a1,_),ConstValue(Const.SByte a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Int16 a1,_),ConstValue(Const.Int16 a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Int32 a1,_),ConstValue(Const.Int32 a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Int64 a1,_),ConstValue(Const.Int64 a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Char a1,_),ConstValue(Const.Char a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.Byte a1,_),ConstValue(Const.Byte a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.UInt16 a1,_),ConstValue(Const.UInt16 a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.UInt32 a1,_),ConstValue(Const.UInt32 a2,_) -> mkBoolVal g (a1 = a2) - | ConstValue(Const.UInt64 a1,_),ConstValue(Const.UInt64 a2,_) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Bool a1, _), ConstValue(Const.Bool a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 = a2) + | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 = a2) | _ -> UnknownValue - | [ AI_clt ],[a;b],_ -> - match stripValue a,stripValue b with - | ConstValue(Const.Bool a1,_),ConstValue(Const.Bool a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.Int32 a1,_),ConstValue(Const.Int32 a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.Int64 a1,_),ConstValue(Const.Int64 a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.SByte a1,_),ConstValue(Const.SByte a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.Int16 a1,_),ConstValue(Const.Int16 a2,_) -> mkBoolVal g (a1 < a2) + | [ AI_clt ], [a;b], _ -> + match stripValue a, stripValue b with + | ConstValue(Const.Bool a1, _), ConstValue(Const.Bool a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 < a2) | _ -> UnknownValue - | [ (AI_conv(DT_U1))],[a],[ty] when typeEquiv g ty g.byte_ty -> + | [ (AI_conv(DT_U1))], [a], [ty] when typeEquiv g ty g.byte_ty -> match stripValue a with - | ConstValue(Const.SByte a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Int16 a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Int32 a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Int64 a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.Byte a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.UInt16 a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.UInt32 a,_) -> mkUInt8Val g (Unchecked.byte a) - | ConstValue(Const.UInt64 a,_) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.SByte a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Int16 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Int32 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Int64 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.Byte a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.UInt16 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.UInt32 a, _) -> mkUInt8Val g (Unchecked.byte a) + | ConstValue(Const.UInt64 a, _) -> mkUInt8Val g (Unchecked.byte a) | _ -> UnknownValue - | [ (AI_conv(DT_U2))],[a],[ty] when typeEquiv g ty g.uint16_ty -> + | [ (AI_conv(DT_U2))], [a], [ty] when typeEquiv g ty g.uint16_ty -> match stripValue a with - | ConstValue(Const.SByte a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Int16 a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Int32 a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Int64 a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.Byte a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.UInt16 a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.UInt32 a,_) -> mkUInt16Val g (Unchecked.uint16 a) - | ConstValue(Const.UInt64 a,_) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.SByte a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Int16 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Int32 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Int64 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.Byte a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.UInt16 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.UInt32 a, _) -> mkUInt16Val g (Unchecked.uint16 a) + | ConstValue(Const.UInt64 a, _) -> mkUInt16Val g (Unchecked.uint16 a) | _ -> UnknownValue - | [ (AI_conv(DT_U4))],[a],[ty] when typeEquiv g ty g.uint32_ty -> + | [ (AI_conv(DT_U4))], [a], [ty] when typeEquiv g ty g.uint32_ty -> match stripValue a with - | ConstValue(Const.SByte a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Int16 a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Int32 a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Int64 a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.Byte a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.UInt16 a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.UInt32 a,_) -> mkUInt32Val g (Unchecked.uint32 a) - | ConstValue(Const.UInt64 a,_) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.SByte a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Int16 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Int32 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Int64 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.Byte a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.UInt16 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.UInt32 a, _) -> mkUInt32Val g (Unchecked.uint32 a) + | ConstValue(Const.UInt64 a, _) -> mkUInt32Val g (Unchecked.uint32 a) | _ -> UnknownValue - | [ (AI_conv(DT_U8))],[a],[ty] when typeEquiv g ty g.uint64_ty -> + | [ (AI_conv(DT_U8))], [a], [ty] when typeEquiv g ty g.uint64_ty -> match stripValue a with - | ConstValue(Const.SByte a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Int16 a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Int32 a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Int64 a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.Byte a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.UInt16 a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.UInt32 a,_) -> mkUInt64Val g (Unchecked.uint64 a) - | ConstValue(Const.UInt64 a,_) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.SByte a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Int16 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Int32 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Int64 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.Byte a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.UInt16 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.UInt32 a, _) -> mkUInt64Val g (Unchecked.uint64 a) + | ConstValue(Const.UInt64 a, _) -> mkUInt64Val g (Unchecked.uint64 a) | _ -> UnknownValue - | [ (AI_conv(DT_I1))],[a],[ty] when typeEquiv g ty g.sbyte_ty -> + | [ (AI_conv(DT_I1))], [a], [ty] when typeEquiv g ty g.sbyte_ty -> match stripValue a with - | ConstValue(Const.SByte a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Int16 a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Int32 a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Int64 a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.Byte a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.UInt16 a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.UInt32 a,_) -> mkInt8Val g (Unchecked.sbyte a) - | ConstValue(Const.UInt64 a,_) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.SByte a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Int16 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Int32 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Int64 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.Byte a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.UInt16 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.UInt32 a, _) -> mkInt8Val g (Unchecked.sbyte a) + | ConstValue(Const.UInt64 a, _) -> mkInt8Val g (Unchecked.sbyte a) | _ -> UnknownValue - | [ (AI_conv(DT_I2))],[a],[ty] when typeEquiv g ty g.int16_ty -> + | [ (AI_conv(DT_I2))], [a], [ty] when typeEquiv g ty g.int16_ty -> match stripValue a with - | ConstValue(Const.Int32 a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.Int16 a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.SByte a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.Int64 a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.UInt32 a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.UInt16 a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.Byte a,_) -> mkInt16Val g (Unchecked.int16 a) - | ConstValue(Const.UInt64 a,_) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Int32 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Int16 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.SByte a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Int64 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.UInt32 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.UInt16 a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.Byte a, _) -> mkInt16Val g (Unchecked.int16 a) + | ConstValue(Const.UInt64 a, _) -> mkInt16Val g (Unchecked.int16 a) | _ -> UnknownValue - | [ (AI_conv(DT_I4))],[a],[ty] when typeEquiv g ty g.int32_ty -> + | [ (AI_conv(DT_I4))], [a], [ty] when typeEquiv g ty g.int32_ty -> match stripValue a with - | ConstValue(Const.Int32 a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.Int16 a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.SByte a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.Int64 a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.UInt32 a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.UInt16 a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.Byte a,_) -> mkInt32Val g (Unchecked.int32 a) - | ConstValue(Const.UInt64 a,_) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Int32 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Int16 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.SByte a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Int64 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.UInt32 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.UInt16 a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.Byte a, _) -> mkInt32Val g (Unchecked.int32 a) + | ConstValue(Const.UInt64 a, _) -> mkInt32Val g (Unchecked.int32 a) | _ -> UnknownValue - | [ (AI_conv(DT_I8))],[a],[ty] when typeEquiv g ty g.int64_ty -> + | [ (AI_conv(DT_I8))], [a], [ty] when typeEquiv g ty g.int64_ty -> match stripValue a with - | ConstValue(Const.Int32 a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.Int16 a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.SByte a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.Int64 a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.UInt32 a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.UInt16 a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.Byte a,_) -> mkInt64Val g (Unchecked.int64 a) - | ConstValue(Const.UInt64 a,_) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Int32 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Int16 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.SByte a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Int64 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.UInt32 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.UInt16 a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.Byte a, _) -> mkInt64Val g (Unchecked.int64 a) + | ConstValue(Const.UInt64 a, _) -> mkInt64Val g (Unchecked.int64 a) | _ -> UnknownValue - | [ AI_clt_un ],[a;b],[ty] when typeEquiv g ty g.bool_ty -> - match stripValue a,stripValue b with - | ConstValue(Const.Char a1,_),ConstValue(Const.Char a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.Byte a1,_),ConstValue(Const.Byte a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.UInt16 a1,_),ConstValue(Const.UInt16 a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.UInt32 a1,_),ConstValue(Const.UInt32 a2,_) -> mkBoolVal g (a1 < a2) - | ConstValue(Const.UInt64 a1,_),ConstValue(Const.UInt64 a2,_) -> mkBoolVal g (a1 < a2) + | [ AI_clt_un ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> + match stripValue a, stripValue b with + | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 < a2) + | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 < a2) | _ -> UnknownValue - | [ AI_cgt ],[a;b],[ty] when typeEquiv g ty g.bool_ty -> - match stripValue a,stripValue b with - | ConstValue(Const.SByte a1,_),ConstValue(Const.SByte a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Int16 a1,_),ConstValue(Const.Int16 a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Int32 a1,_),ConstValue(Const.Int32 a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Int64 a1,_),ConstValue(Const.Int64 a2,_) -> mkBoolVal g (a1 > a2) + | [ AI_cgt ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> + match stripValue a, stripValue b with + | ConstValue(Const.SByte a1, _), ConstValue(Const.SByte a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Int16 a1, _), ConstValue(Const.Int16 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Int32 a1, _), ConstValue(Const.Int32 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Int64 a1, _), ConstValue(Const.Int64 a2, _) -> mkBoolVal g (a1 > a2) | _ -> UnknownValue - | [ AI_cgt_un ],[a;b],[ty] when typeEquiv g ty g.bool_ty -> - match stripValue a,stripValue b with - | ConstValue(Const.Char a1,_),ConstValue(Const.Char a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.Byte a1,_),ConstValue(Const.Byte a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.UInt16 a1,_),ConstValue(Const.UInt16 a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.UInt32 a1,_),ConstValue(Const.UInt32 a2,_) -> mkBoolVal g (a1 > a2) - | ConstValue(Const.UInt64 a1,_),ConstValue(Const.UInt64 a2,_) -> mkBoolVal g (a1 > a2) + | [ AI_cgt_un ], [a;b], [ty] when typeEquiv g ty g.bool_ty -> + match stripValue a, stripValue b with + | ConstValue(Const.Char a1, _), ConstValue(Const.Char a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.Byte a1, _), ConstValue(Const.Byte a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.UInt16 a1, _), ConstValue(Const.UInt16 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.UInt32 a1, _), ConstValue(Const.UInt32 a2, _) -> mkBoolVal g (a1 > a2) + | ConstValue(Const.UInt64 a1, _), ConstValue(Const.UInt64 a2, _) -> mkBoolVal g (a1 > a2) | _ -> UnknownValue - | [ AI_shl ],[a;n],_ -> - match stripValue a,stripValue n with - | ConstValue(Const.Int64 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 63 -> (mkInt64Val g (a <<< n)) - | ConstValue(Const.Int32 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 31 -> (mkInt32Val g (a <<< n)) - | ConstValue(Const.Int16 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 15 -> (mkInt16Val g (a <<< n)) - | ConstValue(Const.SByte a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 7 -> (mkInt8Val g (a <<< n)) - | ConstValue(Const.UInt64 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 63 -> (mkUInt64Val g (a <<< n)) - | ConstValue(Const.UInt32 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 31 -> (mkUInt32Val g (a <<< n)) - | ConstValue(Const.UInt16 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 15 -> (mkUInt16Val g (a <<< n)) - | ConstValue(Const.Byte a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 7 -> (mkUInt8Val g (a <<< n)) + | [ AI_shl ], [a;n], _ -> + match stripValue a, stripValue n with + | ConstValue(Const.Int64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkInt64Val g (a <<< n)) + | ConstValue(Const.Int32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkInt32Val g (a <<< n)) + | ConstValue(Const.Int16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkInt16Val g (a <<< n)) + | ConstValue(Const.SByte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkInt8Val g (a <<< n)) + | ConstValue(Const.UInt64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkUInt64Val g (a <<< n)) + | ConstValue(Const.UInt32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkUInt32Val g (a <<< n)) + | ConstValue(Const.UInt16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkUInt16Val g (a <<< n)) + | ConstValue(Const.Byte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkUInt8Val g (a <<< n)) | _ -> UnknownValue - | [ AI_shr ],[a;n],_ -> - match stripValue a,stripValue n with - | ConstValue(Const.SByte a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 7 -> (mkInt8Val g (a >>> n)) - | ConstValue(Const.Int16 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 15 -> (mkInt16Val g (a >>> n)) - | ConstValue(Const.Int32 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 31 -> (mkInt32Val g (a >>> n)) - | ConstValue(Const.Int64 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 63 -> (mkInt64Val g (a >>> n)) + | [ AI_shr ], [a;n], _ -> + match stripValue a, stripValue n with + | ConstValue(Const.SByte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkInt8Val g (a >>> n)) + | ConstValue(Const.Int16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkInt16Val g (a >>> n)) + | ConstValue(Const.Int32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkInt32Val g (a >>> n)) + | ConstValue(Const.Int64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkInt64Val g (a >>> n)) | _ -> UnknownValue - | [ AI_shr_un ],[a;n],_ -> - match stripValue a,stripValue n with - | ConstValue(Const.Byte a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 7 -> (mkUInt8Val g (a >>> n)) - | ConstValue(Const.UInt16 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 15 -> (mkUInt16Val g (a >>> n)) - | ConstValue(Const.UInt32 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 31 -> (mkUInt32Val g (a >>> n)) - | ConstValue(Const.UInt64 a,_),ConstValue(Const.Int32 n,_) when n >= 0 && n <= 63 -> (mkUInt64Val g (a >>> n)) + | [ AI_shr_un ], [a;n], _ -> + match stripValue a, stripValue n with + | ConstValue(Const.Byte a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 7 -> (mkUInt8Val g (a >>> n)) + | ConstValue(Const.UInt16 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 15 -> (mkUInt16Val g (a >>> n)) + | ConstValue(Const.UInt32 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 31 -> (mkUInt32Val g (a >>> n)) + | ConstValue(Const.UInt64 a, _), ConstValue(Const.Int32 n, _) when n >= 0 && n <= 63 -> (mkUInt64Val g (a >>> n)) | _ -> UnknownValue // Retypings using IL asm "" are quite common in prim-types.fs // Sometimes these are only to get the primitives to pass the type checker. // Here we check for retypings from know values to known types. // We're conservative not to apply any actual data-changing conversions here. - | [ ],[v],[ty] -> + | [ ], [v], [ty] -> match stripValue v with - | ConstValue(Const.Bool a,_) -> + | ConstValue(Const.Bool a, _) -> if typeEquiv g ty g.bool_ty then v elif typeEquiv g ty g.sbyte_ty then mkInt8Val g (if a then 1y else 0y) elif typeEquiv g ty g.int16_ty then mkInt16Val g (if a then 1s else 0s) @@ -892,37 +892,37 @@ let mkAssemblyCodeValueInfo g instrs argvals tys = elif typeEquiv g ty g.uint16_ty then mkUInt16Val g (if a then 1us else 0us) elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (if a then 1u else 0u) else UnknownValue - | ConstValue(Const.SByte a,_) -> + | ConstValue(Const.SByte a, _) -> if typeEquiv g ty g.sbyte_ty then v elif typeEquiv g ty g.int16_ty then mkInt16Val g (Unchecked.int16 a) elif typeEquiv g ty g.int32_ty then mkInt32Val g (Unchecked.int32 a) else UnknownValue - | ConstValue(Const.Byte a,_) -> + | ConstValue(Const.Byte a, _) -> if typeEquiv g ty g.byte_ty then v elif typeEquiv g ty g.uint16_ty then mkUInt16Val g (Unchecked.uint16 a) elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (Unchecked.uint32 a) else UnknownValue - | ConstValue(Const.Int16 a,_) -> + | ConstValue(Const.Int16 a, _) -> if typeEquiv g ty g.int16_ty then v elif typeEquiv g ty g.int32_ty then mkInt32Val g (Unchecked.int32 a) else UnknownValue - | ConstValue(Const.UInt16 a,_) -> + | ConstValue(Const.UInt16 a, _) -> if typeEquiv g ty g.uint16_ty then v elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (Unchecked.uint32 a) else UnknownValue - | ConstValue(Const.Int32 a,_) -> + | ConstValue(Const.Int32 a, _) -> if typeEquiv g ty g.int32_ty then v elif typeEquiv g ty g.uint32_ty then mkUInt32Val g (Unchecked.uint32 a) else UnknownValue - | ConstValue(Const.UInt32 a,_) -> + | ConstValue(Const.UInt32 a, _) -> if typeEquiv g ty g.uint32_ty then v elif typeEquiv g ty g.int32_ty then mkInt32Val g (Unchecked.int32 a) else UnknownValue - | ConstValue(Const.Int64 a,_) -> + | ConstValue(Const.Int64 a, _) -> if typeEquiv g ty g.int64_ty then v elif typeEquiv g ty g.uint64_ty then mkUInt64Val g (Unchecked.uint64 a) else UnknownValue - | ConstValue(Const.UInt64 a,_) -> + | ConstValue(Const.UInt64 a, _) -> if typeEquiv g ty g.uint64_ty then v elif typeEquiv g ty g.int64_ty then mkInt64Val g (Unchecked.int64 a) else UnknownValue @@ -940,7 +940,7 @@ let inline AddTotalSizes l = l |> List.sumBy (fun x -> x.TotalSize) let inline AddFunctionSizes l = l |> List.sumBy (fun x -> x.FunctionSize) //------------------------------------------------------------------------- -// opt list/array combinators - zipping (_,_) return type +// opt list/array combinators - zipping (_, _) return type //------------------------------------------------------------------------- let inline OrEffects l = List.exists (fun x -> x.HasEffect) l @@ -948,7 +948,7 @@ let inline OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l let OptimizeList f l = l |> List.map f |> List.unzip -let NoExprs : (Expr list * list>) = [],[] +let NoExprs : (Expr list * list>) = [], [] //------------------------------------------------------------------------- // Common ways of building new value infos @@ -972,7 +972,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = // The freevars and FreeTyvars can indicate if the non-public (hidden) items have been used. // Under those checks, the further hidden* checks may be subsumed (meaning, not required anymore). - let hiddenTycon,hiddenTyconRepr,hiddenVal, hiddenRecdField, hiddenUnionCase = + let hiddenTycon, hiddenTyconRepr, hiddenVal, hiddenRecdField, hiddenUnionCase = Zset.memberOf mhi.mhiTycons, Zset.memberOf mhi.mhiTyconReprs, Zset.memberOf mhi.mhiVals, @@ -982,7 +982,7 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = let rec abstractExprInfo ivalue = match ivalue with (* Check for escaping value. Revert to old info if possible *) - | ValValue (vref2,detail) -> + | ValValue (vref2, detail) -> let detail' = abstractExprInfo detail let v2 = vref2.Deref let tyvars = freeInVal CollectAll v2 @@ -991,9 +991,9 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = Zset.exists hiddenTycon tyvars.FreeTycons || hiddenVal v2 then detail' - else ValValue (vref2,detail') + else ValValue (vref2, detail') // Check for escape in lambda - | CurriedLambdaValue (_,_,_,expr,_) | ConstExprValue(_,expr) when + | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr CollectAll expr (isAssemblyBoundary && not (freeVarsAllPublic fvs)) || Zset.exists hiddenVal fvs.FreeLocals || @@ -1003,23 +1003,23 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = Zset.exists hiddenUnionCase fvs.FreeUnionCases ) -> UnknownValue // Check for escape in constant - | ConstValue(_,ty) when + | ConstValue(_, ty) when (let ftyvs = freeInType CollectAll ty (isAssemblyBoundary && not (freeTyvarsAllPublic ftyvs)) || Zset.exists hiddenTycon ftyvs.FreeTycons) -> UnknownValue | TupleValue vinfos -> TupleValue (Array.map abstractExprInfo vinfos) - | RecdValue (tcref,vinfos) -> + | RecdValue (tcref, vinfos) -> if hiddenTyconRepr tcref.Deref || Array.exists (tcref.MakeNestedRecdFieldRef >> hiddenRecdField) tcref.AllFieldsArray then UnknownValue - else RecdValue (tcref,Array.map abstractExprInfo vinfos) - | UnionCaseValue(ucref,vinfos) -> + else RecdValue (tcref, Array.map abstractExprInfo vinfos) + | UnionCaseValue(ucref, vinfos) -> let tcref = ucref.TyconRef if hiddenTyconRepr ucref.Tycon || tcref.UnionCasesArray |> Array.exists (tcref.MakeNestedUnionCaseRef >> hiddenUnionCase) then UnknownValue - else UnionCaseValue (ucref,Array.map abstractExprInfo vinfos) - | SizeValue(_vdepth,vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) + else UnionCaseValue (ucref, Array.map abstractExprInfo vinfos) + | SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) | UnknownValue | ConstExprValue _ | CurriedLambdaValue _ @@ -1031,8 +1031,8 @@ let AbstractLazyModulInfoByHiding isAssemblyBoundary mhi = { ModuleOrNamespaceInfos = NameMap.map abstractLazyModulInfo ss.ModuleOrNamespaceInfos ValInfos = ValInfos(ss.ValInfos.Entries - |> Seq.filter (fun (vref,_) -> not (hiddenVal vref.Deref)) - |> Seq.map (fun (vref,e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } + |> Seq.filter (fun (vref, _) -> not (hiddenVal vref.Deref)) + |> Seq.map (fun (vref, e) -> check (* "its implementation uses a binding hidden by a signature" m *) vref (abstractValInfo e) )) } and abstractLazyModulInfo (ss:LazyModuleInfo) = ss.Force() |> abstractModulInfo |> notlazy @@ -1043,7 +1043,7 @@ let AbstractOptimizationInfoToEssentials = let rec abstractModulInfo (ss:ModuleInfo) = { ModuleOrNamespaceInfos = NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) ss.ModuleOrNamespaceInfos - ValInfos = ss.ValInfos.Filter (fun (v,_) -> v.MustInline) } + ValInfos = ss.ValInfos.Filter (fun (v, _) -> v.MustInline) } and abstractLazyModulInfo ss = ss |> Lazy.force |> abstractModulInfo |> notlazy abstractLazyModulInfo @@ -1053,20 +1053,20 @@ let AbstractOptimizationInfoToEssentials = // Hide information because of a "let ... in ..." or "let rec ... in ... " //------------------------------------------------------------------------- -let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = +let AbstractExprInfoByVars (boundVars:Val list, boundTyVars) ivalue = // Module and member bindings can be skipped when checking abstraction, since abstraction of these values has already been done when // we hit the end of the module and called AbstractLazyModulInfoByHiding. If we don't skip these then we end up quadtratically retraversing // the inferred optimization data, i.e. at each binding all the way up a sequences of 'lets' in a module. let boundVars = boundVars |> List.filter (fun v -> not v.IsMemberOrModuleBinding) - match boundVars,boundTyVars with - | [],[] -> ivalue + match boundVars, boundTyVars with + | [], [] -> ivalue | _ -> let rec abstractExprInfo ivalue = match ivalue with // Check for escaping value. Revert to old info if possible - | ValValue (VRefLocal v2,detail) when + | ValValue (VRefLocal v2, detail) when (not (isNil boundVars) && List.exists (valEq v2) boundVars) || (not (isNil boundTyVars) && let ftyvs = freeInVal CollectTypars v2 @@ -1075,12 +1075,12 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = // hiding value when used in expression abstractExprInfo detail - | ValValue (v2,detail) -> + | ValValue (v2, detail) -> let detail' = abstractExprInfo detail - ValValue (v2,detail') + ValValue (v2, detail') // Check for escape in lambda - | CurriedLambdaValue (_,_,_,expr,_) | ConstExprValue(_,expr) when + | CurriedLambdaValue (_, _, _, expr, _) | ConstExprValue(_, expr) when (let fvs = freeInExpr (if isNil boundTyVars then CollectLocals else CollectTyparsAndLocals) expr (not (isNil boundVars) && List.exists (Zset.memberOf fvs.FreeLocals) boundVars) || (not (isNil boundTyVars) && List.exists (Zset.memberOf fvs.FreeTyvars.FreeTypars) boundTyVars) || @@ -1090,7 +1090,7 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = UnknownValue // Check for escape in generic constant - | ConstValue(_,ty) when + | ConstValue(_, ty) when (not (isNil boundTyVars) && (let ftyvs = freeInType CollectTypars ty List.exists (Zset.memberOf ftyvs.FreeTypars) boundTyVars)) -> @@ -1098,13 +1098,13 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = // Otherwise check all sub-values | TupleValue vinfos -> TupleValue (Array.map (abstractExprInfo) vinfos) - | RecdValue (tcref,vinfos) -> RecdValue (tcref,Array.map (abstractExprInfo) vinfos) - | UnionCaseValue (cspec,vinfos) -> UnionCaseValue(cspec,Array.map (abstractExprInfo) vinfos) + | RecdValue (tcref, vinfos) -> RecdValue (tcref, Array.map (abstractExprInfo) vinfos) + | UnionCaseValue (cspec, vinfos) -> UnionCaseValue(cspec, Array.map (abstractExprInfo) vinfos) | CurriedLambdaValue _ | ConstValue _ | ConstExprValue _ | UnknownValue -> ivalue - | SizeValue (_vdepth,vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) + | SizeValue (_vdepth, vinfo) -> MakeSizedValueInfo (abstractExprInfo vinfo) and abstractValInfo v = { ValExprInfo=abstractExprInfo v.ValExprInfo @@ -1112,7 +1112,7 @@ let AbstractExprInfoByVars (boundVars:Val list,boundTyVars) ivalue = and abstractModulInfo ss = { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map (Lazy.force >> abstractModulInfo >> notlazy) - ValInfos = ss.ValInfos.Map (fun (vref,e) -> + ValInfos = ss.ValInfos.Map (fun (vref, e) -> check vref (abstractValInfo e) ) } abstractExprInfo ivalue @@ -1125,25 +1125,25 @@ let RemapOptimizationInfo g tmenv = let rec remapExprInfo ivalue = match ivalue with - | ValValue (v,detail) -> ValValue (remapValRef tmenv v,remapExprInfo detail) + | ValValue (v, detail) -> ValValue (remapValRef tmenv v, remapExprInfo detail) | TupleValue vinfos -> TupleValue (Array.map remapExprInfo vinfos) - | RecdValue (tcref,vinfos) -> RecdValue (remapTyconRef tmenv.tyconRefRemap tcref, Array.map remapExprInfo vinfos) - | UnionCaseValue(cspec,vinfos) -> UnionCaseValue (remapUnionCaseRef tmenv.tyconRefRemap cspec,Array.map remapExprInfo vinfos) - | SizeValue(_vdepth,vinfo) -> MakeSizedValueInfo (remapExprInfo vinfo) + | RecdValue (tcref, vinfos) -> RecdValue (remapTyconRef tmenv.tyconRefRemap tcref, Array.map remapExprInfo vinfos) + | UnionCaseValue(cspec, vinfos) -> UnionCaseValue (remapUnionCaseRef tmenv.tyconRefRemap cspec, Array.map remapExprInfo vinfos) + | SizeValue(_vdepth, vinfo) -> MakeSizedValueInfo (remapExprInfo vinfo) | UnknownValue -> UnknownValue - | CurriedLambdaValue (uniq,arity,sz,expr,typ) -> CurriedLambdaValue (uniq,arity,sz,remapExpr g CloneAll tmenv expr,remapPossibleForallTy g tmenv typ) - | ConstValue (c,ty) -> ConstValue (c,remapPossibleForallTy g tmenv ty) - | ConstExprValue (sz,expr) -> ConstExprValue (sz,remapExpr g CloneAll tmenv expr) + | CurriedLambdaValue (uniq, arity, sz, expr, typ) -> CurriedLambdaValue (uniq, arity, sz, remapExpr g CloneAll tmenv expr, remapPossibleForallTy g tmenv typ) + | ConstValue (c, ty) -> ConstValue (c, remapPossibleForallTy g tmenv ty) + | ConstExprValue (sz, expr) -> ConstExprValue (sz, remapExpr g CloneAll tmenv expr) let remapValInfo v = { ValExprInfo=remapExprInfo v.ValExprInfo; ValMakesNoCriticalTailcalls=v.ValMakesNoCriticalTailcalls } let rec remapModulInfo ss = { ModuleOrNamespaceInfos = ss.ModuleOrNamespaceInfos |> NameMap.map remapLazyModulInfo - ValInfos = ss.ValInfos.Map (fun (vref,vinfo) -> + ValInfos = ss.ValInfos.Map (fun (vref, vinfo) -> let vref' = remapValRef tmenv vref let vinfo = remapValInfo vinfo // Propagate any inferred ValMakesNoCriticalTailcalls flag from implementation to signature information if vinfo.ValMakesNoCriticalTailcalls then vref'.Deref.SetMakesNoCriticalTailcalls() - (vref',vinfo)) } + (vref', vinfo)) } and remapLazyModulInfo ss = ss |> Lazy.force |> remapModulInfo |> notlazy @@ -1154,12 +1154,12 @@ let RemapOptimizationInfo g tmenv = // Hide information when a value is no longer visible //------------------------------------------------------------------------- -let AbstractAndRemapModulInfo msg g m (repackage,hidden) info = +let AbstractAndRemapModulInfo msg g m (repackage, hidden) info = let mrpi = mkRepackageRemapping repackage #if DEBUG if verboseOptimizationInfo then dprintf "%s - %a - Optimization data prior to trim: \n%s\n" msg outputRange m (Layout.showL (Layout.squashTo 192 (moduleInfoL g info))) #else - ignore (msg,m) + ignore (msg, m) #endif let info = info |> AbstractLazyModulInfoByHiding false hidden #if DEBUG @@ -1182,27 +1182,27 @@ let [] suffixForVariablesThatMayNotBeEliminated = "$cont" /// let x<'a> = printfn "hello"; typeof<'a> /// In this case do not treat them as constants. let IsTyFuncValRefExpr = function - | Expr.Val (fv,_,_) -> fv.IsTypeFunction + | Expr.Val (fv, _, _) -> fv.IsTypeFunction | _ -> false /// Type applications of existing functions are always simple constants, with the exception of F# 'type functions' /// REVIEW: we could also include any under-applied application here. let rec IsSmallConstExpr x = match x with - | Expr.Val (v,_,_m) -> not v.IsMutable - | Expr.App(fe,_,_tyargs,args,_) -> isNil args && not (IsTyFuncValRefExpr fe) && IsSmallConstExpr fe + | Expr.Val (v, _, _m) -> not v.IsMutable + | Expr.App(fe, _, _tyargs, args, _) -> isNil args && not (IsTyFuncValRefExpr fe) && IsSmallConstExpr fe | _ -> false let ValueOfExpr expr = if IsSmallConstExpr expr then - ConstExprValue(0,expr) + ConstExprValue(0, expr) else UnknownValue //------------------------------------------------------------------------- // Dead binding elimination //------------------------------------------------------------------------- -let ValueIsUsedOrHasEffect cenv fvs (b:Binding,binfo) = +let ValueIsUsedOrHasEffect cenv fvs (b:Binding, binfo) = let v = b.Var not (cenv.settings.EliminateUnusedBindings()) || Option.isSome v.MemberInfo || @@ -1241,16 +1241,16 @@ let IlAssemblyCodeHasEffect instrs = List.exists IlAssemblyCodeInstrHasEffect in let rec ExprHasEffect g expr = match expr with - | Expr.Val (vref,_,_) -> vref.IsTypeFunction || (vref.IsMutable) + | Expr.Val (vref, _, _) -> vref.IsTypeFunction || (vref.IsMutable) | Expr.Quote _ | Expr.Lambda _ | Expr.TyLambda _ | Expr.Const _ -> false /// type applications do not have effects, with the exception of type functions - | Expr.App(f0,_,_,[],_) -> (IsTyFuncValRefExpr f0) || ExprHasEffect g f0 - | Expr.Op(op,_,args,_) -> ExprsHaveEffect g args || OpHasEffect g op - | Expr.LetRec(binds,body,_,_) -> BindingsHaveEffect g binds || ExprHasEffect g body - | Expr.Let(bind,body,_,_) -> BindingHasEffect g bind || ExprHasEffect g body + | Expr.App(f0, _, _, [], _) -> (IsTyFuncValRefExpr f0) || ExprHasEffect g f0 + | Expr.Op(op, _, args, _) -> ExprsHaveEffect g args || OpHasEffect g op + | Expr.LetRec(binds, body, _, _) -> BindingsHaveEffect g binds || ExprHasEffect g body + | Expr.Let(bind, body, _, _) -> BindingHasEffect g bind || ExprHasEffect g body // REVIEW: could add Expr.Obj on an interface type - these are similar to records of lambda expressions | _ -> true and ExprsHaveEffect g exprs = List.exists (ExprHasEffect g) exprs @@ -1259,7 +1259,7 @@ and BindingHasEffect g bind = bind.Expr |> ExprHasEffect g and OpHasEffect g op = match op with | TOp.Tuple _ -> false - | TOp.Recd (ctor,tcref) -> + | TOp.Recd (ctor, tcref) -> match ctor with | RecdExprIsObjInit -> true | RecdExpr -> isRecdOrUnionOrStructTyconRefAllocObservable g tcref @@ -1268,15 +1268,15 @@ and OpHasEffect g op = | TOp.Bytes _ | TOp.UInt16s _ | TOp.Array -> true (* alloc observable *) | TOp.UnionCaseTagGet _ -> false | TOp.UnionCaseProof _ -> false - | TOp.UnionCaseFieldGet (ucref,n) -> isUnionCaseFieldMutable g ucref n - | TOp.ILAsm(instrs,_) -> IlAssemblyCodeHasEffect instrs + | TOp.UnionCaseFieldGet (ucref, n) -> isUnionCaseFieldMutable g ucref n + | TOp.ILAsm(instrs, _) -> IlAssemblyCodeHasEffect instrs | TOp.TupleFieldGet(_) -> false - | TOp.ExnFieldGet(ecref,n) -> isExnFieldMutable ecref n + | TOp.ExnFieldGet(ecref, n) -> isExnFieldMutable ecref n | TOp.RefAddrGet -> false | TOp.ValFieldGet rfref -> rfref.RecdField.IsMutable || (TryFindTyconRefBoolAttribute g Range.range0 g.attrib_AllowNullLiteralAttribute rfref.TyconRef = Some(true)) | TOp.ValFieldGetAddr rfref -> rfref.RecdField.IsMutable (* data is immutable, so taking address is ok *) | TOp.UnionCaseFieldGetAddr _ -> false (* data is immutable, so taking address is ok *) - | TOp.LValueOp (LGetAddr,lv) -> lv.IsMutable + | TOp.LValueOp (LGetAddr, lv) -> lv.IsMutable | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ | TOp.Coerce @@ -1294,7 +1294,7 @@ and OpHasEffect g op = | TOp.ValFieldSet _ -> true -let TryEliminateBinding cenv _env (TBind(vspec1,e1,spBind)) e2 _m = +let TryEliminateBinding cenv _env (TBind(vspec1, e1, spBind)) e2 _m = // don't eliminate bindings if we're not optimizing AND the binding is not a compiler generated variable if not (cenv.optimizing && cenv.settings.EliminateImmediatelyConsumedLocals()) && not vspec1.IsCompilerGenerated then @@ -1315,54 +1315,54 @@ let TryEliminateBinding cenv _env (TBind(vspec1,e1,spBind)) e2 _m = // Immediate consumption of value as 2nd or subsequent argument to a construction or projection operation let rec GetImmediateUseContext rargsl argsr = match argsr with - | (Expr.Val(VRefLocal vspec2,_,_)) :: argsr2 - when valEq vspec1 vspec2 && IsUniqueUse vspec2 (List.rev rargsl@argsr2) -> Some(List.rev rargsl,argsr2) + | (Expr.Val(VRefLocal vspec2, _, _)) :: argsr2 + when valEq vspec1 vspec2 && IsUniqueUse vspec2 (List.rev rargsl@argsr2) -> Some(List.rev rargsl, argsr2) | argsrh :: argsrt when not (ExprHasEffect cenv.g argsrh) -> GetImmediateUseContext (argsrh::rargsl) argsrt | _ -> None match stripExpr e2 with // Immediate consumption of value as itself 'let x = e in x' - | Expr.Val(VRefLocal vspec2,_,_) + | Expr.Val(VRefLocal vspec2, _, _) when IsUniqueUse vspec2 [] -> Some e1 // Immediate consumption of value by a pattern match 'let x = e in match x with ...' - | Expr.Match(spMatch,_exprm,TDSwitch(Expr.Val(VRefLocal vspec2,_,_),cases,dflt,_),targets,m,ty2) + | Expr.Match(spMatch, _exprm, TDSwitch(Expr.Val(VRefLocal vspec2, _, _), cases, dflt, _), targets, m, ty2) when (valEq vspec1 vspec2 && let fvs = accFreeInTargets CollectLocals targets (accFreeInSwitchCases CollectLocals cases dflt emptyFreeVars) not (Zset.contains vspec1 fvs.FreeLocals)) -> let spMatch = spBind.Combine(spMatch) - Some (Expr.Match(spMatch,e1.Range,TDSwitch(e1,cases,dflt,m),targets,m,ty2)) + Some (Expr.Match(spMatch, e1.Range, TDSwitch(e1, cases, dflt, m), targets, m, ty2)) // Immediate consumption of value as a function 'let f = e in f ...' and 'let x = e in f ... x ...' // Note functions are evaluated before args // Note: do not include functions with a single arg of unit type, introduced by abstractBigTargets - | Expr.App(f,f0ty,tyargs,args,m) + | Expr.App(f, f0ty, tyargs, args, m) when not (vspec1.LogicalName.Contains(suffixForVariablesThatMayNotBeEliminated)) -> match GetImmediateUseContext [] (f::args) with - | Some([],rargs) -> Some (MakeApplicationAndBetaReduce cenv.g (e1,f0ty,[tyargs],rargs ,m)) - | Some(f::largs,rargs) -> Some (MakeApplicationAndBetaReduce cenv.g (f,f0ty,[tyargs],largs @ (e1::rargs),m)) + | Some([], rargs) -> Some (MakeApplicationAndBetaReduce cenv.g (e1, f0ty, [tyargs], rargs , m)) + | Some(f::largs, rargs) -> Some (MakeApplicationAndBetaReduce cenv.g (f, f0ty, [tyargs], largs @ (e1::rargs), m)) | None -> None // Bug 6311: a special case of nested elimination of locals (which really should be handled more generally) // 'let x = e in op[op[x;arg2];arg3]' --> op[op[e;arg2];arg3] // 'let x = e in op[op[arg1;x];arg3]' --> op[op[arg1;e];arg3] when arg1 has no side effects etc. // 'let x = e in op[op[arg1;arg2];x]' --> op[op[arg1;arg2];e] when arg1, arg2 have no side effects etc. - | Expr.Op (c1,tyargs1,[Expr.Op (c2,tyargs2,[arg1;arg2],m2);arg3],m1) -> + | Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;arg2], m2);arg3], m1) -> match GetImmediateUseContext [] [arg1;arg2;arg3] with - | Some([],[arg2;arg3]) -> Some (Expr.Op (c1,tyargs1,[Expr.Op (c2,tyargs2,[e1;arg2],m2);arg3],m1)) - | Some([arg1],[arg3]) -> Some (Expr.Op (c1,tyargs1,[Expr.Op (c2,tyargs2,[arg1;e1],m2);arg3],m1)) - | Some([arg1;arg2],[]) -> Some (Expr.Op (c1,tyargs1,[Expr.Op (c2,tyargs2,[arg1;arg2],m2);e1],m1)) - | Some _ -> error(InternalError("unexpected return pattern from GetImmediateUseContext",m1)) + | Some([], [arg2;arg3]) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [e1;arg2], m2);arg3], m1)) + | Some([arg1], [arg3]) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;e1], m2);arg3], m1)) + | Some([arg1;arg2], []) -> Some (Expr.Op (c1, tyargs1, [Expr.Op (c2, tyargs2, [arg1;arg2], m2);e1], m1)) + | Some _ -> error(InternalError("unexpected return pattern from GetImmediateUseContext", m1)) | None -> None // Immediate consumption of value as first non-effectful argument to a construction or projection operation // 'let x = e in op[x;....]' - | Expr.Op (c,tyargs,args,m) -> + | Expr.Op (c, tyargs, args, m) -> match GetImmediateUseContext [] args with - | Some(largs,rargs) -> Some (Expr.Op (c,tyargs,(largs @ (e1:: rargs)),m)) + | Some(largs, rargs) -> Some (Expr.Op (c, tyargs, (largs @ (e1:: rargs)), m)) | None -> None | _ -> @@ -1370,16 +1370,16 @@ let TryEliminateBinding cenv _env (TBind(vspec1,e1,spBind)) e2 _m = let TryEliminateLet cenv env bind e2 m = match TryEliminateBinding cenv env bind e2 m with - | Some e2' -> e2',-localVarSize (* eliminated a let, hence reduce size estimate *) - | None -> mkLetBind m bind e2 ,0 + | Some e2' -> e2', -localVarSize (* eliminated a let, hence reduce size estimate *) + | None -> mkLetBind m bind e2 , 0 //------------------------------------------------------------------------- /// Detect the application of a value to an arbitrary number of arguments let rec (|KnownValApp|_|) expr = match stripExpr expr with - | Expr.Val(vref,_,_) -> Some(vref,[],[]) - | Expr.App(KnownValApp(vref,typeArgs1,otherArgs1),_,typeArgs2,otherArgs2,_) -> Some(vref,typeArgs1@typeArgs2,otherArgs1@otherArgs2) + | Expr.Val(vref, _, _) -> Some(vref, [], []) + | Expr.App(KnownValApp(vref, typeArgs1, otherArgs1), _, typeArgs2, otherArgs2, _) -> Some(vref, typeArgs1@typeArgs2, otherArgs1@otherArgs2) | _ -> None //------------------------------------------------------------------------- @@ -1400,7 +1400,7 @@ let CanExpandStructuralBinding (v: Val) = let ExprIsValue = function Expr.Val _ -> true | _ -> false let ExpandStructuralBindingRaw cenv expr = match expr with - | Expr.Let (TBind(v,rhs,tgtSeqPtOpt),body,m,_) + | Expr.Let (TBind(v, rhs, tgtSeqPtOpt), body, m, _) when (isRefTupleExpr rhs && CanExpandStructuralBinding v) -> let args = tryDestRefTupleExpr rhs @@ -1410,35 +1410,35 @@ let ExpandStructuralBindingRaw cenv expr = let argTys = destRefTupleTy cenv.g v.Type let argBind i (arg:Expr) argTy = let name = v.LogicalName + "_" + string i - let v,ve = mkCompGenLocal arg.Range name argTy - ve,mkCompGenBind v arg + let v, ve = mkCompGenLocal arg.Range name argTy + ve, mkCompGenBind v arg - let ves,binds = List.mapi2 argBind args argTys |> List.unzip + let ves, binds = List.mapi2 argBind args argTys |> List.unzip let tuple = mkRefTupled cenv.g m ves argTys mkLetsBind m binds (mkLet tgtSeqPtOpt m v tuple body) (* REVIEW: other cases - records, explicit lists etc. *) | expr -> expr // Moves outer tuple binding inside near the tupled expression: -// let t = (let a0=v0 in let a1=v1 in ... in let an=vn in e0,e1,...,em) in body -// let a0=v0 in let a1=v1 in ... in let an=vn in (let t = e0,e1,...,em in body) +// let t = (let a0=v0 in let a1=v1 in ... in let an=vn in e0, e1, ..., em) in body +// let a0=v0 in let a1=v1 in ... in let an=vn in (let t = e0, e1, ..., em in body) // This way ExpandStructuralBinding can replace expressions in constants, t is directly bound -// to a tuple expression so that other optimizations such as OptimizeTupleFieldGet work, +// to a tuple expression so that other optimizations such as OptimizeTupleFieldGet work, // and the tuple allocation can be eliminated. // Most importantly, this successfully eliminates tuple allocations for implicitly returned // formal arguments in method calls. let rec RearrangeTupleBindings expr fin = match expr with - | Expr.Let (bind,body,m,_) -> + | Expr.Let (bind, body, m, _) -> match RearrangeTupleBindings body fin with | Some b -> Some (mkLetBind m bind b) | None -> None - | Expr.Op (TOp.Tuple tupInfo,_,_,_) when not (evalTupInfoIsStruct tupInfo) -> Some (fin expr) + | Expr.Op (TOp.Tuple tupInfo, _, _, _) when not (evalTupInfoIsStruct tupInfo) -> Some (fin expr) | _ -> None let ExpandStructuralBinding cenv expr = match expr with - | Expr.Let (TBind(v,rhs,tgtSeqPtOpt),body,m,_) + | Expr.Let (TBind(v, rhs, tgtSeqPtOpt), body, m, _) when (isRefTupleTy cenv.g v.Type && not (isRefTupleExpr rhs) && CanExpandStructuralBinding v) -> @@ -1458,9 +1458,9 @@ let (|QueryRun|_|) g expr = // g.query_run_enumerable_vref.Deref |> ignore //#endif match expr with - | Expr.App(Expr.Val (vref,_,_),_,_,[_builder; arg],_) when valRefEq g vref g.query_run_value_vref -> + | Expr.App(Expr.Val (vref, _, _), _, _, [_builder; arg], _) when valRefEq g vref g.query_run_value_vref -> Some (arg, None) - | Expr.App(Expr.Val (vref,_,_),_,[ elemTy ] ,[_builder; arg],_) when valRefEq g vref g.query_run_enumerable_vref -> + | Expr.App(Expr.Val (vref, _, _), _, [ elemTy ] , [_builder; arg], _) when valRefEq g vref g.query_run_enumerable_vref -> Some (arg, Some elemTy) | _ -> None @@ -1468,7 +1468,7 @@ let (|QueryRun|_|) g expr = 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) + | Expr.App(Expr.Val (vref, _, _), _, tyargs, [obj; MaybeRefTupled args], _) -> Some (vref, tyargs, obj, args) | _ -> None let (|InstanceMethodApp|_|) g (expectedValRef:ValRef) e = @@ -1477,50 +1477,50 @@ let (|InstanceMethodApp|_|) g (expectedValRef:ValRef) e = //#endif //printfn "for vref = %A" (expectedValRef.TryDeref |> Option.map (fun x -> x.DisplayName)) match e with - | AnyInstanceMethodApp (vref,tyargs,obj,args) when valRefEq g vref expectedValRef -> Some (tyargs,obj,args) + | AnyInstanceMethodApp (vref, tyargs, obj, args) when valRefEq g vref expectedValRef -> Some (tyargs, obj, args) | _ -> None let (|QuerySourceEnumerable|_|) g = function - | InstanceMethodApp g g.query_source_vref ([resTy],_builder, [res]) -> Some (resTy,res) + | InstanceMethodApp g g.query_source_vref ([resTy], _builder, [res]) -> Some (resTy, res) | _ -> None let (|QueryFor|_|) g = function - | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy],_builder, [src;selector]) -> Some (qTy,srcTy,resTy,src,selector) + | InstanceMethodApp g g.query_for_vref ([srcTy;qTy;resTy;_qInnerTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) | _ -> None let (|QueryYield|_|) g = function - | InstanceMethodApp g g.query_yield_vref ([resTy;qTy],_builder, [res]) -> Some (qTy,resTy,res) + | InstanceMethodApp g g.query_yield_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) | _ -> None let (|QueryYieldFrom|_|) g = function - | InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy],_builder, [res]) -> Some (qTy,resTy,res) + | InstanceMethodApp g g.query_yield_from_vref ([resTy;qTy], _builder, [res]) -> Some (qTy, resTy, res) | _ -> None let (|QuerySelect|_|) g = function - | InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy],_builder, [src;selector]) -> Some (qTy,srcTy,resTy,src,selector) + | InstanceMethodApp g g.query_select_vref ([srcTy;qTy;resTy], _builder, [src;selector]) -> Some (qTy, srcTy, resTy, src, selector) | _ -> None let (|QueryZero|_|) g = function - | InstanceMethodApp g g.query_zero_vref ([resTy;qTy],_builder, _) -> Some (qTy, resTy) + | InstanceMethodApp g g.query_zero_vref ([resTy;qTy], _builder, _) -> Some (qTy, resTy) | _ -> None /// Look for a possible tuple and transform let (|AnyRefTupleTrans|) e = match e with - | Expr.Op (TOp.Tuple tupInfo,tys,es,m) when not (evalTupInfoIsStruct tupInfo) -> (es, (fun es -> Expr.Op (TOp.Tuple tupInfo,tys,es,m))) + | Expr.Op (TOp.Tuple tupInfo, tys, es, m) when not (evalTupInfoIsStruct tupInfo) -> (es, (fun es -> Expr.Op (TOp.Tuple tupInfo, tys, es, m))) | _ -> [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.ApparentParent 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))) + Some (src, (fun newSource -> Expr.App(v, vty, tyargs, [builder; replaceArgs(newSource::rest)], m))) | _ -> None let mkUnitDelayLambda (g: TcGlobals) m e = - let uv,_ = mkCompGenLocal m "unitVar" g.unit_ty - mkLambda m uv (e,tyOfExpr g e) + let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty + mkLambda m uv (e, tyOfExpr g e) // := @@ -1561,7 +1561,7 @@ let rec tryRewriteToSeqCombinators g (e: Expr) = Some (mkCallSeqEmpty g m sourceElemTy) // query.For --> Seq.collect - | QueryFor g (_qTy, sourceElemTy, resultElemTy, QuerySourceEnumerable g (_, source), Expr.Lambda(_,_,_,[resultSelectorVar],resultSelector,mLambda,_)) -> + | QueryFor g (_qTy, sourceElemTy, resultElemTy, QuerySourceEnumerable g (_, source), Expr.Lambda(_, _, _, [resultSelectorVar], resultSelector, mLambda, _)) -> match tryRewriteToSeqCombinators g resultSelector with | Some newResultSelector -> Some (mkCallSeqCollect g m sourceElemTy resultElemTy (mkLambda mLambda resultSelectorVar (newResultSelector, tyOfExpr g newResultSelector)) source) @@ -1569,19 +1569,19 @@ let rec tryRewriteToSeqCombinators g (e: Expr) = // let --> let - | Expr.Let(bind,bodyExpr,m,_) -> + | Expr.Let(bind, bodyExpr, m, _) -> match tryRewriteToSeqCombinators g bodyExpr with | Some newBodyExpr -> - Some (Expr.Let(bind,newBodyExpr,m,newCache())) + Some (Expr.Let(bind, newBodyExpr, m, newCache())) | None -> None // match --> match - | Expr.Match (spBind,exprm,pt,targets,m,_ty) -> - let targets = targets |> Array.map (fun (TTarget(vs,e,spTarget)) -> match tryRewriteToSeqCombinators g e with None -> None | Some e -> Some(TTarget(vs,e,spTarget))) + | Expr.Match (spBind, exprm, pt, targets, m, _ty) -> + let targets = targets |> Array.map (fun (TTarget(vs, e, spTarget)) -> match tryRewriteToSeqCombinators g e with None -> None | Some e -> Some(TTarget(vs, e, spTarget))) if targets |> Array.forall Option.isSome then let targets = targets |> Array.map Option.get - let ty = targets |> Array.pick (fun (TTarget(_,e,_)) -> Some(tyOfExpr g e)) - Some (Expr.Match (spBind,exprm,pt,targets,m,ty)) + let ty = targets |> Array.pick (fun (TTarget(_, e, _)) -> Some(tyOfExpr g e)) + Some (Expr.Match (spBind, exprm, pt, targets, m, ty)) else None @@ -1602,7 +1602,7 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) = | QueryRun g (bodyOfRun, reqdResultInfo) -> //printfn "found Query.Run" match bodyOfRun with - | Expr.Quote(quotedExpr,_,true,_,_) -> // true = isFromQueryExpression + | Expr.Quote(quotedExpr, _, true, _, _) -> // true = isFromQueryExpression // This traverses uses of query operators like query.Where and query.AverageBy until we're left with something familiar. @@ -1614,10 +1614,10 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) = let rec loopOuter (e:Expr) = match e with - | QueryFor g (qTy,_,resultElemTy,_,_) - | QuerySelect g (qTy,_,resultElemTy,_,_) - | QueryYield g (qTy,resultElemTy,_) - | QueryYieldFrom g (qTy,resultElemTy,_) + | QueryFor g (qTy, _, resultElemTy, _, _) + | QuerySelect g (qTy, _, resultElemTy, _, _) + | QueryYield g (qTy, resultElemTy, _) + | QueryYieldFrom g (qTy, resultElemTy, _) when typeEquiv cenv.g qTy (mkAppTy cenv.g.tcref_System_Collections_IEnumerable []) -> match tryRewriteToSeqCombinators cenv.g e with @@ -1629,12 +1629,12 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) = //printfn "Not compiling to state machines, but still optimizing the use of quotations away" Some (e, None) - | AnyQueryBuilderOpTrans g (seqSource,replace) -> + | AnyQueryBuilderOpTrans g (seqSource, replace) -> match loopOuter seqSource with | Some (newSeqSource, newSeqSourceIsEnumerableInfo) -> let newSeqSourceAsQuerySource = match newSeqSourceIsEnumerableInfo with - | Some (resultElemTy,qTy) -> mkCallNewQuerySource cenv.g newSeqSource.Range resultElemTy qTy newSeqSource + | Some (resultElemTy, qTy) -> mkCallNewQuerySource cenv.g newSeqSource.Range resultElemTy qTy newSeqSource | None -> newSeqSource Some (replace newSeqSourceAsQuerySource, None) | None -> None @@ -1649,7 +1649,7 @@ let TryDetectQueryQuoteAndRun cenv (expr:Expr) = let resultExprAfterConvertToResultTy = match reqdResultInfo, exprIsEnumerableInfo with | Some _, Some _ | None, None -> resultExpr // the expression is a QuerySource, the result is a QuerySource, nothing to do - | Some resultElemTy, None -> mkCallGetQuerySourceAsEnumerable cenv.g expr.Range resultElemTy (TType_app(cenv.g.tcref_System_Collections_IEnumerable,[])) resultExpr + | Some resultElemTy, None -> mkCallGetQuerySourceAsEnumerable cenv.g expr.Range resultElemTy (TType_app(cenv.g.tcref_System_Collections_IEnumerable, [])) resultExpr | None, Some (resultElemTy, qTy) -> mkCallNewQuerySource cenv.g expr.Range resultElemTy qTy resultExpr Some resultExprAfterConvertToResultTy | None -> @@ -1681,39 +1681,39 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = // treat the common linear cases to avoid stack overflows, using an explicit continuation | Expr.Sequential _ | Expr.Let _ -> OptimizeLinearExpr cenv env expr (fun x -> x) - | Expr.Const (c,m,ty) -> OptimizeConst cenv env expr (c,m,ty) - | Expr.Val (v,_vFlags,m) -> OptimizeVal cenv env expr (v,m) - | Expr.Quote(ast,splices,isFromQueryExpression,m,ty) -> + | Expr.Const (c, m, ty) -> OptimizeConst cenv env expr (c, m, ty) + | Expr.Val (v, _vFlags, m) -> OptimizeVal cenv env expr (v, m) + | Expr.Quote(ast, splices, isFromQueryExpression, m, ty) -> let splices = ref (splices.Value |> Option.map (map3Of4 (List.map (OptimizeExpr cenv env >> fst)))) - Expr.Quote(ast,splices,isFromQueryExpression,m,ty), + Expr.Quote(ast, splices, isFromQueryExpression, m, ty), { TotalSize = 10 FunctionSize = 1 HasEffect = false MightMakeCriticalTailcall=false Info=UnknownValue } - | Expr.Obj (_,typ,basev,expr,overrides,iimpls,m) -> OptimizeObjectExpr cenv env (typ,basev,expr,overrides,iimpls,m) - | Expr.Op (c,tyargs,args,m) -> OptimizeExprOp cenv env (c,tyargs,args,m) - | Expr.App(f,fty,tyargs,argsl,m) -> + | Expr.Obj (_, typ, basev, expr, overrides, iimpls, m) -> OptimizeObjectExpr cenv env (typ, basev, expr, overrides, iimpls, m) + | Expr.Op (c, tyargs, args, m) -> OptimizeExprOp cenv env (c, tyargs, args, m) + | Expr.App(f, fty, tyargs, argsl, m) -> // eliminate uses of query match TryDetectQueryQuoteAndRun cenv expr with | Some newExpr -> OptimizeExpr cenv env newExpr - | None -> OptimizeApplication cenv env (f,fty,tyargs,argsl,m) + | None -> OptimizeApplication cenv env (f, fty, tyargs, argsl, m) (* REVIEW: fold the next two cases together *) - | Expr.Lambda(_lambdaId,_,_,argvs,_body,m,rty) -> - let topValInfo = ValReprInfo ([],[argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal) + | Expr.Lambda(_lambdaId, _, _, argvs, _body, m, rty) -> + let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal) let ty = mkMultiLambdaTy m argvs rty OptimizeLambdas None cenv env topValInfo expr ty - | Expr.TyLambda(_lambdaId,tps,_body,_m,rty) -> - let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) + | Expr.TyLambda(_lambdaId, tps, _body, _m, rty) -> + let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) let ty = tryMkForallTy tps rty OptimizeLambdas None cenv env topValInfo expr ty | Expr.TyChoose _ -> OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) - | Expr.Match(spMatch,exprm,dtree,targets,m,ty) -> OptimizeMatch cenv env (spMatch,exprm,dtree,targets,m,ty) - | Expr.LetRec (binds,e,m,_) -> OptimizeLetRec cenv env (binds,e,m) - | Expr.StaticOptimization (constraints,e2,e3,m) -> - let e2',e2info = OptimizeExpr cenv env e2 - let e3',e3info = OptimizeExpr cenv env e3 - Expr.StaticOptimization(constraints,e2',e3',m), + | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) + | Expr.LetRec (binds, e, m, _) -> OptimizeLetRec cenv env (binds, e, m) + | Expr.StaticOptimization (constraints, e2, e3, m) -> + let e2', e2info = OptimizeExpr cenv env e2 + let e3', e3info = OptimizeExpr cenv env e3 + Expr.StaticOptimization(constraints, e2', e3', m), { TotalSize = min e2info.TotalSize e3info.TotalSize FunctionSize = min e2info.FunctionSize e3info.FunctionSize HasEffect = e2info.HasEffect || e3info.HasEffect @@ -1728,11 +1728,11 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr = // Optimize/analyze an object expression //------------------------------------------------------------------------- -and OptimizeObjectExpr cenv env (typ,baseValOpt,basecall,overrides,iimpls,m) = - let basecall',basecallinfo = OptimizeExpr cenv env basecall - let overrides',overrideinfos = OptimizeMethods cenv env baseValOpt overrides - let iimpls',iimplsinfos = OptimizeInterfaceImpls cenv env baseValOpt iimpls - let expr'=mkObjExpr(typ,baseValOpt,basecall',overrides',iimpls',m) +and OptimizeObjectExpr cenv env (typ, baseValOpt, basecall, overrides, iimpls, m) = + let basecall', basecallinfo = OptimizeExpr cenv env basecall + let overrides', overrideinfos = OptimizeMethods cenv env baseValOpt overrides + let iimpls', iimplsinfos = OptimizeInterfaceImpls cenv env baseValOpt iimpls + let expr'=mkObjExpr(typ, baseValOpt, basecall', overrides', iimpls', m) expr', { TotalSize=closureTotalSize + basecallinfo.TotalSize + AddTotalSizes overrideinfos + AddTotalSizes iimplsinfos FunctionSize=1 (* a newobj *) HasEffect=true @@ -1749,9 +1749,9 @@ and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs let env = BindTypeVarsToUnknown tps env let env = BindInternalValsToUnknown cenv vs env let env = Option.foldBack (BindInternalValToUnknown cenv) baseValOpt env - let e',einfo = OptimizeExpr cenv env e + let e', einfo = OptimizeExpr cenv env e (* REVIEW: if we ever change this from being UnknownValue then we should call AbstractExprInfoByVars *) - TObjExprMethod(slotsig,attribs,tps,vs,e',m), + TObjExprMethod(slotsig, attribs, tps, vs, e', m), { TotalSize = einfo.TotalSize FunctionSize = 0 HasEffect = false @@ -1763,8 +1763,8 @@ and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs //------------------------------------------------------------------------- and OptimizeInterfaceImpls cenv env baseValOpt l = OptimizeList (OptimizeInterfaceImpl cenv env baseValOpt) l -and OptimizeInterfaceImpl cenv env baseValOpt (ty,overrides) = - let overrides',overridesinfos = OptimizeMethods cenv env baseValOpt overrides +and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) = + let overrides', overridesinfos = OptimizeMethods cenv env baseValOpt overrides (ty, overrides'), { TotalSize = AddTotalSizes overridesinfos FunctionSize = 1 @@ -1776,105 +1776,105 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty,overrides) = // Optimize/analyze an application of an intrinsic operator to arguments //------------------------------------------------------------------------- -and OptimizeExprOp cenv env (op,tyargs,args,m) = +and OptimizeExprOp cenv env (op, tyargs, args, m) = (* Special cases *) - match op,tyargs,args with - | TOp.Coerce,[toty;fromty],[e] -> - let e',einfo = OptimizeExpr cenv env e - if typeEquiv cenv.g toty fromty then e',einfo + match op, tyargs, args with + | TOp.Coerce, [toty;fromty], [e] -> + let e', einfo = OptimizeExpr cenv env e + if typeEquiv cenv.g toty fromty then e', einfo else - mkCoerceExpr(e',toty,m,fromty), + mkCoerceExpr(e', toty, m, fromty), { TotalSize=einfo.TotalSize + 1 FunctionSize=einfo.FunctionSize + 1 HasEffect = true MightMakeCriticalTailcall=false Info=UnknownValue } (* Handle addresses *) - | TOp.LValueOp (LGetAddr,lv),_,_ -> - let e,_ = OptimizeExpr cenv env (exprForValRef m lv) + | TOp.LValueOp (LGetAddr, lv), _, _ -> + let e, _ = OptimizeExpr cenv env (exprForValRef m lv) let op' = match e with // Do not optimize if it's a top level static binding. - | Expr.Val (v,_,_) when not v.IsCompiledAsTopLevel -> TOp.LValueOp (LGetAddr,v) + | Expr.Val (v, _, _) when not v.IsCompiledAsTopLevel -> TOp.LValueOp (LGetAddr, v) | _ -> op - Expr.Op (op',tyargs,args,m), + Expr.Op (op', tyargs, args, m), { TotalSize = 1 FunctionSize = 1 HasEffect = OpHasEffect cenv.g op' MightMakeCriticalTailcall = false Info = UnknownValue } (* Handle these as special cases since mutables are allowed inside their bodies *) - | TOp.While (spWhile,marker),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_)] -> OptimizeWhileLoop cenv { env with inLoop=true } (spWhile,marker,e1,e2,m) - | TOp.For(spStart,dir),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_);Expr.Lambda(_,_,_,[v],e3,_,_)] -> OptimizeFastIntegerForLoop cenv { env with inLoop=true } (spStart,v,e1,dir,e2,e3,m) - | TOp.TryFinally(spTry,spFinally),[resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> OptimizeTryFinally cenv env (spTry,spFinally,e1,e2,m,resty) - | TOp.TryCatch(spTry,spWith),[resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[vf],ef,_,_); Expr.Lambda(_,_,_,[vh],eh,_,_)] -> OptimizeTryCatch cenv env (e1,vf,ef,vh,eh,m,resty,spTry,spWith) - | TOp.TraitCall(traitInfo),[],args -> OptimizeTraitCall cenv env (traitInfo, args, m) + | TOp.While (spWhile, marker), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _)] -> OptimizeWhileLoop cenv { env with inLoop=true } (spWhile, marker, e1, e2, m) + | TOp.For(spStart, dir), _, [Expr.Lambda(_, _, _, [_], e1, _, _);Expr.Lambda(_, _, _, [_], e2, _, _);Expr.Lambda(_, _, _, [v], e3, _, _)] -> OptimizeFastIntegerForLoop cenv { env with inLoop=true } (spStart, v, e1, dir, e2, e3, m) + | TOp.TryFinally(spTry, spFinally), [resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> OptimizeTryFinally cenv env (spTry, spFinally, e1, e2, m, resty) + | TOp.TryCatch(spTry, spWith), [resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _); Expr.Lambda(_, _, _, [vh], eh, _, _)] -> OptimizeTryCatch cenv env (e1, vf, ef, vh, eh, m, resty, spTry, spWith) + | TOp.TraitCall(traitInfo), [], args -> OptimizeTraitCall cenv env (traitInfo, args, m) // This code hooks arr.Length. The idea is to ensure loops end up in the "same shape"as the forms of loops that the .NET JIT // guarantees to optimize. - | TOp.ILCall (_,_,_,_,_,_,_,mref,_enclTypeArgs,_methTypeArgs,_tys),_,[arg] + | TOp.ILCall (_, _, _, _, _, _, _, mref, _enclTypeArgs, _methTypeArgs, _tys), _, [arg] when (mref.EnclosingTypeRef.Scope.IsAssemblyRef && mref.EnclosingTypeRef.Scope.AssemblyRef.Name = cenv.g.ilg.typ_Array.TypeRef.Scope.AssemblyRef.Name && mref.EnclosingTypeRef.Name = cenv.g.ilg.typ_Array.TypeRef.Name && mref.Name = "get_Length" && isArray1DTy cenv.g (tyOfExpr cenv.g arg)) -> - OptimizeExpr cenv env (Expr.Op(TOp.ILAsm(i_ldlen,[cenv.g.int_ty]),[],[arg],m)) + OptimizeExpr cenv env (Expr.Op(TOp.ILAsm(i_ldlen, [cenv.g.int_ty]), [], [arg], m)) // Empty IL instruction lists are used as casts in prim-types.fs. But we can get rid of them // if the types match up. - | TOp.ILAsm([],[ty]),_,[a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a + | TOp.ILAsm([], [ty]), _, [a] when typeEquiv cenv.g (tyOfExpr cenv.g a) ty -> OptimizeExpr cenv env a | _ -> (* Reductions *) - let args',arginfos = OptimizeExprsThenConsiderSplits cenv env args + let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args let knownValue = - match op,arginfos with - | TOp.ValFieldGet (rf),[e1info] -> TryOptimizeRecordFieldGet cenv env (e1info,rf,tyargs,m) - | TOp.TupleFieldGet (tupInfo,n),[e1info] -> TryOptimizeTupleFieldGet cenv env (tupInfo,e1info,tyargs,n,m) - | TOp.UnionCaseFieldGet (cspec,n),[e1info] -> TryOptimizeUnionCaseGet cenv env (e1info,cspec,tyargs,n,m) + match op, arginfos with + | TOp.ValFieldGet (rf), [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) + | TOp.TupleFieldGet (tupInfo, n), [e1info] -> TryOptimizeTupleFieldGet cenv env (tupInfo, e1info, tyargs, n, m) + | TOp.UnionCaseFieldGet (cspec, n), [e1info] -> TryOptimizeUnionCaseGet cenv env (e1info, cspec, tyargs, n, m) | _ -> None match knownValue with | Some valu -> - match TryOptimizeVal cenv env (false,valu,m) with + match TryOptimizeVal cenv env (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,args',m) arginfos valu - | None -> OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos UnknownValue + | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu + | None -> OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos UnknownValue -and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = +and OptimizeExprOpFallback cenv env (op, tyargs, args', m) arginfos valu = // The generic case - we may collect information, but the construction/projection doesn't disappear let argsTSize = AddTotalSizes arginfos let argsFSize = AddFunctionSizes arginfos let argEffects = OrEffects arginfos let argValues = List.map (fun x -> x.Info) arginfos let effect = OpHasEffect cenv.g op - let cost,valu = + let cost, valu = match op with - | TOp.UnionCase c -> 2,MakeValueInfoForUnionCase c (Array.ofList argValues) - | TOp.ExnConstr _ -> 2,valu (* REVIEW: information collection possible here *) + | TOp.UnionCase c -> 2, MakeValueInfoForUnionCase c (Array.ofList argValues) + | TOp.ExnConstr _ -> 2, valu (* REVIEW: information collection possible here *) | TOp.Tuple tupInfo -> let isStruct = evalTupInfoIsStruct tupInfo - if isStruct then 0,valu - else 1,MakeValueInfoForTuple (Array.ofList argValues) + if isStruct then 0, valu + else 1, MakeValueInfoForTuple (Array.ofList argValues) | TOp.ValFieldGet _ | TOp.TupleFieldGet _ | TOp.UnionCaseFieldGet _ | TOp.ExnFieldGet _ | TOp.UnionCaseTagGet _ -> // REVIEW: reduction possible here, and may be very effective - 1,valu + 1, valu | TOp.UnionCaseProof _ -> // We count the proof as size 0 // We maintain the value of the source of the proof-cast if it is known to be a UnionCaseValue let valu = match argValues.[0] with - | StripUnionCaseValue (uc,info) -> UnionCaseValue(uc,info) + | StripUnionCaseValue (uc, info) -> UnionCaseValue(uc, info) | _ -> valu - 0,valu - | TOp.ILAsm(instrs,tys) -> + 0, valu + | TOp.ILAsm(instrs, tys) -> min instrs.Length 1, mkAssemblyCodeValueInfo cenv.g instrs argValues tys | TOp.Bytes bytes -> bytes.Length/10 , valu @@ -1884,8 +1884,8 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = | TOp.ILCall _ | TOp.TraitCall _ | TOp.LValueOp _ | TOp.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.RefAddrGet | TOp.Coerce | TOp.Reraise | TOp.UnionCaseFieldGetAddr _ - | TOp.ExnFieldSet _ -> 1,valu - | TOp.Recd (ctorInfo,tcref) -> + | TOp.ExnFieldSet _ -> 1, valu + | TOp.Recd (ctorInfo, tcref) -> let finfos = tcref.AllInstanceFieldsAsList // REVIEW: this seems a little conservative: Allocating a record with a mutable field // is not an effect - only reading or writing the field is. @@ -1894,14 +1894,14 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = | RecdExprIsObjInit -> UnknownValue | RecdExpr -> if argValues.Length <> finfos.Length then valu - else MakeValueInfoForRecord tcref (Array.ofList ((argValues,finfos) ||> List.map2 (fun x f -> if f.IsMutable then UnknownValue else x) )) - 2,valu - | TOp.Goto _ | TOp.Label _ | TOp.Return -> assert false; error(InternalError("unexpected goto/label/return in optimization",m)) + else MakeValueInfoForRecord tcref (Array.ofList ((argValues, finfos) ||> List.map2 (fun x f -> if f.IsMutable then UnknownValue else x) )) + 2, valu + | TOp.Goto _ | TOp.Label _ | TOp.Return -> assert false; error(InternalError("unexpected goto/label/return in optimization", m)) // Indirect calls to IL code are always taken as tailcalls let mayBeCriticalTailcall = match op with - | TOp.ILCall (virt,_,newobj,_,_,_,_,_,_,_,_) -> not newobj && virt + | TOp.ILCall (virt, _, newobj, _, _, _, _, _, _, _, _) -> not newobj && virt | _ -> false let vinfo = { TotalSize=argsTSize + cost @@ -1912,9 +1912,9 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = // Replace entire expression with known value? match TryOptimizeValInfo cenv env m vinfo with - | Some res -> res,vinfo + | Some res -> res, vinfo | None -> - Expr.Op(op,tyargs,args',m), + Expr.Op(op, tyargs, args', m), { TotalSize=argsTSize + cost FunctionSize=argsFSize + cost HasEffect=argEffects || effect @@ -1925,7 +1925,7 @@ and OptimizeExprOpFallback cenv env (op,tyargs,args',m) arginfos valu = // Optimize/analyze a constant node //------------------------------------------------------------------------- -and OptimizeConst cenv env expr (c,m,ty) = +and OptimizeConst cenv env expr (c, m, ty) = match TryEliminateDesugaredConstants cenv.g m c with | Some(e) -> OptimizeExpr cenv env e @@ -1942,30 +1942,30 @@ and OptimizeConst cenv env expr (c,m,ty) = // Optimize/analyze a record lookup. //------------------------------------------------------------------------- -and TryOptimizeRecordFieldGet cenv _env (e1info, (RFRef (rtcref,_) as r),_tinst,m) = +and TryOptimizeRecordFieldGet cenv _env (e1info, (RFRef (rtcref, _) as r), _tinst, m) = match destRecdValue e1info.Info with | Some finfos when cenv.settings.EliminateRecdFieldGet() && not e1info.HasEffect -> match TryFindFSharpAttribute cenv.g cenv.g.attrib_CLIMutableAttribute rtcref.Attribs with | Some _ -> None | None -> let n = r.Index - if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range",m)) + if n >= finfos.Length then errorR(InternalError( "TryOptimizeRecordFieldGet: term argument out of range", m)) Some finfos.[n] (* Uses INVARIANT on record ValInfos that exprs are in defn order *) | _ -> None -and TryOptimizeTupleFieldGet cenv _env (_tupInfo,e1info,tys,n,m) = +and TryOptimizeTupleFieldGet cenv _env (_tupInfo, e1info, tys, n, m) = match destTupleValue e1info.Info with | Some tups when cenv.settings.EliminateTupleFieldGet() && not e1info.HasEffect -> let len = tups.Length - if len <> tys.Length then errorR(InternalError("error: tuple lengths don't match",m)) - if n >= len then errorR(InternalError("TryOptimizeTupleFieldGet: tuple index out of range",m)) + if len <> tys.Length then errorR(InternalError("error: tuple lengths don't match", m)) + if n >= len then errorR(InternalError("TryOptimizeTupleFieldGet: tuple index out of range", m)) Some tups.[n] | _ -> None -and TryOptimizeUnionCaseGet cenv _env (e1info,cspec,_tys,n,m) = +and TryOptimizeUnionCaseGet cenv _env (e1info, cspec, _tys, n, m) = match e1info.Info with - | StripUnionCaseValue(cspec2,args) when cenv.settings.EliminatUnionCaseFieldGet() && not e1info.HasEffect && cenv.g.unionCaseRefEq cspec cspec2 -> - if n >= args.Length then errorR(InternalError( "TryOptimizeUnionCaseGet: term argument out of range",m)) + | StripUnionCaseValue(cspec2, args) when cenv.settings.EliminatUnionCaseFieldGet() && not e1info.HasEffect && cenv.g.unionCaseRefEq cspec cspec2 -> + if n >= args.Length then errorR(InternalError( "TryOptimizeUnionCaseGet: term argument out of range", m)) Some args.[n] | _ -> None @@ -1973,9 +1973,9 @@ and TryOptimizeUnionCaseGet cenv _env (e1info,cspec,_tys,n,m) = // Optimize/analyze a for-loop //------------------------------------------------------------------------- -and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = - let e1',e1info = OptimizeExpr cenv env e1 - let e2',e2info = OptimizeExpr cenv env e2 +and OptimizeFastIntegerForLoop cenv env (spStart, v, e1, dir, e2, e3, m) = + let e1', e1info = OptimizeExpr cenv env e1 + let e2', e2info = OptimizeExpr cenv env e2 let env = BindInternalValToUnknown cenv v env let e3', e3info = OptimizeExpr cenv env e3 // Try to replace F#-style loops with C# style loops that recompute their bounds but which are compiled more efficiently by the JITs, e.g. @@ -1984,13 +1984,13 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = let e2', dir = match dir, e2' with // detect upwards for loops with bounds of the form "arr.Length - 1" and convert them to a C#-style for loop - | FSharpForLoopUp, Expr.Op(TOp.ILAsm([ (AI_sub | AI_sub_ovf)],_),_,[Expr.Op(TOp.ILAsm([ I_ldlen; (AI_conv DT_I4)],_),_,[arre],_); Expr.Const(Const.Int32 1,_,_)],_) + | FSharpForLoopUp, Expr.Op(TOp.ILAsm([ (AI_sub | AI_sub_ovf)], _), _, [Expr.Op(TOp.ILAsm([ I_ldlen; (AI_conv DT_I4)], _), _, [arre], _); Expr.Const(Const.Int32 1, _, _)], _) when not (snd(OptimizeExpr cenv env arre)).HasEffect -> mkLdlen cenv.g (e2'.Range) arre, CSharpForLoopUp // detect upwards for loops with constant bounds, but not MaxValue! - | FSharpForLoopUp, Expr.Const(Const.Int32 n,_,_) + | FSharpForLoopUp, Expr.Const(Const.Int32 n, _, _) when n < System.Int32.MaxValue -> mkIncr cenv.g (e2'.Range) e2', CSharpForLoopUp @@ -2003,7 +2003,7 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = if not eff then mkUnit cenv.g m , { TotalSize=0; FunctionSize=0; HasEffect=false; MightMakeCriticalTailcall=false; Info=UnknownValue } else - let expr' = mkFor cenv.g (spStart,v,e1',dir,e2',e3',m) + let expr' = mkFor cenv.g (spStart, v, e1', dir, e2', e3', m) expr', { TotalSize=AddTotalSizes einfos + forAndWhileLoopSize FunctionSize=AddFunctionSizes einfos + forAndWhileLoopSize HasEffect=eff @@ -2014,21 +2014,21 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = // Optimize/analyze a set of recursive bindings //------------------------------------------------------------------------- -and OptimizeLetRec cenv env (binds,bodyExpr,m) = +and OptimizeLetRec cenv env (binds, bodyExpr, m) = let vs = binds |> List.map (fun v -> v.Var) let env = BindInternalValsToUnknown cenv vs env - let binds',env = OptimizeBindings cenv true env binds - let bodyExpr',einfo = OptimizeExpr cenv env bodyExpr + let binds', env = OptimizeBindings cenv true env binds + let bodyExpr', einfo = OptimizeExpr cenv env bodyExpr // REVIEW: graph analysis to determine which items are unused // Eliminate any unused bindings, as in let case - let binds'',bindinfos = + let binds'', bindinfos = let fvs0 = freeInExpr CollectLocals bodyExpr' let fvs = List.fold (fun acc x -> unionFreeVars acc (fst x |> freeInBindingRhs CollectLocals)) fvs0 binds' SplitValuesByIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) binds' // Trim out any optimization info that involves escaping values - let evalue' = AbstractExprInfoByVars (vs,[]) einfo.Info + let evalue' = AbstractExprInfoByVars (vs, []) einfo.Info // REVIEW: size of constructing new closures - should probably add #freevars + #recfixups here - let bodyExpr' = Expr.LetRec(binds'',bodyExpr',m,NewFreeVarsCache()) + let bodyExpr' = Expr.LetRec(binds'', bodyExpr', m, NewFreeVarsCache()) let info = CombineValueInfos (einfo :: bindinfos) evalue' bodyExpr', info @@ -2042,32 +2042,32 @@ and OptimizeLinearExpr cenv env expr contf = let expr = if cenv.settings.ExpandStructrualValues() then ExpandStructuralBinding cenv expr else expr match expr with - | Expr.Sequential (e1,e2,flag,spSeq,m) -> - let e1',e1info = OptimizeExpr cenv env e1 - OptimizeLinearExpr cenv env e2 (contf << (fun (e2',e2info) -> + | Expr.Sequential (e1, e2, flag, spSeq, m) -> + let e1', e1info = OptimizeExpr cenv env e1 + OptimizeLinearExpr cenv env e2 (contf << (fun (e2', e2info) -> if (flag = NormalSeq) && // Always eliminate '(); expr' sequences, even in debug code, to ensure that // conditional method calls don't leave a dangling breakpoint (see FSharp 1.0 bug 6034) - (cenv.settings.EliminateSequential () || (match e1' with Expr.Const(Const.Unit,_,_) -> true | _ -> false)) && + (cenv.settings.EliminateSequential () || (match e1' with Expr.Const(Const.Unit, _, _) -> true | _ -> false)) && not e1info.HasEffect then e2', e2info else - Expr.Sequential(e1',e2',flag,spSeq,m), + Expr.Sequential(e1', e2', flag, spSeq, m), { TotalSize = e1info.TotalSize + e2info.TotalSize FunctionSize = e1info.FunctionSize + e2info.FunctionSize HasEffect = flag <> NormalSeq || e1info.HasEffect || e2info.HasEffect MightMakeCriticalTailcall = (if flag = NormalSeq then e2info.MightMakeCriticalTailcall else e1info.MightMakeCriticalTailcall || e2info.MightMakeCriticalTailcall) Info = UnknownValue (* can't propagate value: must access result of computation for its effects *) })) - | Expr.Let (bind,body,m,_) -> - let (bind',bindingInfo),env = OptimizeBinding cenv false env bind - OptimizeLinearExpr cenv env body (contf << (fun (body',bodyInfo) -> + | Expr.Let (bind, body, m, _) -> + let (bind', bindingInfo), env = OptimizeBinding cenv false env bind + OptimizeLinearExpr cenv env body (contf << (fun (body', bodyInfo) -> // PERF: This call to ValueIsUsedOrHasEffect/freeInExpr amounts to 9% of all optimization time. // Is it quadratic or quasi-quadtratic? - if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals body').FreeLocals) (bind',bindingInfo) then + if ValueIsUsedOrHasEffect cenv (fun () -> (freeInExpr CollectLocals body').FreeLocals) (bind', bindingInfo) then (* Eliminate let bindings on the way back up *) - let expr',adjust = TryEliminateLet cenv env bind' body' m - expr', + let expr', adjust = TryEliminateLet cenv env bind' body' m + expr', { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize + adjust FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize + adjust HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect @@ -2075,23 +2075,23 @@ and OptimizeLinearExpr cenv env expr contf = Info = UnknownValue } else (* On the way back up: Trim out any optimization info that involves escaping values on the way back up *) - let evalue' = AbstractExprInfoByVars ([bind'.Var],[]) bodyInfo.Info - body', + let evalue' = AbstractExprInfoByVars ([bind'.Var], []) bodyInfo.Info + body', { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize (* eliminated a local var *) FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize - localVarSize (* eliminated a local var *) HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position Info = evalue' } )) - | LinearMatchExpr (spMatch,exprm,dtree,tg1,e2,spTarget2,m,ty) -> - let dtree,dinfo = OptimizeDecisionTree cenv env m dtree - let tg1,tg1info = OptimizeDecisionTreeTarget cenv env m tg1 + | LinearMatchExpr (spMatch, exprm, dtree, tg1, e2, spTarget2, m, ty) -> + let dtree, dinfo = OptimizeDecisionTree cenv env m dtree + let tg1, tg1info = OptimizeDecisionTreeTarget cenv env m tg1 // tailcall - OptimizeLinearExpr cenv env e2 (contf << (fun (e2,e2info) -> - let e2,e2info = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e2,e2info) + OptimizeLinearExpr cenv env e2 (contf << (fun (e2, e2info) -> + let e2, e2info = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e2, e2info) let tinfos = [tg1info; e2info] - let tgs = [tg1; TTarget([],e2,spTarget2)] - RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree,tgs,dinfo,tinfos))) + let tgs = [tg1; TTarget([], e2, spTarget2)] + RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree, tgs, dinfo, tinfos))) | _ -> contf (OptimizeExpr cenv env expr) @@ -2099,9 +2099,9 @@ and OptimizeLinearExpr cenv env expr contf = // Optimize/analyze a try/finally construct. //------------------------------------------------------------------------- -and OptimizeTryFinally cenv env (spTry,spFinally,e1,e2,m,ty) = - let e1',e1info = OptimizeExpr cenv env e1 - let e2',e2info = OptimizeExpr cenv env e2 +and OptimizeTryFinally cenv env (spTry, spFinally, e1, e2, m, ty) = + let e1', e1info = OptimizeExpr cenv env e1 + let e2', e2info = OptimizeExpr cenv env e2 let info = { TotalSize = e1info.TotalSize + e2info.TotalSize + tryFinallySize FunctionSize = e1info.FunctionSize + e2info.FunctionSize + tryFinallySize @@ -2115,41 +2115,41 @@ and OptimizeTryFinally cenv env (spTry,spFinally,e1,e2,m,ty) = | SequencePointAtTry _ -> SequencePointsAtSeq | SequencePointInBodyOfTry -> SequencePointsAtSeq | NoSequencePointAtTry -> SuppressSequencePointOnExprOfSequential - Expr.Sequential(e1',e2',ThenDoSeq,sp,m),info + Expr.Sequential(e1', e2', ThenDoSeq, sp, m), info else - mkTryFinally cenv.g (e1',e2',m,ty,spTry,spFinally), + mkTryFinally cenv.g (e1', e2', m, ty, spTry, spFinally), info //------------------------------------------------------------------------- // Optimize/analyze a try/catch construct. //------------------------------------------------------------------------- -and OptimizeTryCatch cenv env (e1,vf,ef,vh,eh,m,ty,spTry,spWith) = - let e1',e1info = OptimizeExpr cenv env e1 +and OptimizeTryCatch cenv env (e1, vf, ef, vh, eh, m, ty, spTry, spWith) = + let e1', e1info = OptimizeExpr cenv env e1 // try-catch, so no effect means no exception can be raised, so discard the catch if cenv.settings.EliminateTryCatchAndTryFinally () && not e1info.HasEffect then - e1',e1info + e1', e1info else let envinner = BindInternalValToUnknown cenv vf (BindInternalValToUnknown cenv vh env) - let ef',efinfo = OptimizeExpr cenv envinner ef - let eh',ehinfo = OptimizeExpr cenv envinner eh + let ef', efinfo = OptimizeExpr cenv envinner ef + let eh', ehinfo = OptimizeExpr cenv envinner eh let info = { TotalSize = e1info.TotalSize + efinfo.TotalSize+ ehinfo.TotalSize + tryCatchSize FunctionSize = e1info.FunctionSize + efinfo.FunctionSize+ ehinfo.FunctionSize + tryCatchSize HasEffect = e1info.HasEffect || efinfo.HasEffect || ehinfo.HasEffect MightMakeCriticalTailcall = false Info = UnknownValue } - mkTryWith cenv.g (e1',vf,ef',vh,eh',m,ty,spTry,spWith), + mkTryWith cenv.g (e1', vf, ef', vh, eh', m, ty, spTry, spWith), info //------------------------------------------------------------------------- // Optimize/analyze a while loop //------------------------------------------------------------------------- -and OptimizeWhileLoop cenv env (spWhile,marker,e1,e2,m) = - let e1',e1info = OptimizeExpr cenv env e1 - let e2',e2info = OptimizeExpr cenv env e2 - mkWhile cenv.g (spWhile,marker,e1',e2',m), +and OptimizeWhileLoop cenv env (spWhile, marker, e1, e2, m) = + let e1', e1info = OptimizeExpr cenv env e1 + let e2', e2info = OptimizeExpr cenv env e2 + mkWhile cenv.g (spWhile, marker, e1', e2', m), { TotalSize = e1info.TotalSize + e2info.TotalSize + forAndWhileLoopSize FunctionSize = e1info.FunctionSize + e2info.FunctionSize + forAndWhileLoopSize HasEffect = true (* may not terminate *) @@ -2169,41 +2169,41 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) = // Resolve the static overloading early (during the compulsory rewrite phase) so we can inline. match ConstraintSolver.CodegenWitnessThatTypSupportsTraitConstraint cenv.TcVal cenv.g cenv.amap m traitInfo args with - | OkResult (_,Some expr) -> OptimizeExpr cenv env expr + | OkResult (_, Some expr) -> OptimizeExpr cenv env expr // Resolution fails when optimizing generic code, ignore the failure | _ -> - let args',arginfos = OptimizeExprsThenConsiderSplits cenv env args - OptimizeExprOpFallback cenv env (TOp.TraitCall(traitInfo),[],args',m) arginfos UnknownValue + let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args + OptimizeExprOpFallback cenv env (TOp.TraitCall(traitInfo), [], args', m) arginfos UnknownValue //------------------------------------------------------------------------- // Make optimization decisions once we know the optimization information // for a value //------------------------------------------------------------------------- -and TryOptimizeVal cenv env (mustInline,valInfoForVal,m) = +and TryOptimizeVal cenv env (mustInline, valInfoForVal, m) = match valInfoForVal with // Inline all constants immediately - | ConstValue (c,ty) -> Some (Expr.Const (c,m,ty)) - | SizeValue (_,detail) -> TryOptimizeVal cenv env (mustInline,detail,m) - | ValValue (v',detail) -> + | ConstValue (c, ty) -> Some (Expr.Const (c, m, ty)) + | SizeValue (_, detail) -> TryOptimizeVal cenv env (mustInline, detail, m) + | ValValue (v', detail) -> // Inline values bound to other values immediately - match TryOptimizeVal cenv env (mustInline,detail,m) with + match TryOptimizeVal cenv env (mustInline, detail, m) with // Prefer to inline using the more specific info if possible | Some e -> Some e //If the more specific info didn't reveal an inline then use the value | None -> Some(exprForValRef m v') - | ConstExprValue(_size,expr) -> + | ConstExprValue(_size, expr) -> Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) - | CurriedLambdaValue (_,_,_,expr,_) when mustInline -> + | CurriedLambdaValue (_, _, _, expr, _) when mustInline -> Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr)) | 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 - | _ when mustInline -> warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(),m)); None + | UnknownValue when mustInline -> warning(Error(FSComp.SR.optValueMarkedInlineHasUnexpectedValue(), m)); None + | _ when mustInline -> warning(Error(FSComp.SR.optValueMarkedInlineCouldNotBeInlined(), m)); None | _ -> None and TryOptimizeValInfo cenv env m vinfo = - if vinfo.HasEffect then None else TryOptimizeVal cenv env (false,vinfo.Info ,m) + if vinfo.HasEffect then None else TryOptimizeVal cenv env (false, vinfo.Info , m) //------------------------------------------------------------------------- // Add 'v1 = v2' information into the information stored about a value @@ -2220,10 +2220,10 @@ and AddValEqualityInfo g m (v:ValRef) info = // Optimize/analyze a use of a value //------------------------------------------------------------------------- -and OptimizeVal cenv env expr (v:ValRef,m) = +and OptimizeVal cenv env expr (v:ValRef, m) = let valInfoForVal = GetInfoForVal cenv env m v - match TryOptimizeVal cenv env (v.MustInline,valInfoForVal.ValExprInfo,m) with + match TryOptimizeVal cenv env (v.MustInline, valInfoForVal.ValExprInfo, m) with | Some e -> // don't reoptimize inlined lambdas until they get applied to something match e with @@ -2236,12 +2236,12 @@ and OptimizeVal cenv env expr (v:ValRef,m) = FunctionSize=10 TotalSize=10}) | _ -> - let e,einfo = OptimizeExpr cenv env e - e,AddValEqualityInfo cenv.g m v einfo + let e, einfo = OptimizeExpr cenv env e + e, AddValEqualityInfo cenv.g m v einfo | None -> - if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName),m)) - expr,(AddValEqualityInfo cenv.g m v + if v.MustInline then error(Error(FSComp.SR.optFailedToInlineValue(v.DisplayName), m)) + expr, (AddValEqualityInfo cenv.g m v { Info=valInfoForVal.ValExprInfo HasEffect=false MightMakeCriticalTailcall = false @@ -2266,7 +2266,7 @@ and CanDevirtualizeApplication cenv v vref ty args = // Exclusion: Some unions have null as representations && not (IsUnionTypeWithNullAsTrueValue cenv.g (fst(StripToNominalTyconRef cenv ty)).Deref) // If we de-virtualize an operation on structs then we have to take the address of the object argument - // Hence we have to actually have the object argument available to us, + // Hence we have to actually have the object argument available to us, && (not (isStructTy cenv.g ty) || not (isNil args)) and TakeAddressOfStructArgumentIfNeeded cenv (vref:ValRef) ty args m = @@ -2277,7 +2277,7 @@ and TakeAddressOfStructArgumentIfNeeded cenv (vref:ValRef) ty args m = // known calls to known generated F# code for CompareTo, Equals and GetHashCode. // If we ever reuse DevirtualizeApplication to transform an arbitrary virtual call into a // direct call then this assumption is not valid. - let wrap,objArgAddress = mkExprAddrOfExpr cenv.g true false NeverMutates objArg None m + let wrap, objArgAddress = mkExprAddrOfExpr cenv.g true false NeverMutates objArg None m wrap, (objArgAddress::rest) | _ -> // no wrapper, args stay the same @@ -2286,14 +2286,14 @@ and TakeAddressOfStructArgumentIfNeeded cenv (vref:ValRef) ty args m = id, args and DevirtualizeApplication cenv env (vref:ValRef) ty tyargs args m = - let wrap,args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m - let transformedExpr = wrap (MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if isNil tyargs then [] else [tyargs]),args,m)) + let wrap, args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m + let transformedExpr = wrap (MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m)) OptimizeExpr cenv env transformedExpr -and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = - match f,tyargs,args with +and TryDevirtualizeApplication cenv env (f, tyargs, args, m) = + match f, tyargs, args with // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonIntrinsic when type is known // to be augmented with a visible comparison value. @@ -2306,22 +2306,22 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // // If C is a struct type then we have to take the address of 'c' - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_inner_vref ty args -> + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_inner_vref ty args -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToValues with - | Some (_,vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) | _ -> None - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_withc_inner_vref ty args -> + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_comparison_withc_inner_vref ty args -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedCompareToWithComparerValues, args with | Some vref, [comp; x; y] -> // the target takes a tupled argument, so we need to reorder the arg expressions in the // arg list, and create a tuple of y & comp // push the comparer to the end and box the argument - let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y,cenv.g.obj_ty,m,ty) ; comp]] + let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y, cenv.g.obj_ty, m, ty) ; comp]] Some (DevirtualizeApplication cenv env vref ty tyargs args2 m) | _ -> None @@ -2329,53 +2329,53 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // to be augmented with a visible equality-without-comparer value. // REVIEW: GenericEqualityIntrinsic (which has no comparer) implements PER semantics (5537: this should be ER semantics) // We are devirtualizing to a Equals(T) method which also implements PER semantics (5537: this should be ER semantics) - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_er_inner_vref ty args -> + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_er_inner_vref ty args -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsValues with - | Some (_,vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | Some (_, vref) -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerFast - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_withc_inner_vref ty args -> + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with - | Some (_,_,withcEqualsVal), [comp; x; y] -> + | Some (_, _, withcEqualsVal), [comp; x; y] -> // push the comparer to the end and box the argument - let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y,cenv.g.obj_ty,m,ty) ; comp]] + let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y, cenv.g.obj_ty, m, ty) ; comp]] Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparer - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args && not(isRefTupleTy cenv.g ty) -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_equality_per_inner_vref ty args && not(isRefTupleTy cenv.g ty) -> + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with - | Some (_,_,withcEqualsVal), [x; y] -> - let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y,cenv.g.obj_ty,m,ty); (mkCallGetGenericPEREqualityComparer cenv.g m)]] + | Some (_, _, withcEqualsVal), [x; y] -> + let args2 = [x; mkRefTupledNoTypes cenv.g m [mkCoerceExpr(y, cenv.g.obj_ty, m, ty); (mkCallGetGenericPEREqualityComparer cenv.g m)]] Some (DevirtualizeApplication cenv env withcEqualsVal ty tyargs args2 m) | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashIntrinsic - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_inner_vref ty args -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_inner_vref ty args -> + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with - | Some (_,withcGetHashCodeVal,_), [x] -> + | Some (_, withcGetHashCodeVal, _), [x] -> let args2 = [x; mkCallGetGenericEREqualityComparer cenv.g m] Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic - | Expr.Val(v,_,_),[ty],_ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_withc_inner_vref ty args -> - let tcref,tyargs = StripToNominalTyconRef cenv ty + | Expr.Val(v, _, _), [ty], _ when CanDevirtualizeApplication cenv v cenv.g.generic_hash_withc_inner_vref ty args -> + let tcref, tyargs = StripToNominalTyconRef cenv ty match tcref.GeneratedHashAndEqualsWithComparerValues, args with - | Some (_,withcGetHashCodeVal,_), [comp; x] -> + | Some (_, withcGetHashCodeVal, _), [comp; x] -> let args2 = [x; comp] Some (DevirtualizeApplication cenv env withcGetHashCodeVal ty tyargs args2 m) | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_comparison_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2389,7 +2389,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_hash_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_hash_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2406,7 +2406,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types // REVIEW (5537): GenericEqualityIntrinsic implements PER semantics, and we are replacing it to something also // implementing PER semantics. However GenericEqualityIntrinsic should implement ER semantics. - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2420,7 +2420,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2434,7 +2434,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_hash_withc_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_hash_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2448,7 +2448,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic for tuple types - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_equality_withc_inner_vref && isRefTupleTy cenv.g ty -> + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.generic_equality_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty let vref = match tyargs.Length with @@ -2465,7 +2465,7 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // 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. // Note UnboxFast is just the .NET IL 'unbox.any' instruction. - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.unbox_vref && + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.unbox_vref && canUseUnboxFast cenv.g m ty -> Some(DevirtualizeApplication cenv env cenv.g.unbox_fast_vref ty tyargs args m) @@ -2473,14 +2473,14 @@ and TryDevirtualizeApplication cenv env (f,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. // Note TypeTestFast is just the .NET IL 'isinst' instruction followed by a non-null comparison - | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.istype_vref && + | Expr.Val(v, _, _), [ty], _ when valRefEq cenv.g v cenv.g.istype_vref && canUseTypeTestFast cenv.g ty -> Some(DevirtualizeApplication cenv env cenv.g.istype_fast_vref ty tyargs args m) // Don't fiddle with 'methodhandleof' calls - just remake the application - | Expr.Val(vref,_,_),_,_ when valRefEq cenv.g vref cenv.g.methodhandleof_vref -> - Some( MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref,vref.Type,(if isNil tyargs then [] else [tyargs]),args,m), + | Expr.Val(vref, _, _), _, _ when valRefEq cenv.g vref cenv.g.methodhandleof_vref -> + Some( MakeApplicationAndBetaReduce cenv.g (exprForValRef m vref, vref.Type, (if isNil tyargs then [] else [tyargs]), args, m), { TotalSize=1 FunctionSize=1 HasEffect=false @@ -2490,10 +2490,10 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = | _ -> None /// Attempt to inline an application of a known value at callsites -and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = +and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m) = // Considering inlining app match finfo.Info with - | StripLambdaValue (lambdaId,arities,size,f2,f2ty) when + | StripLambdaValue (lambdaId, arities, size, f2, f2ty) when (// Considering inlining lambda cenv.optimizing && cenv.settings.InlineLambdas () && @@ -2510,7 +2510,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = let isBaseCall = args.Length > 0 && match args.[0] with - | Expr.Val(vref,_,_) when vref.BaseOrThisInfo = BaseVal -> true + | Expr.Val(vref, _, _) when vref.BaseOrThisInfo = BaseVal -> true | _ -> false if isBaseCall then None else @@ -2523,11 +2523,11 @@ and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = false else match finfo.Info with - | ValValue(vref,_) -> + | ValValue(vref, _) -> match vref.ApparentParent with | Parent(tcr) when (tyconRefEq cenv.g cenv.g.lazy_tcr_canon tcr) -> match tcr.CompiledRepresentation with - | CompiledTypeRepr.ILAsmNamed(iltr,_,_) -> iltr.Scope.AssemblyRef.Name = "FSharp.Core" + | CompiledTypeRepr.ILAsmNamed(iltr, _, _) -> iltr.Scope.AssemblyRef.Name = "FSharp.Core" | _ -> false | _ -> false | _ -> false @@ -2536,7 +2536,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = let isSecureMethod = match finfo.Info with - | ValValue(vref,_) -> + | ValValue(vref, _) -> vref.Attribs |> List.exists (fun a -> (IsSecurityAttribute cenv.g cenv.amap cenv.casApplied a m) || (IsSecurityCriticalAttribute cenv.g a)) | _ -> false @@ -2544,7 +2544,7 @@ and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = let isGetHashCode = match finfo.Info with - | ValValue(vref,_) -> vref.DisplayName = "GetHashCode" && vref.IsCompilerGenerated + | ValValue(vref, _) -> vref.DisplayName = "GetHashCode" && vref.IsCompilerGenerated | _ -> false if isGetHashCode then None else @@ -2556,10 +2556,10 @@ and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = // REVIEW: this is a cheapshot way of optimizing the arg expressions as well without the restriction of recursive // inlining kicking into effect - let args' = args |> List.map (fun e -> let e',_einfo = OptimizeExpr cenv env e in e') + let args' = args |> List.map (fun e -> let e', _einfo = OptimizeExpr cenv env e in e') // Beta reduce. MakeApplicationAndBetaReduce cenv.g does all the hard work. // Inlining: beta reducing - let expr' = MakeApplicationAndBetaReduce cenv.g (f2',f2ty,[tyargs],args',m) + let expr' = MakeApplicationAndBetaReduce cenv.g (f2', f2ty, [tyargs], args', m) // Inlining: reoptimizing Some (OptimizeExpr cenv {env with dontInline= Zset.add lambdaId env.dontInline} expr') @@ -2569,15 +2569,15 @@ and TryInlineApplication cenv env finfo (tyargs: TType list,args: Expr list,m) = // Optimize/analyze an application of a function to type and term arguments //------------------------------------------------------------------------- -and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = +and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) = // trying to devirtualize - match TryDevirtualizeApplication cenv env (f0,tyargs,args,m) with + match TryDevirtualizeApplication cenv env (f0, tyargs, args, m) with | Some res -> // devirtualized res | None -> - let newf0,finfo = OptimizeExpr cenv env f0 - match TryInlineApplication cenv env finfo (tyargs,args,m) with + let newf0, finfo = OptimizeExpr cenv env f0 + match TryInlineApplication cenv env finfo (tyargs, args, m) with | Some res -> // inlined res @@ -2585,9 +2585,9 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = let shapes = match newf0 with - | Expr.Val(vref,_,_) -> + | Expr.Val(vref, _, _) -> match vref.ValReprInfo with - | Some(ValReprInfo(_,detupArgsL,_)) -> + | Some(ValReprInfo(_, detupArgsL, _)) -> let nargs = args.Length let nDetupArgsL = detupArgsL.Length let nShapes = min nargs nDetupArgsL @@ -2598,12 +2598,12 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = | [] | [_] -> UnknownValue | _ -> TupleValue(Array.ofList (List.map (fun _ -> UnknownValue) detupArgs))) List.zip (detupArgsShapesL @ List.replicate (nargs - nShapes) UnknownValue) args - | _ -> args |> List.map (fun arg -> UnknownValue,arg) - | _ -> args |> List.map (fun arg -> UnknownValue,arg) + | _ -> args |> List.map (fun arg -> UnknownValue, arg) + | _ -> args |> List.map (fun arg -> UnknownValue, arg) - let newArgs,arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env shapes + let newArgs, arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env shapes // beta reducing - let newExpr = MakeApplicationAndBetaReduce cenv.g (newf0,f0ty, [tyargs],newArgs,m) + let newExpr = MakeApplicationAndBetaReduce cenv.g (newf0, f0ty, [tyargs], newArgs, m) match newf0, newExpr with | (Expr.Lambda _ | Expr.TyLambda _), Expr.Let _ -> @@ -2615,7 +2615,7 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = // Determine if this application is a critical tailcall let mayBeCriticalTailcall = match newf0 with - | KnownValApp(vref,_typeArgs,otherArgs) -> + | KnownValApp(vref, _typeArgs, otherArgs) -> // Check if this is a call to a function of known arity that has been inferred to not be a critical tailcall when used as a direct call // This includes recursive calls to the function being defined (in which case we get a non-critical, closed-world tailcall). @@ -2623,14 +2623,14 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = let doesNotMakeCriticalTailcall = vref.MakesNoCriticalTailcalls || (let valInfoForVal = GetInfoForVal cenv env m vref in valInfoForVal.ValMakesNoCriticalTailcalls) || - (match env.functionVal with | None -> false | Some (v,_) -> valEq vref.Deref v) + (match env.functionVal with | None -> false | Some (v, _) -> valEq vref.Deref v) if doesNotMakeCriticalTailcall then let numArgs = otherArgs.Length + newArgs.Length match vref.ValReprInfo with | Some i -> numArgs > i.NumCurriedArgs | None -> match env.functionVal with - | Some (_v,i) -> numArgs > i.NumCurriedArgs + | Some (_v, i) -> numArgs > i.NumCurriedArgs | None -> true // over-application of a known function, which presumably returns a function. This counts as an indirect call else true // application of a function that may make a critical tailcall @@ -2651,17 +2651,17 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = match e with - | Expr.Lambda (lambdaId,_,_,_,_,m,_) - | Expr.TyLambda(lambdaId,_,_,m,_) -> - let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo e - let env = { env with functionVal = (match vspec with None -> None | Some v -> Some (v,topValInfo)) } + | Expr.Lambda (lambdaId, _, _, _, _, m, _) + | Expr.TyLambda(lambdaId, _, _, m, _) -> + let tps, ctorThisValOpt, baseValOpt, vsl, body, bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo e + let env = { env with functionVal = (match vspec with None -> None | Some v -> Some (v, topValInfo)) } let env = Option.foldBack (BindInternalValToUnknown cenv) ctorThisValOpt env let env = Option.foldBack (BindInternalValToUnknown cenv) baseValOpt env let env = BindTypeVarsToUnknown tps env let env = List.foldBack (BindInternalValsToUnknown cenv) vsl env let env = BindInternalValsToUnknown cenv (Option.toList baseValOpt) env - let body',bodyinfo = OptimizeExpr cenv env body - let expr' = mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (body',bodyty) + let body', bodyinfo = OptimizeExpr cenv env body + let expr' = mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (body', bodyty) let arities = vsl.Length let arities = if isNil tps then arities else 1+arities let bsize = bodyinfo.TotalSize @@ -2696,14 +2696,14 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = // can't inline any values with semi-recursive object references to self or base let valu = match baseValOpt with - | None -> CurriedLambdaValue (lambdaId,arities,bsize,expr',ety) + | None -> CurriedLambdaValue (lambdaId, arities, bsize, expr', ety) | Some baseVal -> let fvs = freeInExpr CollectLocals body' if fvs.UsesMethodLocalConstructs || fvs.FreeLocals.Contains baseVal then UnknownValue else - let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (body',bodyty) - CurriedLambdaValue (lambdaId,arities,bsize,expr2,ety) + let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (body', bodyty) + CurriedLambdaValue (lambdaId, arities, bsize, expr2, ety) let estimatedSize = @@ -2736,31 +2736,31 @@ and OptimizeExprsThenConsiderSplits cenv env exprs = | _ -> OptimizeList (OptimizeExprThenConsiderSplit cenv env) exprs -and OptimizeExprThenReshapeAndConsiderSplit cenv env (shape,e) = - OptimizeExprThenConsiderSplit cenv env (ReshapeExpr cenv (shape,e)) +and OptimizeExprThenReshapeAndConsiderSplit cenv env (shape, e) = + OptimizeExprThenConsiderSplit cenv env (ReshapeExpr cenv (shape, e)) and OptimizeDecisionTreeTargets cenv env m targets = OptimizeList (OptimizeDecisionTreeTarget cenv env m) (Array.toList targets) -and ReshapeExpr cenv (shape,e) = - match shape,e with - | TupleValue(subshapes), Expr.Val(_vref,_vFlags,m) -> +and ReshapeExpr cenv (shape, e) = + match shape, e with + | TupleValue(subshapes), Expr.Val(_vref, _vFlags, m) -> let tinst = destRefTupleTy cenv.g (tyOfExpr cenv.g e) let subshapes = Array.toList subshapes - mkRefTupled cenv.g m (List.mapi (fun i subshape -> ReshapeExpr cenv (subshape,mkTupleFieldGet cenv.g (tupInfoRef,e,tinst,i,m))) subshapes) tinst + mkRefTupled cenv.g m (List.mapi (fun i subshape -> ReshapeExpr cenv (subshape, mkTupleFieldGet cenv.g (tupInfoRef, e, tinst, i, m))) subshapes) tinst | _ -> e and OptimizeExprThenConsiderSplit cenv env e = - let e',einfo = OptimizeExpr cenv env e + let e', einfo = OptimizeExpr cenv env e // ALWAYS consider splits for enormous sub terms here - otherwise we will create invalid .NET programs - ConsiderSplitToMethod true cenv.settings.veryBigExprSize cenv env (e',einfo) + ConsiderSplitToMethod true cenv.settings.veryBigExprSize cenv env (e', einfo) //------------------------------------------------------------------------- // Decide whether to List.unzip a sub-expression into a new method //------------------------------------------------------------------------- -and ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) = +and ComputeSplitToMethodCondition flag threshold cenv env (e, einfo) = flag && // REVIEW: The method splitting optimization is completely disabled if we are not taking tailcalls. // REVIEW: This should only apply to methods that actually make self-tailcalls (tested further below). @@ -2788,31 +2788,31 @@ and ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) = not v.IsMutable)))) && not (isByrefLikeTy cenv.g (tyOfExpr cenv.g e)) -and ConsiderSplitToMethod flag threshold cenv env (e,einfo) = - if ComputeSplitToMethodCondition flag threshold cenv env (e,einfo) then +and ConsiderSplitToMethod flag threshold cenv env (e, einfo) = + if ComputeSplitToMethodCondition flag threshold cenv env (e, einfo) then let m = (e.Range) - let uv,_ue = mkCompGenLocal m "unitVar" cenv.g.unit_ty + let uv, _ue = mkCompGenLocal m "unitVar" cenv.g.unit_ty let ty = tyOfExpr cenv.g e let nm = match env.latestBoundId with | Some id -> id.idText+suffixForVariablesThatMayNotBeEliminated | None -> suffixForVariablesThatMayNotBeEliminated - let fv,fe = mkCompGenLocal m nm (cenv.g.unit_ty --> ty) - mkInvisibleLet m fv (mkLambda m uv (e,ty)) - (primMkApp (fe,(cenv.g.unit_ty --> ty)) [] [mkUnit cenv.g m] m), + let fv, fe = mkCompGenLocal m nm (cenv.g.unit_ty --> ty) + mkInvisibleLet m fv (mkLambda m uv (e, ty)) + (primMkApp (fe, (cenv.g.unit_ty --> ty)) [] [mkUnit cenv.g m] m), {einfo with FunctionSize=callSize } else - e,einfo + e, einfo //------------------------------------------------------------------------- // Optimize/analyze a pattern matching expression //------------------------------------------------------------------------- -and OptimizeMatch cenv env (spMatch,exprm,dtree,targets,m, ty) = +and OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty) = // REVIEW: consider collecting, merging and using information flowing through each line of the decision tree to each target - let dtree',dinfo = OptimizeDecisionTree cenv env m dtree - let targets',tinfos = OptimizeDecisionTreeTargets cenv env m targets - RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree',targets',dinfo,tinfos) + let dtree', dinfo = OptimizeDecisionTree cenv env m dtree + let targets', tinfos = OptimizeDecisionTreeTargets cenv env m targets + RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree', targets', dinfo, tinfos) and CombineMatchInfos dinfo tinfo = { TotalSize = dinfo.TotalSize + tinfo.TotalSize @@ -2821,7 +2821,7 @@ and CombineMatchInfos dinfo tinfo = MightMakeCriticalTailcall=tinfo.MightMakeCriticalTailcall // discard tailcall info from decision tree since it's not in tailcall position Info= UnknownValue } -and RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree,tgs,dinfo,tinfos) = +and RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree, tgs, dinfo, tinfos) = let tinfo = CombineValueInfosUnknown tinfos let expr = mkAndSimplifyMatch spMatch exprm m ty dtree tgs let einfo = CombineMatchInfos dinfo tinfo @@ -2831,13 +2831,13 @@ and RebuildOptimizedMatch (spMatch,exprm,m,ty,dtree,tgs,dinfo,tinfos) = // Optimize/analyze a target of a decision tree //------------------------------------------------------------------------- -and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs,e,spTarget)) = +and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs, e, spTarget)) = (* REVIEW: this is where we should be using information collected for each target *) let env = BindInternalValsToUnknown cenv vs env - let e',einfo = OptimizeExpr cenv env e - let e',einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e',einfo) - let evalue' = AbstractExprInfoByVars (vs,[]) einfo.Info - TTarget(vs,e',spTarget), + let e', einfo = OptimizeExpr cenv env e + let e', einfo = ConsiderSplitToMethod cenv.settings.abstractBigTargets cenv.settings.bigTargetSize cenv env (e', einfo) + let evalue' = AbstractExprInfoByVars (vs, []) einfo.Info + TTarget(vs, e', spTarget), { TotalSize=einfo.TotalSize FunctionSize=einfo.FunctionSize HasEffect=einfo.HasEffect @@ -2850,28 +2850,28 @@ and OptimizeDecisionTreeTarget cenv env _m (TTarget(vs,e,spTarget)) = and OptimizeDecisionTree cenv env m x = match x with - | TDSuccess (es,n) -> + | TDSuccess (es, n) -> let es', einfos = OptimizeExprsThenConsiderSplits cenv env es - TDSuccess(es',n),CombineValueInfosUnknown einfos - | TDBind(bind,rest) -> - let (bind,binfo),envinner = OptimizeBinding cenv false env bind - let rest,rinfo = OptimizeDecisionTree cenv envinner m rest + TDSuccess(es', n), CombineValueInfosUnknown einfos + | TDBind(bind, rest) -> + let (bind, binfo), envinner = OptimizeBinding cenv false env bind + let rest, rinfo = OptimizeDecisionTree cenv envinner m rest - if ValueIsUsedOrHasEffect cenv (fun () -> (accFreeInDecisionTree CollectLocals rest emptyFreeVars).FreeLocals) (bind,binfo) then + if ValueIsUsedOrHasEffect cenv (fun () -> (accFreeInDecisionTree CollectLocals rest emptyFreeVars).FreeLocals) (bind, binfo) then let info = CombineValueInfosUnknown [rinfo;binfo] // try to fold the let-binding into a single result expression match rest with - | TDSuccess([e],n) -> - let e,_adjust = TryEliminateLet cenv env bind e m - TDSuccess([e],n),info + | TDSuccess([e], n) -> + let e, _adjust = TryEliminateLet cenv env bind e m + TDSuccess([e], n), info | _ -> - TDBind(bind,rest),info + TDBind(bind, rest), info else - rest,rinfo + rest, rinfo - | TDSwitch (e,cases,dflt,m) -> + | TDSwitch (e, cases, dflt, m) -> // We always duplicate boolean-typed guards prior to optimizing. This is work which really should be done in patcompile.fs // where we must duplicate "when" expressions to ensure uniqueness of bound variables. // @@ -2879,48 +2879,48 @@ and OptimizeDecisionTree cenv env m x = // Hence we do it here. There is no doubt a better way to do this. let e = if typeEquiv cenv.g (tyOfExpr cenv.g e) cenv.g.bool_ty then copyExpr cenv.g CloneAll e else e - OptimizeSwitch cenv env (e,cases,dflt,m) + OptimizeSwitch cenv env (e, cases, dflt, m) and TryOptimizeDecisionTreeTest cenv test vinfo = - match test,vinfo with - | DecisionTreeTest.UnionCase (c1,_), StripUnionCaseValue(c2,_) -> Some(cenv.g.unionCaseRefEq c1 c2) - | DecisionTreeTest.ArrayLength (_,_), _ -> None - | DecisionTreeTest.Const c1,StripConstValue(c2) -> if c1 = Const.Zero || c2 = Const.Zero then None else Some(c1=c2) - | DecisionTreeTest.IsNull,StripConstValue(c2) -> Some(c2=Const.Zero) - | DecisionTreeTest.IsInst (_srcty1,_tgty1), _ -> None + match test, vinfo with + | DecisionTreeTest.UnionCase (c1, _), StripUnionCaseValue(c2, _) -> Some(cenv.g.unionCaseRefEq c1 c2) + | DecisionTreeTest.ArrayLength (_, _), _ -> None + | DecisionTreeTest.Const c1, StripConstValue(c2) -> if c1 = Const.Zero || c2 = Const.Zero then None else Some(c1=c2) + | DecisionTreeTest.IsNull, StripConstValue(c2) -> Some(c2=Const.Zero) + | DecisionTreeTest.IsInst (_srcty1, _tgty1), _ -> None // These should not occur in optimization - | DecisionTreeTest.ActivePatternCase (_,_,_vrefOpt1,_,_),_ -> None + | DecisionTreeTest.ActivePatternCase (_, _, _vrefOpt1, _, _), _ -> None | _ -> None /// Optimize/analyze a switch construct from pattern matching -and OptimizeSwitch cenv env (e,cases,dflt,m) = +and OptimizeSwitch cenv env (e, cases, dflt, m) = let e', einfo = OptimizeExpr cenv env e - let cases,dflt = + let cases, dflt = if cenv.settings.EliminateSwitch() && not einfo.HasEffect then // Attempt to find a definite success, i.e. the first case where there is definite success - match (List.tryFind (function (TCase(d2,_)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some(true) -> true | _ -> false) cases) with - | Some(TCase(_,case)) -> [],Some(case) + match (List.tryFind (function (TCase(d2, _)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some(true) -> true | _ -> false) cases) with + | Some(TCase(_, case)) -> [], Some(case) | _ -> // Filter definite failures - cases |> List.filter (function (TCase(d2,_)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some(false) -> false | _ -> true), + cases |> List.filter (function (TCase(d2, _)) when TryOptimizeDecisionTreeTest cenv d2 einfo.Info = Some(false) -> false | _ -> true), dflt else - cases,dflt + cases, dflt // OK, see what we're left with and continue - match cases,dflt with - | [],Some case -> OptimizeDecisionTree cenv env m case - | _ -> OptimizeSwitchFallback cenv env (e', einfo, cases,dflt,m) + match cases, dflt with + | [], Some case -> OptimizeDecisionTree cenv env m case + | _ -> OptimizeSwitchFallback cenv env (e', einfo, cases, dflt, m) -and OptimizeSwitchFallback cenv env (e', einfo, cases,dflt,m) = - let cases',cinfos = List.unzip (List.map (fun (TCase(discrim,e)) -> let e',einfo = OptimizeDecisionTree cenv env m e in TCase(discrim,e'),einfo) cases) - let dflt',dinfos = match dflt with None -> None,[] | Some df -> let df',einfo = OptimizeDecisionTree cenv env m df in Some df',[einfo] +and OptimizeSwitchFallback cenv env (e', einfo, cases, dflt, m) = + let cases', cinfos = List.unzip (List.map (fun (TCase(discrim, e)) -> let e', einfo = OptimizeDecisionTree cenv env m e in TCase(discrim, e'), einfo) cases) + let dflt', dinfos = match dflt with None -> None, [] | Some df -> let df', einfo = OptimizeDecisionTree cenv env m df in Some df', [einfo] let size = (dinfos.Length + cinfos.Length) * 2 let info = CombineValueInfosUnknown (einfo :: cinfos @ dinfos) let info = { info with TotalSize = info.TotalSize + size; FunctionSize = info.FunctionSize + size; } - TDSwitch (e',cases',dflt',m),info + TDSwitch (e', cases', dflt', m), info -and OptimizeBinding cenv isRec env (TBind(vref,expr,spBind)) = +and OptimizeBinding cenv isRec env (TBind(vref, expr, spBind)) = try // The aim here is to stop method splitting for direct-self-tailcalls. We do more than that: if an expression @@ -2931,19 +2931,19 @@ and OptimizeBinding cenv isRec env (TBind(vref,expr,spBind)) = if isRec then { env with dontSplitVars = env.dontSplitVars.Add vref () } else env - let exprOptimized,einfo = + let exprOptimized, einfo = let env = if vref.IsCompilerGenerated && Option.isSome env.latestBoundId then env else {env with latestBoundId=Some vref.Id} let cenv = if vref.InlineInfo = ValInline.PseudoVal then { cenv with optimizing=false} else cenv let arityInfo = InferArityOfExprBinding cenv.g AllowTypeDirectedDetupling.No vref expr - let exprOptimized,einfo = OptimizeLambdas (Some vref) cenv env arityInfo expr vref.Type + let exprOptimized, einfo = OptimizeLambdas (Some vref) cenv env arityInfo expr vref.Type let size = localVarSize - exprOptimized,{einfo with FunctionSize=einfo.FunctionSize+size; TotalSize = einfo.TotalSize+size} + exprOptimized, {einfo with FunctionSize=einfo.FunctionSize+size; TotalSize = einfo.TotalSize+size} // Trim out optimization information for large lambdas we'll never inline // Trim out optimization information for expressions that call protected members let rec cut ivalue = match ivalue with - | CurriedLambdaValue (_, arities, size, body,_) -> + | CurriedLambdaValue (_, arities, size, body, _) -> if size > (cenv.settings.lambdaInlineThreshold + arities + 2) then // Discarding lambda for binding v.LogicalName UnknownValue (* trim large *) @@ -2955,12 +2955,12 @@ and OptimizeBinding cenv isRec env (TBind(vref,expr,spBind)) = else ivalue - | ValValue(v,x) -> ValValue(v,cut x) + | ValValue(v, x) -> ValValue(v, cut x) | TupleValue a -> TupleValue(Array.map cut a) - | RecdValue (tcref,a) -> RecdValue(tcref,Array.map cut a) - | UnionCaseValue (a,b) -> UnionCaseValue (a,Array.map cut b) + | RecdValue (tcref, a) -> RecdValue(tcref, Array.map cut a) + | UnionCaseValue (a, b) -> UnionCaseValue (a, Array.map cut b) | UnknownValue | ConstValue _ | ConstExprValue _ -> ivalue - | SizeValue(_,a) -> MakeSizedValueInfo (cut a) + | SizeValue(_, a) -> MakeSizedValueInfo (cut a) let einfo = if vref.MustInline then einfo else {einfo with Info = cut einfo.Info } let einfo = if (not vref.MustInline && not (cenv.settings.KeepOptimizationValues())) || @@ -3011,10 +3011,10 @@ and OptimizeBinding cenv isRec env (TBind(vref,expr,spBind)) = then {einfo with Info=UnknownValue} else einfo if vref.MustInline && IsPartialExprVal einfo.Info then - errorR(InternalError("the mustinline value '"+vref.LogicalName+"' was not inferred to have a known value",vref.Range)) + errorR(InternalError("the mustinline value '"+vref.LogicalName+"' was not inferred to have a known value", vref.Range)) let env = BindInternalLocalVal cenv vref (mkValInfo einfo vref) env - (TBind(vref,exprOptimized,spBind), einfo), env + (TBind(vref, exprOptimized, spBind), einfo), env with exn -> errorRecovery exn vref.Range raise (ReportedError (Some exn)) @@ -3023,9 +3023,9 @@ and OptimizeBindings cenv isRec env xs = List.mapFold (OptimizeBinding cenv isRe and OptimizeModuleExpr cenv env x = match x with - | ModuleOrNamespaceExprWithSig(mty,def,m) -> + | ModuleOrNamespaceExprWithSig(mty, def, m) -> // Optimize the module implementation - let (def,info),(_env,bindInfosColl) = OptimizeModuleDef cenv (env,[]) def + let (def, info), (_env, bindInfosColl) = OptimizeModuleDef cenv (env, []) def let bindInfosColl = List.concat bindInfosColl // Compute the elements truly hidden by the module signature. @@ -3039,10 +3039,10 @@ and OptimizeModuleExpr cenv env x = let fvs = freeInModuleOrNamespace CollectLocals def let dead = - bindInfosColl |> List.filter (fun (bind,binfo) -> + bindInfosColl |> List.filter (fun (bind, binfo) -> // Check the expression has no side effect, e.g. is a lambda expression (a function definition) - not (ValueIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) (bind,binfo)) && + not (ValueIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) (bind, binfo)) && // Check the thing is hidden by the signature (if any) hidden.mhiVals.Contains bind.Var && @@ -3050,7 +3050,7 @@ and OptimizeModuleExpr cenv env x = // Check the thing is not compiled as a static field or property, since reflected definitions and other reflective stuff might need it not (IsCompiledAsStaticProperty cenv.g bind.Var)) - let deadSet = Zset.addList (dead |> List.map (fun (bind,_) -> bind.Var)) (Zset.empty valOrder) + let deadSet = Zset.addList (dead |> List.map (fun (bind, _) -> bind.Var)) (Zset.empty valOrder) // Eliminate dead private bindings from a module type by mutation. Note that the optimizer doesn't // actually copy the entire term - it copies the expression portions of the term and leaves the @@ -3064,7 +3064,7 @@ and OptimizeModuleExpr cenv env x = let rec elimModTy (mtyp:ModuleOrNamespaceType) = let mty = new ModuleOrNamespaceType(kind=mtyp.ModuleOrNamespaceKind, - vals= (mtyp.AllValsAndMembers |> QueueList.filter (Zset.memberOf deadSet >> not)), + vals= (mtyp.AllValsAndMembers |> QueueList.filter (Zset.memberOf deadSet >> not)), entities= mtyp.AllEntities) mtyp.ModuleAndNamespaceDefinitions |> List.iter elimModSpec mty @@ -3074,11 +3074,11 @@ and OptimizeModuleExpr cenv env x = let rec elimModDef x = match x with - | TMDefRec(isRec,tycons,mbinds,m) -> + | TMDefRec(isRec, tycons, mbinds, m) -> let mbinds = mbinds |> List.choose elimModuleBinding - TMDefRec(isRec,tycons,mbinds,m) - | TMDefLet(bind,m) -> - if Zset.contains bind.Var deadSet then TMDefRec(false,[],[],m) else x + TMDefRec(isRec, tycons, mbinds, m) + | TMDefLet(bind, m) -> + if Zset.contains bind.Var deadSet then TMDefRec(false, [], [], m) else x | TMDefDo _ -> x | TMDefs(defs) -> TMDefs(List.map elimModDef defs) | TMAbstract _ -> x @@ -3090,81 +3090,81 @@ and OptimizeModuleExpr cenv env x = | ModuleOrNamespaceBinding.Module(mspec, d) -> // Clean up the ModuleOrNamespaceType by mutation elimModSpec mspec - Some (ModuleOrNamespaceBinding.Module(mspec,elimModDef d)) + Some (ModuleOrNamespaceBinding.Module(mspec, elimModDef d)) elimModDef def let info = AbstractAndRemapModulInfo "defs" cenv.g m rpi info - ModuleOrNamespaceExprWithSig(mty,def,m),info + ModuleOrNamespaceExprWithSig(mty, def, m), info and mkValBind (bind:Binding) info = (mkLocalValRef bind.Var, info) -and OptimizeModuleDef cenv (env,bindInfosColl) x = +and OptimizeModuleDef cenv (env, bindInfosColl) x = match x with - | TMDefRec(isRec,tycons,mbinds,m) -> + | TMDefRec(isRec, tycons, mbinds, m) -> let env = if isRec then BindInternalValsToUnknown cenv (allValsOfModDef x) env else env - let mbindInfos,(env,bindInfosColl) = OptimizeModuleBindings cenv (env,bindInfosColl) mbinds - let mbinds,minfos = List.unzip mbindInfos - let binds = minfos |> List.choose (function Choice1Of2 (x,_) -> Some x | _ -> None) - let binfos = minfos |> List.choose (function Choice1Of2 (_,x) -> Some x | _ -> None) + let mbindInfos, (env, bindInfosColl) = OptimizeModuleBindings cenv (env, bindInfosColl) mbinds + let mbinds, minfos = List.unzip mbindInfos + let binds = minfos |> List.choose (function Choice1Of2 (x, _) -> Some x | _ -> None) + let binfos = minfos |> List.choose (function Choice1Of2 (_, x) -> Some x | _ -> None) let minfos = minfos |> List.choose (function Choice2Of2 x -> Some x | _ -> None) (* REVIEW: Eliminate let bindings on the way back up *) - (TMDefRec(isRec,tycons,mbinds,m), + (TMDefRec(isRec, tycons, mbinds, m), notlazy { ValInfos = ValInfos(List.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos) - ModuleOrNamespaceInfos = NameMap.ofList minfos}), - (env,bindInfosColl) + ModuleOrNamespaceInfos = NameMap.ofList minfos}), + (env, bindInfosColl) | TMAbstract(mexpr) -> - let mexpr,info = OptimizeModuleExpr cenv env mexpr + let mexpr, info = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv info env - (TMAbstract(mexpr),info),(env,bindInfosColl) - | TMDefLet(bind,m) -> - let ((bind',binfo) as bindInfo),env = OptimizeBinding cenv false env bind + (TMAbstract(mexpr), info), (env, bindInfosColl) + | TMDefLet(bind, m) -> + let ((bind', binfo) as bindInfo), env = OptimizeBinding cenv false env bind (* REVIEW: Eliminate unused let bindings from modules *) - (TMDefLet(bind',m), + (TMDefLet(bind', m), notlazy { ValInfos=ValInfos [mkValBind bind (mkValInfo binfo bind.Var)] - ModuleOrNamespaceInfos = NameMap.empty }), - (env ,([bindInfo]::bindInfosColl)) + ModuleOrNamespaceInfos = NameMap.empty }), + (env , ([bindInfo]::bindInfosColl)) - | TMDefDo(e,m) -> - let (e,_einfo) = OptimizeExpr cenv env e - (TMDefDo(e,m),EmptyModuleInfo), - (env ,bindInfosColl) + | TMDefDo(e, m) -> + let (e, _einfo) = OptimizeExpr cenv env e + (TMDefDo(e, m), EmptyModuleInfo), + (env , bindInfosColl) | TMDefs(defs) -> - let (defs,info),(env,bindInfosColl) = OptimizeModuleDefs cenv (env,bindInfosColl) defs - (TMDefs(defs), info), (env,bindInfosColl) + let (defs, info), (env, bindInfosColl) = OptimizeModuleDefs cenv (env, bindInfosColl) defs + (TMDefs(defs), info), (env, bindInfosColl) -and OptimizeModuleBindings cenv (env,bindInfosColl) xs = List.mapFold (OptimizeModuleBinding cenv) (env,bindInfosColl) xs +and OptimizeModuleBindings cenv (env, bindInfosColl) xs = List.mapFold (OptimizeModuleBinding cenv) (env, bindInfosColl) xs -and OptimizeModuleBinding cenv (env,bindInfosColl) x = +and OptimizeModuleBinding cenv (env, bindInfosColl) x = match x with | ModuleOrNamespaceBinding.Binding bind -> - let ((bind',binfo) as bindInfo),env = OptimizeBinding cenv true env bind - (ModuleOrNamespaceBinding.Binding bind', Choice1Of2 (bind',binfo)),(env, [ bindInfo ] :: bindInfosColl) + let ((bind', binfo) as bindInfo), env = OptimizeBinding cenv true env bind + (ModuleOrNamespaceBinding.Binding bind', Choice1Of2 (bind', binfo)), (env, [ bindInfo ] :: bindInfosColl) | ModuleOrNamespaceBinding.Module(mspec, def) -> let id = mspec.Id - let (def,info),(_,bindInfosColl) = OptimizeModuleDef cenv (env,bindInfosColl) def + let (def, info), (_, bindInfosColl) = OptimizeModuleDef cenv (env, bindInfosColl) def let env = BindValsInModuleOrNamespace cenv info env - (ModuleOrNamespaceBinding.Module(mspec,def),Choice2Of2 (id.idText, info)), - (env,bindInfosColl) + (ModuleOrNamespaceBinding.Module(mspec, def), Choice2Of2 (id.idText, info)), + (env, bindInfosColl) -and OptimizeModuleDefs cenv (env,bindInfosColl) defs = - let defs,(env,bindInfosColl) = List.mapFold (OptimizeModuleDef cenv) (env,bindInfosColl) defs - let defs,minfos = List.unzip defs - (defs,UnionOptimizationInfos minfos),(env,bindInfosColl) +and OptimizeModuleDefs cenv (env, bindInfosColl) defs = + let defs, (env, bindInfosColl) = List.mapFold (OptimizeModuleDef cenv) (env, bindInfosColl) defs + let defs, minfos = List.unzip defs + (defs, UnionOptimizationInfos minfos), (env, bindInfosColl) -and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty,_,_) as mexpr), hasExplicitEntryPoint,isScript)) = - let env,mexpr',minfo = +and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty, _, _) as mexpr), hasExplicitEntryPoint, isScript)) = + let env, mexpr', minfo = match mexpr with // FSI: FSI compiles everything as if you're typing incrementally into one module // This means the fragment is not truly a constrained module as later fragments will be typechecked // against the internals of the module rather than the externals. Furthermore it would be wrong to apply // optimizations that did lots of reorganizing stuff to the internals of a module should we ever implement that. - | ModuleOrNamespaceExprWithSig(mty,def,m) when isIncrementalFragment -> - let (def,minfo),(env,_bindInfosColl) = OptimizeModuleDef cenv (env,[]) def - env, ModuleOrNamespaceExprWithSig(mty, def,m), minfo + | ModuleOrNamespaceExprWithSig(mty, def, m) when isIncrementalFragment -> + let (def, minfo), (env, _bindInfosColl) = OptimizeModuleDef cenv (env, []) def + env, ModuleOrNamespaceExprWithSig(mty, def, m), minfo | _ -> let mexpr', minfo = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv minfo env @@ -3174,13 +3174,13 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qn let hidden = ComputeHidingInfoAtAssemblyBoundary mty hidden let minfo = AbstractLazyModulInfoByHiding true hidden minfo - env, TImplFile(qname,pragmas,mexpr',hasExplicitEntryPoint,isScript), minfo, hidden + env, TImplFile(qname, pragmas, mexpr', hasExplicitEntryPoint, isScript), minfo, hidden //------------------------------------------------------------------------- // Entry point //------------------------------------------------------------------------- -let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementalFragment,emitTailcalls,hidden,mimpls) = +let OptimizeImplFile(settings, ccu, tcGlobals, tcVal, importMap, optEnv, isIncrementalFragment, emitTailcalls, hidden, mimpls) = let cenv = { settings=settings scope=ccu @@ -3188,10 +3188,10 @@ let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementa g=tcGlobals amap=importMap optimizing=true - localInternalVals=Dictionary(10000) + localInternalVals=Dictionary(10000) emitTailcalls=emitTailcalls - casApplied=new Dictionary() } - let (optEnvNew,_,_,_ as results) = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls + casApplied=new Dictionary() } + let (optEnvNew, _, _, _ as results) = OptimizeImplFileInternal cenv optEnv isIncrementalFragment hidden mimpls let optimizeDuringCodeGen expr = OptimizeExpr cenv optEnvNew expr |> fst results, optimizeDuringCodeGen @@ -3202,15 +3202,15 @@ let OptimizeImplFile(settings,ccu,tcGlobals,tcVal, importMap,optEnv,isIncrementa let rec p_ExprValueInfo x st = match x with - | ConstValue (c,ty) -> p_byte 0 st; p_tup2 p_const p_typ (c,ty) st + | ConstValue (c, ty) -> p_byte 0 st; p_tup2 p_const p_typ (c, ty) st | UnknownValue -> p_byte 1 st - | ValValue (a,b) -> p_byte 2 st; p_tup2 (p_vref "optval") p_ExprValueInfo (a,b) st + | ValValue (a, b) -> p_byte 2 st; p_tup2 (p_vref "optval") p_ExprValueInfo (a, b) st | TupleValue a -> p_byte 3 st; p_array p_ExprValueInfo a st - | UnionCaseValue (a,b) -> p_byte 4 st; p_tup2 p_ucref (p_array p_ExprValueInfo) (a,b) st - | CurriedLambdaValue (_,b,c,d,e) -> p_byte 5 st; p_tup4 p_int p_int p_expr p_typ (b,c,d,e) st - | ConstExprValue (a,b) -> p_byte 6 st; p_tup2 p_int p_expr (a,b) st - | RecdValue (tcref,a) -> p_byte 7 st; p_tup2 (p_tcref "opt data") (p_array p_ExprValueInfo) (tcref,a) st - | SizeValue (_adepth,a) -> p_ExprValueInfo a st + | UnionCaseValue (a, b) -> p_byte 4 st; p_tup2 p_ucref (p_array p_ExprValueInfo) (a, b) st + | CurriedLambdaValue (_, b, c, d, e) -> p_byte 5 st; p_tup4 p_int p_int p_expr p_typ (b, c, d, e) st + | ConstExprValue (a, b) -> p_byte 6 st; p_tup2 p_int p_expr (a, b) st + | RecdValue (tcref, a) -> p_byte 7 st; p_tup2 (p_tcref "opt data") (p_array p_ExprValueInfo) (tcref, a) st + | SizeValue (_adepth, a) -> p_ExprValueInfo a st and p_ValInfo (v:ValInfo) st = p_tup2 p_ExprValueInfo p_bool (v.ValExprInfo, v.ValMakesNoCriticalTailcalls) st @@ -3230,23 +3230,23 @@ let rec u_ExprInfo st = let rec loop st = let tag = u_byte st match tag with - | 0 -> u_tup2 u_const u_typ st |> (fun (c,ty) -> ConstValue(c,ty)) + | 0 -> u_tup2 u_const u_typ st |> (fun (c, ty) -> ConstValue(c, ty)) | 1 -> UnknownValue - | 2 -> u_tup2 u_vref loop st |> (fun (a,b) -> ValValue (a,b)) + | 2 -> u_tup2 u_vref loop st |> (fun (a, b) -> ValValue (a, b)) | 3 -> u_array loop st |> (fun a -> TupleValue a) - | 4 -> u_tup2 u_ucref (u_array loop) st |> (fun (a,b) -> UnionCaseValue (a,b)) - | 5 -> u_tup4 u_int u_int u_expr u_typ st |> (fun (b,c,d,e) -> CurriedLambdaValue (newUnique(),b,c,d,e)) - | 6 -> u_tup2 u_int u_expr st |> (fun (a,b) -> ConstExprValue (a,b)) - | 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a,b) -> RecdValue (a,b)) + | 4 -> u_tup2 u_ucref (u_array loop) st |> (fun (a, b) -> UnionCaseValue (a, b)) + | 5 -> u_tup4 u_int u_int u_expr u_typ st |> (fun (b, c, d, e) -> CurriedLambdaValue (newUnique(), b, c, d, e)) + | 6 -> u_tup2 u_int u_expr st |> (fun (a, b) -> ConstExprValue (a, b)) + | 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a, b) -> RecdValue (a, b)) | _ -> failwith "loop" MakeSizedValueInfo (loop st) (* calc size of unpicked ExprValueInfo *) and u_ValInfo st = - let a,b = u_tup2 u_ExprInfo u_bool st + let a, b = u_tup2 u_ExprInfo u_bool st { ValExprInfo=a; ValMakesNoCriticalTailcalls = b } and u_ModuleInfo st = - let a,b = u_tup2 (u_array (u_tup2 u_vref u_ValInfo)) (u_namemap u_LazyModuleInfo) st + let a, b = u_tup2 (u_array (u_tup2 u_vref u_ValInfo)) (u_namemap u_LazyModuleInfo) st { ValInfos= ValInfos a; ModuleOrNamespaceInfos=b} and u_LazyModuleInfo st = u_lazy u_ModuleInfo st diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 12124c67a890e46581734eb04d3d9a5130af396e..00701c1f1cbfd7d2db3b8183caff3c3665dd172f 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -45,7 +45,7 @@ type TyparMap<'T> = member tm.Add (v: Typar, x) = let (TPMap m) = tm - TPMap (m.Add(v.Stamp,x)) + TPMap (m.Add(v.Stamp, x)) static member Empty : TyparMap<'T> = TPMap Map.empty @@ -54,12 +54,12 @@ type TyconRefMap<'T>(imap: StampMap<'T>) = member m.Item with get (v: TyconRef) = imap.[v.Stamp] member m.TryFind (v: TyconRef) = imap.TryFind v.Stamp member m.ContainsKey (v: TyconRef) = imap.ContainsKey v.Stamp - member m.Add (v: TyconRef) x = TyconRefMap (imap.Add (v.Stamp,x)) + member m.Add (v: TyconRef) x = TyconRefMap (imap.Add (v.Stamp, x)) member m.Remove (v: TyconRef) = TyconRefMap (imap.Remove v.Stamp) member m.IsEmpty = imap.IsEmpty static member Empty : TyconRefMap<'T> = TyconRefMap Map.empty - static member OfList vs = (vs, TyconRefMap<'T>.Empty) ||> List.foldBack (fun (x,y) acc -> acc.Add x y) + static member OfList vs = (vs, TyconRefMap<'T>.Empty) ||> List.foldBack (fun (x, y) acc -> acc.Add x y) [] [] @@ -69,11 +69,11 @@ type ValMap<'T>(imap: StampMap<'T>) = member m.Item with get (v:Val) = imap.[v.Stamp] member m.TryFind (v: Val) = imap.TryFind v.Stamp member m.ContainsVal (v: Val) = imap.ContainsKey v.Stamp - member m.Add (v: Val) x = ValMap (imap.Add(v.Stamp,x)) + member m.Add (v: Val) x = ValMap (imap.Add(v.Stamp, x)) member m.Remove (v: Val) = ValMap (imap.Remove(v.Stamp)) static member Empty = ValMap<'T> Map.empty member m.IsEmpty = imap.IsEmpty - static member OfList vs = (vs, ValMap<'T>.Empty) ||> List.foldBack (fun (x,y) acc -> acc.Add x y) + static member OfList vs = (vs, ValMap<'T>.Empty) ||> List.foldBack (fun (x, y) acc -> acc.Add x y) //-------------------------------------------------------------------------- // renamings @@ -118,7 +118,7 @@ let isRemapEmpty remap = let rec instTyparRef tpinst ty tp = match tpinst with | [] -> ty - | (tp',ty')::t -> + | (tp', ty')::t -> if typarEq tp tp' then ty' else instTyparRef t ty tp @@ -128,7 +128,7 @@ let instMeasureTyparRef tpinst unt (tp:Typar) = let rec loop tpinst = match tpinst with | [] -> unt - | (tp',ty')::t -> + | (tp', ty')::t -> if typarEq tp tp' then match ty' with | TType_measure unt -> unt @@ -143,8 +143,8 @@ let remapTyconRef (tcmap: TyconRefMap<_>) tcr = | Some tcr -> tcr | None -> tcr -let remapUnionCaseRef tcmap (UCRef(tcref,nm)) = UCRef(remapTyconRef tcmap tcref,nm) -let remapRecdFieldRef tcmap (RFRef(tcref,nm)) = RFRef(remapTyconRef tcmap tcref,nm) +let remapUnionCaseRef tcmap (UCRef(tcref, nm)) = UCRef(remapTyconRef tcmap tcref, nm) +let remapRecdFieldRef tcmap (RFRef(tcref, nm)) = RFRef(remapTyconRef tcmap tcref, nm) let mkTyparInst (typars: Typars) tyargs = #if CHECKED @@ -160,9 +160,9 @@ let rec remapTypeAux (tyenv : Remap) (ty:TType) = let ty = stripTyparEqns ty match ty with | TType_var tp as ty -> instTyparRef tyenv.tpinst ty tp - | TType_app (tcr,tinst) as ty -> + | TType_app (tcr, tinst) as ty -> match tyenv.tyconRefRemap.TryFind tcr with - | Some tcr' -> TType_app (tcr',remapTypesAux tyenv tinst) + | Some tcr' -> TType_app (tcr', remapTypesAux tyenv tinst) | None -> match tinst with | [] -> ty // optimization to avoid re-allocation of TType_app node in the common case @@ -170,12 +170,12 @@ let rec remapTypeAux (tyenv : Remap) (ty:TType) = // avoid reallocation on idempotent let tinst' = remapTypesAux tyenv tinst if tinst === tinst' then ty else - TType_app (tcr,tinst') + TType_app (tcr, tinst') - | TType_ucase (UCRef(tcr,n),tinst) -> + | TType_ucase (UCRef(tcr, n), tinst) -> match tyenv.tyconRefRemap.TryFind tcr with - | Some tcr' -> TType_ucase (UCRef(tcr',n),remapTypesAux tyenv tinst) - | None -> TType_ucase (UCRef(tcr,n),remapTypesAux tyenv tinst) + | Some tcr' -> TType_ucase (UCRef(tcr', n), remapTypesAux tyenv tinst) + | None -> TType_ucase (UCRef(tcr, n), remapTypesAux tyenv tinst) | TType_tuple (tupInfo, l) as ty -> let tupInfo' = remapTupInfoAux tyenv tupInfo @@ -183,14 +183,14 @@ let rec remapTypeAux (tyenv : Remap) (ty:TType) = if tupInfo === tupInfo' && l === l' then ty else TType_tuple (tupInfo', l') - | TType_fun (d,r) as ty -> + | TType_fun (d, r) as ty -> let d' = remapTypeAux tyenv d let r' = remapTypeAux tyenv r if d === d' && r === r' then ty else TType_fun (d', r') - | TType_forall (tps,ty) -> - let tps',tyenv = copyAndRemapAndBindTypars tyenv tps + | TType_forall (tps, ty) -> + let tps', tyenv = copyAndRemapAndBindTypars tyenv tps TType_forall (tps', remapTypeAux tyenv ty) | TType_measure unt -> @@ -204,8 +204,8 @@ and remapMeasureAux tyenv unt = match tyenv.tyconRefRemap.TryFind tcr with | Some tcr -> Measure.Con tcr | None -> unt - | Measure.Prod(u1,u2) -> Measure.Prod(remapMeasureAux tyenv u1, remapMeasureAux tyenv u2) - | Measure.RationalPower(u,q) -> Measure.RationalPower(remapMeasureAux tyenv u, q) + | Measure.Prod(u1, u2) -> Measure.Prod(remapMeasureAux tyenv u1, remapMeasureAux tyenv u2) + | Measure.RationalPower(u, q) -> Measure.RationalPower(remapMeasureAux tyenv u, q) | Measure.Inv u -> Measure.Inv(remapMeasureAux tyenv u) | Measure.Var tp as unt -> match tp.Solution with @@ -226,16 +226,16 @@ and remapTypesAux tyenv types = List.mapq (remapTypeAux tyenv) types and remapTyparConstraintsAux tyenv cs = cs |> List.choose (fun x -> match x with - | TyparConstraint.CoercesTo(ty,m) -> - Some(TyparConstraint.CoercesTo (remapTypeAux tyenv ty,m)) - | TyparConstraint.MayResolveMember(traitInfo,m) -> - Some(TyparConstraint.MayResolveMember (remapTraitAux tyenv traitInfo,m)) - | TyparConstraint.DefaultsTo(priority,ty,m) -> Some(TyparConstraint.DefaultsTo(priority,remapTypeAux tyenv ty,m)) - | TyparConstraint.IsEnum(uty,m) -> - Some(TyparConstraint.IsEnum(remapTypeAux tyenv uty,m)) - | TyparConstraint.IsDelegate(uty1,uty2,m) -> - Some(TyparConstraint.IsDelegate(remapTypeAux tyenv uty1,remapTypeAux tyenv uty2,m)) - | TyparConstraint.SimpleChoice(tys,m) -> Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys,m)) + | TyparConstraint.CoercesTo(ty, m) -> + Some(TyparConstraint.CoercesTo (remapTypeAux tyenv ty, m)) + | TyparConstraint.MayResolveMember(traitInfo, m) -> + Some(TyparConstraint.MayResolveMember (remapTraitAux tyenv traitInfo, m)) + | TyparConstraint.DefaultsTo(priority, ty, m) -> Some(TyparConstraint.DefaultsTo(priority, remapTypeAux tyenv ty, m)) + | TyparConstraint.IsEnum(uty, m) -> + Some(TyparConstraint.IsEnum(remapTypeAux tyenv uty, m)) + | TyparConstraint.IsDelegate(uty1, uty2, m) -> + Some(TyparConstraint.IsDelegate(remapTypeAux tyenv uty1, remapTypeAux tyenv uty2, m)) + | TyparConstraint.SimpleChoice(tys, m) -> Some(TyparConstraint.SimpleChoice(remapTypesAux tyenv tys, m)) | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -244,7 +244,7 @@ and remapTyparConstraintsAux tyenv cs = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> Some(x)) -and remapTraitAux tyenv (TTrait(typs,nm,mf,argtys,rty,slnCell)) = +and remapTraitAux tyenv (TTrait(typs, nm, mf, argtys, rty, slnCell)) = let slnCell = match !slnCell with | None -> None @@ -252,10 +252,10 @@ and remapTraitAux tyenv (TTrait(typs,nm,mf,argtys,rty,slnCell)) = | Some sln -> let sln = match sln with - | ILMethSln(typ,extOpt,ilMethRef,minst) -> - ILMethSln(remapTypeAux tyenv typ,extOpt,ilMethRef,remapTypesAux tyenv minst) - | FSMethSln(typ, vref,minst) -> - FSMethSln(remapTypeAux tyenv typ, remapValRef tyenv vref,remapTypesAux tyenv minst) + | ILMethSln(typ, extOpt, ilMethRef, minst) -> + ILMethSln(remapTypeAux tyenv typ, extOpt, ilMethRef, remapTypesAux tyenv minst) + | FSMethSln(typ, vref, minst) -> + FSMethSln(remapTypeAux tyenv typ, remapValRef tyenv vref, remapTypesAux tyenv minst) | FSRecdFieldSln(tinst, rfref, isSet) -> FSRecdFieldSln(remapTypesAux tyenv tinst, remapRecdFieldRef tyenv.tyconRefRemap rfref, isSet) | BuiltInSln -> @@ -271,25 +271,25 @@ and remapTraitAux tyenv (TTrait(typs,nm,mf,argtys,rty,slnCell)) = // The danger here is that a solution for one syntactic occurrence of a trait constraint won't // be propagated to other, "linked" solutions. However trait constraints don't appear in any algebra // in the same way as types - TTrait(remapTypesAux tyenv typs,nm,mf,remapTypesAux tyenv argtys, Option.map (remapTypeAux tyenv) rty,ref slnCell) + TTrait(remapTypesAux tyenv typs, nm, mf, remapTypesAux tyenv argtys, Option.map (remapTypeAux tyenv) rty, ref slnCell) and bindTypars tps tyargs tpinst = match tps with | [] -> tpinst - | _ -> List.map2 (fun tp tyarg -> (tp,tyarg)) tps tyargs @ tpinst + | _ -> List.map2 (fun tp tyarg -> (tp, tyarg)) tps tyargs @ tpinst // This version is used to remap most type parameters, e.g. ones bound at tycons, vals, records // See notes below on remapTypeFull for why we have a function that accepts remapAttribs as an argument and copyAndRemapAndBindTyparsFull remapAttrib tyenv tps = match tps with - | [] -> tps,tyenv + | [] -> tps, tyenv | _ -> let tps' = copyTypars tps let tyenv = { tyenv with tpinst = bindTypars tps (generalizeTypars tps') tyenv.tpinst } - (tps,tps') ||> List.iter2 (fun tporig tp -> + (tps, tps') ||> List.iter2 (fun tporig tp -> tp.FixupConstraints (remapTyparConstraintsAux tyenv tporig.Constraints) tp.typar_attribs <- tporig.typar_attribs |> remapAttrib) - tps',tyenv + tps', tyenv // copies bound typars, extends tpinst and copyAndRemapAndBindTypars tyenv tps = @@ -343,22 +343,22 @@ let remapTypes tyenv x = let remapTypeFull remapAttrib tyenv ty = if isRemapEmpty tyenv then ty else match stripTyparEqns ty with - | TType_forall(tps,tau) -> - let tps',tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tyenv tps - TType_forall(tps',remapType tyenvinner tau) + | TType_forall(tps, tau) -> + let tps', tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tyenv tps + TType_forall(tps', remapType tyenvinner tau) | _ -> remapType tyenv ty -let remapParam tyenv (TSlotParam(nm,typ,fl1,fl2,fl3,attribs) as x) = +let remapParam tyenv (TSlotParam(nm, typ, fl1, fl2, fl3, attribs) as x) = if isRemapEmpty tyenv then x else - TSlotParam(nm,remapTypeAux tyenv typ,fl1,fl2,fl3,attribs) + TSlotParam(nm, remapTypeAux tyenv typ, fl1, fl2, fl3, attribs) -let remapSlotSig remapAttrib tyenv (TSlotSig(nm,typ, ctps,methTypars,paraml, rty) as x) = +let remapSlotSig remapAttrib tyenv (TSlotSig(nm, typ, ctps, methTypars, paraml, rty) as x) = if isRemapEmpty tyenv then x else let typ' = remapTypeAux tyenv typ - let ctps',tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tyenv ctps - let methTypars',tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tyenvinner methTypars - TSlotSig(nm,typ', ctps',methTypars',List.mapSquared (remapParam tyenvinner) paraml,Option.map (remapTypeAux tyenvinner) rty) + let ctps', tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tyenv ctps + let methTypars', tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tyenvinner methTypars + TSlotSig(nm, typ', ctps', methTypars', List.mapSquared (remapParam tyenvinner) paraml, Option.map (remapTypeAux tyenvinner) rty) let mkInstRemap tpinst = { tyconRefRemap = emptyTyconRefRemap @@ -377,7 +377,7 @@ let copySlotSig ss = remapSlotSig (fun _ -> []) Remap.Empty ss let mkTyparToTyparRenaming tpsOrig tps = let tinst = generalizeTypars tps - mkTyparInst tpsOrig tinst,tinst + mkTyparInst tpsOrig tinst, tinst let mkTyconInst (tycon:Tycon) tinst = mkTyparInst tycon.TyparsNoRange tinst let mkTyconRefInst (tcref:TyconRef) tinst = mkTyconInst tcref.Deref tinst @@ -416,8 +416,8 @@ let rec MeasureExprConExponent g abbrev ucref unt = match (if abbrev then stripUnitEqnsFromMeasure unt else stripUnitEqns unt) with | Measure.Con ucref' -> if tyconRefEq g ucref' ucref then OneRational else ZeroRational | Measure.Inv unt' -> NegRational(MeasureExprConExponent g abbrev ucref unt') - | Measure.Prod(unt1,unt2) -> AddRational(MeasureExprConExponent g abbrev ucref unt1) (MeasureExprConExponent g abbrev ucref unt2) - | Measure.RationalPower(unt',q) -> MulRational (MeasureExprConExponent g abbrev ucref unt') q + | Measure.Prod(unt1, unt2) -> AddRational(MeasureExprConExponent g abbrev ucref unt1) (MeasureExprConExponent g abbrev ucref unt2) + | Measure.RationalPower(unt', q) -> MulRational (MeasureExprConExponent g abbrev ucref unt') q | _ -> ZeroRational /// What is the contribution of unit-of-measure constant ucref to unit-of-measure expression measure @@ -426,8 +426,8 @@ let rec MeasureConExponentAfterRemapping g r ucref unt = match stripUnitEqnsFromMeasure unt with | Measure.Con ucref' -> if tyconRefEq g (r ucref') ucref then OneRational else ZeroRational | Measure.Inv unt' -> NegRational(MeasureConExponentAfterRemapping g r ucref unt') - | Measure.Prod(unt1,unt2) -> AddRational(MeasureConExponentAfterRemapping g r ucref unt1) (MeasureConExponentAfterRemapping g r ucref unt2) - | Measure.RationalPower(unt',q) -> MulRational (MeasureConExponentAfterRemapping g r ucref unt') q + | Measure.Prod(unt1, unt2) -> AddRational(MeasureConExponentAfterRemapping g r ucref unt1) (MeasureConExponentAfterRemapping g r ucref unt2) + | Measure.RationalPower(unt', q) -> MulRational (MeasureConExponentAfterRemapping g r ucref unt') q | _ -> ZeroRational /// What is the contribution of unit-of-measure variable tp to unit-of-measure expression unt? @@ -435,8 +435,8 @@ let rec MeasureVarExponent tp unt = match stripUnitEqnsFromMeasure unt with | Measure.Var tp' -> if typarEq tp tp' then OneRational else ZeroRational | Measure.Inv unt' -> NegRational(MeasureVarExponent tp unt') - | Measure.Prod(unt1,unt2) -> AddRational(MeasureVarExponent tp unt1) (MeasureVarExponent tp unt2) - | Measure.RationalPower(unt',q) -> MulRational (MeasureVarExponent tp unt') q + | Measure.Prod(unt1, unt2) -> AddRational(MeasureVarExponent tp unt1) (MeasureVarExponent tp unt2) + | Measure.RationalPower(unt', q) -> MulRational (MeasureVarExponent tp unt') q | _ -> ZeroRational /// List the *literal* occurrences of unit variables in a unit expression, without repeats @@ -444,8 +444,8 @@ let ListMeasureVarOccs unt = let rec gather acc unt = match stripUnitEqnsFromMeasure unt with | Measure.Var tp -> if List.exists (typarEq tp) acc then acc else tp::acc - | Measure.Prod(unt1,unt2) -> gather (gather acc unt1) unt2 - | Measure.RationalPower(unt',_) -> gather acc unt' + | Measure.Prod(unt1, unt2) -> gather (gather acc unt1) unt2 + | Measure.RationalPower(unt', _) -> gather acc unt' | Measure.Inv unt' -> gather acc unt' | _ -> acc gather [] unt @@ -458,10 +458,10 @@ let ListMeasureVarOccsWithNonZeroExponents untexpr = if List.exists (fun (tp', _) -> typarEq tp tp') acc then acc else let e = MeasureVarExponent tp untexpr - if e = ZeroRational then acc else (tp,e)::acc - | Measure.Prod(unt1,unt2) -> gather (gather acc unt1) unt2 + if e = ZeroRational then acc else (tp, e)::acc + | Measure.Prod(unt1, unt2) -> gather (gather acc unt1) unt2 | Measure.Inv unt' -> gather acc unt' - | Measure.RationalPower(unt',_) -> gather acc unt' + | Measure.RationalPower(unt', _) -> gather acc unt' | _ -> acc gather [] untexpr @@ -472,21 +472,21 @@ let ListMeasureConOccsWithNonZeroExponents g eraseAbbrevs untexpr = | Measure.Con c -> if List.exists (fun (c', _) -> tyconRefEq g c c') acc then acc else let e = MeasureExprConExponent g eraseAbbrevs c untexpr - if e = ZeroRational then acc else (c,e)::acc - | Measure.Prod(unt1,unt2) -> gather (gather acc unt1) unt2 + if e = ZeroRational then acc else (c, e)::acc + | Measure.Prod(unt1, unt2) -> gather (gather acc unt1) unt2 | Measure.Inv unt' -> gather acc unt' - | Measure.RationalPower(unt',_) -> gather acc unt' + | Measure.RationalPower(unt', _) -> gather acc unt' | _ -> acc gather [] untexpr -/// List the *literal* occurrences of unit constants in a unit expression, without repeats, +/// List the *literal* occurrences of unit constants in a unit expression, without repeats, /// and after applying a remapping function r to tycons let ListMeasureConOccsAfterRemapping g r unt = let rec gather acc unt = match stripUnitEqnsFromMeasure unt with | Measure.Con c -> if List.exists (tyconRefEq g (r c)) acc then acc else r c::acc - | Measure.Prod(unt1,unt2) -> gather (gather acc unt1) unt2 - | Measure.RationalPower(unt',_) -> gather acc unt' + | Measure.Prod(unt1, unt2) -> gather (gather acc unt1) unt2 + | Measure.RationalPower(unt', _) -> gather acc unt' | Measure.Inv unt' -> gather acc unt' | _ -> acc @@ -502,7 +502,7 @@ let MeasureProdOpt m1 m2 = match m1, m2 with | Measure.One, _ -> m2 | _, Measure.One -> m1 - | _, _ -> Measure.Prod (m1,m2) + | _, _ -> Measure.Prod (m1, m2) /// Construct a measure expression representing the product of a list of measures let ProdMeasures ms = @@ -522,7 +522,7 @@ let destUnitParMeasure g unt = let cs = ListMeasureConOccsWithNonZeroExponents g true unt match vs, cs with - | [(v,e)], [] when e = OneRational -> v + | [(v, e)], [] when e = OneRational -> v | _, _ -> failwith "destUnitParMeasure: not a unit-of-measure parameter" let isUnitParMeasure g unt = @@ -530,16 +530,16 @@ let isUnitParMeasure g unt = let cs = ListMeasureConOccsWithNonZeroExponents g true unt match vs, cs with - | [(_,e)], [] when e = OneRational -> true - | _, _ -> false + | [(_, e)], [] when e = OneRational -> true + | _, _ -> false let normalizeMeasure g ms = let vs = ListMeasureVarOccsWithNonZeroExponents ms let cs = ListMeasureConOccsWithNonZeroExponents g false ms match vs, cs with - | [],[] -> Measure.One - | [(v,e)], [] when e = OneRational -> Measure.Var v - | vs, cs -> List.foldBack (fun (v,e) -> fun m -> Measure.Prod (Measure.RationalPower (Measure.Var v, e), m)) vs (List.foldBack (fun (c,e) -> fun m -> Measure.Prod (Measure.RationalPower (Measure.Con c, e), m)) cs Measure.One) + | [], [] -> Measure.One + | [(v, e)], [] when e = OneRational -> Measure.Var v + | vs, cs -> List.foldBack (fun (v, e) -> fun m -> Measure.Prod (Measure.RationalPower (Measure.Var v, e), m)) vs (List.foldBack (fun (c, e) -> fun m -> Measure.Prod (Measure.RationalPower (Measure.Con c, e), m)) cs Measure.One) let tryNormalizeMeasureInType g ty = match ty with @@ -560,7 +560,7 @@ let mkByrefTy (g:TcGlobals) ty = TType_app (g.byref_tcr, [ty]) let mkArrayTy (g:TcGlobals) rank ty m = if rank < 1 || rank > 32 then - errorR(Error(FSComp.SR.tastopsMaxArrayThirtyTwo(rank),m)) + errorR(Error(FSComp.SR.tastopsMaxArrayThirtyTwo(rank), m)) TType_app (g.il_arr_tcr_map.[3], [ty]) else TType_app (g.il_arr_tcr_map.[rank - 1], [ty]) @@ -605,7 +605,7 @@ let rec mkCompiledTupleTy g isStruct tys = let n = List.length tys if n < maxTuple then TType_app (mkCompiledTupleTyconRef g isStruct n, tys) else - let tysA,tysB = List.splitAfter goodTupleFields tys + let tysA, tysB = List.splitAfter goodTupleFields tys TType_app ((if isStruct then g.struct_tuple8_tcr else g.ref_tuple8_tcr), tysA@[mkCompiledTupleTy g isStruct tysB]) //--------------------------------------------------------------------------- @@ -645,7 +645,7 @@ let reduceTyconRefMeasureableOrProvided (g:TcGlobals) (tcref:TyconRef) tyargs = let rec stripTyEqnsA g canShortcut ty = let ty = stripTyparEqnsAux canShortcut ty match ty with - | TType_app (tcref,tinst) -> + | TType_app (tcref, tinst) -> let tycon = tcref.Deref match tycon.TypeAbbrev with | Some abbrevTy -> @@ -670,7 +670,7 @@ let evalTupInfoIsStruct aexpr = let rec stripTyEqnsAndErase eraseFuncAndTuple (g:TcGlobals) ty = let ty = stripTyEqns g ty match ty with - | TType_app (tcref,args) -> + | TType_app (tcref, args) -> let tycon = tcref.Deref if tycon.IsErased then stripTyEqnsAndErase eraseFuncAndTuple g (reduceTyconMeasureableOrProvided g tycon args) @@ -678,8 +678,8 @@ let rec stripTyEqnsAndErase eraseFuncAndTuple (g:TcGlobals) ty = stripTyEqnsAndErase eraseFuncAndTuple g g.nativeint_ty else ty - | TType_fun(a,b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr,[ a; b]) - | TType_tuple(tupInfo,l) when eraseFuncAndTuple -> mkCompiledTupleTy g (evalTupInfoIsStruct tupInfo) l + | TType_fun(a, b) when eraseFuncAndTuple -> TType_app(g.fastFunc_tcr, [ a; b]) + | TType_tuple(tupInfo, l) when eraseFuncAndTuple -> mkCompiledTupleTy g (evalTupInfoIsStruct tupInfo) l | ty -> ty let stripTyEqnsAndMeasureEqns g ty = @@ -700,25 +700,25 @@ let rec stripExnEqns (eref:TyconRef) = | _ -> exnc -let primDestForallTy g ty = ty |> stripTyEqns g |> (function TType_forall (tyvs,tau) -> (tyvs,tau) | _ -> failwith "primDestForallTy: not a forall type") -let destFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv,tau) -> (tyv,tau) | _ -> failwith "destFunTy: not a function type") -let destAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo,l) -> tupInfo,l | _ -> failwith "destAnyTupleTy: not a tuple type") -let destRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo,l) when not (evalTupInfoIsStruct tupInfo) -> l | _ -> failwith "destRefTupleTy: not a reference tuple type") -let destStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo,l) when evalTupInfoIsStruct tupInfo -> l | _ -> failwith "destStructTupleTy: not a struct tuple type") +let primDestForallTy g ty = ty |> stripTyEqns g |> (function TType_forall (tyvs, tau) -> (tyvs, tau) | _ -> failwith "primDestForallTy: not a forall type") +let destFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> (tyv, tau) | _ -> failwith "destFunTy: not a function type") +let destAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) -> tupInfo, l | _ -> failwith "destAnyTupleTy: not a tuple type") +let destRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) when not (evalTupInfoIsStruct tupInfo) -> l | _ -> failwith "destRefTupleTy: not a reference tuple type") +let destStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, l) when evalTupInfoIsStruct tupInfo -> l | _ -> failwith "destStructTupleTy: not a struct tuple type") let destTyparTy g ty = ty |> stripTyEqns g |> (function TType_var v -> v | _ -> failwith "destTyparTy: not a typar type") let destAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> v | TType_measure unt -> destUnitParMeasure g unt | _ -> failwith "destAnyParTy: not a typar or unpar type") let destMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure m -> m | _ -> failwith "destMeasureTy: not a unit-of-measure type") let isFunTy g ty = ty |> stripTyEqns g |> (function TType_fun _ -> true | _ -> false) let isForallTy g ty = ty |> stripTyEqns g |> (function TType_forall _ -> true | _ -> false) let isAnyTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple _ -> true | _ -> false) -let isRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo,_) -> not (evalTupInfoIsStruct tupInfo) | _ -> false) -let isStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo,_) -> evalTupInfoIsStruct tupInfo | _ -> false) -let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr,_) -> tcr.IsUnionTycon | _ -> false) -let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr,_) -> tcr.IsHiddenReprTycon | _ -> false) -let isFSharpObjModelTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr,_) -> tcr.IsFSharpObjectModelTycon | _ -> false) -let isRecdTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr,_) -> tcr.IsRecordTycon | _ -> false) -let isFSharpStructOrEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr,_) -> tcr.IsFSharpStructOrEnumTycon | _ -> false) -let isFSharpEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr,_) -> tcr.IsFSharpEnumTycon | _ -> false) +let isRefTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> not (evalTupInfoIsStruct tupInfo) | _ -> false) +let isStructTupleTy g ty = ty |> stripTyEqns g |> (function TType_tuple (tupInfo, _) -> evalTupInfoIsStruct tupInfo | _ -> false) +let isUnionTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsUnionTycon | _ -> false) +let isReprHiddenTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsHiddenReprTycon | _ -> false) +let isFSharpObjModelTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsFSharpObjectModelTycon | _ -> false) +let isRecdTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsRecordTycon | _ -> false) +let isFSharpStructOrEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsFSharpStructOrEnumTycon | _ -> false) +let isFSharpEnumTy g ty = ty |> stripTyEqns g |> (function TType_app(tcr, _) -> tcr.IsFSharpEnumTycon | _ -> false) let isTyparTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | _ -> false) let isAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var _ -> true | TType_measure unt -> isUnitParMeasure g unt | _ -> false) let isMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure _ -> true | _ -> false) @@ -726,46 +726,46 @@ let isMeasureTy g ty = ty |> stripTyEqns g |> (function TType_measure _ -> tr let isProvenUnionCaseTy ty = match ty with TType_ucase _ -> true | _ -> false -let mkAppTy tcref tyargs = TType_app(tcref,tyargs) -let mkProvenUnionCaseTy ucref tyargs = TType_ucase(ucref,tyargs) +let mkAppTy tcref tyargs = TType_app(tcref, tyargs) +let mkProvenUnionCaseTy ucref tyargs = TType_ucase(ucref, tyargs) let isAppTy g ty = ty |> stripTyEqns g |> (function TType_app _ -> true | _ -> false) -let destAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,tinst) -> tcref,tinst | _ -> failwith "destAppTy") -let tcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tcref | _ -> failwith "tcrefOfAppTy") -let argsOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(_,tinst) -> tinst | _ -> []) +let destAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, tinst) -> tcref, tinst | _ -> failwith "destAppTy") +let tcrefOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref | _ -> failwith "tcrefOfAppTy") +let argsOfAppTy g ty = ty |> stripTyEqns g |> (function TType_app(_, tinst) -> tinst | _ -> []) let tryDestTyparTy g ty = ty |> stripTyEqns g |> (function TType_var v -> Some v | _ -> None) -let tryDestFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv,tau) -> Some(tyv,tau) | _ -> None) -let tryDestAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> Some tcref | _ -> None) +let tryDestFunTy g ty = ty |> stripTyEqns g |> (function TType_fun (tyv, tau) -> Some(tyv, tau) | _ -> None) +let tryDestAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> Some tcref | _ -> None) let tryAnyParTy g ty = ty |> stripTyEqns g |> (function TType_var v -> Some v | TType_measure unt when isUnitParMeasure g unt -> Some(destUnitParMeasure g unt) | _ -> None) -let (|AppTy|_|) g ty = ty |> stripTyEqns g |> (function TType_app(tcref,tinst) -> Some (tcref,tinst) | _ -> None) -let (|RefTupleTy|_|) g ty = ty |> stripTyEqns g |> (function TType_tuple(tupInfo,tys) when not (evalTupInfoIsStruct tupInfo) -> Some tys | _ -> None) +let (|AppTy|_|) g ty = ty |> stripTyEqns g |> (function TType_app(tcref, tinst) -> Some (tcref, tinst) | _ -> None) +let (|RefTupleTy|_|) g ty = ty |> stripTyEqns g |> (function TType_tuple(tupInfo, tys) when not (evalTupInfoIsStruct tupInfo) -> Some tys | _ -> None) let (|FunTy|_|) g ty = ty |> stripTyEqns g |> (function TType_fun(dty, rty) -> Some (dty, rty) | _ -> None) let tryNiceEntityRefOfTy ty = let ty = stripTyparEqnsAux false ty match ty with - | TType_app (tcref,_) -> Some tcref + | TType_app (tcref, _) -> Some tcref | TType_measure (Measure.Con tcref) -> Some tcref | _ -> None let (|NullableTy|_|) g ty = match ty with - | AppTy g (tcr,[tyarg]) when tyconRefEq g tcr g.system_Nullable_tcref -> Some tyarg + | AppTy g (tcr, [tyarg]) when tyconRefEq g tcr g.system_Nullable_tcref -> Some tyarg | _ -> None let (|StripNullableTy|) g ty = match ty with - | AppTy g (tcr,[tyarg]) when tyconRefEq g tcr g.system_Nullable_tcref -> tyarg + | AppTy g (tcr, [tyarg]) when tyconRefEq g tcr g.system_Nullable_tcref -> tyarg | _ -> ty let (|ByrefTy|_|) g ty = match ty with - | AppTy g (tcr,[tyarg]) when tyconRefEq g tcr g.byref_tcr -> Some tyarg + | AppTy g (tcr, [tyarg]) when tyconRefEq g tcr g.byref_tcr -> Some tyarg | _ -> None let mkInstForAppTy g typ = match typ with - | AppTy g (tcref,tinst) -> mkTyconRefInst tcref tinst + | AppTy g (tcref, tinst) -> mkTyconRefInst tcref tinst | _ -> [] let domainOfFunTy g ty = fst(destFunTy g ty) @@ -790,19 +790,19 @@ type TypeEquivEnv with static member Empty = typeEquivEnvEmpty member aenv.BindTyparsToTypes tps1 tys2 = - { aenv with EquivTypars = (tps1,tys2,aenv.EquivTypars) |||> List.foldBack2 (fun tp ty tpmap -> tpmap.Add(tp,ty)) } + { aenv with EquivTypars = (tps1, tys2, aenv.EquivTypars) |||> List.foldBack2 (fun tp ty tpmap -> tpmap.Add(tp, ty)) } member aenv.BindEquivTypars tps1 tps2 = aenv.BindTyparsToTypes tps1 (List.map mkTyparTy tps2) static member FromTyparInst tpinst = - let tps,tys = List.unzip tpinst + let tps, tys = List.unzip tpinst TypeEquivEnv.Empty.BindTyparsToTypes tps tys static member FromEquivTypars tps1 tps2 = TypeEquivEnv.Empty.BindEquivTypars tps1 tps2 -let rec traitsAEquivAux erasureFlag g aenv (TTrait(typs1,nm,mf1,argtys,rty,_)) (TTrait(typs2,nm2,mf2,argtys2,rty2,_)) = +let rec traitsAEquivAux erasureFlag g aenv (TTrait(typs1, nm, mf1, argtys, rty, _)) (TTrait(typs2, nm2, mf2, argtys2, rty2, _)) = mf1 = mf2 && nm = nm2 && ListSet.equals (typeAEquivAux erasureFlag g aenv) typs1 typs2 && @@ -810,42 +810,42 @@ let rec traitsAEquivAux erasureFlag g aenv (TTrait(typs1,nm,mf1,argtys,rty,_)) ( List.lengthsEqAndForall2 (typeAEquivAux erasureFlag g aenv) argtys argtys2 and returnTypesAEquivAux erasureFlag g aenv rty rty2 = - match rty,rty2 with - | None,None -> true - | Some t1,Some t2 -> typeAEquivAux erasureFlag g aenv t1 t2 + match rty, rty2 with + | None, None -> true + | Some t1, Some t2 -> typeAEquivAux erasureFlag g aenv t1 t2 | _ -> false and typarConstraintsAEquivAux erasureFlag g aenv tpc1 tpc2 = - match tpc1,tpc2 with - | TyparConstraint.CoercesTo(acty,_), - TyparConstraint.CoercesTo(fcty,_) -> + match tpc1, tpc2 with + | TyparConstraint.CoercesTo(acty, _), + TyparConstraint.CoercesTo(fcty, _) -> typeAEquivAux erasureFlag g aenv acty fcty - | TyparConstraint.MayResolveMember(trait1,_), - TyparConstraint.MayResolveMember(trait2,_) -> + | TyparConstraint.MayResolveMember(trait1, _), + TyparConstraint.MayResolveMember(trait2, _) -> traitsAEquivAux erasureFlag g aenv trait1 trait2 - | TyparConstraint.DefaultsTo(_,acty,_), - TyparConstraint.DefaultsTo(_,fcty,_) -> + | TyparConstraint.DefaultsTo(_, acty, _), + TyparConstraint.DefaultsTo(_, fcty, _) -> typeAEquivAux erasureFlag g aenv acty fcty - | TyparConstraint.IsEnum(uty1,_),TyparConstraint.IsEnum(uty2,_) -> + | TyparConstraint.IsEnum(uty1, _), TyparConstraint.IsEnum(uty2, _) -> typeAEquivAux erasureFlag g aenv uty1 uty2 - | TyparConstraint.IsDelegate(aty1,bty1,_),TyparConstraint.IsDelegate(aty2,bty2,_) -> + | TyparConstraint.IsDelegate(aty1, bty1, _), TyparConstraint.IsDelegate(aty2, bty2, _) -> typeAEquivAux erasureFlag g aenv aty1 aty2 && typeAEquivAux erasureFlag g aenv bty1 bty2 - | TyparConstraint.SimpleChoice (tys1,_),TyparConstraint.SimpleChoice(tys2,_) -> + | TyparConstraint.SimpleChoice (tys1, _), TyparConstraint.SimpleChoice(tys2, _) -> ListSet.equals (typeAEquivAux erasureFlag g aenv) tys1 tys2 - | TyparConstraint.SupportsComparison _ ,TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _ ,TyparConstraint.SupportsEquality _ - | TyparConstraint.SupportsNull _ ,TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _ ,TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsReferenceType _ ,TyparConstraint.IsReferenceType _ - | TyparConstraint.IsUnmanaged _ ,TyparConstraint.IsUnmanaged _ + | TyparConstraint.SupportsComparison _ , TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _ , TyparConstraint.SupportsEquality _ + | TyparConstraint.SupportsNull _ , TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _ , TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsReferenceType _ , TyparConstraint.IsReferenceType _ + | TyparConstraint.IsUnmanaged _ , TyparConstraint.IsUnmanaged _ | TyparConstraint.RequiresDefaultConstructor _, TyparConstraint.RequiresDefaultConstructor _ -> true | _ -> false @@ -866,22 +866,22 @@ and typeAEquivAux erasureFlag g aenv ty1 ty2 = let ty1 = stripTyEqnsWrtErasure erasureFlag g ty1 let ty2 = stripTyEqnsWrtErasure erasureFlag g ty2 match ty1, ty2 with - | TType_forall(tps1,rty1), TType_forall(tps2,rty2) -> + | TType_forall(tps1, rty1), TType_forall(tps2, rty2) -> typarsAEquivAux erasureFlag g aenv tps1 tps2 && typeAEquivAux erasureFlag g (aenv.BindEquivTypars tps1 tps2) rty1 rty2 | TType_var tp1, TType_var tp2 when typarEq tp1 tp2 -> true | TType_var tp1, _ when aenv.EquivTypars.ContainsKey tp1 -> typeEquivAux erasureFlag g aenv.EquivTypars.[tp1] ty2 - | TType_app (tc1,b1) ,TType_app (tc2,b2) -> + | TType_app (tc1, b1) , TType_app (tc2, b2) -> tcrefAEquiv g aenv tc1 tc2 && typesAEquivAux erasureFlag g aenv b1 b2 - | TType_ucase (UCRef(tc1,n1),b1) ,TType_ucase (UCRef(tc2,n2),b2) -> + | TType_ucase (UCRef(tc1, n1), b1) , TType_ucase (UCRef(tc2, n2), b2) -> n1=n2 && tcrefAEquiv g aenv tc1 tc2 && typesAEquivAux erasureFlag g aenv b1 b2 - | TType_tuple (s1,l1),TType_tuple (s2,l2) -> + | TType_tuple (s1, l1), TType_tuple (s2, l2) -> structnessAEquiv s1 s2 && typesAEquivAux erasureFlag g aenv l1 l2 - | TType_fun (dtys1,rty1),TType_fun (dtys2,rty2) -> + | TType_fun (dtys1, rty1), TType_fun (dtys2, rty2) -> typeAEquivAux erasureFlag g aenv dtys1 dtys2 && typeAEquivAux erasureFlag g aenv rty1 rty2 | TType_measure m1, TType_measure m2 -> match erasureFlag with @@ -922,7 +922,7 @@ let measureEquiv g m1 m2 = measureAEquiv g TypeEquivEnv.Empty m1 m2 let isErasedType g ty = match stripTyEqns g ty with #if EXTENSIONTYPING - | TType_app (tcref,_) -> tcref.IsProvidedErasedTycon + | TType_app (tcref, _) -> tcref.IsProvidedErasedTycon #endif | _ -> false @@ -931,13 +931,13 @@ let rec getErasedTypes g ty = let ty = stripTyEqns g ty if isErasedType g ty then [ty] else match ty with - | TType_forall(_,rty) -> + | TType_forall(_, rty) -> getErasedTypes g rty | TType_var tp -> if tp.IsErased then [ty] else [] - | TType_app (_,b) | TType_ucase(_,b) | TType_tuple (_, b) -> + | TType_app (_, b) | TType_ucase(_, b) | TType_tuple (_, b) -> List.foldBack (fun ty tys -> getErasedTypes g ty @ tys) b [] - | TType_fun (dty,rty) -> + | TType_fun (dty, rty) -> getErasedTypes g dty @ getErasedTypes g rty | TType_measure _ -> [ty] @@ -947,18 +947,18 @@ let rec getErasedTypes g ty = // Standard orderings, e.g. for order set/map keys //--------------------------------------------------------------------------- -let valOrder = { new IComparer with member __.Compare(v1,v2) = compare v1.Stamp v2.Stamp } -let tyconOrder = { new IComparer with member __.Compare(tc1,tc2) = compare tc1.Stamp tc2.Stamp } +let valOrder = { new IComparer with member __.Compare(v1, v2) = compare v1.Stamp v2.Stamp } +let tyconOrder = { new IComparer with member __.Compare(tc1, tc2) = compare tc1.Stamp tc2.Stamp } let recdFieldRefOrder = { new IComparer with - member __.Compare(RFRef(tcref1,nm1), RFRef(tcref2,nm2)) = + member __.Compare(RFRef(tcref1, nm1), RFRef(tcref2, nm2)) = let c = tyconOrder.Compare (tcref1.Deref, tcref2.Deref) if c <> 0 then c else compare nm1 nm2 } let unionCaseRefOrder = { new IComparer with - member __.Compare(UCRef(tcref1,nm1), UCRef(tcref2,nm2)) = + member __.Compare(UCRef(tcref1, nm1), UCRef(tcref2, nm2)) = let c = tyconOrder.Compare (tcref1.Deref, tcref2.Deref) if c <> 0 then c else compare nm1 nm2 } @@ -967,16 +967,16 @@ let unionCaseRefOrder = // Make some common types //--------------------------------------------------------------------------- -let mkFunTy d r = TType_fun (d,r) +let mkFunTy d r = TType_fun (d, r) let (-->) d r = mkFunTy d r -let mkForallTy d r = TType_forall (d,r) +let mkForallTy d r = TType_forall (d, r) let tryMkForallTy d r = if isNil d then r else mkForallTy d r let (+->) d r = tryMkForallTy d r let mkIteratedFunTy dl r = List.foldBack (-->) dl r let mkLambdaArgTy m tys = match tys with - | [] -> error(InternalError("mkLambdaArgTy",m)) + | [] -> error(InternalError("mkLambdaArgTy", m)) | [h] -> h | _ -> mkRawRefTupleTy tys @@ -988,18 +988,18 @@ let mkLambdaTy tps tys rty = tryMkForallTy tps (mkIteratedFunTy tys rty) /// the library arising from env.fs. Part of this means that we have to be able to resolve these /// references. This function artificially forces the existence of a module or namespace at a /// particular point in order to do this. -let ensureCcuHasModuleOrNamespaceAtPath (ccu:CcuThunk) path (CompPath(_,cpath)) xml = +let ensureCcuHasModuleOrNamespaceAtPath (ccu:CcuThunk) path (CompPath(_, cpath)) xml = let scoref = ccu.ILScopeRef let rec loop prior_cpath (path:Ident list) cpath (modul:ModuleOrNamespace) = let mtype = modul.ModuleOrNamespaceType - match path,cpath with - | (hpath::tpath),((_,mkind)::tcpath) -> + match path, cpath with + | (hpath::tpath), ((_, mkind)::tcpath) -> let modName = hpath.idText if not (Map.containsKey modName mtype.AllEntitiesByCompiledAndLogicalMangledNames) then - let smodul = NewModuleOrNamespace (Some(CompPath(scoref,prior_cpath))) taccessPublic hpath xml [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType mkind)) + let smodul = NewModuleOrNamespace (Some(CompPath(scoref, prior_cpath))) taccessPublic hpath xml [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType mkind)) mtype.AddModuleOrNamespaceByMutation(smodul); let modul = Map.find modName mtype.AllEntitiesByCompiledAndLogicalMangledNames - loop (prior_cpath@[(modName,Namespace)]) tpath tcpath modul + loop (prior_cpath@[(modName, Namespace)]) tpath tcpath modul | _ -> () @@ -1016,10 +1016,10 @@ let rec stripExpr e = | Expr.Link eref -> stripExpr !eref | _ -> e -let mkCase (a,b) = TCase(a,b) +let mkCase (a, b) = TCase(a, b) -let isRefTupleExpr e = match e with Expr.Op (TOp.Tuple tupInfo,_,_,_) -> not (evalTupInfoIsStruct tupInfo) | _ -> false -let tryDestRefTupleExpr e = match e with Expr.Op (TOp.Tuple tupInfo,_,es,_) when not (evalTupInfoIsStruct tupInfo) -> es | _ -> [e] +let isRefTupleExpr e = match e with Expr.Op (TOp.Tuple tupInfo, _, _, _) -> not (evalTupInfoIsStruct tupInfo) | _ -> false +let tryDestRefTupleExpr e = match e with Expr.Op (TOp.Tuple tupInfo, _, es, _) when not (evalTupInfoIsStruct tupInfo) -> es | _ -> [e] //--------------------------------------------------------------------------- // Range info for expressions @@ -1027,10 +1027,10 @@ let tryDestRefTupleExpr e = match e with Expr.Op (TOp.Tuple tupInfo,_,es,_) when let rec rangeOfExpr x = match x with - | Expr.Val (_,_,m) | Expr.Op (_,_,_,m) | Expr.Const (_,m,_) | Expr.Quote (_,_,_,m,_) - | Expr.Obj (_,_,_,_,_,_,m) | Expr.App(_,_,_,_,m) | Expr.Sequential (_,_,_,_,m) - | Expr.StaticOptimization (_,_,_,m) | Expr.Lambda (_,_,_,_,_,m,_) - | Expr.TyLambda (_,_,_,m,_)| Expr.TyChoose (_,_,m) | Expr.LetRec (_,_,m,_) | Expr.Let (_,_,m,_) | Expr.Match (_,_,_,_,m,_) -> m + | Expr.Val (_, _, m) | Expr.Op (_, _, _, m) | Expr.Const (_, m, _) | Expr.Quote (_, _, _, m, _) + | Expr.Obj (_, _, _, _, _, _, m) | Expr.App(_, _, _, _, m) | Expr.Sequential (_, _, _, _, m) + | Expr.StaticOptimization (_, _, _, m) | Expr.Lambda (_, _, _, _, _, m, _) + | Expr.TyLambda (_, _, _, m, _)| Expr.TyChoose (_, _, m) | Expr.LetRec (_, _, m, _) | Expr.Let (_, _, m, _) | Expr.Match (_, _, _, _, m, _) -> m | Expr.Link(eref) -> rangeOfExpr (!eref) type Expr with @@ -1041,9 +1041,9 @@ type Expr with //--------------------------------------------------------------------------- -let primMkMatch(spBind,exprm,tree,targets,matchm,ty) = Expr.Match (spBind,exprm,tree,targets,matchm,ty) +let primMkMatch(spBind, exprm, tree, targets, matchm, ty) = Expr.Match (spBind, exprm, tree, targets, matchm, ty) -type MatchBuilder(spBind,inpRange: Range.range) = +type MatchBuilder(spBind, inpRange: Range.range) = let targets = new ResizeArray<_>(10) member x.AddTarget(tg) = @@ -1051,18 +1051,18 @@ type MatchBuilder(spBind,inpRange: Range.range) = targets.Add tg n - member x.AddResultTarget(e,spTarget) = TDSuccess([], x.AddTarget(TTarget([],e,spTarget))) + member x.AddResultTarget(e, spTarget) = TDSuccess([], x.AddTarget(TTarget([], e, spTarget))) member x.CloseTargets() = targets |> ResizeArray.toList - member x.Close(dtree,m,ty) = primMkMatch (spBind,inpRange,dtree,targets.ToArray(),m,ty) + member x.Close(dtree, m, ty) = primMkMatch (spBind, inpRange, dtree, targets.ToArray(), m, ty) -let mkBoolSwitch m g t e = TDSwitch(g,[TCase(DecisionTreeTest.Const(Const.Bool(true)),t)],Some e,m) +let mkBoolSwitch m g t e = TDSwitch(g, [TCase(DecisionTreeTest.Const(Const.Bool(true)), t)], Some e, m) let primMkCond spBind spTarget1 spTarget2 m ty e1 e2 e3 = - let mbuilder = new MatchBuilder(spBind,m) - let dtree = mkBoolSwitch m e1 (mbuilder.AddResultTarget(e2,spTarget1)) (mbuilder.AddResultTarget(e3,spTarget2)) - mbuilder.Close(dtree,m,ty) + let mbuilder = new MatchBuilder(spBind, m) + let dtree = mkBoolSwitch m e1 (mbuilder.AddResultTarget(e2, spTarget1)) (mbuilder.AddResultTarget(e3, spTarget2)) + mbuilder.Close(dtree, m, ty) let mkCond spBind spTarget m ty e1 e2 e3 = primMkCond spBind spTarget spTarget m ty e1 e2 e3 @@ -1071,11 +1071,11 @@ let mkCond spBind spTarget m ty e1 e2 e3 = primMkCond spBind spTarget spTarget // Primitive constructors //--------------------------------------------------------------------------- -let exprForValRef m vref = Expr.Val(vref,NormalValUse,m) +let exprForValRef m vref = Expr.Val(vref, NormalValUse, m) let exprForVal m v = exprForValRef m (mkLocalValRef v) let mkLocalAux m s ty mut compgen = - let thisv = 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 + let thisv = 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 let mkLocal m s ty = mkLocalAux m s ty Immutable false let mkCompGenLocal m s ty = mkLocalAux m s ty Immutable true @@ -1083,55 +1083,55 @@ let mkMutableCompGenLocal m s ty = mkLocalAux m s ty Mutable true // Type gives return type. For type-lambdas this is the formal return type. -let mkMultiLambda m vs (b,rty) = Expr.Lambda (newUnique(), None,None,vs,b,m, rty) -let rebuildLambda m ctorThisValOpt baseValOpt vs (b,rty) = Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt,vs,b,m, rty) -let mkLambda m v (b,rty) = mkMultiLambda m [v] (b,rty) -let mkTypeLambda m vs (b,tau_ty) = match vs with [] -> b | _ -> Expr.TyLambda (newUnique(), vs,b,m,tau_ty) -let mkTypeChoose m vs b = match vs with [] -> b | _ -> Expr.TyChoose (vs,b,m) +let mkMultiLambda m vs (b, rty) = Expr.Lambda (newUnique(), None, None, vs, b, m, rty) +let rebuildLambda m ctorThisValOpt baseValOpt vs (b, rty) = Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt, vs, b, m, rty) +let mkLambda m v (b, rty) = mkMultiLambda m [v] (b, rty) +let mkTypeLambda m vs (b, tau_ty) = match vs with [] -> b | _ -> Expr.TyLambda (newUnique(), vs, b, m, tau_ty) +let mkTypeChoose m vs b = match vs with [] -> b | _ -> Expr.TyChoose (vs, b, m) -let mkObjExpr (ty,basev,basecall,overrides,iimpls,m) = - Expr.Obj (newUnique(),ty,basev,basecall,overrides,iimpls,m) +let mkObjExpr (ty, basev, basecall, overrides, iimpls, m) = + Expr.Obj (newUnique(), ty, basev, basecall, overrides, iimpls, m) -let mkLambdas m tps (vs:Val list) (b,rty) = - mkTypeLambda m tps (List.foldBack (fun v (e,ty) -> mkLambda m v (e,ty), v.Type --> ty) vs (b,rty)) +let mkLambdas m tps (vs:Val list) (b, rty) = + mkTypeLambda m tps (List.foldBack (fun v (e, ty) -> mkLambda m v (e, ty), v.Type --> ty) vs (b, rty)) -let mkMultiLambdasCore m vsl (b,rty) = - List.foldBack (fun v (e,ty) -> mkMultiLambda m v (e,ty), typeOfLambdaArg m v --> ty) vsl (b,rty) +let mkMultiLambdasCore m vsl (b, rty) = + List.foldBack (fun v (e, ty) -> mkMultiLambda m v (e, ty), typeOfLambdaArg m v --> ty) vsl (b, rty) -let mkMultiLambdas m tps vsl (b,rty) = - mkTypeLambda m tps (mkMultiLambdasCore m vsl (b,rty) ) +let mkMultiLambdas m tps vsl (b, rty) = + mkTypeLambda m tps (mkMultiLambdasCore m vsl (b, rty) ) -let mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (b,rty) = +let mkMemberLambdas m tps ctorThisValOpt baseValOpt vsl (b, rty) = let expr = - match ctorThisValOpt,baseValOpt with - | None,None -> mkMultiLambdasCore m vsl (b,rty) + match ctorThisValOpt, baseValOpt with + | None, None -> mkMultiLambdasCore m vsl (b, rty) | _ -> match vsl with - | [] -> error(InternalError("mk_basev_multi_lambdas_core: can't attach a basev to a non-lambda expression",m)) + | [] -> error(InternalError("mk_basev_multi_lambdas_core: can't attach a basev to a non-lambda expression", m)) | h::t -> - let b,rty = mkMultiLambdasCore m t (b,rty) - (rebuildLambda m ctorThisValOpt baseValOpt h (b,rty), (typeOfLambdaArg m h --> rty)) + let b, rty = mkMultiLambdasCore m t (b, rty) + (rebuildLambda m ctorThisValOpt baseValOpt h (b, rty), (typeOfLambdaArg m h --> rty)) mkTypeLambda m tps expr -let mkMultiLambdaBind v letSeqPtOpt m tps vsl (b,rty) = - TBind(v,mkMultiLambdas m tps vsl (b,rty),letSeqPtOpt) +let mkMultiLambdaBind v letSeqPtOpt m tps vsl (b, rty) = + TBind(v, mkMultiLambdas m tps vsl (b, rty), letSeqPtOpt) -let mkBind seqPtOpt v e = TBind(v,e,seqPtOpt) +let mkBind seqPtOpt v e = TBind(v, e, seqPtOpt) -let mkCompGenBind v e = TBind(v,e,NoSequencePointAtStickyBinding) +let mkCompGenBind v e = TBind(v, e, NoSequencePointAtStickyBinding) /// Make bindings that are compiler generated (though the variables may not be - e.g. they may be lambda arguments in a beta reduction) let mkCompGenBinds vs es = List.map2 mkCompGenBind vs es // n.b. type gives type of body -let mkLetBind m bind body = Expr.Let(bind,body, m, NewFreeVarsCache()) +let mkLetBind m bind body = Expr.Let(bind, body, m, NewFreeVarsCache()) let mkLetsBind m binds body = List.foldBack (mkLetBind m) binds body let mkLetsFromBindings m binds body = List.foldBack (mkLetBind m) binds body let mkLet seqPtOpt m v x body = mkLetBind m (mkBind seqPtOpt v x) body let mkCompGenLet m v x body = mkLetBind m (mkCompGenBind v x) body -let mkInvisibleBind v e = TBind(v,e,NoSequencePointAtInvisibleBinding) +let mkInvisibleBind v e = TBind(v, e, NoSequencePointAtInvisibleBinding) let mkInvisibleLet m v x body = mkLetBind m (mkInvisibleBind v x) body let mkInvisibleBinds (vs: Val list) (es: Expr list) = List.map2 mkInvisibleBind vs es @@ -1139,7 +1139,7 @@ let mkInvisibleBinds (vs: Val list) (es: Expr list) = let mkInvisibleLets m vs xs body = mkLetsBind m (mkInvisibleBinds vs xs) body let mkInvisibleLetsFromBindings m vs xs body = mkLetsFromBindings m (mkInvisibleBinds vs xs) body -let mkLetRecBinds m binds body = if isNil binds then body else Expr.LetRec(binds,body, m, NewFreeVarsCache()) +let mkLetRecBinds m binds body = if isNil binds then body else Expr.LetRec(binds, body, m, NewFreeVarsCache()) //------------------------------------------------------------------------- // Type schemes... @@ -1160,7 +1160,7 @@ let NormalizeDeclaredTyparsForEquiRecursiveInference g tps = type TypeScheme = TypeScheme of Typars * TType let mkGenericBindRhs g m generalizedTyparsForRecursiveBlock typeScheme bodyExpr = - let (TypeScheme(generalizedTypars,tauType)) = typeScheme + let (TypeScheme(generalizedTypars, tauType)) = typeScheme // Normalize the generalized typars let generalizedTypars = NormalizeDeclaredTyparsForEquiRecursiveInference g generalizedTypars @@ -1181,76 +1181,76 @@ let mkGenericBindRhs g m generalizedTyparsForRecursiveBlock typeScheme bodyExpr mkTypeLambda m generalizedTypars (mkTypeChoose m freeChoiceTypars bodyExpr, tauType) let isBeingGeneralized tp typeScheme = - let (TypeScheme(generalizedTypars,_)) = typeScheme + let (TypeScheme(generalizedTypars, _)) = typeScheme ListSet.contains typarRefEq tp generalizedTypars //------------------------------------------------------------------------- // Build conditional expressions... //------------------------------------------------------------------------- -let mkLazyAnd (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 e2 (Expr.Const(Const.Bool false,m,g.bool_ty)) -let mkLazyOr (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 (Expr.Const(Const.Bool true,m,g.bool_ty)) e2 +let mkLazyAnd (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 e2 (Expr.Const(Const.Bool false, m, g.bool_ty)) +let mkLazyOr (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.bool_ty e1 (Expr.Const(Const.Bool true, m, g.bool_ty)) e2 -let mkCoerceExpr(e,to_ty,m,from_ty) = Expr.Op (TOp.Coerce,[to_ty;from_ty],[e],m) +let mkCoerceExpr(e, to_ty, m, from_ty) = Expr.Op (TOp.Coerce, [to_ty;from_ty], [e], m) -let mkAsmExpr(code,tinst,args,rettys,m) = Expr.Op (TOp.ILAsm(code,rettys),tinst,args,m) -let mkUnionCaseExpr(uc,tinst,args,m) = Expr.Op (TOp.UnionCase uc,tinst,args,m) -let mkExnExpr(uc,args,m) = Expr.Op (TOp.ExnConstr uc,[],args,m) -let mkTupleFieldGetViaExprAddr(tupInfo,e,tinst,i,m) = Expr.Op (TOp.TupleFieldGet(tupInfo,i), tinst, [e],m) +let mkAsmExpr(code, tinst, args, rettys, m) = Expr.Op (TOp.ILAsm(code, rettys), tinst, args, m) +let mkUnionCaseExpr(uc, tinst, args, m) = Expr.Op (TOp.UnionCase uc, tinst, args, m) +let mkExnExpr(uc, args, m) = Expr.Op (TOp.ExnConstr uc, [], args, m) +let mkTupleFieldGetViaExprAddr(tupInfo, e, tinst, i, m) = Expr.Op (TOp.TupleFieldGet(tupInfo, i), tinst, [e], m) -let mkRecdFieldGetViaExprAddr(e,fref,tinst,m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [e],m) -let mkRecdFieldGetAddrViaExprAddr(e,fref,tinst,m) = Expr.Op (TOp.ValFieldGetAddr(fref), tinst, [e],m) +let mkRecdFieldGetViaExprAddr(e, fref, tinst, m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [e], m) +let mkRecdFieldGetAddrViaExprAddr(e, fref, tinst, m) = Expr.Op (TOp.ValFieldGetAddr(fref), tinst, [e], m) -let mkStaticRecdFieldGetAddr(fref,tinst,m) = Expr.Op (TOp.ValFieldGetAddr(fref), tinst, [],m) -let mkStaticRecdFieldGet(fref,tinst,m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [],m) -let mkStaticRecdFieldSet(fref,tinst,e,m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e],m) +let mkStaticRecdFieldGetAddr(fref, tinst, m) = Expr.Op (TOp.ValFieldGetAddr(fref), tinst, [], m) +let mkStaticRecdFieldGet(fref, tinst, m) = Expr.Op (TOp.ValFieldGet(fref), tinst, [], m) +let mkStaticRecdFieldSet(fref, tinst, e, m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e], m) -let mkArrayElemAddress g (readonly,isNativePtr,shape,elemTy,aexpr,nexpr,m) = Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly,isNativePtr,shape,mkILTyvarTy 0us)],[mkByrefTy g elemTy]), [elemTy],[aexpr;nexpr],m) +let mkArrayElemAddress g (readonly, isNativePtr, shape, elemTy, aexpr, nexpr, m) = Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly, isNativePtr, shape, mkILTyvarTy 0us)], [mkByrefTy g elemTy]), [elemTy], [aexpr;nexpr], m) -let mkRecdFieldSetViaExprAddr (e1,fref,tinst,e2,m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e1;e2],m) +let mkRecdFieldSetViaExprAddr (e1, fref, tinst, e2, m) = Expr.Op (TOp.ValFieldSet(fref), tinst, [e1;e2], m) -let mkUnionCaseTagGetViaExprAddr (e1,cref,tinst,m) = Expr.Op (TOp.UnionCaseTagGet(cref), tinst, [e1],m) +let mkUnionCaseTagGetViaExprAddr (e1, cref, tinst, m) = Expr.Op (TOp.UnionCaseTagGet(cref), tinst, [e1], m) /// Make a 'TOp.UnionCaseProof' expression, which proves a union value is over a particular case (used only for ref-unions, not struct-unions) -let mkUnionCaseProof (e1,cref:UnionCaseRef,tinst,m) = if cref.Tycon.IsStructOrEnumTycon then e1 else Expr.Op (TOp.UnionCaseProof(cref), tinst, [e1],m) +let mkUnionCaseProof (e1, cref:UnionCaseRef, tinst, m) = if cref.Tycon.IsStructOrEnumTycon then e1 else Expr.Op (TOp.UnionCaseProof(cref), tinst, [e1], m) -/// Build a 'TOp.UnionCaseFieldGet' expression for something we've already determined to be a particular union case. For ref-unions, -/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// Build a 'TOp.UnionCaseFieldGet' expression for something we've already determined to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, /// the input should be the address of the expression. -let mkUnionCaseFieldGetProvenViaExprAddr (e1,cref,tinst,j,m) = Expr.Op (TOp.UnionCaseFieldGet(cref,j), tinst, [e1],m) +let mkUnionCaseFieldGetProvenViaExprAddr (e1, cref, tinst, j, m) = Expr.Op (TOp.UnionCaseFieldGet(cref, j), tinst, [e1], m) -/// Build a 'TOp.UnionCaseFieldGetAddr' expression for a field of a union when we've already determined the value to be a particular union case. For ref-unions, -/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, +/// Build a 'TOp.UnionCaseFieldGetAddr' expression for a field of a union when we've already determined the value to be a particular union case. For ref-unions, +/// the input expression has 'TType_ucase', which is an F# compiler internal "type" corresponding to the union case. For struct-unions, /// the input should be the address of the expression. -let mkUnionCaseFieldGetAddrProvenViaExprAddr (e1,cref,tinst,j,m) = Expr.Op (TOp.UnionCaseFieldGetAddr(cref,j), tinst, [e1],m) +let mkUnionCaseFieldGetAddrProvenViaExprAddr (e1, cref, tinst, j, m) = Expr.Op (TOp.UnionCaseFieldGetAddr(cref, j), tinst, [e1], m) /// Build a 'get' expression for something we've already determined to be a particular union case, but where /// the static type of the input is not yet proven to be that particular union case. This requires a type /// cast to 'prove' the condition. -let mkUnionCaseFieldGetUnprovenViaExprAddr (e1,cref,tinst,j,m) = mkUnionCaseFieldGetProvenViaExprAddr(mkUnionCaseProof(e1,cref,tinst,m),cref,tinst,j,m) +let mkUnionCaseFieldGetUnprovenViaExprAddr (e1, cref, tinst, j, m) = mkUnionCaseFieldGetProvenViaExprAddr(mkUnionCaseProof(e1, cref, tinst, m), cref, tinst, j, m) -let mkUnionCaseFieldSet (e1,cref,tinst,j,e2,m) = Expr.Op (TOp.UnionCaseFieldSet(cref,j), tinst, [e1;e2],m) +let mkUnionCaseFieldSet (e1, cref, tinst, j, e2, m) = Expr.Op (TOp.UnionCaseFieldSet(cref, j), tinst, [e1;e2], m) -let mkExnCaseFieldGet (e1,ecref,j,m) = Expr.Op (TOp.ExnFieldGet(ecref,j), [],[e1],m) -let mkExnCaseFieldSet (e1,ecref,j,e2,m) = Expr.Op (TOp.ExnFieldSet(ecref,j), [],[e1;e2],m) +let mkExnCaseFieldGet (e1, ecref, j, m) = Expr.Op (TOp.ExnFieldGet(ecref, j), [], [e1], m) +let mkExnCaseFieldSet (e1, ecref, j, e2, m) = Expr.Op (TOp.ExnFieldSet(ecref, j), [], [e1;e2], m) -let mkDummyLambda (g:TcGlobals) (e:Expr,ety) = +let mkDummyLambda (g:TcGlobals) (e:Expr, ety) = let m = e.Range - mkLambda m (fst (mkCompGenLocal m "unitVar" g.unit_ty)) (e,ety) + mkLambda m (fst (mkCompGenLocal m "unitVar" g.unit_ty)) (e, ety) -let mkWhile (g:TcGlobals) (spWhile,marker,e1,e2,m) = - Expr.Op (TOp.While (spWhile,marker),[] ,[mkDummyLambda g (e1,g.bool_ty);mkDummyLambda g (e2,g.unit_ty)],m) +let mkWhile (g:TcGlobals) (spWhile, marker, e1, e2, m) = + Expr.Op (TOp.While (spWhile, marker), [] , [mkDummyLambda g (e1, g.bool_ty);mkDummyLambda g (e2, g.unit_ty)], m) -let mkFor (g:TcGlobals) (spFor,v,e1,dir,e2,e3:Expr,m) = - Expr.Op (TOp.For (spFor,dir) ,[] ,[mkDummyLambda g (e1,g.int_ty) ;mkDummyLambda g (e2,g.int_ty);mkLambda e3.Range v (e3,g.unit_ty)],m) +let mkFor (g:TcGlobals) (spFor, v, e1, dir, e2, e3:Expr, m) = + Expr.Op (TOp.For (spFor, dir) , [] , [mkDummyLambda g (e1, g.int_ty) ;mkDummyLambda g (e2, g.int_ty);mkLambda e3.Range v (e3, g.unit_ty)], m) -let mkTryWith g (e1,vf,ef:Expr,vh,eh:Expr,m,ty,spTry,spWith) = - Expr.Op (TOp.TryCatch(spTry,spWith),[ty],[mkDummyLambda g (e1,ty);mkLambda ef.Range vf (ef,ty);mkLambda eh.Range vh (eh,ty)],m) +let mkTryWith g (e1, vf, ef:Expr, vh, eh:Expr, m, ty, spTry, spWith) = + Expr.Op (TOp.TryCatch(spTry, spWith), [ty], [mkDummyLambda g (e1, ty);mkLambda ef.Range vf (ef, ty);mkLambda eh.Range vh (eh, ty)], m) -let mkTryFinally (g:TcGlobals) (e1,e2,m,ty,spTry,spFinally) = - Expr.Op (TOp.TryFinally(spTry,spFinally),[ty],[mkDummyLambda g (e1,ty);mkDummyLambda g (e2,g.unit_ty)],m) +let mkTryFinally (g:TcGlobals) (e1, e2, m, ty, spTry, spFinally) = + Expr.Op (TOp.TryFinally(spTry, spFinally), [ty], [mkDummyLambda g (e1, ty);mkDummyLambda g (e2, g.unit_ty)], m) -let mkDefault (m,ty) = Expr.Const(Const.Zero,m,ty) +let mkDefault (m, ty) = Expr.Const(Const.Zero, m, ty) let mkValSet m v e = Expr.Op (TOp.LValueOp (LSet, v), [], [e], m) let mkAddrSet m v e = Expr.Op (TOp.LValueOp (LByrefSet, v), [], [e], m) @@ -1263,7 +1263,7 @@ let mkValAddr m v = Expr.Op (TOp.LValueOp (LGetAddr, v), [], [], m) [] type ValHash<'T> = - | ValHash of Dictionary + | ValHash of Dictionary member ht.Values = let (ValHash t) = ht @@ -1272,14 +1272,14 @@ type ValHash<'T> = member ht.TryFind (v:Val) = let (ValHash t) = ht match t.TryGetValue v.Stamp with - | true,v -> Some v + | true, v -> Some v | _ -> None member ht.Add (v:Val, x) = let (ValHash t) = ht t.[v.Stamp] <- x - static member Create() = ValHash (new Dictionary<_,'T>(11)) + static member Create() = ValHash (new Dictionary<_, 'T>(11)) [] type ValMultiMap<'T>(contents: StampMap<'T list>) = @@ -1302,7 +1302,7 @@ type TyconRefMultiMap<'T>(contents: TyconRefMap<'T list>) = member m.Add (v, x) = TyconRefMultiMap<'T>(contents.Add v (x :: m.Find v)) static member Empty = TyconRefMultiMap<'T>(TyconRefMap<_>.Empty) - static member OfList vs = (vs, TyconRefMultiMap<'T>.Empty) ||> List.foldBack (fun (x,y) acc -> acc.Add (x, y)) + static member OfList vs = (vs, TyconRefMultiMap<'T>.Empty) ||> List.foldBack (fun (x, y) acc -> acc.Add (x, y)) //-------------------------------------------------------------------------- @@ -1319,7 +1319,7 @@ let tryRescopeEntity viewedCcu (entity:Entity) : EntityRef option = /// Try to create a ValRef suitable for accessing the given Val from another assembly let tryRescopeVal viewedCcu (entityRemap:Remap) (vspec:Val) : ValRef option = match vspec.PublicPath with - | Some (ValPubPath(p,fullLinkageKey)) -> + | Some (ValPubPath(p, fullLinkageKey)) -> // The type information in the val linkage doesn't need to keep any information to trait solutions. let entityRemap = { entityRemap with removeTraitSolutions = true } let fullLinkageKey = remapValLinkage entityRemap fullLinkageKey @@ -1373,25 +1373,25 @@ let actualTyOfUnionFieldRef (fref:UnionCaseRef) n tinst = //--------------------------------------------------------------------------- let destForallTy g ty = - let tps,tau = primDestForallTy g ty + let tps, tau = primDestForallTy g ty // tps may be have been equated to other tps in equi-recursive type inference // and unit type inference. Normalize them here let tps = NormalizeDeclaredTyparsForEquiRecursiveInference g tps - tps,tau + tps, tau let tryDestForallTy g ty = - if isForallTy g ty then destForallTy g ty else [],ty + if isForallTy g ty then destForallTy g ty else [], ty let rec stripFunTy g ty = if isFunTy g ty then - let (d,r) = destFunTy g ty - let more,rty = stripFunTy g r + let (d, r) = destFunTy g ty + let more, rty = stripFunTy g r d::more, rty - else [],ty + else [], ty let applyForallTy g ty tyargs = - let tps,tau = destForallTy g ty + let tps, tau = destForallTy g ty instType (mkTyparInst tps tyargs) tau let reduceIteratedFunTy g ty args = @@ -1402,11 +1402,11 @@ let reduceIteratedFunTy g ty args = let applyTyArgs g functy tyargs = if isForallTy g functy then applyForallTy g functy tyargs else functy -let applyTys g functy (tyargs,argtys) = +let applyTys g functy (tyargs, argtys) = let afterTyappTy = applyTyArgs g functy tyargs reduceIteratedFunTy g afterTyappTy argtys -let formalApplyTys g functy (tyargs,args) = +let formalApplyTys g functy (tyargs, args) = reduceIteratedFunTy g (if isNil tyargs then functy else snd (destForallTy g functy)) args @@ -1414,13 +1414,13 @@ let formalApplyTys g functy (tyargs,args) = let rec stripFunTyN g n ty = assert (n >= 0); if n > 0 && isFunTy g ty then - let (d,r) = destFunTy g ty - let more,rty = stripFunTyN g (n-1) r in d::more, rty - else [],ty + let (d, r) = destFunTy g ty + let more, rty = stripFunTyN g (n-1) r in d::more, rty + else [], ty let tryDestAnyTupleTy g ty = - if isAnyTupleTy g ty then destAnyTupleTy g ty else tupInfoRef,[ty] + if isAnyTupleTy g ty then destAnyTupleTy g ty else tupInfoRef, [ty] let tryDestRefTupleTy g ty = if isRefTupleTy g ty then destRefTupleTy g ty else [ty] @@ -1431,37 +1431,37 @@ type CurriedArgInfos = (TType * ArgReprInfo) list list // A 'tau' type is one with its type paramaeters stripped off let GetTopTauTypeInFSharpForm g (curriedArgInfos: ArgReprInfo list list) tau m = let nArgInfos = curriedArgInfos.Length - let argtys,rty = stripFunTyN g nArgInfos tau + let argtys, rty = stripFunTyN g nArgInfos tau if nArgInfos <> argtys.Length then - error(Error(FSComp.SR.tastInvalidMemberSignature(),m)) + error(Error(FSComp.SR.tastInvalidMemberSignature(), m)) let argtysl = - (curriedArgInfos,argtys) ||> List.map2 (fun argInfos argty -> + (curriedArgInfos, argtys) ||> List.map2 (fun argInfos argty -> match argInfos with | [] -> [ (g.unit_ty, ValReprInfo.unnamedTopArg1) ] | [argInfo] -> [ (argty, argInfo) ] | _ -> List.zip (destRefTupleTy g argty) argInfos) - argtysl,rty + argtysl, rty -let destTopForallTy g (ValReprInfo (ntps,_,_)) ty = - let tps,tau = (if isNil ntps then [],ty else tryDestForallTy g ty) +let destTopForallTy g (ValReprInfo (ntps, _, _)) ty = + let tps, tau = (if isNil ntps then [], ty else tryDestForallTy g ty) #if CHECKED if tps.Length <> kinds.Length then failwith (sprintf "destTopForallTy: internal error, #tps = %d, #ntps = %d" (List.length tps) ntps); #endif // tps may be have been equated to other tps in equi-recursive type inference. Normalize them here let tps = NormalizeDeclaredTyparsForEquiRecursiveInference g tps - tps,tau + tps, tau -let GetTopValTypeInFSharpForm g (ValReprInfo(_,argInfos,retInfo) as topValInfo) ty m = - let tps,tau = destTopForallTy g topValInfo ty - let argtysl,rty = GetTopTauTypeInFSharpForm g argInfos tau m - tps,argtysl,rty,retInfo +let GetTopValTypeInFSharpForm g (ValReprInfo(_, argInfos, retInfo) as topValInfo) ty m = + let tps, tau = destTopForallTy g topValInfo ty + let argtysl, rty = GetTopTauTypeInFSharpForm g argInfos tau m + tps, argtysl, rty, retInfo let IsCompiledAsStaticProperty g (v:Val) = match v.ValReprInfo with | Some valReprInfoValue -> match GetTopValTypeInFSharpForm g valReprInfoValue v.Type v.Range with - | [],[], _,_ when not v.IsMember -> true + | [], [], _, _ when not v.IsMember -> true | _ -> false | _ -> false @@ -1489,12 +1489,12 @@ let rankOfArrayTyconRef (g:TcGlobals) tcr = let destArrayTy (g:TcGlobals) ty = match ty with - | AppTy g (tcref,[ty]) when isArrayTyconRef g tcref -> ty + | AppTy g (tcref, [ty]) when isArrayTyconRef g tcref -> ty | _ -> failwith "destArrayTy" let destListTy (g:TcGlobals) ty = match ty with - | AppTy g (tcref,[ty]) when tyconRefEq g tcref g.list_tcr_canon -> ty + | AppTy g (tcref, [ty]) when tyconRefEq g tcref g.list_tcr_canon -> ty | _ -> failwith "destListTy" let isTypeConstructorEqualToOptional g tcOpt tc = @@ -1508,19 +1508,19 @@ let isByrefLikeTyconRef g tcref = isTypeConstructorEqualToOptional g g.system_ArgIterator_tcref tcref || isTypeConstructorEqualToOptional g g.system_RuntimeArgumentHandle_tcref tcref -let isStringTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g tcref g.system_String_tcref | _ -> false) -let isListTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g tcref g.list_tcr_canon | _ -> false) -let isArrayTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> isArrayTyconRef g tcref | _ -> false) -let isArray1DTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g tcref g.il_arr_tcr_map.[0] | _ -> false) -let isUnitTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.unit_tcr_canon tcref | _ -> false) -let isObjTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) -let isVoidTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.system_Void_tcref tcref | _ -> false) -let isILAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tcref.IsILTycon | _ -> false) -let isNativePtrTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.nativeptr_tcr tcref | _ -> false) -let isByrefTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tyconRefEq g g.byref_tcr tcref | _ -> false) -let isByrefLikeTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> isByrefLikeTyconRef g tcref | _ -> false) +let isStringTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.system_String_tcref | _ -> false) +let isListTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.list_tcr_canon | _ -> false) +let isArrayTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isArrayTyconRef g tcref | _ -> false) +let isArray1DTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g tcref g.il_arr_tcr_map.[0] | _ -> false) +let isUnitTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.unit_tcr_canon tcref | _ -> false) +let isObjTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.system_Object_tcref tcref | _ -> false) +let isVoidTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.system_Void_tcref tcref | _ -> false) +let isILAppTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.IsILTycon | _ -> false) +let isNativePtrTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.nativeptr_tcr tcref | _ -> false) +let isByrefTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tyconRefEq g g.byref_tcr tcref | _ -> false) +let isByrefLikeTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> isByrefLikeTyconRef g tcref | _ -> false) #if EXTENSIONTYPING -let extensionInfoOfTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref,_) -> tcref.TypeReprInfo | _ -> TNoRepr) +let extensionInfoOfTy g ty = ty |> stripTyEqns g |> (function TType_app(tcref, _) -> tcref.TypeReprInfo | _ -> TNoRepr) #endif type TypeDefMetadata = @@ -1560,7 +1560,7 @@ let isILReferenceTy g ty = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> not info.IsStructOrEnum #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> not td.IsStructOrEnum + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> not td.IsStructOrEnum | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> isArrayTy g ty let isILInterfaceTycon (tycon:Tycon) = @@ -1568,14 +1568,14 @@ let isILInterfaceTycon (tycon:Tycon) = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.IsInterface #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> (td.tdKind = ILTypeDefKind.Interface) + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> (td.tdKind = ILTypeDefKind.Interface) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> false let rankOfArrayTy g ty = rankOfArrayTyconRef g (tcrefOfAppTy g ty) let isFSharpObjModelRefTy g ty = isFSharpObjModelTy g ty && - let tcr,_ = destAppTy g ty + let tcr, _ = destAppTy g ty match tcr.FSharpObjectModelTypeInfo.fsobjmodel_kind with | TTyconClass | TTyconInterface | TTyconDelegate _ -> true | TTyconStruct | TTyconEnum -> false @@ -1600,7 +1600,7 @@ let isDelegateTy g ty = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.IsDelegate () #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> (td.tdKind = ILTypeDefKind.Delegate) + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> (td.tdKind = ILTypeDefKind.Delegate) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> match tryDestAppTy g ty with | Some tcref -> tcref.Deref.IsFSharpDelegateTycon @@ -1611,7 +1611,7 @@ let isInterfaceTy g ty = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.IsInterface #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> (td.tdKind = ILTypeDefKind.Interface) + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> (td.tdKind = ILTypeDefKind.Interface) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> isFSharpInterfaceTy g ty let isClassTy g ty = @@ -1619,7 +1619,7 @@ let isClassTy g ty = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.IsClass #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> (td.tdKind = ILTypeDefKind.Class) + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> (td.tdKind = ILTypeDefKind.Class) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> isFSharpClassTy g ty let isStructOrEnumTyconTy g ty = @@ -1699,15 +1699,15 @@ let isEnumTy g ty = | None -> false | Some tcref -> tcref.IsEnumTycon -let actualReturnTyOfSlotSig parentTyInst methTyInst (TSlotSig(_,_,parentFormalTypars,methFormalTypars,_,formalRetTy)) = +let actualReturnTyOfSlotSig parentTyInst methTyInst (TSlotSig(_, _, parentFormalTypars, methFormalTypars, _, formalRetTy)) = let methTyInst = mkTyparInst methFormalTypars methTyInst let parentTyInst = mkTyparInst parentFormalTypars parentTyInst Option.map (instType (parentTyInst @ methTyInst)) formalRetTy -let slotSigHasVoidReturnTy (TSlotSig(_,_,_,_,_,formalRetTy)) = +let slotSigHasVoidReturnTy (TSlotSig(_, _, _, _, _, formalRetTy)) = Option.isNone formalRetTy -let returnTyOfMethod g (TObjExprMethod((TSlotSig(_,parentTy,_,_,_,_) as ss),_,methFormalTypars,_,_,_)) = +let returnTyOfMethod g (TObjExprMethod((TSlotSig(_, parentTy, _, _, _, _) as ss), _, methFormalTypars, _, _, _)) = let tinst = argsOfAppTy g parentTy let methTyInst = generalizeTypars methFormalTypars actualReturnTyOfSlotSig tinst methTyInst ss @@ -1886,12 +1886,12 @@ and accFreeInTyparConstraints opts cxs acc = and accFreeInTyparConstraint opts tpc acc = match tpc with - | TyparConstraint.CoercesTo(typ,_) -> accFreeInType opts typ acc - | TyparConstraint.MayResolveMember (traitInfo,_) -> accFreeInTrait opts traitInfo acc - | TyparConstraint.DefaultsTo(_,rty,_) -> accFreeInType opts rty acc - | TyparConstraint.SimpleChoice(tys,_) -> accFreeInTypes opts tys acc - | TyparConstraint.IsEnum(uty,_) -> accFreeInType opts uty acc - | TyparConstraint.IsDelegate(aty,bty,_) -> accFreeInType opts aty (accFreeInType opts bty acc) + | TyparConstraint.CoercesTo(typ, _) -> accFreeInType opts typ acc + | TyparConstraint.MayResolveMember (traitInfo, _) -> accFreeInTrait opts traitInfo acc + | TyparConstraint.DefaultsTo(_, rty, _) -> accFreeInType opts rty acc + | TyparConstraint.SimpleChoice(tys, _) -> accFreeInTypes opts tys acc + | TyparConstraint.IsEnum(uty, _) -> accFreeInType opts uty acc + | TyparConstraint.IsDelegate(aty, bty, _) -> accFreeInType opts aty (accFreeInType opts bty acc) | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -1900,7 +1900,7 @@ and accFreeInTyparConstraint opts tpc acc = | TyparConstraint.IsUnmanaged _ | TyparConstraint.RequiresDefaultConstructor _ -> acc -and accFreeInTrait opts (TTrait(typs,_,_,argtys,rty,sln)) acc = +and accFreeInTrait opts (TTrait(typs, _, _, argtys, rty, sln)) acc = Option.foldBack (accFreeInTraitSln opts) sln.Value (accFreeInTypes opts typs (accFreeInTypes opts argtys @@ -1908,10 +1908,10 @@ and accFreeInTrait opts (TTrait(typs,_,_,argtys,rty,sln)) acc = and accFreeInTraitSln opts sln acc = match sln with - | ILMethSln(typ,_,_,minst) -> + | ILMethSln(typ, _, _, minst) -> accFreeInType opts typ (accFreeInTypes opts minst acc) - | FSMethSln(typ, vref,minst) -> + | FSMethSln(typ, vref, minst) -> accFreeInType opts typ (accFreeValRefInTraitSln opts vref (accFreeInTypes opts minst acc)) @@ -1940,23 +1940,23 @@ and accFreeTyparRef opts (tp:Typar) acc = and accFreeInType opts ty acc = match stripTyparEqns ty with - | TType_tuple (tupInfo,l) -> accFreeInTypes opts l (accFreeInTupInfo opts tupInfo acc) - | TType_app (tc,tinst) -> + | TType_tuple (tupInfo, l) -> accFreeInTypes opts l (accFreeInTupInfo opts tupInfo acc) + | TType_app (tc, tinst) -> let acc = accFreeTycon opts tc acc match tinst with | [] -> acc // optimization to avoid unneeded call | [h] -> accFreeInType opts h acc // optimization to avoid unneeded call | _ -> accFreeInTypes opts tinst acc - | TType_ucase (UCRef(tc,_),tinst) -> accFreeInTypes opts tinst (accFreeTycon opts tc acc) - | TType_fun (d,r) -> accFreeInType opts d (accFreeInType opts r acc) + | TType_ucase (UCRef(tc, _), tinst) -> accFreeInTypes opts tinst (accFreeTycon opts tc acc) + | TType_fun (d, r) -> accFreeInType opts d (accFreeInType opts r acc) | TType_var r -> accFreeTyparRef opts r acc - | TType_forall (tps,r) -> unionFreeTyvars (boundTypars opts tps (freeInType opts r)) acc + | TType_forall (tps, r) -> unionFreeTyvars (boundTypars opts tps (freeInType opts r)) acc | TType_measure unt -> accFreeInMeasure opts unt acc and accFreeInTupInfo _opts unt acc = match unt with | TupInfo.Const _ -> acc -and accFreeInMeasure opts unt acc = List.foldBack (fun (tp,_) acc -> accFreeTyparRef opts tp acc) (ListMeasureVarOccsWithNonZeroExponents unt) acc +and accFreeInMeasure opts unt acc = List.foldBack (fun (tp, _) acc -> accFreeTyparRef opts tp acc) (ListMeasureVarOccsWithNonZeroExponents unt) acc and accFreeInTypes opts tys acc = match tys with | [] -> acc @@ -1973,7 +1973,7 @@ let accFreeInTypars opts tps acc = List.foldBack (accFreeTyparRef opts) tps acc //-------------------------------------------------------------------------- // Free in type, left-to-right order preserved. This is used to determine the -// order of type variables for top-level definitions based on their signature, +// order of type variables for top-level definitions based on their signature, // so be careful not to change the order. We accumulate in reverse // order. //-------------------------------------------------------------------------- @@ -1991,12 +1991,12 @@ and accFreeInTyparConstraintsLeftToRight g cxFlag thruFlag acc cxs = and accFreeInTyparConstraintLeftToRight g cxFlag thruFlag acc tpc = match tpc with - | TyparConstraint.CoercesTo(typ,_) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc typ - | TyparConstraint.MayResolveMember (traitInfo,_) -> accFreeInTraitLeftToRight g cxFlag thruFlag acc traitInfo - | TyparConstraint.DefaultsTo(_,rty,_) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc rty - | TyparConstraint.SimpleChoice(tys,_) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tys - | TyparConstraint.IsEnum(uty,_) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc uty - | TyparConstraint.IsDelegate(aty,bty,_) -> accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc aty) bty + | TyparConstraint.CoercesTo(typ, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc typ + | TyparConstraint.MayResolveMember (traitInfo, _) -> accFreeInTraitLeftToRight g cxFlag thruFlag acc traitInfo + | TyparConstraint.DefaultsTo(_, rty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc rty + | TyparConstraint.SimpleChoice(tys, _) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tys + | TyparConstraint.IsEnum(uty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag acc uty + | TyparConstraint.IsDelegate(aty, bty, _) -> accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc aty) bty | TyparConstraint.SupportsComparison _ | TyparConstraint.SupportsEquality _ | TyparConstraint.SupportsNull _ @@ -2005,7 +2005,7 @@ and accFreeInTyparConstraintLeftToRight g cxFlag thruFlag acc tpc = | TyparConstraint.IsReferenceType _ | TyparConstraint.RequiresDefaultConstructor _ -> acc -and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(typs,_,_,argtys,rty,_)) = +and accFreeInTraitLeftToRight g cxFlag thruFlag acc (TTrait(typs, _, _, argtys, rty, _)) = let acc = accFreeInTypesLeftToRight g cxFlag thruFlag acc typs let acc = accFreeInTypesLeftToRight g cxFlag thruFlag acc argtys let acc = Option.fold (accFreeInTypeLeftToRight g cxFlag thruFlag) acc rty @@ -2027,12 +2027,12 @@ and accFreeInTypeLeftToRight g cxFlag thruFlag acc ty = | TType_tuple (tupInfo, l) -> let acc = accFreeInTupInfoLeftToRight g cxFlag thruFlag acc tupInfo accFreeInTypesLeftToRight g cxFlag thruFlag acc l - | TType_app (_,tinst) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst - | TType_ucase (_,tinst) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst - | TType_fun (d,r) -> accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc d ) r + | TType_app (_, tinst) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst + | TType_ucase (_, tinst) -> accFreeInTypesLeftToRight g cxFlag thruFlag acc tinst + | TType_fun (d, r) -> accFreeInTypeLeftToRight g cxFlag thruFlag (accFreeInTypeLeftToRight g cxFlag thruFlag acc d ) r | TType_var r -> accFreeTyparRefLeftToRight g cxFlag thruFlag acc r - | TType_forall (tps,r) -> unionFreeTyparsLeftToRight (boundTyparsLeftToRight g cxFlag thruFlag tps (accFreeInTypeLeftToRight g cxFlag thruFlag emptyFreeTyparsLeftToRight r)) acc - | TType_measure unt -> List.foldBack (fun (tp,_) acc -> accFreeTyparRefLeftToRight g cxFlag thruFlag acc tp) (ListMeasureVarOccsWithNonZeroExponents unt) acc + | TType_forall (tps, r) -> unionFreeTyparsLeftToRight (boundTyparsLeftToRight g cxFlag thruFlag tps (accFreeInTypeLeftToRight g cxFlag thruFlag emptyFreeTyparsLeftToRight r)) acc + | TType_measure unt -> List.foldBack (fun (tp, _) acc -> accFreeTyparRefLeftToRight g cxFlag thruFlag acc tp) (ListMeasureVarOccsWithNonZeroExponents unt) acc and accFreeInTupInfoLeftToRight _g _cxFlag _thruFlag acc unt = match unt with @@ -2057,46 +2057,46 @@ let valsOfBinds (binds:Bindings) = binds |> List.map (fun b -> b.Var) // Pull apart the type for an F# value that represents an object model method. Do not strip off a 'unit' argument. // Review: Should GetMemberTypeInFSharpForm have any other direct callers? let GetMemberTypeInFSharpForm g memberFlags arities ty m = - let tps,argInfos,rty,retInfo = GetTopValTypeInFSharpForm g arities ty m + let tps, argInfos, rty, retInfo = GetTopValTypeInFSharpForm g arities ty m let argInfos = if memberFlags.IsInstance then match argInfos with | [] -> - errorR(InternalError("value does not have a valid member type",m)) + errorR(InternalError("value does not have a valid member type", m)) argInfos | _::t -> t else argInfos - tps,argInfos,rty,retInfo + tps, argInfos, rty, retInfo // Check that an F# value represents an object model method. // It will also always have an arity (inferred from syntax). let checkMemberVal membInfo arity m = match membInfo, arity with - | None,_ -> error(InternalError("checkMemberVal - no membInfo" , m)) - | _,None -> error(InternalError("checkMemberVal - no arity", m)) - | Some membInfo,Some arity -> (membInfo,arity) + | None, _ -> error(InternalError("checkMemberVal - no membInfo" , m)) + | _, None -> error(InternalError("checkMemberVal - no arity", m)) + | Some membInfo, Some arity -> (membInfo, arity) let checkMemberValRef (vref:ValRef) = checkMemberVal vref.MemberInfo vref.ValReprInfo vref.Range let GetTopValTypeInCompiledForm g topValInfo typ m = - let tps,paramArgInfos,rty,retInfo = GetTopValTypeInFSharpForm g topValInfo typ m + let tps, paramArgInfos, rty, retInfo = GetTopValTypeInFSharpForm g topValInfo typ m // Eliminate lone single unit arguments let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with // static member and module value unit argument elimination - | [[(_argType,_)]] ,[[]] -> + | [[(_argType, _)]] , [[]] -> //assert isUnitTy g argType [[]] // instance member unit argument elimination - | [objInfo;[(_argType,_)]] ,[[_objArg];[]] -> + | [objInfo;[(_argType, _)]] , [[_objArg];[]] -> //assert isUnitTy g argType [objInfo; []] | _ -> paramArgInfos let rty = if isUnitTy g rty then None else Some rty - (tps,paramArgInfos,rty,retInfo) + (tps, paramArgInfos, rty, retInfo) // Pull apart the type for an F# value that represents an object model method // and see the "member" form for the type, i.e. @@ -2107,44 +2107,44 @@ let GetTopValTypeInCompiledForm g topValInfo typ m = // logic such as determining if abstract methods have been implemented or not, and how // many arguments the method takes etc. let GetMemberTypeInMemberForm g memberFlags topValInfo typ m = - let tps,paramArgInfos,rty,retInfo = GetMemberTypeInFSharpForm g memberFlags topValInfo typ m + let tps, paramArgInfos, rty, retInfo = GetMemberTypeInFSharpForm g memberFlags topValInfo typ m // Eliminate lone single unit arguments let paramArgInfos = match paramArgInfos, topValInfo.ArgInfos with // static member and module value unit argument elimination - | [[(argType,_)]] ,[[]] -> + | [[(argType, _)]] , [[]] -> assert isUnitTy g argType [[]] // instance member unit argument elimination - | [[(argType,_)]] ,[[_objArg];[]] -> + | [[(argType, _)]] , [[_objArg];[]] -> assert isUnitTy g argType [[]] | _ -> paramArgInfos let rty = if isUnitTy g rty then None else Some rty - (tps,paramArgInfos,rty,retInfo) + (tps, paramArgInfos, rty, retInfo) let GetTypeOfMemberInMemberForm g (vref:ValRef) = //assert (not vref.IsExtensionMember) - let membInfo,topValInfo = checkMemberValRef vref + let membInfo, topValInfo = checkMemberValRef vref GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo vref.Type vref.Range let GetTypeOfMemberInFSharpForm g (vref:ValRef) = - let membInfo,topValInfo = checkMemberValRef vref + let membInfo, topValInfo = checkMemberValRef vref GetMemberTypeInFSharpForm g membInfo.MemberFlags topValInfo vref.Type vref.Range let PartitionValTyparsForApparentEnclosingType g (v:Val) = match v.ValReprInfo with | None -> error(InternalError("PartitionValTypars: not a top value", v.Range)) | Some arities -> - let fullTypars,_ = destTopForallTy g arities v.Type + let fullTypars, _ = destTopForallTy g arities v.Type let parent = v.MemberApparentParent let parentTypars = parent.TyparsNoRange let nparentTypars = parentTypars.Length if nparentTypars <= fullTypars.Length then - let memberParentTypars,memberMethodTypars = List.chop nparentTypars fullTypars - let memberToParentInst,tinst = mkTyparToTyparRenaming memberParentTypars parentTypars - Some(parentTypars,memberParentTypars,memberMethodTypars,memberToParentInst,tinst) + let memberParentTypars, memberMethodTypars = List.chop nparentTypars fullTypars + let memberToParentInst, tinst = mkTyparToTyparRenaming memberParentTypars parentTypars + Some(parentTypars, memberParentTypars, memberMethodTypars, memberToParentInst, tinst) else None /// Match up the type variables on an member value with the type @@ -2154,8 +2154,8 @@ let PartitionValTypars g (v:Val) = | None -> error(InternalError("PartitionValTypars: not a top value", v.Range)) | Some arities -> if v.IsExtensionMember then - let fullTypars,_ = destTopForallTy g arities v.Type - Some([],[],fullTypars,emptyTyparInst,[]) + let fullTypars, _ = destTopForallTy g arities v.Type + Some([], [], fullTypars, emptyTyparInst, []) else PartitionValTyparsForApparentEnclosingType g v @@ -2163,8 +2163,8 @@ let PartitionValRefTypars g (vref: ValRef) = PartitionValTypars g vref.Deref /// Get the arguments for an F# value that represents an object model method let ArgInfosOfMemberVal g (v:Val) = - let membInfo,topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range - let _,arginfos,_,_ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let membInfo, topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range + let _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range arginfos let ArgInfosOfMember g (vref: ValRef) = @@ -2179,35 +2179,35 @@ let GetFSharpViewOfReturnType (g:TcGlobals) retTy = /// Get the property "type" (getter return type) for an F# value that represents a getter or setter /// of an object model property. let ReturnTypeOfPropertyVal g (v:Val) = - let membInfo,topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range + let membInfo, topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range match membInfo.MemberFlags.MemberKind with | MemberKind.PropertySet -> - let _,arginfos,_,_ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range if not arginfos.IsEmpty && not arginfos.Head.IsEmpty then arginfos.Head |> List.last |> fst else error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)); | MemberKind.PropertyGet -> - let _,_,rty,_ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let _, _, rty, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range GetFSharpViewOfReturnType g rty - | _ -> error(InternalError("ReturnTypeOfPropertyVal",v.Range)) + | _ -> error(InternalError("ReturnTypeOfPropertyVal", v.Range)) /// Get the property arguments for an F# value that represents a getter or setter /// of an object model property. let ArgInfosOfPropertyVal g (v:Val) = - let membInfo,topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range + let membInfo, topValInfo = checkMemberVal v.MemberInfo v.ValReprInfo v.Range match membInfo.MemberFlags.MemberKind with | MemberKind.PropertyGet -> ArgInfosOfMemberVal g v |> List.concat | MemberKind.PropertySet -> - let _,arginfos,_,_ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range + let _, arginfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags topValInfo v.Type v.Range if not arginfos.IsEmpty && not arginfos.Head.IsEmpty then arginfos.Head |> List.frontAndBack |> fst else error(Error(FSComp.SR.tastValueDoesNotHaveSetterType(), v.Range)); | _ -> - error(InternalError("ArgInfosOfPropertyVal",v.Range)) + error(InternalError("ArgInfosOfPropertyVal", v.Range)) //--------------------------------------------------------------------------- // Generalize type constructors to types @@ -2217,7 +2217,7 @@ let generalTyconRefInst (tc:TyconRef) = generalizeTypars tc.TyparsNoRange let generalizeTyconRef tc = let tinst = generalTyconRefInst tc - tinst,TType_app(tc, tinst) + tinst, TType_app(tc, tinst) let generalizedTyconRef tc = TType_app(tc, generalTyconRefInst tc) @@ -2244,13 +2244,13 @@ type TyparConstraintsWithTypars = (Typar * TyparConstraint) list module PrettyTypes = let newPrettyTypar (tp:Typar) nm = - NewTypar (tp.Kind, tp.Rigidity,Typar(ident(nm, tp.Range),tp.StaticReq,false),false,TyparDynamicReq.Yes,[],false,false) + NewTypar (tp.Kind, tp.Rigidity, Typar(ident(nm, tp.Range), tp.StaticReq, false), false, TyparDynamicReq.Yes, [], false, false) let NewPrettyTypars renaming tps names = let niceTypars = List.map2 newPrettyTypar tps names - let tl,_tt = mkTyparToTyparRenaming tps niceTypars in + let tl, _tt = mkTyparToTyparRenaming tps niceTypars in let renaming = renaming @ tl - (tps,niceTypars) ||> List.iter2 (fun tp tpnice -> tpnice.FixupConstraints (instTyparConstraints renaming tp.Constraints)) ; + (tps, niceTypars) ||> List.iter2 (fun tp tpnice -> tpnice.FixupConstraints (instTyparConstraints renaming tp.Constraints)) ; niceTypars, renaming // We choose names for type parameters from 'a'..'t' @@ -2287,8 +2287,8 @@ module PrettyTypes = if NeedsPrettyTyparName tp then let (typeIndex, measureIndex, baseName, letters, i) = match tp.Kind with - | TyparKind.Type -> (typeIndex+1,measureIndex,'a',20,typeIndex) - | TyparKind.Measure -> (typeIndex,measureIndex+1,'u',6,measureIndex) + | TyparKind.Type -> (typeIndex+1, measureIndex, 'a', 20, typeIndex) + | TyparKind.Measure -> (typeIndex, measureIndex+1, 'u', 6, measureIndex) let nm = if i < letters then String.make 1 (char(int baseName + i)) else String.make 1 baseName + string (i-letters+1) @@ -2300,15 +2300,15 @@ module PrettyTypes = // Use the next index and append it to the natural name let (typeIndex, measureIndex, nm) = match tp.Kind with - | TyparKind.Type -> (typeIndex+1,measureIndex,tp.Name+ string typeIndex) - | TyparKind.Measure -> (typeIndex,measureIndex+1,tp.Name+ string measureIndex) - tryName (nm,typeIndex, measureIndex) (fun () -> + | TyparKind.Type -> (typeIndex+1, measureIndex, tp.Name+ string typeIndex) + | TyparKind.Measure -> (typeIndex, measureIndex+1, tp.Name+ string measureIndex) + tryName (nm, typeIndex, measureIndex) (fun () -> tryAgain (typeIndex, measureIndex))) else - useThisName (tp.Name,typeIndex, measureIndex) + useThisName (tp.Name, typeIndex, measureIndex) - choose tps (0,0) [] + choose tps (0, 0) [] let PrettifyThings g foldTys mapTys things = let ftps = foldTys (accFreeInTypeLeftToRight g true false) emptyFreeTyparsLeftToRight things @@ -2321,7 +2321,7 @@ module PrettyTypes = computeKeep (tp :: keep) change rest else computeKeep keep (tp :: change) rest - let keep,change = computeKeep [] [] ftps + let keep, change = computeKeep [] [] ftps // change |> List.iter (fun tp -> dprintf "change typar: %s %s %d\n" tp.Name (tp.DisplayName) (stamp_of_typar tp)); // keep |> List.iter (fun tp -> dprintf "keep typar: %s %s %d\n" tp.Name (tp.DisplayName) (stamp_of_typar tp)); @@ -2333,21 +2333,21 @@ module PrettyTypes = // strip universal types for printing let getTauStayTau t = match t with - | TType_forall (_,tau) -> tau + | TType_forall (_, tau) -> tau | _ -> t let tauThings = mapTys getTauStayTau things let prettyThings = mapTys (instType renaming) tauThings // niceTypars |> List.iter (fun tp -> dprintf "nice typar: %d\n" (stamp_of_typar tp)); * - let tpconstraints = niceTypars |> List.collect (fun tpnice -> List.map (fun tpc -> tpnice,tpc) tpnice.Constraints) + let tpconstraints = niceTypars |> List.collect (fun tpnice -> List.map (fun tpc -> tpnice, tpc) tpnice.Constraints) prettyThings, tpconstraints let PrettifyType g x = PrettifyThings g id id x - let PrettifyTypePair g x = PrettifyThings g (fun f -> foldPair (f,f)) (fun f -> mapPair (f,f)) x + let PrettifyTypePair g x = PrettifyThings g (fun f -> foldPair (f, f)) (fun f -> mapPair (f, f)) x let PrettifyTypes g x = PrettifyThings g List.fold List.map x let PrettifyCurriedTypes g x = PrettifyThings g (fun f -> List.fold (List.fold f)) List.mapSquared x - let PrettifyCurriedSigTypes g x = PrettifyThings g (fun f -> foldPair (List.fold (List.fold f),f)) (fun f -> mapPair (List.mapSquared f,f)) x + let PrettifyCurriedSigTypes g x = PrettifyThings g (fun f -> foldPair (List.fold (List.fold f), f)) (fun f -> mapPair (List.mapSquared f, f)) x // Badly formed code may instantiate rigid declared typars to types. // Hence we double check here that the thing is really a type variable @@ -2375,12 +2375,12 @@ module PrettyTypes = let PrettifyInstAndUncurriedSig g (x: TyparInst * UncurriedArgInfos * TType) = PrettifyThings g (fun f -> foldTriple (foldTyparInst f, foldUnurriedArgInfos f, f)) - (fun f -> mapTriple (mapTyparInst g f, List.map (map1Of2 f),f)) + (fun f -> mapTriple (mapTyparInst g f, List.map (map1Of2 f), f)) x let PrettifyInstAndCurriedSig g (x: TyparInst * TTypes * CurriedArgInfos * TType) = PrettifyThings g - (fun f -> foldQuadruple (foldTyparInst f, List.fold f, List.fold (List.fold (fold1Of2 f)),f)) + (fun f -> foldQuadruple (foldTyparInst f, List.fold f, List.fold (List.fold (fold1Of2 f)), f)) (fun f -> mapQuadruple (mapTyparInst g f, List.map f, List.mapSquared (map1Of2 f), f)) x @@ -2415,11 +2415,11 @@ module SimplifyTypes = let typ = stripTyparEqns typ let z = f z typ match typ with - | TType_forall (_,body) -> foldTypeButNotConstraints f z body - | TType_app (_,tinst) -> List.fold (foldTypeButNotConstraints f) z tinst - | TType_ucase (_,tinst) -> List.fold (foldTypeButNotConstraints f) z tinst - | TType_tuple (_,typs) -> List.fold (foldTypeButNotConstraints f) z typs - | TType_fun (s,t) -> foldTypeButNotConstraints f (foldTypeButNotConstraints f z s) t + | TType_forall (_, body) -> foldTypeButNotConstraints f z body + | TType_app (_, tinst) -> List.fold (foldTypeButNotConstraints f) z tinst + | TType_ucase (_, tinst) -> List.fold (foldTypeButNotConstraints f) z tinst + | TType_tuple (_, typs) -> List.fold (foldTypeButNotConstraints f) z typs + | TType_fun (s, t) -> foldTypeButNotConstraints f (foldTypeButNotConstraints f z s) t | TType_var _ -> z | TType_measure _ -> z @@ -2438,7 +2438,7 @@ module SimplifyTypes = type TypeSimplificationInfo = { singletons : Typar Zset - inplaceConstraints : Zmap + inplaceConstraints : Zmap postfixConstraints : (Typar * TyparConstraint) list } let typeSimplificationInfo0 = @@ -2456,13 +2456,13 @@ module SimplifyTypes = let usedInTypeConstraint typar = Zset.contains typar constraintTypars let singletons = singletons |> Zset.filter (usedInTypeConstraint >> not) // Here, singletons should really be used once - let inplace,postfix = - cxs |> List.partition (fun (tp,tpc) -> + let inplace, postfix = + cxs |> List.partition (fun (tp, tpc) -> simplify && isTTyparCoercesToType tpc && Zset.contains tp singletons && tp.Constraints.Length = 1) - let inplace = inplace |> List.map (function (tp,TyparConstraint.CoercesTo(ty,_)) -> tp,ty | _ -> failwith "not isTTyparCoercesToType") + let inplace = inplace |> List.map (function (tp, TyparConstraint.CoercesTo(ty, _)) -> tp, ty | _ -> failwith "not isTTyparCoercesToType") { singletons = singletons inplaceConstraints = Zmap.ofList typarOrder inplace @@ -2616,7 +2616,7 @@ let fullNameOfParentOfValRef vref = | VRefLocal x -> match x.PublicPath with | None -> None - | Some (ValPubPath(pp,_)) -> Some(fullNameOfPubPath pp) + | Some (ValPubPath(pp, _)) -> Some(fullNameOfPubPath pp) | VRefNonLocal nlr -> Some (fullNameOfEntityRef (fun (x:EntityRef) -> x.DemangledModuleOrNamespaceName) nlr.EnclosingEntity) @@ -2625,7 +2625,7 @@ let fullNameOfParentOfValRefAsLayout vref = | VRefLocal x -> match x.PublicPath with | None -> None - | Some (ValPubPath(pp,_)) -> Some(fullNameOfPubPathAsLayout pp) + | Some (ValPubPath(pp, _)) -> Some(fullNameOfPubPathAsLayout pp) | VRefNonLocal nlr -> Some (fullNameOfEntityRefAsLayout (fun (x:EntityRef) -> x.DemangledModuleOrNamespaceName) nlr.EnclosingEntity) @@ -2722,7 +2722,7 @@ let isILAttrib (tref:ILTypeRef) (attr: ILAttribute) = // results of attribute lookups in the TAST let HasILAttribute tref (attrs: ILAttributes) = Array.exists (isILAttrib tref) attrs.AsArray -let HasILAttributeByName tname (attrs: ILAttributes) = Array.exists (isILAttribByName ([],tname)) attrs.AsArray +let HasILAttributeByName tname (attrs: ILAttributes) = Array.exists (isILAttribByName ([], tname)) attrs.AsArray let TryDecodeILAttribute (g:TcGlobals) tref (attrs: ILAttributes) = attrs.AsArray |> Array.tryPick (fun x -> if isILAttrib tref x then Some(decodeILAttribData g.ilg x) else None) @@ -2733,27 +2733,27 @@ let ILThingHasExtensionAttribute (attrs : ILAttributes) = |> Array.exists (fun attr -> attr.Method.EnclosingType.TypeSpec.Name = "System.Runtime.CompilerServices.ExtensionAttribute") // F# view of attributes (these get converted to AbsIL attributes in ilxgen) -let IsMatchingFSharpAttribute g (AttribInfo(_,tcref)) (Attrib(tcref2,_,_,_,_,_,_)) = tyconRefEq g tcref tcref2 +let IsMatchingFSharpAttribute g (AttribInfo(_, tcref)) (Attrib(tcref2, _, _, _, _, _, _)) = tyconRefEq g tcref tcref2 let HasFSharpAttribute g tref attrs = List.exists (IsMatchingFSharpAttribute g tref) attrs let findAttrib g tref attrs = List.find (IsMatchingFSharpAttribute g tref) attrs let TryFindFSharpAttribute g tref attrs = List.tryFind (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 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.tryPick (function (AttribNamedArg(nm2, _, _, v)) when nm = nm2 -> Some v | _ -> 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|_|) = 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 TryFindFSharpBoolAttributeWithDefault dflt g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_,_,[ ],_,_,_,_)) -> Some(dflt) - | Some(Attrib(_,_,[ AttribBoolArg(b) ],_,_,_,_)) -> Some(b) + | Some(Attrib(_, _, [ ], _, _, _, _)) -> Some(dflt) + | Some(Attrib(_, _, [ AttribBoolArg(b) ], _, _, _, _)) -> Some(b) | _ -> None let TryFindFSharpBoolAttribute g nm attrs = TryFindFSharpBoolAttributeWithDefault true g nm attrs @@ -2761,37 +2761,37 @@ let TryFindFSharpBoolAttributeAssumeFalse g nm attrs = TryFindFSharpBoolAttribut let TryFindFSharpInt32Attribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_,_,[ AttribInt32Arg(b) ],_,_,_,_)) -> Some b + | Some(Attrib(_, _, [ AttribInt32Arg(b) ], _, _, _, _)) -> Some b | _ -> None let TryFindFSharpStringAttribute g nm attrs = match TryFindFSharpAttribute g nm attrs with - | Some(Attrib(_,_,[ AttribStringArg(b) ],_,_,_,_)) -> Some b + | Some(Attrib(_, _, [ AttribStringArg(b) ], _, _, _, _)) -> Some b | _ -> None -let TryFindILAttribute (AttribInfo (atref,_)) attrs = +let TryFindILAttribute (AttribInfo (atref, _)) attrs = HasILAttribute atref attrs let TryFindILAttributeOpt attr attrs = match attr with - | Some (AttribInfo (atref,_)) -> HasILAttribute atref attrs + | Some (AttribInfo (atref, _)) -> HasILAttribute atref attrs | _ -> false /// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and /// provided attributes. // // This is used for AttributeUsageAttribute, DefaultMemberAttribute and ConditionalAttribute (on attribute types) -let TryBindTyconRefAttribute g (m:range) (AttribInfo (atref,_) as args) (tcref:TyconRef) f1 f2 f3 = +let TryBindTyconRefAttribute g (m:range) (AttribInfo (atref, _) as args) (tcref:TyconRef) f1 f2 f3 = ignore m; ignore f3 match metadataOfTycon tcref.Deref with #if EXTENSIONTYPING | ProvidedTypeMetadata info -> - let provAttribs = info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)),m) - match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)),m) with + let provAttribs = info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)), m) + match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)), m) with | Some args -> f3 args | None -> None #endif - | ILTypeMetadata (TILObjectReprData(_,_,tdef)) -> + | ILTypeMetadata (TILObjectReprData(_, _, tdef)) -> match TryDecodeILAttribute g atref tdef.CustomAttrs with | Some attr -> f1 attr | _ -> None @@ -2803,23 +2803,23 @@ let TryBindTyconRefAttribute g (m:range) (AttribInfo (atref,_) as args) (tcref:T let TryFindTyconRefBoolAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref (function - | ([ ],_) -> Some true - | ([ILAttribElem.Bool (v) ],_) -> Some v + | ([ ], _) -> Some true + | ([ILAttribElem.Bool (v) ], _) -> Some v | _ -> None) (function - | (Attrib(_,_,[ ],_,_,_,_)) -> Some true - | (Attrib(_,_,[ AttribBoolArg v ],_,_,_,_)) -> Some v + | (Attrib(_, _, [ ], _, _, _, _)) -> Some true + | (Attrib(_, _, [ AttribBoolArg v ], _, _, _, _)) -> Some v | _ -> None) (function - | ([ ],_) -> Some true - | ([ Some ((:? bool as v) : obj) ],_) -> Some v + | ([ ], _) -> Some true + | ([ Some ((:? bool as v) : obj) ], _) -> Some v | _ -> None) let TryFindAttributeUsageAttribute g m tcref = TryBindTyconRefAttribute g m g.attrib_AttributeUsageAttribute tcref - (fun (_,named) -> named |> List.tryPick (function ("AllowMultiple",_,_,ILAttribElem.Bool res) -> Some res | _ -> None)) - (fun (Attrib(_,_,_,named,_,_,_)) -> named |> List.tryPick (function AttribNamedArg("AllowMultiple",_,_,AttribBoolArg(res) ) -> Some res | _ -> None)) - (fun (_,named) -> named |> List.tryPick (function ("AllowMultiple", Some ((:? bool as res) : obj)) -> Some res | _ -> None)) + (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", _, _, ILAttribElem.Bool res) -> Some res | _ -> None)) + (fun (Attrib(_, _, _, named, _, _, _)) -> named |> List.tryPick (function AttribNamedArg("AllowMultiple", _, _, AttribBoolArg(res) ) -> Some res | _ -> None)) + (fun (_, named) -> named |> List.tryPick (function ("AllowMultiple", Some ((:? bool as res) : obj)) -> Some res | _ -> None)) /// Try to find a specific attribute on a type definition, where the attribute accepts a string argument. @@ -2827,8 +2827,8 @@ let TryFindAttributeUsageAttribute g m tcref = /// This is used to detect the 'DefaultMemberAttribute' and 'ConditionalAttribute' attributes (on type definitions) let TryFindTyconRefStringAttribute g m attribSpec tcref = TryBindTyconRefAttribute g m attribSpec tcref - (function ([ILAttribElem.String (Some(msg)) ],_) -> Some msg | _ -> None) - (function (Attrib(_,_,[ AttribStringArg(msg) ],_,_,_,_)) -> Some msg | _ -> None) + (function ([ILAttribElem.String (Some(msg)) ], _) -> Some msg | _ -> None) + (function (Attrib(_, _, [ AttribStringArg(msg) ], _, _, _, _)) -> Some msg | _ -> None) (function ([ Some ((:? string as msg) : obj) ], _) -> Some msg | _ -> None) /// Check if a type definition has a specific attribute @@ -2845,12 +2845,12 @@ let TyconRefHasAttribute g m attribSpec tcref = let destByrefTy g ty = match ty |> stripTyEqns g with - | TType_app(tcref,[x]) when tyconRefEq g g.byref_tcr tcref -> x + | TType_app(tcref, [x]) when tyconRefEq g g.byref_tcr tcref -> x | _ -> failwith "destByrefTy: not a byref type" let destNativePtrTy g ty = match ty |> stripTyEqns g with - | TType_app(tcref,[x]) when tyconRefEq g g.nativeptr_tcr tcref -> x + | TType_app(tcref, [x]) when tyconRefEq g g.nativeptr_tcr tcref -> x | _ -> failwith "destNativePtrTy: not a native ptr type" let isRefCellTy g ty = @@ -2860,17 +2860,17 @@ let isRefCellTy g ty = let destRefCellTy g ty = match ty |> stripTyEqns g with - | TType_app(tcref,[x]) when tyconRefEq g g.refcell_tcr_canon tcref -> x + | TType_app(tcref, [x]) when tyconRefEq g g.refcell_tcr_canon tcref -> x | _ -> failwith "destRefCellTy: not a ref type" -let StripSelfRefCell(g:TcGlobals,baseOrThisInfo:ValBaseOrThisInfo,tau: TType) : TType = +let StripSelfRefCell(g:TcGlobals, baseOrThisInfo:ValBaseOrThisInfo, tau: TType) : TType = if baseOrThisInfo = CtorThisVal && isRefCellTy g tau then destRefCellTy g tau else tau -let mkRefCellTy (g:TcGlobals) ty = TType_app(g.refcell_tcr_nice,[ty]) +let mkRefCellTy (g:TcGlobals) ty = TType_app(g.refcell_tcr_nice, [ty]) -let mkLazyTy (g:TcGlobals) ty = TType_app(g.lazy_tcr_nice,[ty]) +let mkLazyTy (g:TcGlobals) ty = TType_app(g.lazy_tcr_nice, [ty]) let mkPrintfFormatTy (g:TcGlobals) aty bty cty dty ety = TType_app(g.format_tcr, [aty;bty;cty;dty; ety]) @@ -2919,12 +2919,12 @@ type ValRef with let (|UnopExpr|_|) _g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,_,[arg1],_) -> Some (vref, arg1) + | Expr.App(Expr.Val(vref, _, _), _, _, [arg1], _) -> Some (vref, arg1) | _ -> None let (|BinopExpr|_|) _g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,_,[arg1;arg2],_) -> Some (vref, arg1, arg2) + | Expr.App(Expr.Val(vref, _, _), _, _, [arg1;arg2], _) -> Some (vref, arg1, arg2) | _ -> None let (|SpecificUnopExpr|_|) g vrefReqd expr = @@ -2951,7 +2951,7 @@ let (|AttribBitwiseOrExpr|_|) g expr = // 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.compilingFslib -> + | Expr.App(Expr.Lambda _, _, _, [arg1;arg2], _) when g.compilingFslib -> Some(arg1, arg2) | _ -> None @@ -2977,22 +2977,22 @@ let isTypeDefOfValRef g vref = let (|UncheckedDefaultOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isUncheckedDefaultOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isUncheckedDefaultOfValRef g vref -> Some ty | _ -> None let (|TypeOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isTypeOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeOfValRef g vref -> Some ty | _ -> None let (|SizeOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isSizeOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isSizeOfValRef g vref -> Some ty | _ -> None let (|TypeDefOfExpr|_|) g expr = match expr with - | Expr.App(Expr.Val(vref,_,_),_,[ty],[],_) when isTypeDefOfValRef g vref -> Some ty + | Expr.App(Expr.Val(vref, _, _), _, [ty], [], _) when isTypeDefOfValRef g vref -> Some ty | _ -> None @@ -3063,15 +3063,15 @@ module DebugPrint = begin and auxTypeWrapL env isAtomic typ = let wrap x = bracketIfL isAtomic x in // wrap iff require atomic expr match stripTyparEqns typ with - | TType_forall (typars,rty) -> + | TType_forall (typars, rty) -> (leftL (tagText "!") ^^ layoutTyparDecls typars --- auxTypeL env rty) |> wrap - | TType_ucase (UCRef(tcref,_),tinst) - | TType_app (tcref,tinst) -> + | TType_ucase (UCRef(tcref, _), tinst) + | TType_app (tcref, tinst) -> let prefix = tcref.IsPrefixDisplay let tcL = layoutTyconRef tcref auxTyparsL env tcL prefix tinst - | TType_tuple (_tupInfo,typs) -> sepListL (wordL (tagText "*")) (List.map (auxTypeAtomL env) typs) |> wrap - | TType_fun (f,x) -> ((auxTypeAtomL env f ^^ wordL (tagText "->")) --- auxTypeL env x) |> wrap + | TType_tuple (_tupInfo, typs) -> sepListL (wordL (tagText "*")) (List.map (auxTypeAtomL env) typs) |> wrap + | TType_fun (f, x) -> ((auxTypeAtomL env f ^^ wordL (tagText "->")) --- auxTypeL env x) |> wrap | TType_var typar -> auxTyparWrapL env isAtomic typar | TType_measure unt -> #if DEBUG @@ -3079,20 +3079,20 @@ module DebugPrint = begin (match !global_g with | None -> wordL (tagText "") | Some g -> - let sortVars (vs:(Typar * Rational) list) = vs |> List.sortBy (fun (v,_) -> v.DisplayName) - let sortCons (cs:(TyconRef * Rational) list) = cs |> List.sortBy (fun (c,_) -> c.DisplayName) - let negvs,posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_,e) -> SignRational e < 0) - let negcs,poscs = ListMeasureConOccsWithNonZeroExponents g false unt |> sortCons |> List.partition (fun (_,e) -> SignRational e < 0) + let sortVars (vs:(Typar * Rational) list) = vs |> List.sortBy (fun (v, _) -> v.DisplayName) + let sortCons (cs:(TyconRef * Rational) list) = cs |> List.sortBy (fun (c, _) -> c.DisplayName) + let negvs, posvs = ListMeasureVarOccsWithNonZeroExponents unt |> sortVars |> List.partition (fun (_, e) -> SignRational e < 0) + let negcs, poscs = ListMeasureConOccsWithNonZeroExponents g false unt |> sortCons |> List.partition (fun (_, e) -> SignRational e < 0) let unparL (uv:Typar) = wordL (tagText ("'" ^ uv.DisplayName)) let unconL tc = layoutTyconRef tc let rationalL e = wordL (tagText(RationalToString e)) let measureToPowerL x e = if e = OneRational then x else x -- wordL (tagText "^") -- rationalL e - let prefix = spaceListL (List.map (fun (v,e) -> measureToPowerL (unparL v) e) posvs @ - List.map (fun (c,e) -> measureToPowerL (unconL c) e) poscs) - let postfix = spaceListL (List.map (fun (v,e) -> measureToPowerL (unparL v) (NegRational e)) negvs @ - List.map (fun (c,e) -> measureToPowerL (unconL c) (NegRational e)) negcs) - match (negvs,negcs) with - | [],[] -> prefix + let prefix = spaceListL (List.map (fun (v, e) -> measureToPowerL (unparL v) e) posvs @ + List.map (fun (c, e) -> measureToPowerL (unconL c) e) poscs) + let postfix = spaceListL (List.map (fun (v, e) -> measureToPowerL (unparL v) (NegRational e)) negvs @ + List.map (fun (c, e) -> measureToPowerL (unconL c) (NegRational e)) negcs) + match (negvs, negcs) with + | [], [] -> prefix | _ -> prefix ^^ sepL (tagText "/") ^^ postfix) ^^ rightL (tagText "}") #else @@ -3130,7 +3130,7 @@ module DebugPrint = begin and auxTraitL env (ttrait: TraitConstraintInfo) = #if DEBUG - let (TTrait(tys,nm,memFlags,argtys,rty,_)) = ttrait + let (TTrait(tys, nm, memFlags, argtys, rty, _)) = ttrait match !global_g with | None -> wordL (tagText "") | Some g -> @@ -3141,22 +3141,22 @@ module DebugPrint = begin let methodTypeL = (argsL ^^ wordL (tagText "->")) ++ resL bracketL (stat ++ bracketL (sepListL (wordL (tagText "or")) (List.map (auxTypeAtomL env) tys)) ++ wordL (tagText "member") --- (wordL (tagText nm) ^^ wordL (tagText ":") -- methodTypeL)) #else - ignore (env,ttrait) + ignore (env, ttrait) wordL(tagText "trait") #endif - and auxTyparConstraintL env (tp,tpc) = + and auxTyparConstraintL env (tp, tpc) = let constraintPrefix l = auxTypar2L env tp ^^ wordL (tagText ":") ^^ l match tpc with - | TyparConstraint.CoercesTo(typarConstrTyp,_) -> + | TyparConstraint.CoercesTo(typarConstrTyp, _) -> auxTypar2L env tp ^^ wordL (tagText ":>") --- auxTyparConstraintTypL env typarConstrTyp - | TyparConstraint.MayResolveMember(traitInfo,_) -> + | TyparConstraint.MayResolveMember(traitInfo, _) -> auxTypar2L env tp ^^ wordL (tagText ":") --- auxTraitL env traitInfo - | TyparConstraint.DefaultsTo(_,ty,_) -> + | TyparConstraint.DefaultsTo(_, ty, _) -> wordL (tagText "default") ^^ auxTypar2L env tp ^^ wordL (tagText ":") ^^ auxTypeL env ty - | TyparConstraint.IsEnum(ty,_) -> + | TyparConstraint.IsEnum(ty, _) -> auxTyparsL env (wordL (tagText "enum")) true [ty] |> constraintPrefix - | TyparConstraint.IsDelegate(aty,bty,_) -> + | TyparConstraint.IsDelegate(aty, bty, _) -> auxTyparsL env (wordL (tagText "delegate")) true [aty; bty] |> constraintPrefix | TyparConstraint.SupportsNull _ -> wordL (tagText "null") |> constraintPrefix @@ -3170,7 +3170,7 @@ module DebugPrint = begin wordL (tagText "not struct") |> constraintPrefix | TyparConstraint.IsUnmanaged _ -> wordL (tagText "unmanaged") |> constraintPrefix - | TyparConstraint.SimpleChoice(tys,_) -> + | TyparConstraint.SimpleChoice(tys, _) -> bracketL (sepListL (sepL (tagText "|")) (List.map (auxTypeL env) tys)) |> constraintPrefix | TyparConstraint.RequiresDefaultConstructor _ -> bracketL (wordL (tagText "new : unit -> ") ^^ (auxTypar2L env tp)) |> constraintPrefix @@ -3184,21 +3184,21 @@ module DebugPrint = begin and typarAtomL tp = auxTyparAtomL SimplifyTypes.typeSimplificationInfo0 tp and typeAtomL tau = - let tau,cxs = tau,[] + let tau, cxs = tau, [] let env = SimplifyTypes.CollectInfo false [tau] cxs match env.postfixConstraints with | [] -> auxTypeAtomL env tau | _ -> bracketL (auxTypeL env tau --- auxTyparConstraintsL env env.postfixConstraints) and typeL tau = - let tau,cxs = tau,[] + let tau, cxs = tau, [] let env = SimplifyTypes.CollectInfo false [tau] cxs match env.postfixConstraints with | [] -> auxTypeL env tau | _ -> (auxTypeL env tau --- auxTyparConstraintsL env env.postfixConstraints) and typarDeclL tp = - let tau,cxs = mkTyparTy tp,(List.map (fun x -> (tp,x)) tp.Constraints) + let tau, cxs = mkTyparTy tp, (List.map (fun x -> (tp, x)) tp.Constraints) let env = SimplifyTypes.CollectInfo false [tau] cxs match env.postfixConstraints with | [] -> auxTypeL env tau @@ -3219,7 +3219,7 @@ module DebugPrint = begin let valRefL (vr:ValRef) = wordL (tagText vr.LogicalName) |> stampL vr.Stamp - let layoutAttrib (Attrib(_,k,_,_,_,_,_)) = + let layoutAttrib (Attrib(_, k, _, _, _, _, _)) = leftL (tagText "[<") ^^ (match k with | ILAttrib (ilmeth) -> wordL (tagText ilmeth.Name) @@ -3228,7 +3228,7 @@ module DebugPrint = begin let layoutAttribs attribs = aboveListL (List.map layoutAttrib attribs) - let arityInfoL (ValReprInfo (tpNames,_,_) as tvd) = + let arityInfoL (ValReprInfo (tpNames, _, _) as tvd) = let ns = tvd.AritiesOfArgs in leftL (tagText "arity<") ^^ intL tpNames.Length ^^ sepL (tagText ">[") ^^ commaListL (List.map intL ns) ^^ rightL (tagText "]") @@ -3245,13 +3245,13 @@ module DebugPrint = begin ^^ wordL (tagText ":")) -- typeL v.Type - let tslotparamL(TSlotParam(nmOpt, typ, inFlag, outFlag, _,_)) = + let tslotparamL(TSlotParam(nmOpt, typ, inFlag, outFlag, _, _)) = (optionL (tagText >> wordL) nmOpt) ^^ wordL(tagText ":") ^^ typeL typ ^^ (if inFlag then wordL(tagText "[in]") else emptyL) ^^ (if outFlag then wordL(tagText "[out]") else emptyL) ^^ (if inFlag then wordL(tagText "[opt]") else emptyL) let slotSigL (slotsig:SlotSig) = #if DEBUG - let (TSlotSig(nm,typ,tps1,tps2,pms,rty)) = slotsig + let (TSlotSig(nm, typ, tps1, tps2, pms, rty)) = slotsig match !global_g with | None -> wordL(tagText "") | Some g -> @@ -3300,12 +3300,12 @@ module DebugPrint = begin | Const.IntPtr x -> (x |> string)+"n" | Const.UIntPtr x -> (x |> string)+"un" | Const.Single d -> - (let s = d.ToString("g12",System.Globalization.CultureInfo.InvariantCulture) + (let s = d.ToString("g12", System.Globalization.CultureInfo.InvariantCulture) if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s) + "f" | Const.Double d -> - let s = d.ToString("g12",System.Globalization.CultureInfo.InvariantCulture) + let s = d.ToString("g12", System.Globalization.CultureInfo.InvariantCulture) if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s then s + ".0" else s @@ -3332,12 +3332,12 @@ module DebugPrint = begin match tycon.TypeReprInfo with | TFSharpObjectRepr r when (match r.fsobjmodel_kind with TTyconInterface -> true | _ -> false) -> [] | _ -> tycon.ImmediateInterfacesOfFSharpTycon - let iimpls = iimpls |> List.filter (fun (_,compgen,_) -> not compgen) + let iimpls = iimpls |> List.filter (fun (_, compgen, _) -> not compgen) // if TTyconInterface, the iimpls should be printed as inherited interfaces if isNil adhoc && isNil iimpls then emptyL else - let iimplsLs = iimpls |> List.map (fun (ty,_,_) -> wordL(tagText "interface") --- typeL ty) + let iimplsLs = iimpls |> List.map (fun (ty, _, _) -> wordL(tagText "interface") --- typeL ty) let adhocLs = adhoc |> List.map (fun vref -> vspecAtBindL vref.Deref) (wordL(tagText "with") @@-- aboveListL (iimplsLs @ adhocLs)) @@ wordL(tagText "end") @@ -3358,7 +3358,7 @@ module DebugPrint = begin let lhs = if fld.IsMutable then wordL(tagText "mutable") --- lhs else lhs (lhs ^^ rightL(tagText ":")) --- typeL fld.FormalType - let tyconReprL (repr,tycon:Tycon) = + let tyconReprL (repr, tycon:Tycon) = match repr with | TRecdRepr _ -> tycon.TrueFieldsAsList |> List.map (fun fld -> layoutRecdField fld ^^ rightL(tagText ";")) |> aboveListL @@ -3376,11 +3376,11 @@ module DebugPrint = begin | _ -> failwith "???" let inherits = match r.fsobjmodel_kind, tycon.TypeContents.tcaug_super with - | TTyconClass,Some super -> [wordL(tagText "inherit") ^^ (typeL super)] - | TTyconInterface,_ -> + | TTyconClass, Some super -> [wordL(tagText "inherit") ^^ (typeL super)] + | TTyconInterface, _ -> tycon.ImmediateInterfacesOfFSharpTycon - |> List.filter (fun (_,compgen,_) -> not compgen) - |> List.map (fun (ity,_,_) -> wordL(tagText "inherit") ^^ (typeL ity)) + |> List.filter (fun (_, compgen, _) -> not compgen) + |> List.map (fun (ity, _, _) -> wordL(tagText "inherit") ^^ (typeL ity)) | _ -> [] let vsprs = tycon.MembersOfFSharpTyconSorted @@ -3393,7 +3393,7 @@ module DebugPrint = begin | TUnionRepr _ -> tycon.UnionCasesAsList |> layoutUnionCases |> aboveListL | TAsmRepr _ -> wordL(tagText "(# ... #)") | TMeasureableRepr ty -> typeL ty - | TILObjectRepr (TILObjectReprData(_,_,td)) -> wordL (tagText td.Name) + | TILObjectRepr (TILObjectReprData(_, _, td)) -> wordL (tagText td.Name) | _ -> failwith "unreachable" let reprL = match tycon.TypeReprInfo with @@ -3406,7 +3406,7 @@ module DebugPrint = begin | None -> lhsL @@-- memberLs | Some a -> (lhsL ^^ wordL(tagText "=")) --- (typeL a @@ memberLs) | a -> - let rhsL = tyconReprL (a,tycon) @@ memberLs + let rhsL = tyconReprL (a, tycon) @@ memberLs (lhsL ^^ wordL(tagText "=")) @@-- rhsL reprL @@ -3415,7 +3415,7 @@ module DebugPrint = begin // layout - bind, expr, dtree etc. //-------------------------------------------------------------------------- - and bindingL (TBind(v,repr,_)) = + and bindingL (TBind(v, repr, _)) = vspecAtBindL v --- (wordL(tagText "=") ^^ exprL repr) and exprL expr = exprWrapL false expr @@ -3436,8 +3436,8 @@ module DebugPrint = begin let wrap = bracketIfL isAtomic // wrap iff require atomic expr let lay = match expr with - | Expr.Const (c,_,_) -> constL c - | Expr.Val (v,flags,_) -> + | Expr.Const (c, _, _) -> constL c + | Expr.Val (v, flags, _) -> let xL = valL v.Deref let xL = match flags with @@ -3447,41 +3447,41 @@ module DebugPrint = begin | VSlotDirectCall -> xL ^^ rightL(tagText "") | NormalValUse -> xL xL - | Expr.Sequential (x0,x1,flag,_,_) -> + | Expr.Sequential (x0, x1, flag, _, _) -> let flag = match flag with | NormalSeq -> "; (*Seq*)" | ThenDoSeq -> "; (*ThenDo*)" ((exprL x0 ^^ rightL (tagText flag)) @@ exprL x1) |> wrap - | Expr.Lambda(_, _, baseValOpt,argvs,body,_,_) -> + | Expr.Lambda(_, _, baseValOpt, argvs, body, _, _) -> let formalsL = spaceListL (List.map vspecAtBindL argvs) in let bindingL = match baseValOpt with | None -> wordL(tagText "lam") ^^ formalsL ^^ rightL(tagText ".") | Some basev -> wordL(tagText "lam") ^^ (leftL(tagText "base=") ^^ vspecAtBindL basev) --- formalsL ^^ rightL(tagText ".") in (bindingL ++ exprL body) |> wrap - | Expr.TyLambda(_,argtyvs,body,_,_) -> + | Expr.TyLambda(_, argtyvs, body, _, _) -> ((wordL(tagText "LAM") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap - | Expr.TyChoose(argtyvs,body,_) -> + | Expr.TyChoose(argtyvs, body, _) -> ((wordL(tagText "CHOOSE") ^^ spaceListL (List.map typarL argtyvs) ^^ rightL(tagText ".")) ++ exprL body) |> wrap - | Expr.App (f,_,tys,argtys,_) -> + | Expr.App (f, _, tys, argtys, _) -> let flayout = atomL f appL flayout tys argtys |> wrap - | Expr.LetRec (binds,body,_,_) -> + | Expr.LetRec (binds, body, _, _) -> letRecL binds (exprL body) |> wrap - | Expr.Let (bind,body,_,_) -> + | Expr.Let (bind, body, _, _) -> letL bind (exprL body) |> wrap | Expr.Link rX -> (wordL(tagText "RecLink") --- atomL (!rX)) |> wrap - | Expr.Match (_,_,dtree,targets,_,_) -> + | Expr.Match (_, _, dtree, targets, _, _) -> leftL(tagText "[") ^^ (decisionTreeL dtree @@ aboveListL (List.mapi targetL (targets |> Array.toList)) ^^ rightL(tagText "]")) - | Expr.Op (TOp.UnionCase (c),_,args,_) -> + | Expr.Op (TOp.UnionCase (c), _, args, _) -> (unionCaseRefL c ++ spaceListL (List.map atomL args)) |> wrap - | Expr.Op (TOp.ExnConstr (ecref),_,args,_) -> + | Expr.Op (TOp.ExnConstr (ecref), _, args, _) -> wordL (tagText ecref.LogicalName) ^^ bracketL (commaListL (List.map atomL args)) - | Expr.Op (TOp.Tuple _,_,xs,_) -> + | Expr.Op (TOp.Tuple _, _, xs, _) -> tupleL (List.map exprL xs) - | Expr.Op (TOp.Recd (ctor,tc),_,xs,_) -> + | Expr.Op (TOp.Recd (ctor, tc), _, xs, _) -> let fields = tc.TrueInstanceFieldsAsList let lay fs x = (wordL (tagText fs.rfield_id.idText) ^^ sepL(tagText "=")) --- (exprL x) let ctorL = @@ -3489,75 +3489,75 @@ module DebugPrint = begin | RecdExpr -> emptyL | RecdExprIsObjInit-> wordL(tagText "(new)") leftL(tagText "{") ^^ semiListL (List.map2 lay fields xs) ^^ rightL(tagText "}") ^^ ctorL - | Expr.Op (TOp.ValFieldSet rf,_,[rx;x],_) -> + | Expr.Op (TOp.ValFieldSet rf, _, [rx;x], _) -> (atomL rx --- wordL(tagText ".")) ^^ (recdFieldRefL rf ^^ wordL(tagText "<-") --- exprL x) - | Expr.Op (TOp.ValFieldSet rf,_,[x],_) -> + | Expr.Op (TOp.ValFieldSet rf, _, [x], _) -> (recdFieldRefL rf ^^ wordL(tagText "<-") --- exprL x) - | Expr.Op (TOp.ValFieldGet rf,_,[rx],_) -> + | Expr.Op (TOp.ValFieldGet rf, _, [rx], _) -> (atomL rx ^^ rightL(tagText ".#") ^^ recdFieldRefL rf) - | Expr.Op (TOp.ValFieldGet rf,_,[],_) -> + | Expr.Op (TOp.ValFieldGet rf, _, [], _) -> recdFieldRefL rf - | Expr.Op (TOp.ValFieldGetAddr rf,_,[rx],_) -> + | Expr.Op (TOp.ValFieldGetAddr rf, _, [rx], _) -> leftL(tagText "&") ^^ bracketL (atomL rx ^^ rightL(tagText ".!") ^^ recdFieldRefL rf) - | Expr.Op (TOp.ValFieldGetAddr rf,_,[],_) -> + | Expr.Op (TOp.ValFieldGetAddr rf, _, [], _) -> leftL(tagText "&") ^^ (recdFieldRefL rf) - | Expr.Op (TOp.UnionCaseTagGet tycr,_,[x],_) -> + | Expr.Op (TOp.UnionCaseTagGet tycr, _, [x], _) -> wordL (tagText ("#" ^ tycr.LogicalName ^ ".tag")) ^^ atomL x - | Expr.Op (TOp.UnionCaseProof c,_,[x],_) -> + | Expr.Op (TOp.UnionCaseProof c, _, [x], _) -> wordL (tagText ("#" ^ c.CaseName^ ".cast")) ^^ atomL x - | Expr.Op (TOp.UnionCaseFieldGet (c,i),_,[x],_) -> + | Expr.Op (TOp.UnionCaseFieldGet (c, i), _, [x], _) -> wordL (tagText ("#" ^ c.CaseName ^ "." ^ string i)) --- atomL x - | Expr.Op (TOp.UnionCaseFieldSet (c,i),_,[x;y],_) -> + | Expr.Op (TOp.UnionCaseFieldSet (c, i), _, [x;y], _) -> ((atomL x --- (rightL (tagText ("#" ^ c.CaseName ^ "." ^ string i)))) ^^ wordL(tagText ":=")) --- exprL y - | Expr.Op (TOp.TupleFieldGet (_,i),_,[x],_) -> + | Expr.Op (TOp.TupleFieldGet (_, i), _, [x], _) -> wordL (tagText ("#" ^ string i)) --- atomL x - | Expr.Op (TOp.Coerce,[typ;_],[x],_) -> + | Expr.Op (TOp.Coerce, [typ;_], [x], _) -> atomL x --- (wordL(tagText ":>") ^^ typeL typ) - | Expr.Op (TOp.Reraise,[_],[],_) -> + | Expr.Op (TOp.Reraise, [_], [], _) -> wordL(tagText "Rethrow!") - | Expr.Op (TOp.ILAsm (a,tys),tyargs,args,_) -> + | Expr.Op (TOp.ILAsm (a, tys), tyargs, args, _) -> let instrs = a |> List.map (sprintf "%+A" >> tagText >> wordL) |> spaceListL // %+A has + since instrs are from an "internal" type let instrs = leftL(tagText "(#") ^^ instrs ^^ rightL(tagText "#)") (appL instrs tyargs args --- wordL(tagText ":") ^^ spaceListL (List.map typeAtomL tys)) |> wrap - | Expr.Op (TOp.LValueOp (lvop,vr),_,args,_) -> + | Expr.Op (TOp.LValueOp (lvop, vr), _, args, _) -> (lvalopL lvop ^^ valRefL vr --- bracketL (commaListL (List.map atomL args))) |> wrap - | Expr.Op (TOp.ILCall (_isVirtCall,_isProtectedCall,_valu,_isNewObjCall,_valUseFlags,_isProperty,_noTailCall,ilMethRef,tinst,minst,_tys),tyargs,args,_) -> + | Expr.Op (TOp.ILCall (_isVirtCall, _isProtectedCall, _valu, _isNewObjCall, _valUseFlags, _isProperty, _noTailCall, ilMethRef, tinst, minst, _tys), tyargs, args, _) -> let meth = ilMethRef.Name wordL(tagText "ILCall") ^^ aboveListL [wordL(tagText "meth ") --- wordL (tagText ilMethRef.EnclosingTypeRef.FullName) ^^ sepL(tagText ".") ^^ wordL (tagText meth); wordL(tagText "tinst ") --- listL typeL tinst; wordL(tagText "minst ") --- listL typeL minst; wordL(tagText "tyargs") --- listL typeL tyargs; wordL(tagText "args ") --- listL exprL args] |> wrap - | Expr.Op (TOp.Array,[_],xs,_) -> + | Expr.Op (TOp.Array, [_], xs, _) -> leftL(tagText "[|") ^^ commaListL (List.map exprL xs) ^^ rightL(tagText "|]") - | Expr.Op (TOp.While _,[],[x1;x2],_) -> + | Expr.Op (TOp.While _, [], [x1;x2], _) -> wordL(tagText "while") ^^ exprL x1 ^^ wordL(tagText "do") ^^ exprL x2 ^^ rightL(tagText "}") - | Expr.Op (TOp.For _,[],[x1;x2;x3],_) -> + | Expr.Op (TOp.For _, [], [x1;x2;x3], _) -> wordL(tagText "for") ^^ aboveListL [(exprL x1 ^^ wordL(tagText "to") ^^ exprL x2 ^^ wordL(tagText "do")); exprL x3 ] ^^ rightL(tagText "done") - | Expr.Op (TOp.TryCatch _,[_],[x1;x2],_) -> + | Expr.Op (TOp.TryCatch _, [_], [x1;x2], _) -> wordL(tagText "try") ^^ exprL x1 ^^ wordL(tagText "with") ^^ exprL x2 ^^ rightL(tagText "}") - | Expr.Op (TOp.TryFinally _,[_],[x1;x2],_) -> + | Expr.Op (TOp.TryFinally _, [_], [x1;x2], _) -> wordL(tagText "try") ^^ exprL x1 ^^ wordL(tagText "finally") ^^ exprL x2 ^^ rightL(tagText "}") - | Expr.Op (TOp.Bytes _,_ ,_ ,_) -> + | Expr.Op (TOp.Bytes _, _ , _ , _) -> wordL(tagText "bytes++") - | Expr.Op (TOp.UInt16s _,_ ,_ ,_) -> wordL(tagText "uint16++") - | Expr.Op (TOp.RefAddrGet,_tyargs,_args,_) -> wordL(tagText "GetRefLVal...") - | Expr.Op (TOp.TraitCall _,_tyargs,_args,_) -> wordL(tagText "traitcall...") - | Expr.Op (TOp.ExnFieldGet _,_tyargs,_args,_) -> wordL(tagText "TOp.ExnFieldGet...") - | Expr.Op (TOp.ExnFieldSet _,_tyargs,_args,_) -> wordL(tagText "TOp.ExnFieldSet...") - | Expr.Op (TOp.TryFinally _,_tyargs,_args,_) -> wordL(tagText "TOp.TryFinally...") - | Expr.Op (TOp.TryCatch _,_tyargs,_args,_) -> wordL(tagText "TOp.TryCatch...") - | Expr.Op (_,_tys,args,_) -> wordL(tagText "Expr.Op ...") ^^ bracketL (commaListL (List.map atomL args)) - | Expr.Quote (a,_,_,_,_) -> leftL(tagText "<@") ^^ atomL a ^^ rightL(tagText "@>") - | Expr.Obj (_lambdaId,typ,basev,ccall,overrides,iimpls,_) -> + | Expr.Op (TOp.UInt16s _, _ , _ , _) -> wordL(tagText "uint16++") + | Expr.Op (TOp.RefAddrGet, _tyargs, _args, _) -> wordL(tagText "GetRefLVal...") + | Expr.Op (TOp.TraitCall _, _tyargs, _args, _) -> wordL(tagText "traitcall...") + | Expr.Op (TOp.ExnFieldGet _, _tyargs, _args, _) -> wordL(tagText "TOp.ExnFieldGet...") + | Expr.Op (TOp.ExnFieldSet _, _tyargs, _args, _) -> wordL(tagText "TOp.ExnFieldSet...") + | Expr.Op (TOp.TryFinally _, _tyargs, _args, _) -> wordL(tagText "TOp.TryFinally...") + | Expr.Op (TOp.TryCatch _, _tyargs, _args, _) -> wordL(tagText "TOp.TryCatch...") + | Expr.Op (_, _tys, args, _) -> wordL(tagText "Expr.Op ...") ^^ bracketL (commaListL (List.map atomL args)) + | Expr.Quote (a, _, _, _, _) -> leftL(tagText "<@") ^^ atomL a ^^ rightL(tagText "@>") + | Expr.Obj (_lambdaId, typ, basev, ccall, overrides, iimpls, _) -> wordL(tagText "OBJ:") ^^ aboveListL [typeL typ; exprL ccall; optionL vspecAtBindL basev; aboveListL (List.map overrideL overrides); aboveListL (List.map iimplL iimpls)] - | Expr.StaticOptimization (_tcs,csx,x,_) -> + | Expr.StaticOptimization (_tcs, csx, x, _) -> (wordL(tagText "opt") @@- (exprL x)) @@-- (wordL(tagText "|") ^^ exprL csx --- (wordL(tagText "when...") )) @@ -3575,18 +3575,18 @@ module DebugPrint = begin let z = z --- sepL(tagText "`") --- (spaceListL (List.map atomL args)) z - and implFileL (TImplFile(_,_,e,_,_)) = + and implFileL (TImplFile(_, _, e, _, _)) = aboveListL [(wordL(tagText "top implementation ")) @@-- mexprL e] and mexprL x = match x with - | ModuleOrNamespaceExprWithSig(mtyp,defs,_) -> mdefL defs @@- (wordL(tagText ":") @@- entityTypeL mtyp) + | ModuleOrNamespaceExprWithSig(mtyp, defs, _) -> mdefL defs @@- (wordL(tagText ":") @@- entityTypeL mtyp) and mdefsL defs = wordL(tagText "Module Defs") @@-- aboveListL(List.map mdefL defs) and mdefL x = match x with - | TMDefRec(_,tycons ,mbinds,_) -> aboveListL ((tycons |> List.map tyconL) @ List.map mbindL mbinds) - | TMDefLet(bind,_) -> letL bind emptyL - | TMDefDo(e,_) -> exprL e + | TMDefRec(_, tycons , mbinds, _) -> aboveListL ((tycons |> List.map tyconL) @ List.map mbindL mbinds) + | TMDefLet(bind, _) -> letL bind emptyL + | TMDefDo(e, _) -> exprL e | TMDefs defs -> mdefsL defs; | TMAbstract mexpr -> mexprL mexpr and mbindL x = @@ -3609,35 +3609,39 @@ module DebugPrint = begin and decisionTreeL x = match x with - | TDBind (bind,body) -> let bind = wordL(tagText "let") ^^ bindingL bind ^^ wordL(tagText "in") in (bind @@ decisionTreeL body) - | TDSuccess (args,n) -> wordL(tagText "Success") ^^ leftL(tagText "T") ^^ intL n ^^ tupleL (args |> List.map exprL) - | TDSwitch (test,dcases,dflt,_) -> (wordL(tagText "Switch") --- exprL test) @@-- - (aboveListL (List.map dcaseL dcases) @@ - match dflt with - None -> emptyL - | Some dtree -> wordL(tagText "dflt:") --- decisionTreeL dtree) - - and dcaseL (TCase (test,dtree)) = (dtestL test ^^ wordL(tagText "//")) --- decisionTreeL dtree + | TDBind (bind, body) -> + let bind = wordL(tagText "let") ^^ bindingL bind ^^ wordL(tagText "in") + (bind @@ decisionTreeL body) + | TDSuccess (args, n) -> + wordL(tagText "Success") ^^ leftL(tagText "T") ^^ intL n ^^ tupleL (args |> List.map exprL) + | TDSwitch (test, dcases, dflt, _) -> + (wordL(tagText "Switch") --- exprL test) @@-- + (aboveListL (List.map dcaseL dcases) @@ + match dflt with + | None -> emptyL + | Some dtree -> wordL(tagText "dflt:") --- decisionTreeL dtree) + + and dcaseL (TCase (test, dtree)) = (dtestL test ^^ wordL(tagText "//")) --- decisionTreeL dtree and dtestL x = match x with - | (DecisionTreeTest.UnionCase (c,tinst)) -> wordL(tagText "is") ^^ unionCaseRefL c ^^ instL typeL tinst - | (DecisionTreeTest.ArrayLength (n,ty)) -> wordL(tagText "length") ^^ intL n ^^ typeL ty + | (DecisionTreeTest.UnionCase (c, tinst)) -> wordL(tagText "is") ^^ unionCaseRefL c ^^ instL typeL tinst + | (DecisionTreeTest.ArrayLength (n, ty)) -> wordL(tagText "length") ^^ intL n ^^ typeL ty | (DecisionTreeTest.Const c ) -> wordL(tagText "is") ^^ constL c | (DecisionTreeTest.IsNull ) -> wordL(tagText "isnull") - | (DecisionTreeTest.IsInst (_,typ) ) -> wordL(tagText "isinst") ^^ typeL typ - | (DecisionTreeTest.ActivePatternCase (exp,_,_,_,_)) -> wordL(tagText "query") ^^ exprL exp + | (DecisionTreeTest.IsInst (_, typ) ) -> wordL(tagText "isinst") ^^ typeL typ + | (DecisionTreeTest.ActivePatternCase (exp, _, _, _, _)) -> wordL(tagText "query") ^^ exprL exp - and targetL i (TTarget (argvs,body,_)) = leftL(tagText "T") ^^ intL i ^^ tupleL (flatValsL argvs) ^^ rightL(tagText ":") --- exprL body + and targetL i (TTarget (argvs, body, _)) = leftL(tagText "T") ^^ intL i ^^ tupleL (flatValsL argvs) ^^ rightL(tagText ":") --- exprL body and flatValsL vs = vs |> List.map valL - and tmethodL (TObjExprMethod(TSlotSig(nm,_,_,_,_,_), _, tps, vs, e, _)) = + and tmethodL (TObjExprMethod(TSlotSig(nm, _, _, _, _, _), _, tps, vs, e, _)) = (wordL(tagText "TObjExprMethod") --- (wordL (tagText nm)) ^^ wordL(tagText "=")) -- (wordL(tagText "METH-LAM") --- angleBracketListL (List.map typarL tps) ^^ rightL(tagText ".")) --- (wordL(tagText "meth-lam") --- tupleL (List.map (List.map vspecAtBindL >> tupleL) vs) ^^ rightL(tagText ".")) --- (atomL e) and overrideL tmeth = wordL(tagText "with") ^^ tmethodL tmeth - and iimplL (typ,tmeths) = wordL(tagText "impl") ^^ aboveListL (typeL typ :: List.map tmethodL tmeths) + and iimplL (typ, tmeths) = wordL(tagText "impl") ^^ aboveListL (typeL typ :: List.map tmethodL tmeths) let showType x = Layout.showL (typeL x) let showExpr x = Layout.showL (exprL x) @@ -3663,7 +3667,7 @@ let wrapModuleOrNamespaceExprInNamespace (id :Ident) cpath mexpr = TMDefRec (false, [], [ModuleOrNamespaceBinding.Module(mspec, mexpr)], id.idRange) // cleanup: make this a property -let SigTypeOfImplFile (TImplFile(_,_,mexpr,_,_)) = mexpr.Type +let SigTypeOfImplFile (TImplFile(_, _, mexpr, _, _)) = mexpr.Type //-------------------------------------------------------------------------- // Data structures representing what gets hidden and what gets remapped (i.e. renamed or alpha-converted) @@ -3695,7 +3699,7 @@ let addValRemap v v' tmenv = { tmenv with valRemap= tmenv.valRemap.Add v (mkLocalValRef v') } let mkRepackageRemapping mrpi = - { valRemap = ValMap.OfList (mrpi.mrpiVals |> List.map (fun (vref,x) -> vref.Deref, x)); + { valRemap = ValMap.OfList (mrpi.mrpiVals |> List.map (fun (vref, x) -> vref.Deref, x)); tpinst = emptyTyparInst; tyconRefRemap = TyconRefMap.OfList mrpi.mrpiEntities removeTraitSolutions = false } @@ -3704,13 +3708,13 @@ let mkRepackageRemapping mrpi = // Compute instances of the above for mty -> mty //-------------------------------------------------------------------------- -let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi,mhi) = +let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) = let sigtyconOpt = (NameMap.tryFind entity.LogicalName msigty.AllEntitiesByCompiledAndLogicalMangledNames) match sigtyconOpt with | None -> // The type constructor is not present in the signature. Hence it is hidden. let mhi = { mhi with mhiTycons = Zset.add entity mhi.mhiTycons } - (mrpi,mhi) + (mrpi, mhi) | Some sigtycon -> // The type constructor is in the signature. Hence record the repackage entry let sigtcref = mkLocalTyconRef sigtycon @@ -3745,27 +3749,27 @@ let accEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi,mhi) = let ucref = tcref.MakeNestedUnionCaseRef ucase { mhi with mhiUnionCases = Zset.add ucref mhi.mhiUnionCases }) (entity.UnionCasesAsList) - (mrpi,mhi) + (mrpi, mhi) -let accSubEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi,mhi) = +let accSubEntityRemap (msigty:ModuleOrNamespaceType) (entity:Entity) (mrpi, mhi) = let sigtyconOpt = (NameMap.tryFind entity.LogicalName msigty.AllEntitiesByCompiledAndLogicalMangledNames) match sigtyconOpt with | None -> // The type constructor is not present in the signature. Hence it is hidden. let mhi = { mhi with mhiTycons = Zset.add entity mhi.mhiTycons } - (mrpi,mhi) + (mrpi, mhi) | Some sigtycon -> // The type constructor is in the signature. Hence record the repackage entry let sigtcref = mkLocalTyconRef sigtycon let tcref = mkLocalTyconRef entity let mrpi = { mrpi with mrpiEntities = ((tcref, sigtcref) :: mrpi.mrpiEntities) } - (mrpi,mhi) + (mrpi, mhi) let valLinkageAEquiv g aenv (v1:Val) (v2:Val) = (v1.LinkagePartialKey = v2.LinkagePartialKey) && (if v1.IsMember && v2.IsMember then typeAEquivAux EraseAll g aenv v1.Type v2.Type else true) -let accValRemap g aenv (msigty:ModuleOrNamespaceType) (implVal:Val) (mrpi,mhi) = +let accValRemap g aenv (msigty:ModuleOrNamespaceType) (implVal:Val) (mrpi, mhi) = let sigValOpt = msigty.AllValsAndMembersByPartialLinkageKey |> MultiMap.find implVal.LinkagePartialKey @@ -3776,11 +3780,11 @@ let accValRemap g aenv (msigty:ModuleOrNamespaceType) (implVal:Val) (mrpi,mhi) = | None -> if verbose then dprintf "accValRemap, hide = %s#%d\n" implVal.LogicalName implVal.Stamp let mhi = { mhi with mhiVals = Zset.add implVal mhi.mhiVals } - (mrpi,mhi) + (mrpi, mhi) | Some (sigVal:Val) -> // The value is in the signature. Add the repackage entry. - let mrpi = { mrpi with mrpiVals = (vref,mkLocalValRef sigVal) :: mrpi.mrpiVals } - (mrpi,mhi) + let mrpi = { mrpi with mrpiVals = (vref, mkLocalValRef sigVal) :: mrpi.mrpiVals } + (mrpi, mhi) let getCorrespondingSigTy nm (msigty:ModuleOrNamespaceType) = match NameMap.tryFind nm msigty.AllEntitiesByCompiledAndLogicalMangledNames with @@ -3793,13 +3797,13 @@ let rec accEntityRemapFromModuleOrNamespaceType (mty:ModuleOrNamespaceType) (msi acc let rec accValRemapFromModuleOrNamespaceType g aenv (mty:ModuleOrNamespaceType) msigty acc = - let acc = (mty.AllEntities, acc) ||> QueueList.foldBack (fun e acc -> accValRemapFromModuleOrNamespaceType g aenv e.ModuleOrNamespaceType (getCorrespondingSigTy e.LogicalName msigty) acc) + let acc = (mty.AllEntities, acc) ||> QueueList.foldBack (fun e acc -> accValRemapFromModuleOrNamespaceType g aenv e.ModuleOrNamespaceType (getCorrespondingSigTy e.LogicalName msigty) acc) let acc = (mty.AllValsAndMembers, acc) ||> QueueList.foldBack (accValRemap g aenv msigty) acc let ComputeRemappingFromInferredSignatureToExplicitSignature g mty msigty = - // dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature,\nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); - let ((mrpi,_) as entityRemap) = accEntityRemapFromModuleOrNamespaceType mty msigty (SignatureRepackageInfo.Empty, SignatureHidingInfo.Empty) + // dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature, \nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); + let ((mrpi, _) as entityRemap) = accEntityRemapFromModuleOrNamespaceType mty msigty (SignatureRepackageInfo.Empty, SignatureHidingInfo.Empty) let aenv = mrpi.ImplToSigMapping let valAndEntityRemap = accValRemapFromModuleOrNamespaceType g aenv mty msigty entityRemap valAndEntityRemap @@ -3818,7 +3822,7 @@ let abstractSlotValsOfTycons (tycons:Tycon list) = let rec accEntityRemapFromModuleOrNamespace msigty x acc = match x with - | TMDefRec(_,tycons,mbinds,_) -> + | TMDefRec(_, tycons, mbinds, _) -> let acc = (mbinds, acc) ||> List.foldBack (accEntityRemapFromModuleOrNamespaceBind msigty) let acc = (tycons, acc) ||> List.foldBack (accEntityRemap msigty) let acc = (tycons, acc) ||> List.foldBack (fun e acc -> accEntityRemapFromModuleOrNamespaceType e.ModuleOrNamespaceType (getCorrespondingSigTy e.LogicalName msigty) acc) @@ -3840,13 +3844,13 @@ and accEntityRemapFromModuleOrNamespaceBind msigty x acc = let rec accValRemapFromModuleOrNamespace g aenv msigty x acc = match x with - | TMDefRec(_,tycons,mbinds,_) -> + | TMDefRec(_, tycons, mbinds, _) -> let acc = (mbinds, acc) ||> List.foldBack (accValRemapFromModuleOrNamespaceBind g aenv msigty) // Abstract (virtual) vslots in the tycons at TMDefRec nodes are binders. They also need to be added to the remapping. let vslotvs = abstractSlotValsOfTycons tycons let acc = (vslotvs, acc) ||> List.foldBack (accValRemap g aenv msigty) acc - | TMDefLet(bind,_) -> accValRemap g aenv msigty bind.Var acc + | TMDefLet(bind, _) -> accValRemap g aenv msigty bind.Var acc | TMDefDo _ -> acc | TMDefs defs -> accValRemapFromModuleOrNamespaceDefs g aenv msigty defs acc | TMAbstract mexpr -> accValRemapFromModuleOrNamespaceType g aenv mexpr.Type msigty acc @@ -3859,8 +3863,8 @@ and accValRemapFromModuleOrNamespaceBind g aenv msigty x acc = and accValRemapFromModuleOrNamespaceDefs g aenv msigty mdefs acc = List.foldBack (accValRemapFromModuleOrNamespace g aenv msigty) mdefs acc let ComputeRemappingFromImplementationToSignature g mdef msigty = - //if verbose then dprintf "ComputeRemappingFromImplementationToSignature,\nmdefs = %s\nmsigty=%s\n" (showL(DebugPrint.mdefL mdef)) (showL(DebugPrint.entityTypeL msigty)); - let ((mrpi,_) as entityRemap) = accEntityRemapFromModuleOrNamespace msigty mdef (SignatureRepackageInfo.Empty, SignatureHidingInfo.Empty) + //if verbose then dprintf "ComputeRemappingFromImplementationToSignature, \nmdefs = %s\nmsigty=%s\n" (showL(DebugPrint.mdefL mdef)) (showL(DebugPrint.entityTypeL msigty)); + let ((mrpi, _) as entityRemap) = accEntityRemapFromModuleOrNamespace msigty mdef (SignatureRepackageInfo.Empty, SignatureHidingInfo.Empty) let aenv = mrpi.ImplToSigMapping let valAndEntityRemap = accValRemapFromModuleOrNamespace g aenv msigty mdef entityRemap @@ -3917,7 +3921,7 @@ let rec accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty acc = acc let ComputeHidingInfoAtAssemblyBoundary mty acc = -// dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature,\nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); +// dprintf "ComputeRemappingFromInferredSignatureToExplicitSignature, \nmty = %s\nmmsigty=%s\n" (showL(entityTypeL mty)) (showL(entityTypeL msigty)); accModuleOrNamespaceHidingInfoAtAssemblyBoundary mty acc //-------------------------------------------------------------------------- @@ -3931,7 +3935,7 @@ let IsHidden setF accessF remapF debugF = not (canAccessFromEverywhere (accessF x)) || (match mrmi with | [] -> false // Ah! we escaped to freedom! - | (rpi,mhi) :: rest -> + | (rpi, mhi) :: rest -> // Explicitly hidden? Zset.contains x (setF mhi) || // Recurse... @@ -3998,11 +4002,11 @@ let freeTyvarsAllPublic tyvars = let (|LinearMatchExpr|_|) expr = match expr with - | Expr.Match (sp,m,dtree,[|tg1;(TTarget([],e2,sp2))|],m2,ty) -> Some(sp,m,dtree,tg1,e2,sp2,m2,ty) + | Expr.Match (sp, m, dtree, [|tg1;(TTarget([], e2, sp2))|], m2, ty) -> Some(sp, m, dtree, tg1, e2, sp2, m2, ty) | _ -> None -let rebuildLinearMatchExpr (sp,m,dtree,tg1,e2,sp2,m2,ty) = - primMkMatch (sp,m,dtree,[|tg1;(TTarget([],e2,sp2))|],m2,ty) +let rebuildLinearMatchExpr (sp, m, dtree, tg1, e2, sp2, m2, ty) = + primMkMatch (sp, m, dtree, [|tg1;(TTarget([], e2, sp2))|], m2, ty) //--------------------------------------------------------------------------- @@ -4069,31 +4073,31 @@ let bindLhs opts (bind:Binding) fvs = boundLocalVal opts bind.Var fvs let freeVarsCacheCompute opts cache f = if opts.canCache then cached cache f else f() -let rec accBindRhs opts (TBind(_,repr,_)) acc = accFreeInExpr opts repr acc +let rec accBindRhs opts (TBind(_, repr, _)) acc = accFreeInExpr opts repr acc and accFreeInSwitchCases opts csl dflt (acc:FreeVars) = Option.foldBack (accFreeInDecisionTree opts) dflt (List.foldBack (accFreeInSwitchCase opts) csl acc) -and accFreeInSwitchCase opts (TCase(discrim,dtree)) acc = +and accFreeInSwitchCase opts (TCase(discrim, dtree)) acc = accFreeInDecisionTree opts dtree (accFreeInTest opts discrim acc) and accFreeInTest (opts:FreeVarOptions) discrim acc = match discrim with - | DecisionTreeTest.UnionCase(ucref,tinst) -> accFreeUnionCaseRef opts ucref (accFreeVarsInTys opts tinst acc) - | DecisionTreeTest.ArrayLength(_,ty) -> accFreeVarsInTy opts ty acc + | DecisionTreeTest.UnionCase(ucref, tinst) -> accFreeUnionCaseRef opts ucref (accFreeVarsInTys opts tinst acc) + | DecisionTreeTest.ArrayLength(_, ty) -> accFreeVarsInTy opts ty acc | DecisionTreeTest.Const _ | DecisionTreeTest.IsNull -> acc - | DecisionTreeTest.IsInst (srcty,tgty) -> accFreeVarsInTy opts srcty (accFreeVarsInTy opts tgty acc) + | DecisionTreeTest.IsInst (srcty, tgty) -> accFreeVarsInTy opts srcty (accFreeVarsInTy opts tgty acc) | DecisionTreeTest.ActivePatternCase (exp, tys, activePatIdentity, _, _) -> accFreeInExpr opts exp (accFreeVarsInTys opts tys - (Option.foldBack (fun (vref,tinst) acc -> accFreeValRef opts vref (accFreeVarsInTys opts tinst acc)) activePatIdentity acc)) + (Option.foldBack (fun (vref, tinst) acc -> accFreeValRef opts vref (accFreeVarsInTys opts tinst acc)) activePatIdentity acc)) and accFreeInDecisionTree opts x (acc : FreeVars) = match x with - | TDSwitch(e1,csl,dflt,_) -> accFreeInExpr opts e1 (accFreeInSwitchCases opts csl dflt acc) - | TDSuccess (es,_) -> accFreeInFlatExprs opts es acc - | TDBind (bind,body) -> unionFreeVars (bindLhs opts bind (accBindRhs opts bind (freeInDecisionTree opts body))) acc + | TDSwitch(e1, csl, dflt, _) -> accFreeInExpr opts e1 (accFreeInSwitchCases opts csl dflt acc) + | TDSuccess (es, _) -> accFreeInFlatExprs opts es acc + | TDBind (bind, body) -> unionFreeVars (bindLhs opts bind (accBindRhs opts bind (freeInDecisionTree opts body))) acc and accFreeInValFlags opts flag acc = let isMethLocal = @@ -4148,14 +4152,14 @@ and accFreeValRef opts (vref:ValRef) fvs = // non-local values do not contain free variables | _ -> fvs -and accFreeInMethod opts (TObjExprMethod(slotsig,_attribs,tps,tmvs,e,_)) acc = +and accFreeInMethod opts (TObjExprMethod(slotsig, _attribs, tps, tmvs, e, _)) acc = accFreeInSlotSig opts slotsig (unionFreeVars (accFreeTyvars opts boundTypars tps (List.foldBack (boundLocalVals opts) tmvs (freeInExpr opts e))) acc) and accFreeInMethods opts methods acc = List.foldBack (accFreeInMethod opts) methods acc -and accFreeInInterfaceImpl opts (ty,overrides) acc = +and accFreeInInterfaceImpl opts (ty, overrides) acc = accFreeVarsInTy opts ty (accFreeInMethods opts overrides acc) and accFreeInExpr (opts:FreeVarOptions) x acc = @@ -4166,7 +4170,7 @@ and accFreeInExpr (opts:FreeVarOptions) x acc = and accFreeInExprLinear (opts:FreeVarOptions) x acc contf = // for nested let-bindings, we need to continue after the whole let-binding is processed match x with - | Expr.Let (bind,e,_,cache) -> + | Expr.Let (bind, e, _, cache) -> let contf = contf << (fun free -> unionFreeVars (freeVarsCacheCompute opts cache (fun () -> bindLhs opts bind (accBindRhs opts bind free))) acc ) accFreeInExprLinear opts e emptyFreeVars contf @@ -4177,7 +4181,7 @@ and accFreeInExprLinear (opts:FreeVarOptions) x acc contf = and accFreeInExprNonLinear opts x acc = match x with // BINDING CONSTRUCTS - | Expr.Lambda (_,ctorThisValOpt,baseValOpt,vs,b,_,rty) -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> unionFreeVars (Option.foldBack (boundLocalVal opts) ctorThisValOpt (Option.foldBack (boundLocalVal opts) baseValOpt @@ -4185,15 +4189,15 @@ and accFreeInExprNonLinear opts x acc = (accFreeVarsInTy opts rty (freeInExpr opts b))))) acc - | Expr.TyLambda (_,vs,b,_,rty) -> + | Expr.TyLambda (_, vs, b, _, rty) -> unionFreeVars (accFreeTyvars opts boundTypars vs (accFreeVarsInTy opts rty (freeInExpr opts b))) acc - | Expr.TyChoose (vs,b,_) -> + | Expr.TyChoose (vs, b, _) -> unionFreeVars (accFreeTyvars opts boundTypars vs (freeInExpr opts b)) acc - | Expr.LetRec (binds,e,_,cache) -> + | Expr.LetRec (binds, e, _, cache) -> unionFreeVars (freeVarsCacheCompute opts cache (fun () -> List.foldBack (bindLhs opts) binds (List.foldBack (accBindRhs opts) binds (freeInExpr opts e)))) acc | Expr.Let _ -> failwith "unreachable - linear expr" - | Expr.Obj (_,typ,basev,basecall,overrides,iimpls,_) -> + | Expr.Obj (_, typ, basev, basecall, overrides, iimpls, _) -> unionFreeVars (boundProtect (Option.foldBack (boundLocalVal opts) basev @@ -4204,31 +4208,31 @@ and accFreeInExprNonLinear opts x acc = acc // NON-BINDING CONSTRUCTS | Expr.Const _ -> acc - | Expr.Val (lvr,flags,_) -> + | Expr.Val (lvr, flags, _) -> accFreeInValFlags opts flags (accFreeValRef opts lvr acc) - | Expr.Quote (ast,{contents=Some(_,argTypes,argExprs,_data)},_,_,ty) -> + | Expr.Quote (ast, {contents=Some(_, argTypes, argExprs, _data)}, _, _, ty) -> accFreeInExpr opts ast (accFreeInExprs opts argExprs (accFreeVarsInTys opts argTypes (accFreeVarsInTy opts ty acc))) - | Expr.Quote (ast,{contents=None},_,_,ty) -> + | Expr.Quote (ast, {contents=None}, _, _, ty) -> accFreeInExpr opts ast (accFreeVarsInTy opts ty acc) - | Expr.App(f0,f0ty,tyargs,args,_) -> + | Expr.App(f0, f0ty, tyargs, args, _) -> accFreeVarsInTy opts f0ty (accFreeInExpr opts f0 (accFreeVarsInTys opts tyargs (accFreeInExprs opts args acc))) | Expr.Link(eref) -> accFreeInExpr opts !eref acc - | Expr.Sequential (e1,e2,_,_,_) -> + | Expr.Sequential (e1, e2, _, _, _) -> let acc = accFreeInExpr opts e1 acc // tail-call - this is required because we should be able to handle (((e1; e2); e3); e4; .... )) accFreeInExpr opts e2 acc - | Expr.StaticOptimization (_,e2,e3,_) -> accFreeInExpr opts e2 (accFreeInExpr opts e3 acc) - | Expr.Match (_,_,dtree,targets,_,_) -> + | Expr.StaticOptimization (_, e2, e3, _) -> accFreeInExpr opts e2 (accFreeInExpr opts e3 acc) + | Expr.Match (_, _, dtree, targets, _, _) -> match x with // Handle if-then-else - | LinearMatchExpr(_,_,dtree,tg1,e2,_,_,_) -> + | LinearMatchExpr(_, _, dtree, tg1, e2, _, _, _) -> let acc = accFreeInDecisionTree opts dtree acc let acc = accFreeInTarget opts tg1 acc accFreeInExpr opts e2 acc // tailcall @@ -4237,14 +4241,14 @@ and accFreeInExprNonLinear opts x acc = let acc = accFreeInDecisionTree opts dtree acc accFreeInTargets opts targets acc - //| Expr.Op (TOp.TryCatch,tinst,[Expr.Lambda(_,_,[_],e1,_,_,_); Expr.Lambda(_,_,[_],e2,_,_,_); Expr.Lambda(_,_,[_],e3,_,_,_)],_) -> - | Expr.Op (TOp.TryCatch _,tinst,[e1;e2;e3],_) -> + //| Expr.Op (TOp.TryCatch, tinst, [Expr.Lambda(_, _, [_], e1, _, _, _); Expr.Lambda(_, _, [_], e2, _, _, _); Expr.Lambda(_, _, [_], e3, _, _, _)], _) -> + | Expr.Op (TOp.TryCatch _, tinst, [e1;e2;e3], _) -> unionFreeVars (accFreeVarsInTys opts tinst (accFreeInExprs opts [e1;e2] acc)) (bound_rethrow (accFreeInExpr opts e3 emptyFreeVars)) - | Expr.Op (op,tinst,args,_) -> + | Expr.Op (op, tinst, args, _) -> let acc = accFreeInOp opts op acc let acc = accFreeVarsInTys opts tinst acc accFreeInExprs opts args acc @@ -4272,36 +4276,36 @@ and accFreeInOp opts op acc = // Things containing just a union case reference | TOp.UnionCaseProof cr | TOp.UnionCase cr - | TOp.UnionCaseFieldGetAddr (cr,_) - | TOp.UnionCaseFieldGet (cr,_) - | TOp.UnionCaseFieldSet (cr,_) -> accFreeUnionCaseRef opts cr acc + | TOp.UnionCaseFieldGetAddr (cr, _) + | TOp.UnionCaseFieldGet (cr, _) + | TOp.UnionCaseFieldSet (cr, _) -> accFreeUnionCaseRef opts cr acc // Things containing just an exception reference | TOp.ExnConstr ecr - | TOp.ExnFieldGet (ecr,_) - | TOp.ExnFieldSet (ecr,_) -> accFreeExnRef ecr acc + | TOp.ExnFieldGet (ecr, _) + | TOp.ExnFieldSet (ecr, _) -> accFreeExnRef ecr acc | TOp.ValFieldGet fr | TOp.ValFieldGetAddr fr | TOp.ValFieldSet fr -> accFreeRecdFieldRef opts fr acc - | TOp.Recd (kind,tcr) -> + | TOp.Recd (kind, tcr) -> let acc = accUsesFunctionLocalConstructs (kind = RecdExprIsObjInit) acc (accUsedRecdOrUnionTyconRepr opts tcr.Deref (accFreeTyvars opts accFreeTycon tcr acc)) - | TOp.ILAsm (_,tys) -> accFreeVarsInTys opts tys acc + | TOp.ILAsm (_, tys) -> accFreeVarsInTys opts tys acc | TOp.Reraise -> accUsesRethrow true acc - | TOp.TraitCall(TTrait(tys,_,_,argtys,rty,sln)) -> + | TOp.TraitCall(TTrait(tys, _, _, argtys, rty, sln)) -> Option.foldBack (accFreeVarsInTraitSln opts) sln.Value (accFreeVarsInTys opts tys (accFreeVarsInTys opts argtys (Option.foldBack (accFreeVarsInTy opts) rty acc))) - | TOp.LValueOp (_,lvr) -> + | TOp.LValueOp (_, lvr) -> accFreeValRef opts lvr acc - | TOp.ILCall (_,isProtectedCall,_,_,valUseFlags,_,_,_,enclTypeArgs,methTypeArgs,tys) -> + | TOp.ILCall (_, isProtectedCall, _, _, valUseFlags, _, _, _, enclTypeArgs, methTypeArgs, tys) -> accFreeVarsInTys opts enclTypeArgs (accFreeVarsInTys opts methTypeArgs (accFreeInValFlags opts valUseFlags @@ -4311,7 +4315,7 @@ and accFreeInOp opts op acc = and accFreeInTargets opts targets acc = Array.foldBack (accFreeInTarget opts) targets acc -and accFreeInTarget opts (TTarget(vs,e,_)) acc = +and accFreeInTarget opts (TTarget(vs, e, _)) acc = List.foldBack (boundLocalVal opts) vs (accFreeInExpr opts e acc) and accFreeInFlatExprs opts (es:Exprs) acc = List.foldBack (accFreeInExpr opts) es acc @@ -4321,10 +4325,10 @@ and accFreeInExprs opts (es: Exprs) acc = | [] -> acc | h::t -> let acc = accFreeInExpr opts h acc - // tailcall - e.g. Cons(x,Cons(x2,.......Cons(x1000000,Nil))) and [| x1; .... ; x1000000 |] + // tailcall - e.g. Cons(x, Cons(x2, .......Cons(x1000000, Nil))) and [| x1; .... ; x1000000 |] accFreeInExprs opts t acc -and accFreeInSlotSig opts (TSlotSig(_,typ,_,_,_,_)) acc = accFreeVarsInTy opts typ acc +and accFreeInSlotSig opts (TSlotSig(_, typ, _, _, _, _)) acc = accFreeVarsInTy opts typ acc and freeInDecisionTree opts e = accFreeInDecisionTree opts e emptyFreeVars and freeInExpr opts e = accFreeInExpr opts e emptyFreeVars @@ -4332,11 +4336,11 @@ and freeInExpr opts e = accFreeInExpr opts e emptyFreeVars // Note: these are only an approximation - they are currently used only by the optimizer let rec accFreeInModuleOrNamespace opts x acc = match x with - | TMDefRec(_,_,mbinds,_) -> List.foldBack (accFreeInModuleOrNamespaceBind opts) mbinds acc - | TMDefLet(bind,_) -> accBindRhs opts bind acc - | TMDefDo(e,_) -> accFreeInExpr opts e acc + | TMDefRec(_, _, mbinds, _) -> List.foldBack (accFreeInModuleOrNamespaceBind opts) mbinds acc + | TMDefLet(bind, _) -> accBindRhs opts bind acc + | TMDefDo(e, _) -> accFreeInExpr opts e acc | TMDefs defs -> accFreeInModuleOrNamespaces opts defs acc - | TMAbstract(ModuleOrNamespaceExprWithSig(_,mdef,_)) -> accFreeInModuleOrNamespace opts mdef acc // not really right, but sufficient for how this is used in optimization + | TMAbstract(ModuleOrNamespaceExprWithSig(_, mdef, _)) -> accFreeInModuleOrNamespace opts mdef acc // not really right, but sufficient for how this is used in optimization and accFreeInModuleOrNamespaceBind opts x acc = match x with | ModuleOrNamespaceBinding.Binding bind -> accBindRhs opts bind acc @@ -4353,37 +4357,37 @@ let freeInModuleOrNamespace opts mdef = accFreeInModuleOrNamespace opts mdef emp // Destruct - rarely needed //--------------------------------------------------------------------------- -let rec stripLambda (e,ty) = +let rec stripLambda (e, ty) = match e with - | Expr.Lambda (_,ctorThisValOpt,baseValOpt,v,b,_,rty) -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, b, _, rty) -> if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); - let (vs',b',rty') = stripLambda (b,rty) + let (vs', b', rty') = stripLambda (b, rty) (v :: vs', b', rty') - | _ -> ([],e,ty) + | _ -> ([], e, ty) let rec stripLambdaN n e = assert (n >= 0) match e with - | Expr.Lambda (_,ctorThisValOpt,baseValOpt,v,body,_,_) when n > 0 -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, v, body, _, _) when n > 0 -> if Option.isSome ctorThisValOpt then errorR(InternalError("skipping ctorThisValOpt", e.Range)); if Option.isSome baseValOpt then errorR(InternalError("skipping baseValOpt", e.Range)); - let (vs,body',remaining) = stripLambdaN (n-1) body + let (vs, body', remaining) = stripLambdaN (n-1) body (v :: vs, body', remaining) - | _ -> ([],e,n) + | _ -> ([], e, n) let tryStripLambdaN n e = match e with - | Expr.Lambda(_,None,None,_,_,_,_) -> + | Expr.Lambda(_, None, None, _, _, _, _) -> let argvsl, body, remaining = stripLambdaN n e if remaining = 0 then Some (argvsl, body) else None | _ -> None -let stripTopLambda (e,ty) = - let tps,taue,tauty = match e with Expr.TyLambda (_,tps,b,_,rty) -> tps,b,rty | _ -> [],e,ty - let vs,body,rty = stripLambda (taue,tauty) - tps,vs,body,rty +let stripTopLambda (e, ty) = + let tps, taue, tauty = match e with Expr.TyLambda (_, tps, b, _, rty) -> tps, b, rty | _ -> [], e, ty + let vs, body, rty = stripLambda (taue, tauty) + tps, vs, body, rty [] type AllowTypeDirectedDetupling = Yes | No @@ -4393,25 +4397,25 @@ type AllowTypeDirectedDetupling = Yes | No let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttribs e = let rec stripLambda_notypes e = match e with - | Expr.Lambda (_,_,_,vs,b,_,_) -> - let (vs',b') = stripLambda_notypes b + | Expr.Lambda (_, _, _, vs, b, _, _) -> + let (vs', b') = stripLambda_notypes b (vs :: vs', b') - | Expr.TyChoose (_,b,_) -> stripLambda_notypes b - | _ -> ([],e) + | Expr.TyChoose (_, b, _) -> stripLambda_notypes b + | _ -> ([], e) let stripTopLambdaNoTypes e = - let tps,taue = match e with Expr.TyLambda (_,tps,b,_,_) -> tps,b | _ -> [],e - let vs,body = stripLambda_notypes taue - tps,vs,body + let tps, taue = match e with Expr.TyLambda (_, tps, b, _, _) -> tps, b | _ -> [], e + let vs, body = stripLambda_notypes taue + tps, vs, body - let tps,vsl,_ = stripTopLambdaNoTypes e + let tps, vsl, _ = stripTopLambdaNoTypes e let fun_arity = vsl.Length - let dtys,_ = stripFunTyN g fun_arity (snd (tryDestForallTy g ty)) + let dtys, _ = stripFunTyN g fun_arity (snd (tryDestForallTy g ty)) let partialArgAttribsL = Array.ofList partialArgAttribsL assert (List.length vsl = List.length dtys) let curriedArgInfos = - (List.zip vsl dtys) |> List.mapi (fun i (vs,ty) -> + (List.zip vsl dtys) |> List.mapi (fun i (vs, ty) -> let partialAttribs = if i < partialArgAttribsL.Length then partialArgAttribsL.[i] else [] let tys = match allowTypeDirectedDetupling with @@ -4425,7 +4429,7 @@ let InferArityOfExpr g allowTypeDirectedDetupling ty partialArgAttribsL retAttri let attribs = if partialAttribs.Length = tys.Length then partialAttribs else tys |> List.map (fun _ -> []) - (ids,attribs) ||> List.map2 (fun id attribs -> { Name = id; Attribs = attribs } : ArgReprInfo )) + (ids, attribs) ||> List.map2 (fun id attribs -> { Name = id; Attribs = attribs } : ArgReprInfo )) let retInfo : ArgReprInfo = { Attribs = retAttribs; Name = None } ValReprInfo (ValReprInfo.InferTyparInfo tps, curriedArgInfos, retInfo) @@ -4445,9 +4449,9 @@ let underlyingTypeOfEnumTy (g: TcGlobals) typ = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.UnderlyingTypeOfEnum() #endif - | ILTypeMetadata (TILObjectReprData(_,_,tdef)) -> + | ILTypeMetadata (TILObjectReprData(_, _, tdef)) -> - let info = computeILEnumInfo (tdef.Name,tdef.Fields) + let info = computeILEnumInfo (tdef.Name, tdef.Fields) let ilTy = getTyOfILEnumInfo info match ilTy.TypeSpec.Name with | "System.Byte" -> g.byte_ty @@ -4467,7 +4471,7 @@ let underlyingTypeOfEnumTy (g: TcGlobals) typ = let tycon = (tcrefOfAppTy g typ).Deref match tycon.GetFieldByName "value__" with | Some rf -> rf.FormalType - | None -> error(InternalError("no 'value__' field found for enumeration type "^tycon.LogicalName,tycon.Range)) + | None -> error(InternalError("no 'value__' field found for enumeration type "^tycon.LogicalName, tycon.Range)) // CLEANUP NOTE: Get rid of this mutation. @@ -4488,7 +4492,7 @@ type StaticOptimizationAnswer = let decideStaticOptimizationConstraint g c = match c with - | TTyconEqualsTycon (a,b) -> + | TTyconEqualsTycon (a, b) -> // Both types must be nominal for a definite result let rec checkTypes a b = let a = normalizeEnumTy g (stripTyEqnsAndMeasureEqns g a) @@ -4532,11 +4536,11 @@ let rec DecideStaticOptimizations g cs = elif d = StaticOptimizationAnswer.Yes then DecideStaticOptimizations g t else StaticOptimizationAnswer.Unknown -let mkStaticOptimizationExpr g (cs,e1,e2,m) = +let mkStaticOptimizationExpr g (cs, e1, e2, m) = let d = DecideStaticOptimizations g cs in if d = StaticOptimizationAnswer.No then e2 elif d = StaticOptimizationAnswer.Yes then e1 - else Expr.StaticOptimization(cs,e1,e2,m) + else Expr.StaticOptimization(cs, e1, e2, m) //-------------------------------------------------------------------------- // Copy expressions, including new names for locally bound values. @@ -4569,7 +4573,7 @@ let bindTycon (tc:Tycon) (tc':Tycon) tyenv = { tyenv with tyconRefRemap=tyenv.tyconRefRemap.Add (mkLocalTyconRef tc) (mkLocalTyconRef tc') } let bindTycons tcs tcs' tyenv = - { tyenv with tyconRefRemap= (tcs,tcs',tyenv.tyconRefRemap) |||> List.foldBack2 (fun tc tc' acc -> acc.Add (mkLocalTyconRef tc) (mkLocalTyconRef tc')) } + { tyenv with tyconRefRemap= (tcs, tcs', tyenv.tyconRefRemap) |||> List.foldBack2 (fun tc tc' acc -> acc.Add (mkLocalTyconRef tc) (mkLocalTyconRef tc')) } let remapAttribKind tmenv k = match k with @@ -4577,20 +4581,20 @@ let remapAttribKind tmenv k = | FSAttrib vref -> FSAttrib(remapValRef tmenv vref) let tmenvCopyRemapAndBindTypars remapAttrib tmenv tps = - let tps',tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tmenv tps + let tps', tyenvinner = copyAndRemapAndBindTyparsFull remapAttrib tmenv tps let tmenvinner = tyenvinner - tps',tmenvinner + tps', tmenvinner -let rec remapAttrib g tmenv (Attrib (tcref,kind, args, props,isGetOrSetAttr,targets,m)) = - Attrib(remapTyconRef tmenv.tyconRefRemap tcref, +let rec remapAttrib g tmenv (Attrib (tcref, kind, args, props, isGetOrSetAttr, targets, m)) = + Attrib(remapTyconRef tmenv.tyconRefRemap tcref, remapAttribKind tmenv kind, args |> List.map (remapAttribExpr g tmenv), - props |> List.map (fun (AttribNamedArg(nm,ty,flg,expr)) -> AttribNamedArg(nm,remapType tmenv ty, flg, remapAttribExpr g tmenv expr)), - isGetOrSetAttr, - targets, + props |> List.map (fun (AttribNamedArg(nm, ty, flg, expr)) -> AttribNamedArg(nm, remapType tmenv ty, flg, remapAttribExpr g tmenv expr)), + isGetOrSetAttr, + targets, m) -and remapAttribExpr g tmenv (AttribExpr(e1,e2)) = +and remapAttribExpr g tmenv (AttribExpr(e1, e2)) = AttribExpr(remapExpr g CloneAll tmenv e1, remapExpr g CloneAll tmenv e2) and remapAttribs g tmenv xs = List.map (remapAttrib g tmenv) xs @@ -4600,8 +4604,8 @@ and remapPossibleForallTy g tmenv ty = remapTypeFull (remapAttribs g tmenv) tmen and remapArgData g tmenv (argInfo : ArgReprInfo) : ArgReprInfo = { Attribs = remapAttribs g tmenv argInfo.Attribs; Name = argInfo.Name } -and remapValReprInfo g tmenv (ValReprInfo(tpNames,arginfosl,retInfo)) = - ValReprInfo(tpNames,List.mapSquared (remapArgData g tmenv) arginfosl, remapArgData g tmenv retInfo) +and remapValReprInfo g tmenv (ValReprInfo(tpNames, arginfosl, retInfo)) = + ValReprInfo(tpNames, List.mapSquared (remapArgData g tmenv) arginfosl, remapArgData g tmenv retInfo) and remapValData g tmenv (d: ValData) = let ty = d.val_type @@ -4653,151 +4657,151 @@ and copyAndRemapAndBindVal g compgen tmenv v = and remapExpr (g: TcGlobals) (compgen:ValCopyFlag) (tmenv:Remap) x = match x with // Binding constructs - see also dtrees below - | Expr.Lambda (_,ctorThisValOpt, baseValOpt,vs,b,m,rty) -> + | Expr.Lambda (_, ctorThisValOpt, baseValOpt, vs, b, m, rty) -> let ctorThisValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv ctorThisValOpt let baseValOpt, tmenv = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv baseValOpt - let vs,tmenv = copyAndRemapAndBindVals g compgen tmenv vs + let vs, tmenv = copyAndRemapAndBindVals g compgen tmenv vs let b = remapExpr g compgen tmenv b let rty = remapType tmenv rty - Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt,vs,b,m, rty) - | Expr.TyLambda (_,tps,b,m,rty) -> - let tps',tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - mkTypeLambda m tps' (remapExpr g compgen tmenvinner b,remapType tmenvinner rty) - | Expr.TyChoose (tps,b,m) -> - let tps',tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps - Expr.TyChoose(tps',remapExpr g compgen tmenvinner b,m) - | Expr.LetRec (binds,e,m,_) -> - let binds',tmenvinner = copyAndRemapAndBindBindings g compgen tmenv binds - Expr.LetRec (binds',remapExpr g compgen tmenvinner e,m,NewFreeVarsCache()) + Expr.Lambda (newUnique(), ctorThisValOpt, baseValOpt, vs, b, m, rty) + | Expr.TyLambda (_, tps, b, m, rty) -> + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps + mkTypeLambda m tps' (remapExpr g compgen tmenvinner b, remapType tmenvinner rty) + | Expr.TyChoose (tps, b, m) -> + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps + Expr.TyChoose(tps', remapExpr g compgen tmenvinner b, m) + | Expr.LetRec (binds, e, m, _) -> + let binds', tmenvinner = copyAndRemapAndBindBindings g compgen tmenv binds + Expr.LetRec (binds', remapExpr g compgen tmenvinner e, m, NewFreeVarsCache()) | Expr.Sequential _ | Expr.Let _ -> remapLinearExpr g compgen tmenv x (fun x -> x) - | Expr.Match (spBind,exprm,pt,targets,m,ty) -> - primMkMatch (spBind,exprm,remapDecisionTree g compgen tmenv pt, - targets |> Array.map (remapTarget g compgen tmenv), - m,remapType tmenv ty) + | Expr.Match (spBind, exprm, pt, targets, m, ty) -> + primMkMatch (spBind, exprm, remapDecisionTree g compgen tmenv pt, + targets |> Array.map (remapTarget g compgen tmenv), + m, remapType tmenv ty) // Other constructs - | Expr.Val (vr,vf,m) -> + | Expr.Val (vr, vf, m) -> let vr' = remapValRef tmenv vr let vf' = remapValFlags tmenv vf if vr === vr' && vf === vf' then x - else Expr.Val (vr',vf',m) - | Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty) -> + else Expr.Val (vr', vf', m) + | Expr.Quote (a, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> // fix value of compgen for both original expression and pickled AST let compgen = fixValCopyFlagForQuotations compgen - Expr.Quote (remapExpr g compgen tmenv a,{contents=Some(typeDefs,remapTypesAux tmenv argTypes,remapExprs g compgen tmenv argExprs,data)},isFromQueryExpression,m,remapType tmenv ty) - | Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty) -> - Expr.Quote (remapExpr g (fixValCopyFlagForQuotations compgen) tmenv a,{contents=None},isFromQueryExpression,m,remapType tmenv ty) - | Expr.Obj (_,typ,basev,basecall,overrides,iimpls,m) -> - let basev',tmenvinner = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv basev - mkObjExpr(remapType tmenv typ,basev', - remapExpr g compgen tmenv basecall, - List.map (remapMethod g compgen tmenvinner) overrides, - List.map (remapInterfaceImpl g compgen tmenvinner) iimpls,m) + Expr.Quote (remapExpr g compgen tmenv a, {contents=Some(typeDefs, remapTypesAux tmenv argTypes, remapExprs g compgen tmenv argExprs, data)}, isFromQueryExpression, m, remapType tmenv ty) + | Expr.Quote (a, {contents=None}, isFromQueryExpression, m, ty) -> + Expr.Quote (remapExpr g (fixValCopyFlagForQuotations compgen) tmenv a, {contents=None}, isFromQueryExpression, m, remapType tmenv ty) + | Expr.Obj (_, typ, basev, basecall, overrides, iimpls, m) -> + let basev', tmenvinner = Option.mapFold (copyAndRemapAndBindVal g compgen) tmenv basev + mkObjExpr(remapType tmenv typ, basev', + remapExpr g compgen tmenv basecall, + List.map (remapMethod g compgen tmenvinner) overrides, + List.map (remapInterfaceImpl g compgen tmenvinner) iimpls, m) // Addresses of immutable field may "leak" across assembly boundaries - see CanTakeAddressOfRecdFieldRef below. // This is "ok", in the sense that it is always valid to fix these up to be uses // of a temporary local, e.g. // &(E.RF) --> let mutable v = E.RF in &v - | Expr.Op (TOp.ValFieldGetAddr rfref,tinst,[arg],m) when + | Expr.Op (TOp.ValFieldGetAddr rfref, tinst, [arg], m) when not rfref.RecdField.IsMutable && not (entityRefInThisAssembly g.compilingFslib rfref.TyconRef) -> let tinst = remapTypes tmenv tinst let arg = remapExpr g compgen tmenv arg - let tmp,_ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfRecdFieldRef rfref tinst) - mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr(arg,rfref,tinst,m)) (mkValAddr m (mkLocalValRef tmp)) + let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfRecdFieldRef rfref tinst) + mkCompGenLet m tmp (mkRecdFieldGetViaExprAddr(arg, rfref, tinst, m)) (mkValAddr m (mkLocalValRef tmp)) - | Expr.Op (TOp.UnionCaseFieldGetAddr (uref,cidx),tinst,[arg],m) when + | Expr.Op (TOp.UnionCaseFieldGetAddr (uref, cidx), tinst, [arg], m) when not (uref.FieldByIndex(cidx).IsMutable) && not (entityRefInThisAssembly g.compilingFslib uref.TyconRef) -> let tinst = remapTypes tmenv tinst let arg = remapExpr g compgen tmenv arg - let tmp,_ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfUnionFieldRef uref cidx tinst) - mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr(arg,uref,tinst,cidx,m)) (mkValAddr m (mkLocalValRef tmp)) + let tmp, _ = mkMutableCompGenLocal m "copyOfStruct" (actualTyOfUnionFieldRef uref cidx tinst) + mkCompGenLet m tmp (mkUnionCaseFieldGetProvenViaExprAddr(arg, uref, tinst, cidx, m)) (mkValAddr m (mkLocalValRef tmp)) - | Expr.Op (op,tinst,args,m) -> + | Expr.Op (op, tinst, args, m) -> let op' = remapOp tmenv op let tinst' = remapTypes tmenv tinst let args' = remapExprs g compgen tmenv args if op === op' && tinst === tinst' && args === args' then x - else Expr.Op (op',tinst',args',m) + else Expr.Op (op', tinst', args', m) - | Expr.App(e1,e1ty,tyargs,args,m) -> + | Expr.App(e1, e1ty, tyargs, args, m) -> let e1' = remapExpr g compgen tmenv e1 let e1ty' = remapPossibleForallTy g tmenv e1ty let tyargs' = remapTypes tmenv tyargs let args' = remapExprs g compgen tmenv args if e1 === e1' && e1ty === e1ty' && tyargs === tyargs' && args === args' then x - else Expr.App(e1',e1ty',tyargs',args',m) + else Expr.App(e1', e1ty', tyargs', args', m) | Expr.Link(eref) -> remapExpr g compgen tmenv !eref - | Expr.StaticOptimization (cs,e2,e3,m) -> + | Expr.StaticOptimization (cs, e2, e3, m) -> // note that type instantiation typically resolve the static constraints here - mkStaticOptimizationExpr g (List.map (remapConstraint tmenv) cs,remapExpr g compgen tmenv e2,remapExpr g compgen tmenv e3,m) + mkStaticOptimizationExpr g (List.map (remapConstraint tmenv) cs, remapExpr g compgen tmenv e2, remapExpr g compgen tmenv e3, m) - | Expr.Const (c,m,ty) -> + | Expr.Const (c, m, ty) -> let ty' = remapType tmenv ty - if ty === ty' then x else Expr.Const (c,m,ty') + if ty === ty' then x else Expr.Const (c, m, ty') -and remapTarget g compgen tmenv (TTarget(vs,e,spTarget)) = - let vs',tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs - TTarget(vs', remapExpr g compgen tmenvinner e,spTarget) +and remapTarget g compgen tmenv (TTarget(vs, e, spTarget)) = + let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv vs + TTarget(vs', remapExpr g compgen tmenvinner e, spTarget) and remapLinearExpr g compgen tmenv e contf = match e with - | Expr.Let (bind,e,m,_) -> - let bind',tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind + | Expr.Let (bind, e, m, _) -> + let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind // tailcall remapLinearExpr g compgen tmenvinner e (contf << mkLetBind m bind') - | Expr.Sequential (e1,e2,dir,spSeq,m) -> + | Expr.Sequential (e1, e2, dir, spSeq, m) -> let e1' = remapExpr g compgen tmenv e1 // tailcall remapLinearExpr g compgen tmenv e2 (contf << (fun e2' -> if e1 === e1' && e2 === e2' then e - else Expr.Sequential (e1',e2',dir,spSeq,m))) + else Expr.Sequential (e1', e2', dir, spSeq, m))) - | LinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty) -> + | LinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty) -> let dtree = remapDecisionTree g compgen tmenv dtree let tg1 = remapTarget g compgen tmenv tg1 let ty = remapType tmenv ty // tailcall remapLinearExpr g compgen tmenv e2 (contf << (fun e2 -> - rebuildLinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty))) + rebuildLinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty))) | _ -> contf (remapExpr g compgen tmenv e) and remapConstraint tyenv c = match c with - | TTyconEqualsTycon(ty1,ty2) -> TTyconEqualsTycon(remapType tyenv ty1, remapType tyenv ty2) + | TTyconEqualsTycon(ty1, ty2) -> TTyconEqualsTycon(remapType tyenv ty1, remapType tyenv ty2) | TTyconIsStruct(ty1) -> TTyconIsStruct(remapType tyenv ty1) and remapOp tmenv op = match op with - | TOp.Recd (ctor,tcr) -> TOp.Recd(ctor,remapTyconRef tmenv.tyconRefRemap tcr) + | TOp.Recd (ctor, tcr) -> TOp.Recd(ctor, remapTyconRef tmenv.tyconRefRemap tcr) | TOp.UnionCaseTagGet tcr -> TOp.UnionCaseTagGet(remapTyconRef tmenv.tyconRefRemap tcr) | TOp.UnionCase(ucref) -> TOp.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap ucref) | TOp.UnionCaseProof(ucref) -> TOp.UnionCaseProof(remapUnionCaseRef tmenv.tyconRefRemap ucref) | TOp.ExnConstr ec -> TOp.ExnConstr(remapTyconRef tmenv.tyconRefRemap ec) - | TOp.ExnFieldGet(ec,n) -> TOp.ExnFieldGet(remapTyconRef tmenv.tyconRefRemap ec,n) - | TOp.ExnFieldSet(ec,n) -> TOp.ExnFieldSet(remapTyconRef tmenv.tyconRefRemap ec,n) + | TOp.ExnFieldGet(ec, n) -> TOp.ExnFieldGet(remapTyconRef tmenv.tyconRefRemap ec, n) + | TOp.ExnFieldSet(ec, n) -> TOp.ExnFieldSet(remapTyconRef tmenv.tyconRefRemap ec, n) | TOp.ValFieldSet rfref -> TOp.ValFieldSet(remapRecdFieldRef tmenv.tyconRefRemap rfref) | TOp.ValFieldGet rfref -> TOp.ValFieldGet(remapRecdFieldRef tmenv.tyconRefRemap rfref) | TOp.ValFieldGetAddr rfref -> TOp.ValFieldGetAddr(remapRecdFieldRef tmenv.tyconRefRemap rfref) - | TOp.UnionCaseFieldGet(ucref,n) -> TOp.UnionCaseFieldGet(remapUnionCaseRef tmenv.tyconRefRemap ucref,n) - | TOp.UnionCaseFieldSet(ucref,n) -> TOp.UnionCaseFieldSet(remapUnionCaseRef tmenv.tyconRefRemap ucref,n) - | TOp.ILAsm (instrs,tys) -> + | TOp.UnionCaseFieldGet(ucref, n) -> TOp.UnionCaseFieldGet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) + | TOp.UnionCaseFieldSet(ucref, n) -> TOp.UnionCaseFieldSet(remapUnionCaseRef tmenv.tyconRefRemap ucref, n) + | TOp.ILAsm (instrs, tys) -> let tys2 = remapTypes tmenv tys if tys === tys2 then op else - TOp.ILAsm (instrs,tys2) + TOp.ILAsm (instrs, tys2) | TOp.TraitCall(traitInfo) -> TOp.TraitCall(remapTraitAux tmenv traitInfo) - | TOp.LValueOp (kind,lvr) -> TOp.LValueOp (kind,remapValRef tmenv lvr) - | TOp.ILCall (isVirtCall,isProtectedCall,valu,isNewObjCall,valUseFlags,isProperty,noTailCall,ilMethRef,enclTypeArgs,methTypeArgs,tys) -> - TOp.ILCall (isVirtCall,isProtectedCall,valu,isNewObjCall,remapValFlags tmenv valUseFlags, - isProperty,noTailCall,ilMethRef,remapTypes tmenv enclTypeArgs, - remapTypes tmenv methTypeArgs,remapTypes tmenv tys) + | TOp.LValueOp (kind, lvr) -> TOp.LValueOp (kind, remapValRef tmenv lvr) + | TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, valUseFlags, isProperty, noTailCall, ilMethRef, enclTypeArgs, methTypeArgs, tys) -> + TOp.ILCall (isVirtCall, isProtectedCall, valu, isNewObjCall, remapValFlags tmenv valUseFlags, + isProperty, noTailCall, ilMethRef, remapTypes tmenv enclTypeArgs, + remapTypes tmenv methTypeArgs, remapTypes tmenv tys) | _ -> op @@ -4811,25 +4815,25 @@ and remapFlatExprs g compgen tmenv es = List.mapq (remapExpr g compgen tmenv) es and remapDecisionTree g compgen tmenv x = match x with - | TDSwitch(e1,csl,dflt,m) -> - TDSwitch(remapExpr g compgen tmenv e1, - List.map (fun (TCase(test,y)) -> + | TDSwitch(e1, csl, dflt, m) -> + TDSwitch(remapExpr g compgen tmenv e1, + List.map (fun (TCase(test, y)) -> let test' = match test with - | DecisionTreeTest.UnionCase (uc,tinst) -> DecisionTreeTest.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap uc,remapTypes tmenv tinst) - | DecisionTreeTest.ArrayLength (n,ty) -> DecisionTreeTest.ArrayLength(n,remapType tmenv ty) + | DecisionTreeTest.UnionCase (uc, tinst) -> DecisionTreeTest.UnionCase(remapUnionCaseRef tmenv.tyconRefRemap uc, remapTypes tmenv tinst) + | DecisionTreeTest.ArrayLength (n, ty) -> DecisionTreeTest.ArrayLength(n, remapType tmenv ty) | DecisionTreeTest.Const _ -> test - | DecisionTreeTest.IsInst (srcty,tgty) -> DecisionTreeTest.IsInst (remapType tmenv srcty,remapType tmenv tgty) + | DecisionTreeTest.IsInst (srcty, tgty) -> DecisionTreeTest.IsInst (remapType tmenv srcty, remapType tmenv tgty) | DecisionTreeTest.IsNull -> DecisionTreeTest.IsNull | DecisionTreeTest.ActivePatternCase _ -> failwith "DecisionTreeTest.ActivePatternCase should only be used during pattern match compilation" - TCase(test',remapDecisionTree g compgen tmenv y)) csl, - Option.map (remapDecisionTree g compgen tmenv) dflt, + TCase(test', remapDecisionTree g compgen tmenv y)) csl, + Option.map (remapDecisionTree g compgen tmenv) dflt, m) - | TDSuccess (es,n) -> - TDSuccess (remapFlatExprs g compgen tmenv es,n) - | TDBind (bind,rest) -> - let bind',tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind - TDBind (bind',remapDecisionTree g compgen tmenvinner rest) + | TDSuccess (es, n) -> + TDSuccess (remapFlatExprs g compgen tmenv es, n) + | TDBind (bind, rest) -> + let bind', tmenvinner = copyAndRemapAndBindBinding g compgen tmenv bind + TDBind (bind', remapDecisionTree g compgen tmenvinner rest) and copyAndRemapAndBindBinding g compgen tmenv (bind:Binding) = let v = bind.Var @@ -4838,20 +4842,20 @@ and copyAndRemapAndBindBinding g compgen tmenv (bind:Binding) = and copyAndRemapAndBindBindings g compgen tmenv binds = let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenv (valsOfBinds binds) - remapAndRenameBinds g compgen tmenvinner binds vs',tmenvinner + remapAndRenameBinds g compgen tmenvinner binds vs', tmenvinner and remapAndRenameBinds g compgen tmenvinner binds vs' = List.map2 (remapAndRenameBind g compgen tmenvinner) binds vs' -and remapAndRenameBind g compgen tmenvinner (TBind(_,repr,letSeqPtOpt)) v' = TBind(v', remapExpr g compgen tmenvinner repr,letSeqPtOpt) +and remapAndRenameBind g compgen tmenvinner (TBind(_, repr, letSeqPtOpt)) v' = TBind(v', remapExpr g compgen tmenvinner repr, letSeqPtOpt) -and remapMethod g compgen tmenv (TObjExprMethod(slotsig,attribs,tps,vs,e,m)) = +and remapMethod g compgen tmenv (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = let attribs2 = attribs |> remapAttribs g tmenv let slotsig2 = remapSlotSig (remapAttribs g tmenv) tmenv slotsig - let tps2,tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps + let tps2, tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv tps let vs2, tmenvinner2 = List.mapFold (copyAndRemapAndBindVals g compgen) tmenvinner vs let e2 = remapExpr g compgen tmenvinner2 e - TObjExprMethod(slotsig2,attribs2,tps2,vs2,e2,m) + TObjExprMethod(slotsig2, attribs2, tps2, vs2, e2, m) -and remapInterfaceImpl g compgen tmenv (ty,overrides) = +and remapInterfaceImpl g compgen tmenv (ty, overrides) = (remapType tmenv ty, List.map (remapMethod g compgen tmenv) overrides) and remapRecdField g tmenv x = @@ -4922,9 +4926,9 @@ and remapMemberInfo g m topValInfo ty ty' tmenv x = // The slotsig in the ImplementedSlotSigs is w.r.t. the type variables in the value's type. // REVIEW: this is a bit gross. It would be nice if the slotsig was standalone assert (Option.isSome topValInfo) - let tpsOrig,_,_,_ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty m - let tps,_,_,_ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty' m - let renaming,_ = mkTyparToTyparRenaming tpsOrig tps + let tpsOrig, _, _, _ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty m + let tps, _, _, _ = GetMemberTypeInFSharpForm g x.MemberFlags (Option.get topValInfo) ty' m + let renaming, _ = mkTyparToTyparRenaming tpsOrig tps let tmenv = { tmenv with tpinst = tmenv.tpinst @ renaming } { x with ApparentParent = x.ApparentParent |> remapTyconRef tmenv.tyconRefRemap ; @@ -4934,7 +4938,7 @@ and remapMemberInfo g m topValInfo ty ty' tmenv x = and copyAndRemapAndBindModTy g compgen tmenv mty = let tycons = allEntitiesOfModuleOrNamespaceTy mty let vs = allValsOfModuleOrNamespaceTy mty - let _,_,tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs + let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs remapModTy g compgen tmenvinner mty, tmenvinner and remapModTy _g _compgen tmenv mty = @@ -4946,7 +4950,7 @@ and renameTycon tyenv x = let res = tyenv.tyconRefRemap.[mkLocalTyconRef x] res with :? KeyNotFoundException -> - errorR(InternalError("couldn't remap internal tycon "^showL(DebugPrint.tyconL x),x.Range)); + errorR(InternalError("couldn't remap internal tycon "^showL(DebugPrint.tyconL x), x.Range)); mkLocalTyconRef x tcref.Deref @@ -4967,7 +4971,7 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let tmenvinner = bindTycons tycons tycons' tmenv // Values need to be copied and renamed. - let vs',tmenvinner = copyAndRemapAndBindVals g compgen tmenvinner vs + let vs', tmenvinner = copyAndRemapAndBindVals g compgen tmenvinner vs // "if a type constructor is hidden then all its inner values and inner type constructors must also be hidden" // Hence we can just lookup the inner tycon/value mappings in the tables. @@ -4978,7 +4982,7 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let res = tmenvinner.valRemap.[v] res with :? KeyNotFoundException -> - errorR(InternalError(sprintf "couldn't remap internal value '%s'" v.LogicalName,v.Range)); + errorR(InternalError(sprintf "couldn't remap internal value '%s'" v.LogicalName, v.Range)); mkLocalValRef v vref.Deref @@ -4988,12 +4992,12 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = let res = tmenvinner.tyconRefRemap.[mkLocalTyconRef tycon] res with :? KeyNotFoundException -> - errorR(InternalError("couldn't remap internal tycon "^showL(DebugPrint.tyconL tycon),tycon.Range)); + errorR(InternalError("couldn't remap internal tycon "^showL(DebugPrint.tyconL tycon), tycon.Range)); mkLocalTyconRef tycon tcref.Deref - (tycons,tycons') ||> List.iter2 (fun tcd tcd' -> - let tps',tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs g tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) + (tycons, tycons') ||> List.iter2 (fun tcd tcd' -> + let tps', tmenvinner2 = tmenvCopyRemapAndBindTypars (remapAttribs g tmenvinner) tmenvinner (tcd.entity_typars.Force(tcd.entity_range)) tcd'.entity_typars <- LazyWithContext.NotLazy tps'; tcd'.entity_attribs <- tcd.entity_attribs |> remapAttribs g tmenvinner2; tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2; @@ -5002,7 +5006,7 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = tcd'.entity_modul_contents <- MaybeLazy.Strict (tcd.entity_modul_contents.Value |> mapImmediateValsAndTycons lookupTycon lookupVal); tcd'.entity_exn_info <- tcd.entity_exn_info |> remapTyconExnInfo g tmenvinner2) ; - tycons',vs', tmenvinner + tycons', vs', tmenvinner and allTyconsOfTycon (tycon:Tycon) = @@ -5012,7 +5016,7 @@ and allTyconsOfTycon (tycon:Tycon) = and allEntitiesOfModDef mdef = seq { match mdef with - | TMDefRec(_,tycons,mbinds,_) -> + | TMDefRec(_, tycons, mbinds, _) -> for tycon in tycons do yield! allTyconsOfTycon tycon for mbind in mbinds do @@ -5026,40 +5030,40 @@ and allEntitiesOfModDef mdef = | TMDefs defs -> for def in defs do yield! allEntitiesOfModDef def - | TMAbstract(ModuleOrNamespaceExprWithSig(mty,_,_)) -> + | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> yield! allEntitiesOfModuleOrNamespaceTy mty } and allValsOfModDef mdef = seq { match mdef with - | TMDefRec(_,tycons,mbinds,_) -> + | TMDefRec(_, tycons, mbinds, _) -> yield! abstractSlotValsOfTycons tycons for mbind in mbinds do match mbind with | ModuleOrNamespaceBinding.Binding bind -> yield bind.Var | ModuleOrNamespaceBinding.Module(_, def) -> yield! allValsOfModDef def - | TMDefLet(bind,_) -> + | TMDefLet(bind, _) -> yield bind.Var | TMDefDo _ -> () | TMDefs defs -> for def in defs do yield! allValsOfModDef def - | TMAbstract(ModuleOrNamespaceExprWithSig(mty,_,_)) -> + | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> yield! allValsOfModuleOrNamespaceTy mty } -and remapAndBindModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty,mdef,m)) = +and remapAndBindModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = let mdef = copyAndRemapModDef g compgen tmenv mdef - let mty,tmenv = copyAndRemapAndBindModTy g compgen tmenv mty - ModuleOrNamespaceExprWithSig(mty,mdef,m), tmenv + let mty, tmenv = copyAndRemapAndBindModTy g compgen tmenv mty + ModuleOrNamespaceExprWithSig(mty, mdef, m), tmenv -and remapModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty,mdef,m)) = +and remapModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = let mdef = copyAndRemapModDef g compgen tmenv mdef let mty = remapModTy g compgen tmenv mty - ModuleOrNamespaceExprWithSig(mty,mdef,m) + ModuleOrNamespaceExprWithSig(mty, mdef, m) and copyAndRemapModDef g compgen tmenv mdef = let tycons = allEntitiesOfModDef mdef |> List.ofSeq let vs = allValsOfModDef mdef |> List.ofSeq - let _,_,tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs + let _, _, tmenvinner = copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs remapAndRenameModDef g compgen tmenvinner mdef and remapAndRenameModDefs g compgen tmenv x = @@ -5067,16 +5071,16 @@ and remapAndRenameModDefs g compgen tmenv x = and remapAndRenameModDef g compgen tmenv mdef = match mdef with - | TMDefRec(isRec,tycons,mbinds,m) -> + | TMDefRec(isRec, tycons, mbinds, m) -> // Abstract (virtual) vslots in the tycons at TMDefRec nodes are binders. They also need to be copied and renamed. let tycons = tycons |> List.map (renameTycon tmenv) let mbinds = mbinds |> List.map (remapAndRenameModBind g compgen tmenv) - TMDefRec(isRec,tycons,mbinds,m) - | TMDefLet(bind,m) -> + TMDefRec(isRec, tycons, mbinds, m) + | TMDefLet(bind, m) -> let v = bind.Var let bind = remapAndRenameBind g compgen tmenv bind (renameVal tmenv v) TMDefLet(bind, m) - | TMDefDo(e,m) -> + | TMDefDo(e, m) -> let e = remapExpr g compgen tmenv e TMDefDo(e, m) | TMDefs defs -> @@ -5113,39 +5117,39 @@ let instExpr g tpinst e = remapExpr g CloneAll (mkInstRemap tpinst) e let rec remarkExpr m x = match x with - | Expr.Lambda (uniq,ctorThisValOpt,baseValOpt,vs,b,_,rty) -> Expr.Lambda (uniq,ctorThisValOpt,baseValOpt,vs,remarkExpr m b,m,rty) - | Expr.TyLambda (uniq,tps,b,_,rty) -> Expr.TyLambda (uniq,tps,remarkExpr m b,m,rty) - | Expr.TyChoose (tps,b,_) -> Expr.TyChoose (tps,remarkExpr m b,m) - | Expr.LetRec (binds,e,_,fvs) -> Expr.LetRec (remarkBinds m binds,remarkExpr m e,m,fvs) - | Expr.Let (bind,e,_,fvs) -> Expr.Let (remarkBind m bind,remarkExpr m e,m,fvs) - | Expr.Match (_,_,pt,targets,_,ty) -> primMkMatch (NoSequencePointAtInvisibleBinding,m,remarkDecisionTree m pt, Array.map (fun (TTarget(vs,e,_)) ->TTarget(vs, remarkExpr m e,SuppressSequencePointAtTarget)) targets,m,ty) - | Expr.Val (x,valUseFlags,_) -> Expr.Val (x,valUseFlags,m) - | Expr.Quote (a,conv,isFromQueryExpression,_,ty) -> Expr.Quote (remarkExpr m a,conv,isFromQueryExpression,m,ty) - | Expr.Obj (n,typ,basev,basecall,overrides,iimpls,_) -> - Expr.Obj (n,typ,basev,remarkExpr m basecall, - List.map (remarkObjExprMethod m) overrides, - List.map (remarkInterfaceImpl m) iimpls,m) - | Expr.Op (op,tinst,args,_) -> + | Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, b, _, rty) -> Expr.Lambda (uniq, ctorThisValOpt, baseValOpt, vs, remarkExpr m b, m, rty) + | Expr.TyLambda (uniq, tps, b, _, rty) -> Expr.TyLambda (uniq, tps, remarkExpr m b, m, rty) + | Expr.TyChoose (tps, b, _) -> Expr.TyChoose (tps, remarkExpr m b, m) + | Expr.LetRec (binds, e, _, fvs) -> Expr.LetRec (remarkBinds m binds, remarkExpr m e, m, fvs) + | Expr.Let (bind, e, _, fvs) -> Expr.Let (remarkBind m bind, remarkExpr m e, m, fvs) + | Expr.Match (_, _, pt, targets, _, ty) -> primMkMatch (NoSequencePointAtInvisibleBinding, m, remarkDecisionTree m pt, Array.map (fun (TTarget(vs, e, _)) ->TTarget(vs, remarkExpr m e, SuppressSequencePointAtTarget)) targets, m, ty) + | Expr.Val (x, valUseFlags, _) -> Expr.Val (x, valUseFlags, m) + | Expr.Quote (a, conv, isFromQueryExpression, _, ty) -> Expr.Quote (remarkExpr m a, conv, isFromQueryExpression, m, ty) + | Expr.Obj (n, typ, basev, basecall, overrides, iimpls, _) -> + Expr.Obj (n, typ, basev, remarkExpr m basecall, + List.map (remarkObjExprMethod m) overrides, + List.map (remarkInterfaceImpl m) iimpls, m) + | Expr.Op (op, tinst, args, _) -> let op = match op with - | TOp.TryFinally(_,_) -> TOp.TryFinally(NoSequencePointAtTry,NoSequencePointAtFinally) - | TOp.TryCatch(_,_) -> TOp.TryCatch(NoSequencePointAtTry,NoSequencePointAtWith) + | TOp.TryFinally(_, _) -> TOp.TryFinally(NoSequencePointAtTry, NoSequencePointAtFinally) + | TOp.TryCatch(_, _) -> TOp.TryCatch(NoSequencePointAtTry, NoSequencePointAtWith) | _ -> op - Expr.Op (op,tinst,remarkExprs m args,m) + Expr.Op (op, tinst, remarkExprs m args, m) | Expr.Link (eref) -> // Preserve identity of fixup nodes during remarkExpr eref := remarkExpr m !eref; x - | Expr.App(e1,e1ty,tyargs,args,_) -> Expr.App(remarkExpr m e1,e1ty,tyargs,remarkExprs m args,m) - | Expr.Sequential (e1,e2,dir,_,_) -> Expr.Sequential (remarkExpr m e1,remarkExpr m e2,dir,SuppressSequencePointOnExprOfSequential,m) - | Expr.StaticOptimization (eqns,e2,e3,_) -> Expr.StaticOptimization (eqns,remarkExpr m e2,remarkExpr m e3,m) - | Expr.Const (c,_,ty) -> Expr.Const (c,m,ty) + | Expr.App(e1, e1ty, tyargs, args, _) -> Expr.App(remarkExpr m e1, e1ty, tyargs, remarkExprs m args, m) + | Expr.Sequential (e1, e2, dir, _, _) -> Expr.Sequential (remarkExpr m e1, remarkExpr m e2, dir, SuppressSequencePointOnExprOfSequential, m) + | Expr.StaticOptimization (eqns, e2, e3, _) -> Expr.StaticOptimization (eqns, remarkExpr m e2, remarkExpr m e3, m) + | Expr.Const (c, _, ty) -> Expr.Const (c, m, ty) and remarkObjExprMethod m (TObjExprMethod(slotsig, attribs, tps, vs, e, _)) = TObjExprMethod(slotsig, attribs, tps, vs, remarkExpr m e, m) -and remarkInterfaceImpl m (ty,overrides) = +and remarkInterfaceImpl m (ty, overrides) = (ty, List.map (remarkObjExprMethod m) overrides) and remarkExprs m es = es |> List.map (remarkExpr m) @@ -5154,15 +5158,15 @@ and remarkFlatExprs m es = es |> List.map (remarkExpr m) and remarkDecisionTree m x = match x with - | TDSwitch(e1,csl,dflt,_) -> TDSwitch(remarkExpr m e1, List.map (fun (TCase(test,y)) -> TCase(test,remarkDecisionTree m y)) csl, Option.map (remarkDecisionTree m) dflt,m) - | TDSuccess (es,n) -> TDSuccess (remarkFlatExprs m es,n) - | TDBind (bind,rest) -> TDBind(remarkBind m bind,remarkDecisionTree m rest) + | TDSwitch(e1, csl, dflt, _) -> TDSwitch(remarkExpr m e1, List.map (fun (TCase(test, y)) -> TCase(test, remarkDecisionTree m y)) csl, Option.map (remarkDecisionTree m) dflt, m) + | TDSuccess (es, n) -> TDSuccess (remarkFlatExprs m es, n) + | TDBind (bind, rest) -> TDBind(remarkBind m bind, remarkDecisionTree m rest) and remarkBinds m binds = List.map (remarkBind m) binds // This very deliberately drops the sequence points since this is used when adjusting the marks for inlined expressions -and remarkBind m (TBind(v,repr,_)) = - TBind(v, remarkExpr m repr,NoSequencePointAtStickyBinding) +and remarkBind m (TBind(v, repr, _)) = + TBind(v, remarkExpr m repr, NoSequencePointAtStickyBinding) //-------------------------------------------------------------------------- @@ -5199,7 +5203,7 @@ let isUnionCaseFieldMutable (g: TcGlobals) (ucref:UnionCaseRef) n = (ucref.FieldByIndex n).IsMutable let isExnFieldMutable ecref n = - if n < 0 || n >= List.length (recdFieldsOfExnDefRef ecref) then errorR(InternalError(sprintf "isExnFieldMutable, exnc = %s, n = %d" ecref.LogicalName n,ecref.Range)); + if n < 0 || n >= List.length (recdFieldsOfExnDefRef ecref) then errorR(InternalError(sprintf "isExnFieldMutable, exnc = %s, n = %d" ecref.LogicalName n, ecref.Range)); (recdFieldOfExnDefRefByIdx ecref n).IsMutable let useGenuineField (tycon:Tycon) (f:RecdField) = @@ -5213,11 +5217,11 @@ let ComputeFieldName tycon f = // Helpers for building code contained in the initial environment //------------------------------------------------------------------------- -let isQuotedExprTy g ty = match ty with AppTy g (tcref,_) -> tyconRefEq g tcref g.expr_tcr | _ -> false -let destQuotedExprTy g ty = match ty with AppTy g (_,[ty]) -> ty | _ -> failwith "destQuotedExprTy" +let isQuotedExprTy g ty = match ty with AppTy g (tcref, _) -> tyconRefEq g tcref g.expr_tcr | _ -> false +let destQuotedExprTy g ty = match ty with AppTy g (_, [ty]) -> ty | _ -> failwith "destQuotedExprTy" -let mkQuotedExprTy (g:TcGlobals) ty = TType_app(g.expr_tcr,[ty]) -let mkRawQuotedExprTy (g:TcGlobals) = TType_app(g.raw_expr_tcr,[]) +let mkQuotedExprTy (g:TcGlobals) ty = TType_app(g.expr_tcr, [ty]) +let mkRawQuotedExprTy (g:TcGlobals) = TType_app(g.raw_expr_tcr, []) let mkAnyTupledTy (g:TcGlobals) tupInfo tys = match tys with @@ -5239,50 +5243,50 @@ let mkByteArrayTy (g:TcGlobals) = mkArrayType g g.byte_ty let rec tyOfExpr g e = match e with - | Expr.App(_,fty,tyargs,args,_) -> applyTys g fty (tyargs,args) - | Expr.Obj (_,ty,_,_,_,_,_) - | Expr.Match (_,_,_,_,_,ty) - | Expr.Quote(_,_,_,_,ty) - | Expr.Const(_,_,ty) -> (ty) - | Expr.Val(vref,_,_) -> vref.Type - | Expr.Sequential(a,b,k,_,_) -> tyOfExpr g (match k with NormalSeq -> b | ThenDoSeq -> a) - | Expr.Lambda(_,_,_,vs,_,_,rty) -> (mkRefTupledVarsTy g vs --> rty) - | Expr.TyLambda(_,tyvs,_,_,rty) -> (tyvs +-> rty) - | Expr.Let(_,e,_,_) - | Expr.TyChoose(_,e,_) + | Expr.App(_, fty, tyargs, args, _) -> applyTys g fty (tyargs, args) + | Expr.Obj (_, ty, _, _, _, _, _) + | Expr.Match (_, _, _, _, _, ty) + | Expr.Quote(_, _, _, _, ty) + | Expr.Const(_, _, ty) -> (ty) + | Expr.Val(vref, _, _) -> vref.Type + | Expr.Sequential(a, b, k, _, _) -> tyOfExpr g (match k with NormalSeq -> b | ThenDoSeq -> a) + | Expr.Lambda(_, _, _, vs, _, _, rty) -> (mkRefTupledVarsTy g vs --> rty) + | Expr.TyLambda(_, tyvs, _, _, rty) -> (tyvs +-> rty) + | Expr.Let(_, e, _, _) + | Expr.TyChoose(_, e, _) | Expr.Link { contents=e} - | Expr.StaticOptimization (_,_,e,_) - | Expr.LetRec(_,e,_,_) -> tyOfExpr g e - | Expr.Op (op,tinst,_,_) -> + | Expr.StaticOptimization (_, _, e, _) + | Expr.LetRec(_, e, _, _) -> tyOfExpr g e + | Expr.Op (op, tinst, _, _) -> match op with | TOp.Coerce -> (match tinst with [to_ty;_fromTy] -> to_ty | _ -> failwith "bad TOp.Coerce node") - | (TOp.ILCall (_,_,_,_,_,_,_,_,_,_,rtys) | TOp.ILAsm(_,rtys)) -> (match rtys with [h] -> h | _ -> g.unit_ty) + | (TOp.ILCall (_, _, _, _, _, _, _, _, _, _, rtys) | TOp.ILAsm(_, rtys)) -> (match rtys with [h] -> h | _ -> g.unit_ty) | TOp.UnionCase uc -> actualResultTyOfUnionCase tinst uc | TOp.UnionCaseProof uc -> mkProvenUnionCaseTy uc tinst - | TOp.Recd (_,tcref) -> mkAppTy tcref tinst + | TOp.Recd (_, tcref) -> mkAppTy tcref tinst | TOp.ExnConstr _ -> g.exn_ty | TOp.Bytes _ -> mkByteArrayTy g | TOp.UInt16s _ -> mkArrayType g g.uint16_ty - | TOp.TupleFieldGet(_,i) -> List.item i tinst + | TOp.TupleFieldGet(_, i) -> List.item i tinst | TOp.Tuple tupInfo -> mkAnyTupledTy g tupInfo tinst | (TOp.For _ | TOp.While _) -> g.unit_ty | TOp.Array -> (match tinst with [ty] -> mkArrayType g ty | _ -> failwith "bad TOp.Array node") | (TOp.TryCatch _ | TOp.TryFinally _) -> (match tinst with [ty] -> ty | _ -> failwith "bad TOp_try node") | TOp.ValFieldGetAddr(fref) -> mkByrefTy g (actualTyOfRecdFieldRef fref tinst) | TOp.ValFieldGet(fref) -> actualTyOfRecdFieldRef fref tinst - | (TOp.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ | TOp.LValueOp ((LSet | LByrefSet),_)) ->g.unit_ty + | (TOp.ValFieldSet _ | TOp.UnionCaseFieldSet _ | TOp.ExnFieldSet _ | TOp.LValueOp ((LSet | LByrefSet), _)) ->g.unit_ty | TOp.UnionCaseTagGet _ -> g.int_ty - | TOp.UnionCaseFieldGetAddr(cref,j) -> mkByrefTy g (actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j)) - | TOp.UnionCaseFieldGet(cref,j) -> actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j) - | TOp.ExnFieldGet(ecref,j) -> recdFieldTyOfExnDefRefByIdx ecref j + | TOp.UnionCaseFieldGetAddr(cref, j) -> mkByrefTy g (actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j)) + | TOp.UnionCaseFieldGet(cref, j) -> actualTyOfRecdField (mkTyconRefInst cref.TyconRef tinst) (cref.FieldByIndex j) + | TOp.ExnFieldGet(ecref, j) -> recdFieldTyOfExnDefRefByIdx ecref j | TOp.LValueOp (LByrefGet, v) -> destByrefTy g v.Type | TOp.LValueOp (LGetAddr, v) -> mkByrefTy g v.Type | TOp.RefAddrGet -> (match tinst with [ty] -> mkByrefTy g ty | _ -> failwith "bad TOp.RefAddrGet node") - | TOp.TraitCall (TTrait(_,_,_,_,ty,_)) -> GetFSharpViewOfReturnType g ty + | TOp.TraitCall (TTrait(_, _, _, _, ty, _)) -> GetFSharpViewOfReturnType g ty | TOp.Reraise -> (match tinst with [rtn_ty] -> rtn_ty | _ -> failwith "bad TOp.Reraise node") | TOp.Goto _ | TOp.Label _ | TOp.Return -> //assert false; - //errorR(InternalError("unexpected goto/label/return in tyOfExpr",m)); + //errorR(InternalError("unexpected goto/label/return in tyOfExpr", m)); // It doesn't matter what type we return here. This is only used in free variable analysis in the code generator g.unit_ty @@ -5290,8 +5294,8 @@ let rec tyOfExpr g e = // Make applications //--------------------------------------------------------------------------- -let primMkApp (f,fty) tyargs argsl m = - Expr.App(f,fty,tyargs,argsl,m) +let primMkApp (f, fty) tyargs argsl m = + Expr.App(f, fty, tyargs, argsl, m) // Check for the funky where a generic type instantiation at function type causes a generic function // to appear to accept more arguments than it really does, e.g. "id id 1", where the first "id" is @@ -5300,7 +5304,7 @@ let primMkApp (f,fty) tyargs argsl m = // In this case, apply the arguments one at a time. let isExpansiveUnderInstantiation g fty0 tyargs pargs argsl = isForallTy g fty0 && - let fty1 = formalApplyTys g fty0 (tyargs,pargs) + let fty1 = formalApplyTys g fty0 (tyargs, pargs) (not (isFunTy g fty1) || let rec loop fty xs = match xs with @@ -5316,22 +5320,22 @@ let rec mkExprApplAux g f fty argsl m = // // Combine the term application with a term application, but only when f' is an under-applied value of known arity match f with - | Expr.App(f',fty',tyargs,pargs,m2) + | Expr.App(f', fty', tyargs, pargs, m2) when (isNil pargs || (match stripExpr f' with - | Expr.Val(v,_,_) -> + | Expr.Val(v, _, _) -> match v.ValReprInfo with | Some info -> info.NumCurriedArgs > pargs.Length | None -> false | _ -> false)) && not (isExpansiveUnderInstantiation g fty' tyargs pargs argsl) -> - primMkApp (f',fty') tyargs (pargs@argsl) (unionRanges m2 m) + primMkApp (f', fty') tyargs (pargs@argsl) (unionRanges m2 m) | _ -> // Don't combine. 'f' is not an application - if not (isFunTy g fty) then error(InternalError("expected a function type",m)); - primMkApp (f,fty) [] argsl m + if not (isFunTy g fty) then error(InternalError("expected a function type", m)); + primMkApp (f, fty) [] argsl m let rec mkAppsAux g f fty tyargsl argsl m = @@ -5341,12 +5345,12 @@ let rec mkAppsAux g f fty tyargsl argsl m = | [] -> mkAppsAux g f fty rest argsl m | _ -> let arfty = applyForallTy g fty tyargs - mkAppsAux g (primMkApp (f,fty) tyargs [] m) arfty rest argsl m + mkAppsAux g (primMkApp (f, fty) tyargs [] m) arfty rest argsl m | [] -> mkExprApplAux g f fty argsl m -let mkApps g ((f,fty),tyargsl,argl,m) = mkAppsAux g f fty tyargsl argl m -let mkTyAppExpr m (f,fty) tyargs = match tyargs with [] -> f | _ -> primMkApp (f,fty) tyargs [] m +let mkApps g ((f, fty), tyargsl, argl, m) = mkAppsAux g f fty tyargsl argl m +let mkTyAppExpr m (f, fty) tyargs = match tyargs with [] -> f | _ -> primMkApp (f, fty) tyargs [] m //-------------------------------------------------------------------------- @@ -5355,17 +5359,17 @@ let mkTyAppExpr m (f,fty) tyargs = match tyargs with [] -> f | _ -> primMkApp (f let rec accTargetsOfDecisionTree tree acc = match tree with - | TDSwitch (_,edges,dflt,_) -> List.foldBack (fun (c:DecisionTreeCase) -> accTargetsOfDecisionTree c.CaseTree) edges (Option.foldBack accTargetsOfDecisionTree dflt acc) - | TDSuccess (_,i) -> i::acc - | TDBind (_,rest) -> accTargetsOfDecisionTree rest acc + | TDSwitch (_, edges, dflt, _) -> List.foldBack (fun (c:DecisionTreeCase) -> accTargetsOfDecisionTree c.CaseTree) edges (Option.foldBack accTargetsOfDecisionTree dflt acc) + | TDSuccess (_, i) -> i::acc + | TDBind (_, rest) -> accTargetsOfDecisionTree rest acc let rec mapAccTipsOfDecisionTree f tree = match tree with - | TDSwitch (e,edges,dflt,m) -> TDSwitch (e,List.map (mapAccTipsOfEdge f) edges,Option.map (mapAccTipsOfDecisionTree f) dflt,m) - | TDSuccess (es,i) -> f es i - | TDBind (bind,rest) -> TDBind(bind,mapAccTipsOfDecisionTree f rest) -and mapAccTipsOfEdge f (TCase(x,t)) = - TCase(x,mapAccTipsOfDecisionTree f t) + | TDSwitch (e, edges, dflt, m) -> TDSwitch (e, List.map (mapAccTipsOfEdge f) edges, Option.map (mapAccTipsOfDecisionTree f) dflt, m) + | TDSuccess (es, i) -> f es i + | TDBind (bind, rest) -> TDBind(bind, mapAccTipsOfDecisionTree f rest) +and mapAccTipsOfEdge f (TCase(x, t)) = + TCase(x, mapAccTipsOfDecisionTree f t) let mapTargetsOfDecisionTree f tree = mapAccTipsOfDecisionTree (fun es i -> TDSuccess(es, f i)) tree @@ -5382,26 +5386,26 @@ let eliminateDeadTargetsFromMatch tree (targets:_[]) = if remap.[tgn] = -1 then failwith "eliminateDeadTargetsFromMatch: failure while eliminating unused targets"; remap.[tgn]) let targets' = Array.map (Array.get targets) used - tree',targets' + tree', targets' else - tree,targets + tree, targets let rec targetOfSuccessDecisionTree tree = match tree with | TDSwitch _ -> None - | TDSuccess (_,i) -> Some i - | TDBind(_,t) -> targetOfSuccessDecisionTree t + | TDSuccess (_, i) -> Some i + | TDBind(_, t) -> targetOfSuccessDecisionTree t /// Check a decision tree only has bindings that immediately cover a 'Success' let rec decisionTreeHasNonTrivialBindings tree = match tree with - | TDSwitch (_,edges,dflt,_) -> + | TDSwitch (_, edges, dflt, _) -> edges |> List.exists (fun c -> decisionTreeHasNonTrivialBindings c.CaseTree) || dflt |> Option.exists decisionTreeHasNonTrivialBindings | TDSuccess _ -> false - | TDBind (_,t) -> Option.isNone (targetOfSuccessDecisionTree t) + | TDBind (_, t) -> Option.isNone (targetOfSuccessDecisionTree t) // If a target has assignments and can only be reached through one // branch (i.e. is "linear"), then transfer the assignments to the r.h.s. to be a "let". @@ -5410,22 +5414,22 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = // Don't do this when there are any bindings in the tree except where those bindings immediately cover a success node // since the variables would be extruded from their scope. if decisionTreeHasNonTrivialBindings tree then - tree,targets + tree, targets else let branchesToTargets = Array.create targets.Length [] // Build a map showing how each target might be reached let rec accumulateTipsOfDecisionTree accBinds tree = match tree with - | TDSwitch (_,edges,dflt,_) -> + | TDSwitch (_, edges, dflt, _) -> assert (isNil accBinds) // No switches under bindings for edge in edges do accumulateTipsOfDecisionTree accBinds edge.CaseTree match dflt with | None -> () | Some tree -> accumulateTipsOfDecisionTree accBinds tree - | TDSuccess (es,i) -> - branchesToTargets.[i] <- (List.rev accBinds,es) :: branchesToTargets.[i] - | TDBind (bind,rest) -> + | TDSuccess (es, i) -> + branchesToTargets.[i] <- (List.rev accBinds, es) :: branchesToTargets.[i] + | TDBind (bind, rest) -> accumulateTipsOfDecisionTree (bind::accBinds) rest // Compute the targets that can only be reached one way @@ -5437,7 +5441,7 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = if not hasLinearTgtIdx then - tree,targets + tree, targets else @@ -5446,43 +5450,43 @@ let foldLinearBindingTargetsOfMatch tree (targets: _[]) = // Check if this is a bind-then-success tree match targetOfSuccessDecisionTree tree with - | Some i when isLinearTgtIdx i -> TDSuccess([],i) + | Some i when isLinearTgtIdx i -> TDSuccess([], i) | _ -> match tree with - | TDSwitch (e,edges,dflt,m) -> TDSwitch (e,List.map rebuildDecisionTreeEdge edges,Option.map rebuildDecisionTree dflt,m) + | TDSwitch (e, edges, dflt, m) -> TDSwitch (e, List.map rebuildDecisionTreeEdge edges, Option.map rebuildDecisionTree dflt, m) | TDSuccess _ -> tree | TDBind _ -> tree - and rebuildDecisionTreeEdge (TCase(x,t)) = - TCase(x,rebuildDecisionTree t) + and rebuildDecisionTreeEdge (TCase(x, t)) = + TCase(x, rebuildDecisionTree t) let tree' = rebuildDecisionTree tree /// rebuild the targets , replacing linear targets by ones that include all the 'let' bindings from the source let targets' = - targets |> Array.mapi (fun i (TTarget(vs,exprTarget,spTarget) as tg) -> + targets |> Array.mapi (fun i (TTarget(vs, exprTarget, spTarget) as tg) -> if isLinearTgtIdx i then - let (binds,es) = getLinearTgtIdx i + let (binds, es) = getLinearTgtIdx i // The value bindings are moved to become part of the target. // Hence the expressions in the value bindings can be remarked with the range of the target. let mTarget = exprTarget.Range let es = es |> List.map (remarkExpr mTarget) - TTarget(List.empty,mkLetsBind mTarget binds (mkInvisibleLetsFromBindings mTarget vs es exprTarget),spTarget) + TTarget(List.empty, mkLetsBind mTarget binds (mkInvisibleLetsFromBindings mTarget vs es exprTarget), spTarget) else tg ) - tree',targets' + tree', targets' // Simplify a little as we go, including dead target elimination let rec simplifyTrivialMatch spBind exprm matchm ty tree (targets : _[]) = match tree with - | TDSuccess(es,n) -> + | TDSuccess(es, n) -> if n >= targets.Length then failwith "simplifyTrivialMatch: target out of range"; // REVIEW: should we use _spTarget here? - let (TTarget(vs,rhs,_spTarget)) = targets.[n] + let (TTarget(vs, rhs, _spTarget)) = targets.[n] if vs.Length <> es.Length then failwith ("simplifyTrivialMatch: invalid argument, n = "^string n^", List.length targets = "^string targets.Length); mkInvisibleLetsFromBindings rhs.Range vs es rhs | _ -> - primMkMatch (spBind,exprm,tree,targets,matchm,ty) + primMkMatch (spBind, exprm, tree, targets, matchm, ty) // Simplify a little as we go, including dead target elimination let mkAndSimplifyMatch spBind exprm matchm ty tree targets = @@ -5491,8 +5495,8 @@ let mkAndSimplifyMatch spBind exprm matchm ty tree targets = | TDSuccess _ -> simplifyTrivialMatch spBind exprm matchm ty tree targets | _ -> - let tree,targets = eliminateDeadTargetsFromMatch tree targets - let tree,targets = foldLinearBindingTargetsOfMatch tree targets + let tree, targets = eliminateDeadTargetsFromMatch tree targets + let tree, targets = foldLinearBindingTargetsOfMatch tree targets simplifyTrivialMatch spBind exprm matchm ty tree targets @@ -5562,43 +5566,43 @@ let CanTakeAddressOfUnionFieldRef (g:TcGlobals) (uref: UnionCaseRef) mut tinst c let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = - if not mustTakeAddress then None,e else + if not mustTakeAddress then None, e else match e with // LVALUE: "x" where "x" is byref - | Expr.Op (TOp.LValueOp (LByrefGet, v), _,[], m) -> + | Expr.Op (TOp.LValueOp (LByrefGet, v), _, [], m) -> None, exprForValRef m v // LVALUE: "x" where "x" is mutable local, mutable intra-assembly module/static binding, or operation doesn't mutate // Note: we can always take the address of mutable values - | Expr.Val(v, _,m) when MustTakeAddressOfVal g v || CanTakeAddressOfImmutableVal g v mut -> + | Expr.Val(v, _, m) when MustTakeAddressOfVal g v || CanTakeAddressOfImmutableVal g v mut -> None, mkValAddr m v // LVALUE: "x" where "e.x" is record field. - | Expr.Op (TOp.ValFieldGet rfref, tinst,[e],m) when MustTakeAddressOfRecdFieldRef rfref || CanTakeAddressOfRecdFieldRef g rfref mut tinst -> + | Expr.Op (TOp.ValFieldGet rfref, tinst, [e], m) when MustTakeAddressOfRecdFieldRef rfref || CanTakeAddressOfRecdFieldRef g rfref mut tinst -> let exprty = tyOfExpr g e - let wrap,expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m - wrap, mkRecdFieldGetAddrViaExprAddr(expra,rfref,tinst,m) + let wrap, expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m + wrap, mkRecdFieldGetAddrViaExprAddr(expra, rfref, tinst, m) // LVALUE: "x" where "e.x" is union field - | Expr.Op (TOp.UnionCaseFieldGet (uref,cidx), tinst,[e],m) when MustTakeAddressOfRecdField (uref.FieldByIndex(cidx)) || CanTakeAddressOfUnionFieldRef g uref mut tinst cidx -> + | Expr.Op (TOp.UnionCaseFieldGet (uref, cidx), tinst, [e], m) when MustTakeAddressOfRecdField (uref.FieldByIndex(cidx)) || CanTakeAddressOfUnionFieldRef g uref mut tinst cidx -> let exprty = tyOfExpr g e - let wrap,expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m - wrap, mkUnionCaseFieldGetAddrProvenViaExprAddr(expra,uref,tinst,cidx,m) + let wrap, expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m + wrap, mkUnionCaseFieldGetAddrProvenViaExprAddr(expra, uref, tinst, cidx, m) // LVALUE: "x" where "e.x" is a .NET static field. - | Expr.Op (TOp.ILAsm ([IL.I_ldsfld(_vol,fspec)],[ty2]), tinst,[],m) -> - None,Expr.Op (TOp.ILAsm ([IL.I_ldsflda(fspec)],[mkByrefTy g ty2]), tinst,[],m) + | Expr.Op (TOp.ILAsm ([IL.I_ldsfld(_vol, fspec)], [ty2]), tinst, [], m) -> + None, Expr.Op (TOp.ILAsm ([IL.I_ldsflda(fspec)], [mkByrefTy g ty2]), tinst, [], m) // LVALUE: "x" where "e.x" is a .NET instance field. "e" may be an lvalue - | Expr.Op (TOp.ILAsm ([IL.I_ldfld(_align,_vol,fspec)],[ty2]), tinst,[e],m) + | Expr.Op (TOp.ILAsm ([IL.I_ldfld(_align, _vol, fspec)], [ty2]), tinst, [e], m) -> let exprty = tyOfExpr g e - let wrap,expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m - wrap,Expr.Op (TOp.ILAsm ([IL.I_ldflda(fspec)],[mkByrefTy g ty2]), tinst,[expra],m) + let wrap, expra = mkExprAddrOfExprAux g (isStructTy g exprty) false mut e None m + wrap, Expr.Op (TOp.ILAsm ([IL.I_ldflda(fspec)], [mkByrefTy g ty2]), tinst, [expra], m) // LVALUE: "x" where "x" is mutable static field. - | Expr.Op (TOp.ValFieldGet rfref, tinst,[],m) when MustTakeAddressOfRecdFieldRef rfref || CanTakeAddressOfRecdFieldRef g rfref mut tinst -> - None, mkStaticRecdFieldGetAddr(rfref,tinst,m) + | Expr.Op (TOp.ValFieldGet rfref, tinst, [], m) when MustTakeAddressOfRecdFieldRef rfref || CanTakeAddressOfRecdFieldRef g rfref mut tinst -> + None, mkStaticRecdFieldGetAddr(rfref, tinst, m) // LVALUE: "e.[n]" where e is an array of structs - | Expr.App(Expr.Val(vf,_,_),_,[elemTy],[aexpr;nexpr],_) + | Expr.App(Expr.Val(vf, _, _), _, [elemTy], [aexpr;nexpr], _) when (valRefEq g vf g.array_get_vref) -> let shape = ILArrayShape.SingleDimensional @@ -5607,10 +5611,10 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress match addrExprVal with | Some(vf) -> valRefEq g vf g.addrof2_vref | _ -> false - None, mkArrayElemAddress g (readonly,isNativePtr,shape,elemTy,aexpr,nexpr,m) + None, mkArrayElemAddress g (readonly, isNativePtr, shape, elemTy, aexpr, nexpr, m) - // LVALUE: "e.[n1,n2]", "e.[n1,n2,n3]", "e.[n1,n2,n3,n4]" where e is an array of structs - | Expr.App(Expr.Val(vf,_,_),_,[elemTy],(aexpr::args),_) + // LVALUE: "e.[n1, n2]", "e.[n1, n2, n3]", "e.[n1, n2, n3, n4]" where e is an array of structs + | Expr.App(Expr.Val(vf, _, _), _, [elemTy], (aexpr::args), _) when (valRefEq g vf g.array2D_get_vref || valRefEq g vf g.array3D_get_vref || valRefEq g vf g.array4D_get_vref) -> let shape = ILArrayShape.FromRank args.Length @@ -5620,16 +5624,16 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress | Some(vf) -> valRefEq g vf g.addrof2_vref | _ -> false - None, Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly,isNativePtr,shape,mkILTyvarTy 0us)],[mkByrefTy g elemTy]), [elemTy],(aexpr::args),m) + None, Expr.Op (TOp.ILAsm ([IL.I_ldelema(readonly, isNativePtr, shape, mkILTyvarTy 0us)], [mkByrefTy g elemTy]), [elemTy], (aexpr::args), m) // Give a nice error message for DefinitelyMutates on immutable values, or mutable values in other assemblies - | Expr.Val(v, _,m) when mut = DefinitelyMutates + | Expr.Val(v, _, m) when mut = DefinitelyMutates -> - if isByrefTy g v.Type then error(Error(FSComp.SR.tastUnexpectedByRef(),m)); + if isByrefTy g v.Type then error(Error(FSComp.SR.tastUnexpectedByRef(), m)); if v.IsMutable then - error(Error(FSComp.SR.tastInvalidAddressOfMutableAcrossAssemblyBoundary(),m)); + error(Error(FSComp.SR.tastInvalidAddressOfMutableAcrossAssemblyBoundary(), m)); else - error(Error(FSComp.SR.tastValueMustBeLocalAndMutable(),m)); + error(Error(FSComp.SR.tastValueMustBeLocalAndMutable(), m)); | _ -> let ty = tyOfExpr g e @@ -5637,37 +5641,37 @@ let rec mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress match mut with | NeverMutates -> () | DefinitelyMutates -> - errorR(Error(FSComp.SR.tastInvalidMutationOfConstant(),m)); + errorR(Error(FSComp.SR.tastInvalidMutationOfConstant(), m)); | PossiblyMutates -> - warning(DefensiveCopyWarning(FSComp.SR.tastValueHasBeenCopied(),m)); - let tmp,_ = + warning(DefensiveCopyWarning(FSComp.SR.tastValueHasBeenCopied(), m)); + let tmp, _ = match mut with | NeverMutates -> mkCompGenLocal m "copyOfStruct" ty | _ -> mkMutableCompGenLocal m "copyOfStruct" ty - Some (tmp,e), (mkValAddr m (mkLocalValRef tmp)) + Some (tmp, e), (mkValAddr m (mkLocalValRef tmp)) let mkExprAddrOfExpr g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m = let optBind, addre = mkExprAddrOfExprAux g mustTakeAddress useReadonlyForGenericArrayAddress mut e addrExprVal m match optBind with | None -> (fun x -> x), addre - | Some (tmp,rval) -> (fun x -> mkCompGenLet m tmp rval x), addre + | Some (tmp, rval) -> (fun x -> mkCompGenLet m tmp rval x), addre -let mkTupleFieldGet g (tupInfo,e,tinst,i,m) = - let wrap,e' = mkExprAddrOfExpr g (evalTupInfoIsStruct tupInfo) false NeverMutates e None m - wrap (mkTupleFieldGetViaExprAddr(tupInfo,e',tinst,i,m)) +let mkTupleFieldGet g (tupInfo, e, tinst, i, m) = + let wrap, e' = mkExprAddrOfExpr g (evalTupInfoIsStruct tupInfo) false NeverMutates e None m + wrap (mkTupleFieldGetViaExprAddr(tupInfo, e', tinst, i, m)) -let mkRecdFieldGet g (e,fref:RecdFieldRef,tinst,m) = +let mkRecdFieldGet g (e, fref:RecdFieldRef, tinst, m) = assert (not (isByrefTy g (tyOfExpr g e))) - let wrap,e' = mkExprAddrOfExpr g fref.Tycon.IsStructOrEnumTycon false NeverMutates e None m - wrap (mkRecdFieldGetViaExprAddr(e',fref,tinst,m)) + let wrap, e' = mkExprAddrOfExpr g fref.Tycon.IsStructOrEnumTycon false NeverMutates e None m + wrap (mkRecdFieldGetViaExprAddr(e', fref, tinst, m)) -let mkUnionCaseFieldGetUnproven g (e,cref:UnionCaseRef,tinst,j,m) = +let mkUnionCaseFieldGetUnproven g (e, cref:UnionCaseRef, tinst, j, m) = assert (not (isByrefTy g (tyOfExpr g e))) - let wrap,e' = mkExprAddrOfExpr g cref.Tycon.IsStructOrEnumTycon false NeverMutates e None m - wrap (mkUnionCaseFieldGetUnprovenViaExprAddr (e',cref,tinst,j,m)) + let wrap, e' = mkExprAddrOfExpr g cref.Tycon.IsStructOrEnumTycon false NeverMutates e None m + wrap (mkUnionCaseFieldGetUnprovenViaExprAddr (e', cref, tinst, j, m)) -let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty],args,m) +let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty], args, m) //--------------------------------------------------------------------------- // Compute fixups for letrec's. @@ -5689,40 +5693,40 @@ let mkArray (argty, args, m) = Expr.Op(TOp.Array, [argty],args,m) // somehow appears twice on the right. //--------------------------------------------------------------------------- -let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr),set) exprToFix = +let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr), set) exprToFix = let exprToFix = stripExpr exprToFix match exprToFix with | Expr.Const _ -> () - | Expr.Op (TOp.Tuple tupInfo,argtys,args,m) when not (evalTupInfoIsStruct tupInfo) -> + | Expr.Op (TOp.Tuple tupInfo, argtys, args, m) when not (evalTupInfoIsStruct tupInfo) -> args |> List.iteri (fun n -> IterateRecursiveFixups g None rvs - (mkTupleFieldGet g (tupInfo,access,argtys,n,m), + (mkTupleFieldGet g (tupInfo, access, argtys, n, m), (fun e -> // NICE: it would be better to do this check in the type checker - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeInConstructionOfTuple(),m)); + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeInConstructionOfTuple(), m)); e))) - | Expr.Op (TOp.UnionCase (c),tinst,args,m) -> + | Expr.Op (TOp.UnionCase (c), tinst, args, m) -> args |> List.iteri (fun n -> IterateRecursiveFixups g None rvs - (mkUnionCaseFieldGetUnprovenViaExprAddr (access,c,tinst,n,m), + (mkUnionCaseFieldGetUnprovenViaExprAddr (access, c, tinst, n, m), (fun e -> // NICE: it would be better to do this check in the type checker let tcref = c.TyconRef if not (c.FieldByIndex(n)).IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName),m)); - mkUnionCaseFieldSet (access,c,tinst,n,e,m)))) + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotAppearInConstructionOfType(tcref.LogicalName), m)); + mkUnionCaseFieldSet (access, c, tinst, n, e, m)))) - | Expr.Op (TOp.Recd (_,tcref),tinst,args,m) -> + | Expr.Op (TOp.Recd (_, tcref), tinst, args, m) -> (tcref.TrueInstanceFieldsAsRefList, args) ||> List.iter2 (fun fref arg -> let fspec = fref.RecdField IterateRecursiveFixups g None rvs - (mkRecdFieldGetViaExprAddr(access,fref,tinst,m), + (mkRecdFieldGetViaExprAddr(access, fref, tinst, m), (fun e -> // NICE: it would be better to do this check in the type checker if not fspec.IsMutable && not (entityRefInThisAssembly g.compilingFslib tcref) then - errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeAssignedToNonMutableField(fspec.rfield_id.idText, tcref.LogicalName),m)); - mkRecdFieldSetViaExprAddr (access,fref,tinst,e,m))) arg ) + errorR(Error(FSComp.SR.tastRecursiveValuesMayNotBeAssignedToNonMutableField(fspec.rfield_id.idText, tcref.LogicalName), m)); + mkRecdFieldSetViaExprAddr (access, fref, tinst, e, m))) arg ) | Expr.Val _ | Expr.Lambda _ | Expr.Obj _ @@ -5739,9 +5743,9 @@ let rec IterateRecursiveFixups g (selfv : Val option) rvs ((access : Expr),set) //-------------------------------------------------------------------------- let JoinTyparStaticReq r1 r2 = - match r1,r2 with - | NoStaticReq,r | r,NoStaticReq -> r - | HeadTypeStaticReq,r | r,HeadTypeStaticReq -> r + match r1, r2 with + | NoStaticReq, r | r, NoStaticReq -> r + | HeadTypeStaticReq, r | r, HeadTypeStaticReq -> r @@ -5788,44 +5792,44 @@ type ExprFolders<'State> (folders : _ ExprFolder) = match x with | Expr.Const _ -> z | Expr.Val _ -> z - | Expr.Op (_c,_tyargs,args,_) -> exprsF z args - | Expr.Sequential (x0,x1,_dir,_,_) -> exprsF z [x0;x1] - | Expr.Lambda(_lambdaId ,_ctorThisValOpt,_baseValOpt,_argvs,body,_m,_rty) -> exprF z body - | Expr.TyLambda(_lambdaId,_argtyvs,body,_m,_rty) -> exprF z body - | Expr.TyChoose(_,body,_) -> exprF z body + | Expr.Op (_c, _tyargs, args, _) -> exprsF z args + | Expr.Sequential (x0, x1, _dir, _, _) -> exprsF z [x0;x1] + | Expr.Lambda(_lambdaId , _ctorThisValOpt, _baseValOpt, _argvs, body, _m, _rty) -> exprF z body + | Expr.TyLambda(_lambdaId, _argtyvs, body, _m, _rty) -> exprF z body + | Expr.TyChoose(_, body, _) -> exprF z body - | Expr.App (f,_fty,_tys,argtys,_) -> + | Expr.App (f, _fty, _tys, argtys, _) -> let z = exprF z f let z = exprsF z argtys z - | Expr.LetRec (binds,body,_,_) -> + | Expr.LetRec (binds, body, _, _) -> let z = valBindsF false z binds let z = exprF z body z - | Expr.Let (bind,body,_,_) -> + | Expr.Let (bind, body, _, _) -> let z = valBindF false z bind let z = exprF z body z | Expr.Link rX -> exprF z (!rX) - | Expr.Match (_spBind,_exprm,dtree,targets,_m,_ty) -> + | Expr.Match (_spBind, _exprm, dtree, targets, _m, _ty) -> let z = dtreeF z dtree let z = Array.fold targetF z targets z - | Expr.Quote(e,{contents=Some(_typeDefs,_argTypes,argExprs,_)},_,_,_) -> + | Expr.Quote(e, {contents=Some(_typeDefs, _argTypes, argExprs, _)}, _, _, _) -> let z = exprF z e exprsF z argExprs - | Expr.Quote(e,{contents=None},_,_m,_) -> + | Expr.Quote(e, {contents=None}, _, _m, _) -> exprF z e - | Expr.Obj (_n,_typ,_basev,basecall,overrides,iimpls,_m) -> + | Expr.Obj (_n, _typ, _basev, basecall, overrides, iimpls, _m) -> let z = exprF z basecall let z = List.fold tmethodF z overrides let z = List.fold (foldOn snd (List.fold tmethodF)) z iimpls z - | Expr.StaticOptimization (_tcs,csx,x,_) -> exprsF z [csx;x] + | Expr.StaticOptimization (_tcs, csx, x, _) -> exprsF z [csx;x] and valBindF dtree z bind = let z = folders.nonRecBindingsIntercept z bind @@ -5836,51 +5840,51 @@ type ExprFolders<'State> (folders : _ ExprFolder) = List.fold (bindF dtree) z binds and bindF dtree z (bind:Binding) = - let z = folders.valBindingSiteIntercept z (dtree,bind.Var) + let z = folders.valBindingSiteIntercept z (dtree, bind.Var) exprF z bind.Expr and dtreeF z dtree = let z = folders.dtreeIntercept z dtree match dtree with - | TDBind (bind,rest) -> + | TDBind (bind, rest) -> let z = valBindF true z bind dtreeF z rest - | TDSuccess (args,_) -> exprsF z args - | TDSwitch (test,dcases,dflt,_) -> + | TDSuccess (args, _) -> exprsF z args + | TDSwitch (test, dcases, dflt, _) -> let z = exprF z test let z = List.fold dcaseF z dcases let z = Option.fold dtreeF z dflt z and dcaseF z = function - TCase (_,dtree) -> dtreeF z dtree (* not collecting from test *) + TCase (_, dtree) -> dtreeF z dtree (* not collecting from test *) and targetF z x = match folders.targetIntercept exprFClosure z x with | Some z -> z // intercepted | None -> // structurally recurse - let (TTarget (_,body,_)) = x + let (TTarget (_, body, _)) = x exprF z body and tmethodF z x = match folders.tmethodIntercept exprFClosure z x with | Some z -> z // intercepted | None -> // structurally recurse - let (TObjExprMethod(_,_,_,_,e,_)) = x + let (TObjExprMethod(_, _, _, _, e, _)) = x exprF z e and mexprF z x = match x with - | ModuleOrNamespaceExprWithSig(_,def,_) -> mdefF z def + | ModuleOrNamespaceExprWithSig(_, def, _) -> mdefF z def and mdefF z x = match x with - | TMDefRec(_,_,mbinds,_) -> + | TMDefRec(_, _, mbinds, _) -> (* REVIEW: also iterate the abstract slot vspecs hidden in the _vslots field in the tycons *) let z = List.fold mbindF z mbinds z - | TMDefLet(bind,_) -> valBindF false z bind - | TMDefDo(e,_) -> exprF z e + | TMDefLet(bind, _) -> valBindF false z bind + | TMDefDo(e, _) -> exprF z e | TMDefs defs -> List.fold mdefF z defs | TMAbstract x -> mexprF z x @@ -5914,21 +5918,21 @@ let ExprStats x = // //------------------------------------------------------------------------- -let mkString (g:TcGlobals) m n = Expr.Const(Const.String n,m,g.string_ty) -let mkBool (g:TcGlobals) m b = Expr.Const(Const.Bool b,m,g.bool_ty) -let mkByte (g:TcGlobals) m b = Expr.Const(Const.Byte b,m,g.byte_ty) -let mkUInt16 (g:TcGlobals) m b = Expr.Const(Const.UInt16 b,m,g.uint16_ty) +let mkString (g:TcGlobals) m n = Expr.Const(Const.String n, m, g.string_ty) +let mkBool (g:TcGlobals) m b = Expr.Const(Const.Bool b, m, g.bool_ty) +let mkByte (g:TcGlobals) m b = Expr.Const(Const.Byte b, m, g.byte_ty) +let mkUInt16 (g:TcGlobals) m b = Expr.Const(Const.UInt16 b, m, g.uint16_ty) let mkTrue g m = mkBool g m true let mkFalse g m = mkBool g m false -let mkUnit (g:TcGlobals) m = Expr.Const(Const.Unit,m,g.unit_ty) -let mkInt32 (g:TcGlobals) m n = Expr.Const(Const.Int32 n,m,g.int32_ty) +let mkUnit (g:TcGlobals) m = Expr.Const(Const.Unit, m, g.unit_ty) +let mkInt32 (g:TcGlobals) m n = Expr.Const(Const.Int32 n, m, g.int32_ty) let mkInt g m n = mkInt32 g m (n) let mkZero g m = mkInt g m 0 let mkOne g m = mkInt g m 1 let mkTwo g m = mkInt g m 2 let mkMinusOne g m = mkInt g m (-1) -let destInt32 = function Expr.Const(Const.Int32 n,_,_) -> Some n | _ -> None +let destInt32 = function Expr.Const(Const.Int32 n, _, _) -> Some n | _ -> None let isIDelegateEventType g ty = isAppTy g ty && tyconRefEq g g.fslib_IDelegateEvent_tcr (tcrefOfAppTy g ty) let destIDelegateEventType g ty = @@ -5943,7 +5947,7 @@ let mkIObserverType (g:TcGlobals) ty1 = TType_app (g.tcref_IObserver, [ty1]) let mkRefCellContentsRef (g:TcGlobals) = mkRecdFieldRef g.refcell_tcr_canon "contents" -let mkSequential spSeq m e1 e2 = Expr.Sequential(e1,e2,NormalSeq,spSeq,m) +let mkSequential spSeq m e1 e2 = Expr.Sequential(e1, e2, NormalSeq, spSeq, m) let mkCompGenSequential m e1 e2 = mkSequential SuppressSequencePointOnExprOfSequential m e1 e2 let rec mkSequentials spSeq g m es = match es with @@ -5951,7 +5955,7 @@ let rec mkSequentials spSeq g m es = | e::es -> mkSequential spSeq m e (mkSequentials spSeq g m es) | [] -> mkUnit g m -let mkGetArg0 m ty = mkAsmExpr( [ mkLdarg0 ],[],[],[ty],m) +let mkGetArg0 m ty = mkAsmExpr( [ mkLdarg0 ], [], [], [ty], m) //------------------------------------------------------------------------- // Tuples... @@ -5961,7 +5965,7 @@ let mkAnyTupled g m tupInfo es tys = match es with | [] -> mkUnit g m | [e] -> e - | _ -> Expr.Op (TOp.Tuple tupInfo,tys,es,m) + | _ -> Expr.Op (TOp.Tuple tupInfo, tys, es, m) let mkRefTupled g m es tys = mkAnyTupled g m tupInfoRef es tys @@ -6006,13 +6010,13 @@ let liftAllBefore sigma = /// Put record field assignments in order. // let permuteExprList (sigma:int[]) (exprs: Expr list) (typ: TType list) (names:string list) = - let typ,names = (Array.ofList typ, Array.ofList names) + let typ, names = (Array.ofList typ, Array.ofList names) let liftLim = liftAllBefore sigma let rewrite rbinds (i, expri:Expr) = if i < liftLim then - let tmpvi,tmpei = mkCompGenLocal expri.Range names.[i] typ.[i] + let tmpvi, tmpei = mkCompGenLocal expri.Range names.[i] typ.[i] let bindi = mkCompGenBind tmpvi expri tmpei, bindi :: rbinds else @@ -6021,7 +6025,7 @@ let permuteExprList (sigma:int[]) (exprs: Expr list) (typ: TType list) (names:st let newExprs, reversedBinds = List.mapFold rewrite [] (exprs |> List.indexed) let binds = List.rev reversedBinds let reorderedExprs = permute sigma (Array.ofList newExprs) - binds,Array.toList reorderedExprs + binds, Array.toList reorderedExprs //------------------------------------------------------------------------- // Build record expressions... @@ -6033,37 +6037,37 @@ let permuteExprList (sigma:int[]) (exprs: Expr list) (typ: TType list) (names:st /// let sigma = Array.map #Index () /// However the presence of static fields means .Index may index into a non-compact set of instance field indexes. /// We still need to sort by index. -let mkRecordExpr g (lnk,tcref,tinst,rfrefs:RecdFieldRef list,args,m) = +let mkRecordExpr g (lnk, tcref, tinst, rfrefs:RecdFieldRef list, args, m) = // Remove any abbreviations - let tcref,tinst = destAppTy g (mkAppTy tcref tinst) + let tcref, tinst = destAppTy g (mkAppTy tcref tinst) let rfrefsArray = rfrefs |> List.indexed |> Array.ofList - rfrefsArray |> Array.sortInPlaceBy (fun (_,r) -> r.Index) + rfrefsArray |> Array.sortInPlaceBy (fun (_, r) -> r.Index) let sigma = Array.create rfrefsArray.Length -1 - Array.iteri (fun j (i,_) -> - if sigma.[i] <> -1 then error(InternalError("bad permutation",m)) + Array.iteri (fun j (i, _) -> + if sigma.[i] <> -1 then error(InternalError("bad permutation", m)) sigma.[i] <- j) rfrefsArray let argTyps = List.map (fun rfref -> actualTyOfRecdFieldRef rfref tinst) rfrefs let names = rfrefs |> List.map (fun rfref -> rfref.FieldName) - let binds,args = permuteExprList sigma args argTyps names - mkLetsBind m binds (Expr.Op (TOp.Recd(lnk,tcref),tinst,args,m)) + let binds, args = permuteExprList sigma args argTyps names + mkLetsBind m binds (Expr.Op (TOp.Recd(lnk, tcref), tinst, args, m)) //------------------------------------------------------------------------- // List builders //------------------------------------------------------------------------- -let mkRefCell g m ty e = mkRecordExpr g (RecdExpr,g.refcell_tcr_canon,[ty],[mkRefCellContentsRef g],[e],m) -let mkRefCellGet g m ty e = mkRecdFieldGetViaExprAddr (e,mkRefCellContentsRef g,[ty],m) -let mkRefCellSet g m ty e1 e2 = mkRecdFieldSetViaExprAddr (e1,mkRefCellContentsRef g,[ty],e2,m) +let mkRefCell g m ty e = mkRecordExpr g (RecdExpr, g.refcell_tcr_canon, [ty], [mkRefCellContentsRef g], [e], m) +let mkRefCellGet g m ty e = mkRecdFieldGetViaExprAddr (e, mkRefCellContentsRef g, [ty], m) +let mkRefCellSet g m ty e1 e2 = mkRecdFieldSetViaExprAddr (e1, mkRefCellContentsRef g, [ty], e2, m) -let mkNil (g:TcGlobals) m ty = mkUnionCaseExpr (g.nil_ucref,[ty],[],m) -let mkCons (g:TcGlobals) ty h t = mkUnionCaseExpr (g.cons_ucref,[ty],[h;t],unionRanges h.Range t.Range) +let mkNil (g:TcGlobals) m ty = mkUnionCaseExpr (g.nil_ucref, [ty], [], m) +let mkCons (g:TcGlobals) ty h t = mkUnionCaseExpr (g.cons_ucref, [ty], [h;t], unionRanges h.Range t.Range) let mkCompGenLocalAndInvisbleBind g nm m e = - let locv,loce = mkCompGenLocal m nm (tyOfExpr g e) - locv,loce,mkInvisibleBind locv e + let locv, loce = mkCompGenLocal m nm (tyOfExpr g e) + locv, loce, mkInvisibleBind locv e //---------------------------------------------------------------------------- // Make some fragments of code @@ -6072,61 +6076,61 @@ let mkCompGenLocalAndInvisbleBind g nm m e = let box = IL.I_box (mkILTyvarTy 0us) let isinst = IL.I_isinst (mkILTyvarTy 0us) let unbox = IL.I_unbox_any (mkILTyvarTy 0us) -let mkUnbox ty e m = mkAsmExpr ([ unbox ], [ty],[e], [ ty ], m) -let mkBox ty e m = mkAsmExpr ([box],[],[e],[ty],m) -let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty],[e], [ ty ], m) +let mkUnbox ty e m = mkAsmExpr ([ unbox ], [ty], [e], [ ty ], m) +let mkBox ty e m = mkAsmExpr ([box], [], [e], [ty], m) +let mkIsInst ty e m = mkAsmExpr ([ isinst ], [ty], [e], [ ty ], m) -let mspec_Type_GetTypeFromHandle (g: TcGlobals) = IL.mkILNonGenericStaticMethSpecInTy(g.ilg.typ_Type,"GetTypeFromHandle",[g.iltyp_RuntimeTypeHandle],g.ilg.typ_Type) +let mspec_Type_GetTypeFromHandle (g: TcGlobals) = IL.mkILNonGenericStaticMethSpecInTy(g.ilg.typ_Type, "GetTypeFromHandle", [g.iltyp_RuntimeTypeHandle], g.ilg.typ_Type) let mspec_String_Length (g: TcGlobals) = mkILNonGenericInstanceMethSpecInTy (g.ilg.typ_String, "get_Length", [], g.ilg.typ_Int32) let fspec_Missing_Value (g: TcGlobals) = IL.mkILFieldSpecInTy(g.iltyp_Missing, "Value", g.iltyp_Missing) let mkInitializeArrayMethSpec (g: TcGlobals) = - mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(g.FindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"),"InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) + mkILNonGenericStaticMethSpecInTy(mkILNonGenericBoxedTy(g.FindSysILTypeRef "System.Runtime.CompilerServices.RuntimeHelpers"), "InitializeArray", [g.ilg.typ_Array;g.iltyp_RuntimeFieldHandle], ILType.Void) let mkInvalidCastExnNewobj (g: TcGlobals) = mkNormalNewobj (mkILCtorMethSpecForTy (mkILNonGenericBoxedTy (g.FindSysILTypeRef "System.InvalidCastException"), [])) -let typedExprForIntrinsic _g m (IntrinsicValRef(_,_,_,ty,_) as i) = +let typedExprForIntrinsic _g m (IntrinsicValRef(_, _, _, ty, _) as i) = let vref = ValRefForIntrinsic i - exprForValRef m vref,ty + exprForValRef m vref, ty let mkCallGetGenericComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_comparer_info |> fst let mkCallGetGenericEREqualityComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_er_equality_comparer_info |> fst let mkCallGetGenericPEREqualityComparer (g:TcGlobals) m = typedExprForIntrinsic g m g.get_generic_per_equality_comparer_info |> fst -let mkCallUnbox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_info, [[ty]], [ e1 ], m) -let mkCallUnboxFast (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_fast_info, [[ty]], [ e1 ], m) -let mkCallTypeTest (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.istype_info, [[ty]], [ e1 ], m) -let mkCallTypeOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typeof_info, [[ty]], [ ], m) -let mkCallTypeDefOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typedefof_info, [[ty]], [ ], m) +let mkCallUnbox (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_info, [[ty]], [ e1 ], m) +let mkCallUnboxFast (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.unbox_fast_info, [[ty]], [ e1 ], m) +let mkCallTypeTest (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.istype_info, [[ty]], [ e1 ], m) +let mkCallTypeOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typeof_info, [[ty]], [ ], m) +let mkCallTypeDefOf (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.typedefof_info, [[ty]], [ ], m) -let mkCallDispose (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.dispose_info, [[ty]], [ e1 ], m) -let mkCallSeq (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.seq_info, [[ty]], [ e1 ], m) -let mkCallCreateInstance (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.create_instance_info, [[ty]], [ mkUnit g m ], m) +let mkCallDispose (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.dispose_info, [[ty]], [ e1 ], m) +let mkCallSeq (g:TcGlobals) m ty e1 = mkApps g (typedExprForIntrinsic g m g.seq_info, [[ty]], [ e1 ], m) +let mkCallCreateInstance (g:TcGlobals) m ty = mkApps g (typedExprForIntrinsic g m g.create_instance_info, [[ty]], [ mkUnit g m ], m) -let mkCallGetQuerySourceAsEnumerable (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.query_source_as_enum_info, [[ty1;ty2]], [ e1; mkUnit g m ], m) -let mkCallNewQuerySource (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.new_query_source_info, [[ty1;ty2]], [ e1 ], m) +let mkCallGetQuerySourceAsEnumerable (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.query_source_as_enum_info, [[ty1;ty2]], [ e1; mkUnit g m ], m) +let mkCallNewQuerySource (g:TcGlobals) m ty1 ty2 e1 = mkApps g (typedExprForIntrinsic g m g.new_query_source_info, [[ty1;ty2]], [ e1 ], m) -let mkCallCreateEvent (g:TcGlobals) m ty1 ty2 e1 e2 e3 = mkApps g (typedExprForIntrinsic g m g.create_event_info, [[ty1;ty2]], [ e1;e2;e3 ], m) -let mkCallGenericComparisonWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_comparison_withc_outer_info, [[ty]], [ comp;e1;e2 ], m) -let mkCallEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) -let mkCallGenericEqualityEROuter (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_er_outer_info, [[ty]], [ e1;e2 ], m) -let mkCallGenericEqualityWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_withc_outer_info, [[ty]], [comp;e1;e2], m) -let mkCallGenericHashWithComparerOuter (g:TcGlobals) m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) +let mkCallCreateEvent (g:TcGlobals) m ty1 ty2 e1 e2 e3 = mkApps g (typedExprForIntrinsic g m g.create_event_info, [[ty1;ty2]], [ e1;e2;e3 ], m) +let mkCallGenericComparisonWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_comparison_withc_outer_info, [[ty]], [ comp;e1;e2 ], m) +let mkCallEqualsOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.equals_operator_info, [[ty]], [ e1;e2 ], m) +let mkCallGenericEqualityEROuter (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_er_outer_info, [[ty]], [ e1;e2 ], m) +let mkCallGenericEqualityWithComparerOuter (g:TcGlobals) m ty comp e1 e2 = mkApps g (typedExprForIntrinsic g m g.generic_equality_withc_outer_info, [[ty]], [comp;e1;e2], m) +let mkCallGenericHashWithComparerOuter (g:TcGlobals) m ty comp e1 = mkApps g (typedExprForIntrinsic g m g.generic_hash_withc_outer_info, [[ty]], [comp;e1], m) let mkCallSubtractionOperator (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.unchecked_subtraction_info, [[ty; ty; ty]], [e1;e2], m) let mkCallArrayLength (g:TcGlobals) m ty el = mkApps g (typedExprForIntrinsic g m g.array_length_info, [[ty]], [el], m) -let mkCallArrayGet (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; e2 ], m) -let mkCallArray2DGet (g:TcGlobals) m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m) -let mkCallArray3DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m) -let mkCallArray4DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 idx4 = mkApps g (typedExprForIntrinsic g m g.array4D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4 ], m) -let mkCallNewDecimal (g:TcGlobals) m (e1,e2,e3,e4,e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m) +let mkCallArrayGet (g:TcGlobals) m ty e1 e2 = mkApps g (typedExprForIntrinsic g m g.array_get_info, [[ty]], [ e1 ; e2 ], m) +let mkCallArray2DGet (g:TcGlobals) m ty e1 idx1 idx2 = mkApps g (typedExprForIntrinsic g m g.array2D_get_info, [[ty]], [ e1 ; idx1; idx2 ], m) +let mkCallArray3DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 = mkApps g (typedExprForIntrinsic g m g.array3D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3 ], m) +let mkCallArray4DGet (g:TcGlobals) m ty e1 idx1 idx2 idx3 idx4 = mkApps g (typedExprForIntrinsic g m g.array4D_get_info, [[ty]], [ e1 ; idx1; idx2; idx3; idx4 ], m) +let mkCallNewDecimal (g:TcGlobals) m (e1, e2, e3, e4, e5) = mkApps g (typedExprForIntrinsic g m g.new_decimal_info, [], [ e1;e2;e3;e4;e5 ], m) -let mkCallNewFormat (g:TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) -let mkCallRaise (g:TcGlobals) m aty e1 = mkApps g (typedExprForIntrinsic g m g.raise_info, [[aty]], [ e1 ], m) +let mkCallNewFormat (g:TcGlobals) m aty bty cty dty ety e1 = mkApps g (typedExprForIntrinsic g m g.new_format_info, [[aty;bty;cty;dty;ety]], [ e1 ], m) +let mkCallRaise (g:TcGlobals) m aty e1 = mkApps g (typedExprForIntrinsic g m g.raise_info, [[aty]], [ e1 ], m) let TryEliminateDesugaredConstants g m c = match c with @@ -6135,7 +6139,7 @@ let TryEliminateDesugaredConstants g m c = | [| lo;med;hi; signExp |] -> let scale = (min (((signExp &&& 0xFF0000) >>> 16) &&& 0xFF) 28) |> byte let isNegative = (signExp &&& 0x80000000) <> 0 - Some(mkCallNewDecimal g m (mkInt g m lo,mkInt g m med,mkInt g m hi,mkBool g m isNegative,mkByte g m scale) ) + Some(mkCallNewDecimal g m (mkInt g m lo, mkInt g m med, mkInt g m hi, mkBool g m isNegative, mkByte g m scale) ) | _ -> failwith "unreachable" | _ -> None @@ -6145,63 +6149,63 @@ let mkIEnumeratorTy (g:TcGlobals) ty = mkAppTy g.tcref_System_Collections_Generi let mkCallSeqCollect g m alphaTy betaTy arg1 arg2 = let enumty2 = try rangeOfFunTy g (tyOfExpr g arg1) with _ -> (* defensive programming *) (mkSeqTy g betaTy) - mkApps g (typedExprForIntrinsic g m g.seq_collect_info, [[alphaTy;enumty2;betaTy]], [ arg1; arg2 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_collect_info, [[alphaTy;enumty2;betaTy]], [ arg1; arg2 ], m) let mkCallSeqUsing g m resourceTy elemTy arg1 arg2 = // We're instantiating val using : 'a -> ('a -> 'sb) -> seq<'b> when 'sb :> seq<'b> and 'a :> IDisposable // We set 'sb -> range(typeof(arg2)) let enumty = try rangeOfFunTy g (tyOfExpr g arg2) with _ -> (* defensive programming *) (mkSeqTy g elemTy) - mkApps g (typedExprForIntrinsic g m g.seq_using_info, [[resourceTy;enumty;elemTy]], [ arg1; arg2 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_using_info, [[resourceTy;enumty;elemTy]], [ arg1; arg2 ], m) let mkCallSeqDelay g m elemTy arg1 = - mkApps g (typedExprForIntrinsic g m g.seq_delay_info, [[elemTy]], [ arg1 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_delay_info, [[elemTy]], [ arg1 ], m) let mkCallSeqAppend g m elemTy arg1 arg2 = - mkApps g (typedExprForIntrinsic g m g.seq_append_info, [[elemTy]], [ arg1; arg2 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_append_info, [[elemTy]], [ arg1; arg2 ], m) let mkCallSeqGenerated g m elemTy arg1 arg2 = - mkApps g (typedExprForIntrinsic g m g.seq_generated_info, [[elemTy]], [ arg1; arg2 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_generated_info, [[elemTy]], [ arg1; arg2 ], m) let mkCallSeqFinally g m elemTy arg1 arg2 = - mkApps g (typedExprForIntrinsic g m g.seq_finally_info, [[elemTy]], [ arg1; arg2 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_finally_info, [[elemTy]], [ arg1; arg2 ], m) let mkCallSeqOfFunctions g m ty1 ty2 arg1 arg2 arg3 = - mkApps g (typedExprForIntrinsic g m g.seq_of_functions_info, [[ty1;ty2]], [ arg1; arg2; arg3 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_of_functions_info, [[ty1;ty2]], [ arg1; arg2; arg3 ], m) let mkCallSeqToArray g m elemTy arg1 = - mkApps g (typedExprForIntrinsic g m g.seq_to_array_info, [[elemTy]], [ arg1 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_to_array_info, [[elemTy]], [ arg1 ], m) let mkCallSeqToList g m elemTy arg1 = - mkApps g (typedExprForIntrinsic g m g.seq_to_list_info, [[elemTy]], [ arg1 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_to_list_info, [[elemTy]], [ arg1 ], m) let mkCallSeqMap g m inpElemTy genElemTy arg1 arg2 = - mkApps g (typedExprForIntrinsic g m g.seq_map_info, [[inpElemTy;genElemTy]], [ arg1; arg2 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_map_info, [[inpElemTy;genElemTy]], [ arg1; arg2 ], m) let mkCallSeqSingleton g m ty1 arg1 = - mkApps g (typedExprForIntrinsic g m g.seq_singleton_info, [[ty1]], [ arg1 ], m) + mkApps g (typedExprForIntrinsic g m g.seq_singleton_info, [[ty1]], [ arg1 ], m) let mkCallSeqEmpty g m ty1 = - mkApps g (typedExprForIntrinsic g m g.seq_empty_info, [[ty1]], [ ], m) + mkApps g (typedExprForIntrinsic g m g.seq_empty_info, [[ty1]], [ ], m) let mkCallDeserializeQuotationFSharp20Plus g m e1 e2 e3 e4 = let args = [ e1; e2; e3; e4 ] - mkApps g (typedExprForIntrinsic g m g.deserialize_quoted_FSharp_20_plus_info, [], [ mkRefTupledNoTypes g m args ], m) + mkApps g (typedExprForIntrinsic g m g.deserialize_quoted_FSharp_20_plus_info, [], [ mkRefTupledNoTypes g m args ], m) let mkCallDeserializeQuotationFSharp40Plus g m e1 e2 e3 e4 e5 = let args = [ e1; e2; e3; e4; e5 ] - mkApps g (typedExprForIntrinsic g m g.deserialize_quoted_FSharp_40_plus_info, [], [ mkRefTupledNoTypes g m args ], m) + mkApps g (typedExprForIntrinsic g m g.deserialize_quoted_FSharp_40_plus_info, [], [ mkRefTupledNoTypes g m args ], m) let mkCallCastQuotation g m ty e1 = - mkApps g (typedExprForIntrinsic g m g.cast_quotation_info, [[ty]], [ e1 ], m) + mkApps g (typedExprForIntrinsic g m g.cast_quotation_info, [[ty]], [ e1 ], m) let mkCallLiftValueWithName (g:TcGlobals) m ty nm e1 = let vref = ValRefForIntrinsic g.lift_value_with_name_info // Use "Expr.ValueWithName" if it exists in FSharp.Core match vref.TryDeref with | VSome _ -> - mkApps g (typedExprForIntrinsic g m g.lift_value_with_name_info , [[ty]], [mkRefTupledNoTypes g m [e1; mkString g m nm]], m) + mkApps g (typedExprForIntrinsic g m g.lift_value_with_name_info , [[ty]], [mkRefTupledNoTypes g m [e1; mkString g m nm]], m) | VNone -> - mkApps g (typedExprForIntrinsic g m g.lift_value_info , [[ty]], [e1], m) + mkApps g (typedExprForIntrinsic g m g.lift_value_info , [[ty]], [e1], m) let mkCallLiftValueWithDefn g m qty e1 = assert isQuotedExprTy g qty @@ -6212,31 +6216,31 @@ let mkCallLiftValueWithDefn g m qty e1 = | VSome _ -> let copyOfExpr = copyExpr g ValCopyFlag.CloneAll e1 let quoteOfCopyOfExpr = Expr.Quote(copyOfExpr, ref None, false, m, qty) - mkApps g (typedExprForIntrinsic g m g.lift_value_with_defn_info , [[ty]], [mkRefTupledNoTypes g m [e1; quoteOfCopyOfExpr]], m) + mkApps g (typedExprForIntrinsic g m g.lift_value_with_defn_info , [[ty]], [mkRefTupledNoTypes g m [e1; quoteOfCopyOfExpr]], m) | VNone -> Expr.Quote(e1, ref None, false, m, qty) let mkCallCheckThis g m ty e1 = - mkApps g (typedExprForIntrinsic g m g.check_this_info, [[ty]], [e1], m) + mkApps g (typedExprForIntrinsic g m g.check_this_info, [[ty]], [e1], m) let mkCallFailInit g m = - mkApps g (typedExprForIntrinsic g m g.fail_init_info , [], [mkUnit g m], m) + mkApps g (typedExprForIntrinsic g m g.fail_init_info , [], [mkUnit g m], m) let mkCallFailStaticInit g m = - mkApps g (typedExprForIntrinsic g m g.fail_static_init_info , [], [mkUnit g m], m) + mkApps g (typedExprForIntrinsic g m g.fail_static_init_info , [], [mkUnit g m], m) let mkCallQuoteToLinqLambdaExpression g m ty e1 = - mkApps g (typedExprForIntrinsic g m g.quote_to_linq_lambda_info , [[ty]], [e1], m) + mkApps g (typedExprForIntrinsic g m g.quote_to_linq_lambda_info , [[ty]], [e1], m) -let mkLazyDelayed g m ty f = mkApps g (typedExprForIntrinsic g m g.lazy_create_info, [[ty]], [ f ], m) -let mkLazyForce g m ty e = mkApps g (typedExprForIntrinsic g m g.lazy_force_info, [[ty]], [ e; mkUnit g m ], m) +let mkLazyDelayed g m ty f = mkApps g (typedExprForIntrinsic g m g.lazy_create_info, [[ty]], [ f ], m) +let mkLazyForce g m ty e = mkApps g (typedExprForIntrinsic g m g.lazy_force_info, [[ty]], [ e; mkUnit g m ], m) let mkGetString g m e1 e2 = mkApps g (typedExprForIntrinsic g m g.getstring_info, [], [e1;e2], m) let mkGetStringChar = mkGetString let mkGetStringLength g m e = let mspec = mspec_String_Length g - /// ILCall(useCallvirt,isProtected,valu,newobj,valUseFlags,isProp,noTailCall,mref,actualTypeInst,actualMethInst, retTy) - Expr.Op(TOp.ILCall(false,false,false,false,ValUseFlag.NormalValUse,true,false,mspec.MethodRef,[],[],[g.int32_ty]),[],[e],m) + /// ILCall(useCallvirt, isProtected, valu, newobj, valUseFlags, isProp, noTailCall, mref, actualTypeInst, actualMethInst, retTy) + Expr.Op(TOp.ILCall(false, false, false, false, ValUseFlag.NormalValUse, true, false, mspec.MethodRef, [], [], [g.int32_ty]), [], [e], m) // Quotations can't contain any IL. @@ -6245,42 +6249,42 @@ let mkGetStringLength g m e = // Hence each of the following are marked with places where they are generated. // Generated by the optimizer and the encoding of 'for' loops -let mkDecr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_sub ],[],[e; mkOne g m],[g.int_ty],m) -let mkIncr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_add ],[],[mkOne g m; e],[g.int_ty],m) +let mkDecr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_sub ], [], [e; mkOne g m], [g.int_ty], m) +let mkIncr (g:TcGlobals) m e = mkAsmExpr([ IL.AI_add ], [], [mkOne g m; e], [g.int_ty], m) // Generated by the pattern match compiler and the optimizer for // 1. array patterns // 2. optimizations associated with getting 'for' loops into the shape expected by the JIT. // // NOTE: The conv.i4 assumes that int_ty is int32. Note: ldlen returns native UNSIGNED int -let mkLdlen (g:TcGlobals) m arre = mkAsmExpr ([ IL.I_ldlen; (IL.AI_conv IL.DT_I4) ],[],[ arre ], [ g.int_ty ], m) -let mkLdelem (_g:TcGlobals) m ty arre idxe = mkAsmExpr ([ IL.I_ldelem_any (ILArrayShape.SingleDimensional, mkILTyvarTy 0us) ],[ty],[ arre;idxe ], [ ty ], m) +let mkLdlen (g:TcGlobals) m arre = mkAsmExpr ([ IL.I_ldlen; (IL.AI_conv IL.DT_I4) ], [], [ arre ], [ g.int_ty ], m) +let mkLdelem (_g:TcGlobals) m ty arre idxe = mkAsmExpr ([ IL.I_ldelem_any (ILArrayShape.SingleDimensional, mkILTyvarTy 0us) ], [ty], [ arre;idxe ], [ ty ], m) // This is generated in equality/compare/hash augmentations and in the pattern match compiler. // It is understood by the quotation processor and turned into "Equality" nodes. // // Note: this is IL assembly code, don't go inserting this in expressions which will be exposed via quotations -let mkILAsmCeq (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_ceq ],[], [e1; e2],[g.bool_ty],m) -let mkILAsmClt (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ],[], [e1; e2],[g.bool_ty],m) +let mkILAsmCeq (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_ceq ], [], [e1; e2], [g.bool_ty], m) +let mkILAsmClt (g:TcGlobals) m e1 e2 = mkAsmExpr ([ IL.AI_clt ], [], [e1; e2], [g.bool_ty], m) // This is generated in the initialization of the "ctorv" field in the typechecker's compilation of // an implicit class construction. -let mkNull m ty = Expr.Const(Const.Zero, m,ty) +let mkNull m ty = Expr.Const(Const.Zero, m, ty) //---------------------------------------------------------------------------- // rethrow //---------------------------------------------------------------------------- (* throw, rethrow *) -let mkThrow m ty e = mkAsmExpr ([ IL.I_throw ],[], [e],[ty],m) +let mkThrow m ty e = mkAsmExpr ([ IL.I_throw ], [], [e], [ty], m) let destThrow = function - | Expr.Op (TOp.ILAsm([IL.I_throw],[ty2]),[],[e],m) -> Some (m,ty2,e) + | Expr.Op (TOp.ILAsm([IL.I_throw], [ty2]), [], [e], m) -> Some (m, ty2, e) | _ -> None let isThrow x = Option.isSome (destThrow x) // rethrow - parsed as library call - internally represented as op form. -let mkReraiseLibCall (g:TcGlobals) ty m = let ve,vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve,vt,[ty],[mkUnit g m],m) -let mkReraise m returnTy = Expr.Op (TOp.Reraise,[returnTy],[],m) (* could suppress unitArg *) +let mkReraiseLibCall (g:TcGlobals) ty m = let ve, vt = typedExprForIntrinsic g m g.reraise_info in Expr.App(ve, vt, [ty], [mkUnit g m], m) +let mkReraise m returnTy = Expr.Op (TOp.Reraise, [returnTy], [], m) (* could suppress unitArg *) //---------------------------------------------------------------------------- // CompilationMappingAttribute, SourceConstructFlags @@ -6298,27 +6302,27 @@ let tref_SourceConstructFlags (g:TcGlobals) = mkILTyRef (g.fslibCcu.ILS let mkCompilationMappingAttrPrim (g:TcGlobals) k nums = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, - ((mkILNonGenericValueTy (tref_SourceConstructFlags g)) :: (nums |> List.map (fun _ -> g.ilg.typ_Int32))), - ((k :: nums) |> List.map (fun n -> ILAttribElem.Int32(n))), + ((mkILNonGenericValueTy (tref_SourceConstructFlags g)) :: (nums |> List.map (fun _ -> g.ilg.typ_Int32))), + ((k :: nums) |> List.map (fun n -> ILAttribElem.Int32(n))), []) let mkCompilationMappingAttr g kind = mkCompilationMappingAttrPrim g kind [] let mkCompilationMappingAttrWithSeqNum g kind seqNum = mkCompilationMappingAttrPrim g kind [seqNum] let mkCompilationMappingAttrWithVariantNumAndSeqNum g kind varNum seqNum = mkCompilationMappingAttrPrim g kind [varNum;seqNum] let mkCompilationArgumentCountsAttr (g:TcGlobals) nums = - mkILCustomAttribute g.ilg (tref_CompilationArgumentCountsAttr g, [ mkILArr1DTy g.ilg.typ_Int32 ], - [ILAttribElem.Array (g.ilg.typ_Int32, List.map (fun n -> ILAttribElem.Int32(n)) nums)], + mkILCustomAttribute g.ilg (tref_CompilationArgumentCountsAttr g, [ mkILArr1DTy g.ilg.typ_Int32 ], + [ILAttribElem.Array (g.ilg.typ_Int32, List.map (fun n -> ILAttribElem.Int32(n)) nums)], []) let mkCompilationSourceNameAttr (g:TcGlobals) n = - mkILCustomAttribute g.ilg (tref_CompilationSourceNameAttr g, [ g.ilg.typ_String ], - [ILAttribElem.String(Some n)], + mkILCustomAttribute g.ilg (tref_CompilationSourceNameAttr g, [ g.ilg.typ_String ], + [ILAttribElem.String(Some n)], []) let mkCompilationMappingAttrForQuotationResource (g:TcGlobals) (nm, tys: ILTypeRef list) = mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, - [ g.ilg.typ_String; mkILArr1DTy g.ilg.typ_Type ], - [ ILAttribElem.String (Some nm); ILAttribElem.Array (g.ilg.typ_Type, [ for ty in tys -> ILAttribElem.TypeRef (Some ty) ]) ], + [ g.ilg.typ_String; mkILArr1DTy g.ilg.typ_Type ], + [ ILAttribElem.String (Some nm); ILAttribElem.Array (g.ilg.typ_Type, [ for ty in tys -> ILAttribElem.TypeRef (Some ty) ]) ], []) #if EXTENSIONTYPING @@ -6350,22 +6354,22 @@ let tname_SignatureDataVersionAttr = FSharpLib.Core + ".FSharpInterfaceDataVersi let tnames_SignatureDataVersionAttr = splitILTypeName tname_SignatureDataVersionAttr let tref_SignatureDataVersionAttr () = mkILTyRef(IlxSettings.ilxFsharpCoreLibScopeRef (), tname_SignatureDataVersionAttr) -let mkSignatureDataVersionAttr (g:TcGlobals) ((v1,v2,v3,_) : ILVersionInfo) = +let mkSignatureDataVersionAttr (g:TcGlobals) ((v1, v2, v3, _) : ILVersionInfo) = mkILCustomAttribute g.ilg (tref_SignatureDataVersionAttr(), - [g.ilg.typ_Int32;g.ilg.typ_Int32;g.ilg.typ_Int32], + [g.ilg.typ_Int32;g.ilg.typ_Int32;g.ilg.typ_Int32], [ILAttribElem.Int32 (int32 v1); ILAttribElem.Int32 (int32 v2) ; - ILAttribElem.Int32 (int32 v3)],[]) + ILAttribElem.Int32 (int32 v3)], []) let tname_AutoOpenAttr = FSharpLib.Core + ".AutoOpenAttribute" -let IsSignatureDataVersionAttr cattr = isILAttribByName ([],tname_SignatureDataVersionAttr) cattr +let IsSignatureDataVersionAttr cattr = isILAttribByName ([], tname_SignatureDataVersionAttr) cattr let TryFindAutoOpenAttr (ilg : IL.ILGlobals) cattr = - if isILAttribByName ([],tname_AutoOpenAttr) cattr then + if isILAttribByName ([], tname_AutoOpenAttr) cattr then match decodeILAttribData ilg cattr with - | [ILAttribElem.String s],_ -> s - | [],_ -> None + | [ILAttribElem.String s], _ -> s + | [], _ -> None | _ -> warning(Failure(FSComp.SR.tastUnexpectedDecodeOfAutoOpenAttribute())); None @@ -6375,32 +6379,32 @@ let TryFindAutoOpenAttr (ilg : IL.ILGlobals) cattr = let tname_InternalsVisibleToAttr = "System.Runtime.CompilerServices.InternalsVisibleToAttribute" let TryFindInternalsVisibleToAttr ilg cattr = - if isILAttribByName ([],tname_InternalsVisibleToAttr) cattr then + if isILAttribByName ([], tname_InternalsVisibleToAttr) cattr then match decodeILAttribData ilg cattr with - | [ILAttribElem.String s],_ -> s - | [],_ -> None + | [ILAttribElem.String s], _ -> s + | [], _ -> None | _ -> warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInternalsVisibleToAttribute())); None else None -let IsMatchingSignatureDataVersionAttr ilg ((v1,v2,v3,_) : ILVersionInfo) cattr = +let IsMatchingSignatureDataVersionAttr ilg ((v1, v2, v3, _) : ILVersionInfo) cattr = IsSignatureDataVersionAttr cattr && match decodeILAttribData ilg cattr with - | [ILAttribElem.Int32 u1; ILAttribElem.Int32 u2;ILAttribElem.Int32 u3 ],_ -> + | [ILAttribElem.Int32 u1; ILAttribElem.Int32 u2;ILAttribElem.Int32 u3 ], _ -> (v1 = uint16 u1) && (v2 = uint16 u2) && (v3 = uint16 u3) | _ -> warning(Failure(FSComp.SR.tastUnexpectedDecodeOfInterfaceDataVersionAttribute())); false let mkCompilerGeneratedAttr (g:TcGlobals) n = - mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)],[ILAttribElem.Int32(n)],[]) + mkILCustomAttribute g.ilg (tref_CompilationMappingAttr g, [mkILNonGenericValueTy (tref_SourceConstructFlags g)], [ILAttribElem.Int32(n)], []) //-------------------------------------------------------------------------- // tupled lambda --> method/function with a given topValInfo specification. // -// AdjustArityOfLambdaBody: "(vs,body)" represents a lambda "fun (vs) -> body". The +// AdjustArityOfLambdaBody: "(vs, body)" represents a lambda "fun (vs) -> body". The // aim is to produce a "static method" represented by a pair // "(mvs, body)" where mvs has the List.length "arity". //-------------------------------------------------------------------------- @@ -6409,8 +6413,8 @@ let mkCompilerGeneratedAttr (g:TcGlobals) n = let untupledToRefTupled g vs = let untupledTys = typesOfVals vs let m = (List.head vs).Range - let tupledv,tuplede = mkCompGenLocal m "tupledArg" (mkRefTupledTy g untupledTys) - let untupling_es = List.mapi (fun i _ -> mkTupleFieldGet g (tupInfoRef,tuplede,untupledTys,i,m)) untupledTys + let tupledv, tuplede = mkCompGenLocal m "tupledArg" (mkRefTupledTy g untupledTys) + let untupling_es = List.mapi (fun i _ -> mkTupleFieldGet g (tupInfoRef, tuplede, untupledTys, i, m)) untupledTys tupledv, mkInvisibleLets m vs untupling_es // The required tupled-arity (arity) can either be 1 @@ -6420,27 +6424,27 @@ let AdjustArityOfLambdaBody g arity (vs:Val list) body = let nvs = vs.Length if not (nvs = arity || nvs = 1 || arity = 1) then failwith ("lengths don't add up"); if arity = 0 then - vs,body + vs, body elif nvs = arity then - vs,body + vs, body elif nvs = 1 then let v = vs.Head let untupledTys = destRefTupleTy g v.Type if (untupledTys.Length <> arity) then failwith "length untupledTys <> arity"; - let dummyvs,dummyes = + let dummyvs, dummyes = untupledTys |> List.mapi (fun i ty -> mkCompGenLocal v.Range (v.LogicalName ^"_"^string i) ty) |> List.unzip let body = mkInvisibleLet v.Range v (mkRefTupled g v.Range dummyes untupledTys) body - dummyvs,body + dummyvs, body else let tupledv, untupler = untupledToRefTupled g vs - [tupledv],untupler body + [tupledv], untupler body let MultiLambdaToTupledLambda g vs body = match vs with | [] -> failwith "MultiLambdaToTupledLambda: expected some argments" - | [v] -> v,body + | [v] -> v, body | vs -> let tupledv, untupler = untupledToRefTupled g vs tupledv, untupler body @@ -6448,15 +6452,15 @@ let MultiLambdaToTupledLambda g vs body = let (|RefTuple|_|) expr = match expr with - | Expr.Op (TOp.Tuple (TupInfo.Const false),_,args,_) -> Some args + | Expr.Op (TOp.Tuple (TupInfo.Const false), _, args, _) -> Some args | _ -> None -let MultiLambdaToTupledLambdaIfNeeded g (vs,arg) body = - match vs,arg with - | [],_ -> failwith "MultiLambdaToTupledLambda: expected some argments" - | [v],_ -> [(v,arg)],body - | vs,RefTuple args when args.Length = vs.Length -> List.zip vs args,body - | vs,_ -> +let MultiLambdaToTupledLambdaIfNeeded g (vs, arg) body = + match vs, arg with + | [], _ -> failwith "MultiLambdaToTupledLambda: expected some argments" + | [v], _ -> [(v, arg)], body + | vs, RefTuple args when args.Length = vs.Length -> List.zip vs args, body + | vs, _ -> let tupledv, untupler = untupledToRefTupled g vs [(tupledv, arg)], untupler body @@ -6471,30 +6475,30 @@ let MultiLambdaToTupledLambdaIfNeeded g (vs,arg) body = let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl : TType list list, argsl: Expr list, m) = (* let verbose = true in *) match f with - | Expr.Let(bind,body,mlet,_) -> + | Expr.Let(bind, body, mlet, _) -> // Lift bindings out, i.e. (let x = e in f) y --> let x = e in f y // This increases the scope of 'x', which I don't like as it mucks with debugging // scopes of variables, but this is an important optimization, especially when the '|>' // notation is used a lot. - mkLetBind mlet bind (MakeApplicationAndBetaReduceAux g (body,fty,tyargsl,argsl,m)) + mkLetBind mlet bind (MakeApplicationAndBetaReduceAux g (body, fty, tyargsl, argsl, m)) | _ -> match tyargsl with | [] :: rest -> - MakeApplicationAndBetaReduceAux g (f,fty,rest,argsl,m) + MakeApplicationAndBetaReduceAux g (f, fty, rest, argsl, m) | tyargs :: rest -> // Bind type parameters by immediate substitution match f with - | Expr.TyLambda(_, tyvs,body,_,bodyty) when tyvs.Length = List.length tyargs -> + | Expr.TyLambda(_, tyvs, body, _, bodyty) when tyvs.Length = List.length tyargs -> let tpenv = bindTypars tyvs tyargs emptyTyparInst let body = remarkExpr m (instExpr g tpenv body) let bodyty' = instType tpenv bodyty - MakeApplicationAndBetaReduceAux g (body,bodyty', rest,argsl,m) + MakeApplicationAndBetaReduceAux g (body, bodyty', rest, argsl, m) | _ -> let f = mkAppsAux g f fty [tyargs] [] m let fty = applyTyArgs g fty tyargs - MakeApplicationAndBetaReduceAux g (f,fty, rest,argsl,m) + MakeApplicationAndBetaReduceAux g (f, fty, rest, argsl, m) | [] -> match argsl with | _ :: _ -> @@ -6504,14 +6508,14 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl : TType list list, ar // all arguments get evaluated before application. // // VALID: - // (fun a b -> E[a,b]) t1 t2 ---> let a = t1 in let b = t2 in E[t1,t2] + // (fun a b -> E[a, b]) t1 t2 ---> let a = t1 in let b = t2 in E[t1, t2] // INVALID: // (fun a -> E[a]) t1 t2 ---> let a = t1 in E[a] t2 UNLESS: E[a] has no effects OR t2 has no effects match tryStripLambdaN argsl.Length f with | Some (argvsl, body) -> assert (argvsl.Length = argsl.Length) - let pairs,body = List.mapFoldBack (MultiLambdaToTupledLambdaIfNeeded g) (List.zip argvsl argsl) body + let pairs, body = List.mapFoldBack (MultiLambdaToTupledLambdaIfNeeded g) (List.zip argvsl argsl) body let argvs2, args2 = List.unzip (List.concat pairs) mkLetsBind m (mkCompGenBinds argvs2 args2) body | _ -> @@ -6520,8 +6524,8 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl : TType list list, ar | [] -> f -let MakeApplicationAndBetaReduce g (f,fty,tyargsl,argl,m) = - MakeApplicationAndBetaReduceAux g (f,fty,tyargsl,argl,m) +let MakeApplicationAndBetaReduce g (f, fty, tyargsl, argl, m) = + MakeApplicationAndBetaReduceAux g (f, fty, tyargsl, argl, m) //--------------------------------------------------------------------------- // Adjust for expected usage @@ -6530,7 +6534,7 @@ let MakeApplicationAndBetaReduce g (f,fty,tyargsl,argl,m) = let MakeArgsForTopArgs _g m argtysl tpenv = argtysl |> List.mapi (fun i argtys -> - argtys |> List.mapi (fun j (argty,argInfo : ArgReprInfo) -> + argtys |> List.mapi (fun j (argty, argInfo : ArgReprInfo) -> let ty = instType tpenv argty let nm = match argInfo.Name with @@ -6540,20 +6544,20 @@ let MakeArgsForTopArgs _g m argtysl tpenv = let AdjustValForExpectedArity g m (vref:ValRef) flags topValInfo = - let tps,argtysl,rty,_ = GetTopValTypeInFSharpForm g topValInfo vref.Type m + let tps, argtysl, rty, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type m let tps' = copyTypars tps let tyargs' = List.map mkTyparTy tps' let tpenv = bindTypars tps tyargs' emptyTyparInst let rty' = instType tpenv rty let vsl = MakeArgsForTopArgs g m argtysl tpenv - let call = MakeApplicationAndBetaReduce g (Expr.Val(vref,flags,m),vref.Type,[tyargs'],(List.map (mkRefTupledVars g m) vsl),m) - let tauexpr,tauty = + let call = MakeApplicationAndBetaReduce g (Expr.Val(vref, flags, m), vref.Type, [tyargs'], (List.map (mkRefTupledVars g m) vsl), m) + let tauexpr, tauty = List.foldBack - (fun vs (e,ty) -> mkMultiLambda m vs (e, ty), (mkRefTupledVarsTy g vs --> ty)) + (fun vs (e, ty) -> mkMultiLambda m vs (e, ty), (mkRefTupledVarsTy g vs --> ty)) vsl (call, rty') // Build a type-lambda expression for the toplevel value if needed... - mkTypeLambda m tps' (tauexpr,tauty),tps' +-> tauty + mkTypeLambda m tps' (tauexpr, tauty), tps' +-> tauty //--------------------------------------------------------------------------- @@ -6562,22 +6566,22 @@ let AdjustValForExpectedArity g m (vref:ValRef) flags topValInfo = let IsSubsumptionExpr g expr = match expr with - | Expr.Op (TOp.Coerce,[inputTy;actualTy],[_],_) -> + | Expr.Op (TOp.Coerce, [inputTy;actualTy], [_], _) -> isFunTy g actualTy && isFunTy g inputTy | _ -> false let stripTupledFunTy g ty = - let argTys,retTy = stripFunTy g ty + let argTys, retTy = stripFunTy g ty let curriedArgTys = argTys |> List.map (tryDestRefTupleTy g) curriedArgTys, retTy let (|ExprValWithPossibleTypeInst|_|) expr = match expr with - | Expr.App(Expr.Val(vref,flags,m),_fty,tyargs,[],_) -> - Some(vref,flags,tyargs,m) - | Expr.Val(vref,flags,m) -> - Some(vref,flags,[],m) + | Expr.App(Expr.Val(vref, flags, m), _fty, tyargs, [], _) -> + Some(vref, flags, tyargs, m) + | Expr.Val(vref, flags, m) -> + Some(vref, flags, [], m) | _ -> None @@ -6585,11 +6589,11 @@ let mkCoerceIfNeeded g tgtTy srcTy expr = if typeEquiv g tgtTy srcTy then expr else - mkCoerceExpr(expr,tgtTy,expr.Range,srcTy) + mkCoerceExpr(expr, tgtTy, expr.Range, srcTy) let mkCompGenLetIn m nm ty e f = - let v,ve = mkCompGenLocal m nm ty - mkCompGenLet m v e (f (v,ve)) + let v, ve = mkCompGenLocal m nm ty + mkCompGenLet m v e (f (v, ve)) /// Take a node representing a coercion from one function type to another, e.g. /// A -> A * A -> int @@ -6616,26 +6620,26 @@ let mkCompGenLetIn m nm ty e f = let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Expr* Expr list) option = match expr with - | Expr.Op (TOp.Coerce,[inputTy;actualTy],[exprWithActualTy],m) when + | Expr.Op (TOp.Coerce, [inputTy;actualTy], [exprWithActualTy], m) when isFunTy g actualTy && isFunTy g inputTy -> if typeEquiv g actualTy inputTy then Some(exprWithActualTy, suppliedArgs) else - let curriedActualArgTys,retTy = stripTupledFunTy g actualTy + let curriedActualArgTys, retTy = stripTupledFunTy g actualTy - let curriedInputTys,_ = stripFunTy g inputTy + let curriedInputTys, _ = stripFunTy g inputTy assert (curriedActualArgTys.Length = curriedInputTys.Length) - let argTys = (curriedInputTys,curriedActualArgTys) ||> List.mapi2 (fun i x y -> (i,x,y)) + let argTys = (curriedInputTys, curriedActualArgTys) ||> List.mapi2 (fun i x y -> (i, x, y)) // Use the nice names for a function of known arity and name. Note that 'nice' here also - // carries a semantic meaning. For a function with top-info, + // carries a semantic meaning. For a function with top-info, // let f (x:A) (y:A) (z:A) = ... - // we know there are no side effects on the application of 'f' to 1,2 args. This greatly simplifies + // we know there are no side effects on the application of 'f' to 1, 2 args. This greatly simplifies // the closure built for // f b1 b2 // and indeed for @@ -6645,11 +6649,11 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex let curriedNiceNames = match stripExpr exprWithActualTy with - | ExprValWithPossibleTypeInst(vref,_,_,_) when vref.ValReprInfo.IsSome -> + | ExprValWithPossibleTypeInst(vref, _, _, _) when vref.ValReprInfo.IsSome -> - let _,argtysl,_,_ = GetTopValTypeInFSharpForm g vref.ValReprInfo.Value vref.Type expr.Range + let _, argtysl, _, _ = GetTopValTypeInFSharpForm g vref.ValReprInfo.Value vref.Type expr.Range argtysl |> List.mapi (fun i argtys -> - argtys |> List.mapi (fun j (_,argInfo) -> + argtys |> List.mapi (fun j (_, argInfo) -> match argInfo.Name with | None -> CompilerGeneratedName ("arg" ^ string i ^string j) | Some id -> id.idText)) @@ -6658,7 +6662,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex assert (curriedActualArgTys.Length >= curriedNiceNames.Length) - let argTysWithNiceNames,argTysWithoutNiceNames = + let argTysWithNiceNames, argTysWithoutNiceNames = List.chop curriedNiceNames.Length argTys /// Only consume 'suppliedArgs' up to at most the number of nice arguments @@ -6666,9 +6670,9 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex List.chop (min suppliedArgs.Length curriedNiceNames.Length) suppliedArgs /// The relevant range for any expressions and applications includes the arguments - let appm = (m,suppliedArgs) ||> List.fold (fun m e -> unionRanges m (e.Range)) + let appm = (m, suppliedArgs) ||> List.fold (fun m e -> unionRanges m (e.Range)) - // See if we have 'enough' suppliedArgs. If not, we have to build some lambdas, and, + // See if we have 'enough' suppliedArgs. If not, we have to build some lambdas, and, // we have to 'let' bind all arguments that we consume, e.g. // Seq.take (effect;4) : int list -> int list // is a classic case. Here we generate @@ -6676,7 +6680,7 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex // (fun v -> Seq.take tmp (v :> seq<_>)) let buildingLambdas = suppliedArgs.Length <> curriedNiceNames.Length - /// Given a tuple of argument variables that has a tuple type that satisfies the input argument types, + /// Given a tuple of argument variables that has a tuple type that satisfies the input argument types, /// coerce it to a tuple that satisfies the matching coerced argument type(s). let CoerceDetupled (argTys: TType list) (detupledArgs: Expr list) (actualTys: TType list) = assert (actualTys.Length = argTys.Length) @@ -6686,18 +6690,18 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex mkRefTupled g argm (List.map3 (mkCoerceIfNeeded g) actualTys argTys detupledArgs) actualTys /// Given an argument variable of tuple type that has been evaluated and stored in the - /// given variable, where the tuple type that satisfies the input argument types, + /// given variable, where the tuple type that satisfies the input argument types, /// coerce it to a tuple that satisfies the matching coerced argument type(s). let CoerceBoundTuple tupleVar argTys (actualTys : TType list) = assert (actualTys.Length > 1) mkRefTupled g appm - ((actualTys,argTys) ||> List.mapi2 (fun i actualTy dummyTy -> - let argExprElement = mkTupleFieldGet g (tupInfoRef,tupleVar,argTys,i,appm) + ((actualTys, argTys) ||> List.mapi2 (fun i actualTy dummyTy -> + let argExprElement = mkTupleFieldGet g (tupInfoRef, tupleVar, argTys, i, appm) mkCoerceIfNeeded g actualTy dummyTy argExprElement)) actualTys - /// Given an argument that has a tuple type that satisfies the input argument types, + /// Given an argument that has a tuple type that satisfies the input argument types, /// coerce it to a tuple that satisfies the matching coerced argument type. Try to detuple the argument if possible. let CoerceTupled niceNames (argExpr: Expr) (actualTys: TType list) = let argExprTy = (tyOfExpr g argExpr) @@ -6719,33 +6723,33 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex // // for // let f a = 1 - // let f (a,a) = 1 - let v,ve = mkCompGenLocal appm nm argExprTy + // let f (a, a) = 1 + let v, ve = mkCompGenLocal appm nm argExprTy let binderBuilder = (fun tm -> mkCompGenLet appm v argExpr tm) let expr = - match actualTys,argTys with - | [actualTy],[argTy] -> mkCoerceIfNeeded g actualTy argTy ve + match actualTys, argTys with + | [actualTy], [argTy] -> mkCoerceIfNeeded g actualTy argTy ve | _ -> CoerceBoundTuple ve argTys actualTys - binderBuilder,expr + binderBuilder, expr else if typeEquiv g (mkRefTupledTy g actualTys) argExprTy then (fun tm -> tm), argExpr else - let detupledArgs,argTys = + let detupledArgs, argTys = match actualTys with | [_actualType] -> - [argExpr],[tyOfExpr g argExpr] + [argExpr], [tyOfExpr g argExpr] | _ -> - tryDestRefTupleExpr argExpr,tryDestRefTupleTy g argExprTy + tryDestRefTupleExpr argExpr, tryDestRefTupleTy g argExprTy - // OK, the tuples match, or there is no de-tupling, + // OK, the tuples match, or there is no de-tupling, // f x - // f (x,y) + // f (x, y) // // for - // let f (x,y) = 1 + // let f (x, y) = 1 // and we're not building lambdas, just coerce the arguments in place if detupledArgs.Length = actualTys.Length then (fun tm -> tm), CoerceDetupled argTys detupledArgs actualTys @@ -6755,22 +6759,22 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex // // // for - // let f (x,y) = 1 + // let f (x, y) = 1 // Assign the argument to make sure it is only run once - let v,ve = mkCompGenLocal appm nm argExprTy + let v, ve = mkCompGenLocal appm nm argExprTy let binderBuilder = (fun tm -> mkCompGenLet appm v argExpr tm) let expr = CoerceBoundTuple ve argTys actualTys - binderBuilder,expr + binderBuilder, expr // This variable is really a dummy to make the code below more regular. // In the i = N - 1 cases we skip the introduction of the 'let' for // this variable. - let resVar,resVarAsExpr = mkCompGenLocal appm "result" retTy + let resVar, resVarAsExpr = mkCompGenLocal appm "result" retTy let N = argTys.Length - let (cloVar,exprForOtherArgs,_) = + let (cloVar, exprForOtherArgs, _) = List.foldBack - (fun (i,inpArgTy,actualArgTys) (cloVar:Val,res,resTy) -> + (fun (i, inpArgTy, actualArgTys) (cloVar:Val, res, resTy) -> let inpArgTys = match actualArgTys with @@ -6779,26 +6783,26 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex assert (inpArgTys.Length = actualArgTys.Length) - let inpsAsVars,inpsAsExprs = inpArgTys |> List.mapi (fun j ty -> mkCompGenLocal appm ("arg"^string i^string j) ty) |> List.unzip + let inpsAsVars, inpsAsExprs = inpArgTys |> List.mapi (fun j ty -> mkCompGenLocal appm ("arg"^string i^string j) ty) |> List.unzip let inpsAsActualArg = CoerceDetupled inpArgTys inpsAsExprs actualArgTys let inpCloVarType = (mkFunTy (mkRefTupledTy g actualArgTys) cloVar.Type) let newResTy = mkFunTy inpArgTy resTy - let inpCloVar,inpCloVarAsExpr = mkCompGenLocal appm ("clo"^string i) inpCloVarType + let inpCloVar, inpCloVarAsExpr = mkCompGenLocal appm ("clo"^string i) inpCloVarType let newRes = // For the final arg we can skip introducing the dummy variable if i = N - 1 then mkMultiLambda appm inpsAsVars - (mkApps g ((inpCloVarAsExpr,inpCloVarType),[],[inpsAsActualArg],appm),resTy) + (mkApps g ((inpCloVarAsExpr, inpCloVarType), [], [inpsAsActualArg], appm), resTy) else mkMultiLambda appm inpsAsVars (mkInvisibleLet appm cloVar - (mkApps g ((inpCloVarAsExpr,inpCloVarType),[],[inpsAsActualArg],appm)) + (mkApps g ((inpCloVarAsExpr, inpCloVarType), [], [inpsAsActualArg], appm)) res, resTy) - inpCloVar,newRes,newResTy) + inpCloVar, newRes, newResTy) argTysWithoutNiceNames - (resVar,resVarAsExpr,retTy) + (resVar, resVarAsExpr, retTy) // Mark the up as Some/None @@ -6811,9 +6815,9 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex if isNil argTysWithNiceNames then mkInvisibleLet appm cloVar exprWithActualTy exprForOtherArgs else - let lambdaBuilders,binderBuilders,inpsAsArgs = + let lambdaBuilders, binderBuilders, inpsAsArgs = - (argTysWithNiceNames,curriedNiceNames,suppliedArgs) |||> List.map3 (fun (_,inpArgTy,actualArgTys) niceNames suppliedArg -> + (argTysWithNiceNames, curriedNiceNames, suppliedArgs) |||> List.map3 (fun (_, inpArgTy, actualArgTys) niceNames suppliedArg -> let inpArgTys = match actualArgTys with @@ -6829,15 +6833,15 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex | nms -> nms match suppliedArg with | Some arg -> - let binderBuilder,inpsAsActualArg = CoerceTupled niceNames arg actualArgTys + let binderBuilder, inpsAsActualArg = CoerceTupled niceNames arg actualArgTys let lambdaBuilder = (fun tm -> tm) - lambdaBuilder, binderBuilder,inpsAsActualArg + lambdaBuilder, binderBuilder, inpsAsActualArg | None -> - let inpsAsVars,inpsAsExprs = (niceNames,inpArgTys) ||> List.map2 (fun nm ty -> mkCompGenLocal appm nm ty) |> List.unzip + let inpsAsVars, inpsAsExprs = (niceNames, inpArgTys) ||> List.map2 (fun nm ty -> mkCompGenLocal appm nm ty) |> List.unzip let inpsAsActualArg = CoerceDetupled inpArgTys inpsAsExprs actualArgTys let lambdaBuilder = (fun tm -> mkMultiLambda appm inpsAsVars (tm, tyOfExpr g tm)) let binderBuilder = (fun tm -> tm) - lambdaBuilder,binderBuilder,inpsAsActualArg) + lambdaBuilder, binderBuilder, inpsAsActualArg) |> List.unzip3 // If no trailing args then we can skip introducing the dummy variable @@ -6852,56 +6856,56 @@ let AdjustPossibleSubsumptionExpr g (expr: Expr) (suppliedArgs: Expr list) : (Ex // (fun b -> let clo = f (b :> A) in clo) let exprApp = if isNil argTysWithoutNiceNames then - mkApps g ((exprWithActualTy,actualTy),[],inpsAsArgs,appm) + mkApps g ((exprWithActualTy, actualTy), [], inpsAsArgs, appm) else mkInvisibleLet appm - cloVar (mkApps g ((exprWithActualTy,actualTy),[],inpsAsArgs,appm)) + cloVar (mkApps g ((exprWithActualTy, actualTy), [], inpsAsArgs, appm)) exprForOtherArgs List.foldBack (fun f acc -> f acc) binderBuilders (List.foldBack (fun f acc -> f acc) lambdaBuilders exprApp) - Some(exprForAllArgs,droppedSuppliedArgs) + Some(exprForAllArgs, droppedSuppliedArgs) | _ -> None /// Find and make all subsumption eliminations let NormalizeAndAdjustPossibleSubsumptionExprs g inputExpr = - let expr,args = + let expr, args = // AdjustPossibleSubsumptionExpr can take into account an application match stripExpr inputExpr with - | Expr.App(f,_fty,[],args,_) -> - f,args + | Expr.App(f, _fty, [], args, _) -> + f, args | _ -> - inputExpr,[] + inputExpr, [] match AdjustPossibleSubsumptionExpr g expr args with | None -> inputExpr - | Some (expr',[]) -> + | Some (expr', []) -> expr' - | Some (expr',args') -> + | Some (expr', args') -> //printfn "adjusted...." - Expr.App(expr',tyOfExpr g expr',[],args',inputExpr.Range) + Expr.App(expr', tyOfExpr g expr', [], args', inputExpr.Range) //--------------------------------------------------------------------------- // LinearizeTopMatch - when only one non-failing target, make linear. The full // complexity of this is only used for spectacularly rare bindings such as -// type ('a,'b) either = This of 'a | That of 'b +// type ('a, 'b) either = This of 'a | That of 'b // let this_f1 = This (fun x -> x) // let This fA | That fA = this_f1 // // Here a polymorphic top level binding "fA" is _computed_ by a pattern match!!! -// The TAST coming out of type checking must, however, define fA as a type function, +// The TAST coming out of type checking must, however, define fA as a type function, // since it is marked with an arity that indicates it's r.h.s. is a type function] // without side effects and so can be compiled as a generic method (for example). // polymorphic things bound in complex matches at top level require eta expansion of the // type function to ensure the r.h.s. of the binding is indeed a type function -let etaExpandTypeLambda g m tps (tm,ty) = - if isNil tps then tm else mkTypeLambda m tps (mkApps g ((tm,ty),[(List.map mkTyparTy tps)],[],m),ty) +let etaExpandTypeLambda g m tps (tm, ty) = + if isNil tps then tm else mkTypeLambda m tps (mkApps g ((tm, ty), [(List.map mkTyparTy tps)], [], m), ty) let AdjustValToTopVal (tmp:Val) parent valData = tmp.SetValReprInfo (Some valData); @@ -6909,41 +6913,42 @@ let AdjustValToTopVal (tmp:Val) parent valData = tmp.SetIsMemberOrModuleBinding() /// For match with only one non-failing target T0, the other targets, T1... failing (say, raise exception). -/// tree, T0(v0,..,vN) => rhs ; T1() => fail ; ... +/// tree, T0(v0, .., vN) => rhs ; T1() => fail ; ... /// Convert it to bind T0's variables, then continue with T0's rhs: -/// let tmp = switch tree, TO(fv0,...,fvN) => Tup (fv0,...,fvN) ; T1() => fail; ... +/// let tmp = switch tree, TO(fv0, ..., fvN) => Tup (fv0, ..., fvN) ; T1() => fail; ... /// let v1 = #1 tmp in ... /// and vN = #N tmp /// rhs /// Motivation: -/// - For top-level let bindings with possibly failing matches, +/// - For top-level let bindings with possibly failing matches, /// this makes clear that subsequent bindings (if reached) are top-level ones. -let LinearizeTopMatchAux g parent (spBind,m,tree,targets,m2,ty) = +let LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) = let targetsL = Array.toList targets - (* items* package up 0,1,more items *) + (* items* package up 0, 1, more items *) let itemsProj tys i x = match tys with | [] -> failwith "itemsProj: no items?" | [_] -> x (* no projection needed *) - | tys -> Expr.Op (TOp.TupleFieldGet(tupInfoRef, i),tys,[x],m) - let isThrowingTarget = function TTarget(_,x,_) -> isThrow x + | tys -> Expr.Op (TOp.TupleFieldGet(tupInfoRef, i), tys, [x], m) + let isThrowingTarget = function TTarget(_, x, _) -> isThrow x if 1 + List.count isThrowingTarget targetsL = targetsL.Length then (* Have failing targets and ONE successful one, so linearize *) - let (TTarget (vs,rhs,spTarget)) = Option.get (List.tryFind (isThrowingTarget >> not) targetsL) + let (TTarget (vs, rhs, spTarget)) = Option.get (List.tryFind (isThrowingTarget >> not) targetsL) (* note - old code here used copy value to generate locals - this was not right *) let fvs = vs |> List.map (fun v -> fst(mkLocal v.Range v.LogicalName v.Type)) (* fresh *) let vtys = vs |> List.map (fun v -> v.Type) let tmpTy = mkRefTupledVarsTy g vs - let tmp,tmpe = mkCompGenLocal m "matchResultHolder" tmpTy + let tmp, tmpe = mkCompGenLocal m "matchResultHolder" tmpTy AdjustValToTopVal tmp parent ValReprInfo.emptyValData; - let newTg = TTarget (fvs,mkRefTupledVars g m fvs,spTarget) - let fixup (TTarget (tvs,tx,spTarget)) = + let newTg = TTarget (fvs, mkRefTupledVars g m fvs, spTarget) + let fixup (TTarget (tvs, tx, spTarget)) = match destThrow tx with - | Some (m,_,e) -> let tx = mkThrow m tmpTy e - TTarget(tvs,tx,spTarget) (* Throwing targets, recast it's "return type" *) - | None -> newTg (* Non-throwing target, replaced [new/old] *) + | Some (m, _, e) -> + let tx = mkThrow m tmpTy e + TTarget(tvs, tx, spTarget) (* Throwing targets, recast it's "return type" *) + | None -> newTg (* Non-throwing target, replaced [new/old] *) let targets = Array.map fixup targets let binds = @@ -6954,14 +6959,14 @@ let LinearizeTopMatchAux g parent (spBind,m,tree,targets,m2,ty) = v.SetValReprInfo (Some (InferArityOfExpr g AllowTypeDirectedDetupling.Yes ty [] [] rhs)) mkInvisibleBind v rhs) in (* vi = proj tmp *) mkCompGenLet m - tmp (primMkMatch (spBind,m,tree,targets,m2,tmpTy)) (* note, probably retyped match, but note, result still has same type *) + tmp (primMkMatch (spBind, m, tree, targets, m2, tmpTy)) (* note, probably retyped match, but note, result still has same type *) (mkLetsFromBindings m binds rhs) else (* no change *) - primMkMatch (spBind,m,tree,targets,m2,ty) + primMkMatch (spBind, m, tree, targets, m2, ty) let LinearizeTopMatch g parent = function - | Expr.Match (spBind,m,tree,targets,m2,ty) -> LinearizeTopMatchAux g parent (spBind,m,tree,targets,m2,ty) + | Expr.Match (spBind, m, tree, targets, m2, ty) -> LinearizeTopMatchAux g parent (spBind, m, tree, targets, m2, ty) | x -> x @@ -6977,23 +6982,23 @@ let ticksAndArgCountTextOfTyconRef (tcref:TyconRef) = let path = Array.toList (fullMangledPathToTyconRef tcref) @ [tcref.CompiledName] textOfPath path -let typarEnc _g (gtpsType,gtpsMethod) typar = +let typarEnc _g (gtpsType, gtpsMethod) typar = match List.tryFindIndex (typarEq typar) gtpsType with | Some idx -> "`" ^ string idx // single-tick-index for typar from type | None -> match List.tryFindIndex (typarEq typar) gtpsMethod with | Some idx -> "``" ^ string idx // double-tick-index for typar from method - | None -> warning(InternalError("Typar not found during XmlDoc generation",typar.Range)) + | None -> warning(InternalError("Typar not found during XmlDoc generation", typar.Range)) "``0" // REVIEW: this should be ERROR not WARNING? -let rec typeEnc g (gtpsType,gtpsMethod) ty = +let rec typeEnc g (gtpsType, gtpsMethod) ty = if verbose then dprintf "--> typeEnc" let stripped = stripTyEqnsAndMeasureEqns g ty match stripped with | TType_forall _ -> "Microsoft.FSharp.Core.FSharpTypeFunc" | _ when isArrayTy g ty -> - let tcref,tinst = destAppTy g ty + let tcref, tinst = destAppTy g ty let arraySuffix = match rankOfArrayTyconRef g tcref with // The easy case @@ -7002,59 +7007,59 @@ let rec typeEnc g (gtpsType,gtpsMethod) ty = // In fact IL supports 3 kinds of multidimensional arrays, and each kind of array has its own xmldoc spec. // We don't support all these, and instead always pull xmldocs for 0-based-arbitrary-length ("0:") multidimensional arrays. // This is probably the 99% case anyway. - | 2 -> "[0:,0:]" - | 3 -> "[0:,0:,0:]" - | 4 -> "[0:,0:,0:,0:]" + | 2 -> "[0:, 0:]" + | 3 -> "[0:, 0:, 0:]" + | 4 -> "[0:, 0:, 0:, 0:]" | _ -> failwith "impossible: rankOfArrayTyconRef: unsupported array rank" - typeEnc g (gtpsType,gtpsMethod) (List.head tinst) ^ arraySuffix - | TType_ucase (UCRef(tcref,_),tinst) - | TType_app (tcref,tinst) -> + typeEnc g (gtpsType, gtpsMethod) (List.head tinst) ^ arraySuffix + | TType_ucase (UCRef(tcref, _), tinst) + | TType_app (tcref, tinst) -> if tyconRefEq g g.byref_tcr tcref then - typeEnc g (gtpsType,gtpsMethod) (List.head tinst) ^ "@" + typeEnc g (gtpsType, gtpsMethod) (List.head tinst) ^ "@" elif tyconRefEq g tcref g.nativeptr_tcr then - typeEnc g (gtpsType,gtpsMethod) (List.head tinst) ^ "*" + typeEnc g (gtpsType, gtpsMethod) (List.head tinst) ^ "*" else let tyName = let ty = stripTyEqnsAndMeasureEqns g ty match ty with - | TType_app (tcref,_tinst) -> + | TType_app (tcref, _tinst) -> // Generic type names are (name ^ "`" ^ digits) where name does not contain "`". // In XML doc, when used in type instances, these do not use the ticks. let path = Array.toList (fullMangledPathToTyconRef tcref) @ [tcref.CompiledName] textOfPath (List.map DemangleGenericTypeName path) | _ -> assert(false); failwith "impossible" - tyName + tyargsEnc g (gtpsType,gtpsMethod) tinst + tyName + tyargsEnc g (gtpsType, gtpsMethod) tinst | TType_tuple (tupInfo, typs) -> if evalTupInfoIsStruct tupInfo then - sprintf "System.ValueTuple%s"(tyargsEnc g (gtpsType,gtpsMethod) typs) + sprintf "System.ValueTuple%s"(tyargsEnc g (gtpsType, gtpsMethod) typs) else - sprintf "System.Tuple%s"(tyargsEnc g (gtpsType,gtpsMethod) typs) - | TType_fun (f,x) -> - "Microsoft.FSharp.Core.FSharpFunc" + tyargsEnc g (gtpsType,gtpsMethod) [f;x] + sprintf "System.Tuple%s"(tyargsEnc g (gtpsType, gtpsMethod) typs) + | TType_fun (f, x) -> + "Microsoft.FSharp.Core.FSharpFunc" + tyargsEnc g (gtpsType, gtpsMethod) [f;x] | TType_var typar -> - typarEnc g (gtpsType,gtpsMethod) typar + typarEnc g (gtpsType, gtpsMethod) typar | TType_measure _ -> "?" -and tyargsEnc g (gtpsType,gtpsMethod) args = +and tyargsEnc g (gtpsType, gtpsMethod) args = match args with | [] -> "" | [a] when (match (stripTyEqns g a) with TType_measure _ -> true | _ -> false) -> "" // float should appear as just "float" in the generated .XML xmldoc file - | _ -> angleEnc (commaEncs (List.map (typeEnc g (gtpsType,gtpsMethod)) args)) + | _ -> angleEnc (commaEncs (List.map (typeEnc g (gtpsType, gtpsMethod)) args)) -let XmlDocArgsEnc g (gtpsType,gtpsMethod) argTs = +let XmlDocArgsEnc g (gtpsType, gtpsMethod) argTs = if isNil argTs then "" - else "(" + String.concat "," (List.map (typeEnc g (gtpsType,gtpsMethod)) argTs) + ")" + else "(" + String.concat "," (List.map (typeEnc g (gtpsType, gtpsMethod)) argTs) + ")" let buildAccessPath (cp : CompilationPath option) = match cp with | Some(cp) -> let ap = cp.AccessPath |> List.map fst |> List.toArray - System.String.Join(".",ap) + System.String.Join(".", ap) | None -> "Extension Type" let prependPath path name = if path = "" then name else path + "." + name let XmlDocSigOfVal g path (v:Val) = - let parentTypars,methTypars,argInfos,prefix,path,name = + let parentTypars, methTypars, argInfos, prefix, path, name = // CLEANUP: this is one of several code paths that treat module values and members // separately when really it would be cleaner to make sure GetTopValTypeInFSharpForm, GetMemberTypeInFSharpForm etc. @@ -7063,32 +7068,32 @@ let XmlDocSigOfVal g path (v:Val) = match v.MemberInfo with | Some membInfo when not v.IsExtensionMember -> (* Methods, Properties etc. *) - let tps,argInfos,_,_ = GetMemberTypeInMemberForm g membInfo.MemberFlags (Option.get v.ValReprInfo) v.Type v.Range - let prefix,name = + let tps, argInfos, _, _ = GetMemberTypeInMemberForm g membInfo.MemberFlags (Option.get v.ValReprInfo) v.Type v.Range + let prefix, name = match membInfo.MemberFlags.MemberKind with | MemberKind.ClassConstructor | MemberKind.Constructor -> "M:", "#ctor" | MemberKind.Member -> "M:", v.CompiledName | MemberKind.PropertyGetSet | MemberKind.PropertySet - | MemberKind.PropertyGet -> "P:",v.PropertyName + | MemberKind.PropertyGet -> "P:", v.PropertyName let path = if v.HasTopValActualParent then prependPath path v.TopValActualParent.CompiledName else path - let parentTypars,methTypars = + let parentTypars, methTypars = match PartitionValTypars g v with - | Some(_,memberParentTypars,memberMethodTypars,_,_) -> memberParentTypars,memberMethodTypars - | None -> [],tps - parentTypars,methTypars,argInfos,prefix,path,name + | Some(_, memberParentTypars, memberMethodTypars, _, _) -> memberParentTypars, memberMethodTypars + | None -> [], tps + parentTypars, methTypars, argInfos, prefix, path, name | _ -> // Regular F# values and extension members let w = arityOfVal v - let tps,argInfos,_,_ = GetTopValTypeInCompiledForm g w v.Type v.Range + let tps, argInfos, _, _ = GetTopValTypeInCompiledForm g w v.Type v.Range let name = v.CompiledName let prefix = if w.NumCurriedArgs = 0 && isNil tps then "P:" else "M:" - [],tps,argInfos,prefix,path,name + [], tps, argInfos, prefix, path, name let argTs = argInfos |> List.concat |> List.map fst - let args = XmlDocArgsEnc g (parentTypars,methTypars) argTs + let args = XmlDocArgsEnc g (parentTypars, methTypars) argTs let arity = List.length methTypars in (* C# XML doc adds `` to *generic* member names *) let genArity = if arity=0 then "" else sprintf "``%d" arity prefix + prependPath path name + genArity + args @@ -7183,7 +7188,7 @@ let rec TypeHasDefaultValue g m ty = || (isStructTy g ty && // Is it an F# struct type? (if isFSharpStructTy g ty then - let tcref,tinst = destAppTy g ty + let tcref, tinst = destAppTy g ty let flds = // Note this includes fields implied by the use of the implicit class construction syntax tcref.AllInstanceFieldsAsList @@ -7207,7 +7212,7 @@ let (|SpecialComparableHeadType|_|) g ty = Some elemTys else match ty with - | AppTy g (tcref,tinst) -> + | AppTy g (tcref, tinst) -> if isArrayTyconRef g tcref || tyconRefEq g tcref g.system_UIntPtr_tcref || tyconRefEq g tcref g.system_IntPtr_tcref then @@ -7245,19 +7250,19 @@ let mkIsInstConditional g m tgty vinpe v e2 e3 = if canUseTypeTestFast g tgty then - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m) - let tg2 = mbuilder.AddResultTarget(e2,SuppressSequencePointAtTarget) - let tg3 = mbuilder.AddResultTarget(e3,SuppressSequencePointAtTarget) - let dtree = TDSwitch(exprForVal m v,[TCase(DecisionTreeTest.IsNull,tg3)],Some tg2,m) - let expr = mbuilder.Close(dtree,m,tyOfExpr g e2) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m) + let tg2 = mbuilder.AddResultTarget(e2, SuppressSequencePointAtTarget) + let tg3 = mbuilder.AddResultTarget(e3, SuppressSequencePointAtTarget) + let dtree = TDSwitch(exprForVal m v, [TCase(DecisionTreeTest.IsNull, tg3)], Some tg2, m) + let expr = mbuilder.Close(dtree, m, tyOfExpr g e2) mkInvisibleLet m v (mkIsInst tgty vinpe m) expr else - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m) - let tg2 = TDSuccess([mkCallUnbox g m tgty vinpe], mbuilder.AddTarget(TTarget([v],e2,SuppressSequencePointAtTarget))) - let tg3 = mbuilder.AddResultTarget(e3,SuppressSequencePointAtTarget) - let dtree = TDSwitch(vinpe,[TCase(DecisionTreeTest.IsInst(tyOfExpr g vinpe,tgty),tg2)],Some tg3,m) - let expr = mbuilder.Close(dtree,m,tyOfExpr g e2) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m) + let tg2 = TDSuccess([mkCallUnbox g m tgty vinpe], mbuilder.AddTarget(TTarget([v], e2, SuppressSequencePointAtTarget))) + let tg3 = mbuilder.AddResultTarget(e3, SuppressSequencePointAtTarget) + let dtree = TDSwitch(vinpe, [TCase(DecisionTreeTest.IsInst(tyOfExpr g vinpe, tgty), tg2)], Some tg3, m) + let expr = mbuilder.Close(dtree, m, tyOfExpr g e2) expr @@ -7266,13 +7271,13 @@ let mkIsInstConditional g m tgty vinpe v e2 e3 = // 1. The compilation of array patterns in the pattern match compiler // 2. The compilation of string patterns in the pattern match compiler let mkNullTest g m e1 e2 e3 = - let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding,m) - let tg2 = mbuilder.AddResultTarget(e2,SuppressSequencePointAtTarget) - let tg3 = mbuilder.AddResultTarget(e3,SuppressSequencePointAtTarget) - let dtree = TDSwitch(e1, [TCase(DecisionTreeTest.IsNull,tg3)],Some tg2,m) - let expr = mbuilder.Close(dtree,m,tyOfExpr g e2) + let mbuilder = new MatchBuilder(NoSequencePointAtInvisibleBinding, m) + let tg2 = mbuilder.AddResultTarget(e2, SuppressSequencePointAtTarget) + let tg3 = mbuilder.AddResultTarget(e3, SuppressSequencePointAtTarget) + let dtree = TDSwitch(e1, [TCase(DecisionTreeTest.IsNull, tg3)], Some tg2, m) + let expr = mbuilder.Close(dtree, m, tyOfExpr g e2) expr -let mkNonNullTest (g:TcGlobals) m e = mkAsmExpr ([ IL.AI_ldnull ; IL.AI_cgt_un ],[], [e],[g.bool_ty],m) +let mkNonNullTest (g:TcGlobals) m e = mkAsmExpr ([ IL.AI_ldnull ; IL.AI_cgt_un ], [], [e], [g.bool_ty], m) let mkNonNullCond g m ty e1 e2 e3 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m ty (mkNonNullTest g m e1) e2 e3 let mkIfThen (g:TcGlobals) m e1 e2 = mkCond NoSequencePointAtStickyBinding SuppressSequencePointAtTarget m g.unit_ty e1 e2 (mkUnit g m) @@ -7293,12 +7298,12 @@ let MemberIsCompiledAsInstance g parent isExtensionMember (membInfo:ValMemberInf elif not (isNil membInfo.ImplementedSlotSigs) then true else // Otherwise check attributes to see if there is an explicit instance or explicit static flag - let explicitInstance,explicitStatic = + let explicitInstance, explicitStatic = match TryFindFSharpInt32Attribute g g.attrib_CompilationRepresentationAttribute attrs with | Some(flags) -> - ((flags &&& enum_CompilationRepresentationAttribute_Instance) <> 0), + ((flags &&& enum_CompilationRepresentationAttribute_Instance) <> 0), ((flags &&& enum_CompilationRepresentationAttribute_Static) <> 0) - | _ -> false,false + | _ -> false, false explicitInstance || (membInfo.MemberFlags.IsInstance && not explicitStatic && @@ -7315,18 +7320,18 @@ let isSealedTy g ty = #if EXTENSIONTYPING | ProvidedTypeMetadata st -> st.IsSealed #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> td.IsSealed + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> td.IsSealed | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> if (isFSharpInterfaceTy g ty || isFSharpClassTy g ty) then - let tcref,_ = destAppTy g ty + let tcref, _ = destAppTy g ty (TryFindFSharpBoolAttribute g g.attrib_SealedAttribute tcref.Attribs = Some(true)) else // All other F# types, array, byref, tuple types are sealed true let isComInteropTy g ty = - let tcr,_ = destAppTy g ty + let tcr, _ = destAppTy g ty match g.attrib_ComImportAttribute with | None -> false | Some attr -> TryFindFSharpBoolAttribute g attr tcr.Attribs = Some(true) @@ -7347,7 +7352,7 @@ let ValRefIsCompiledAsInstanceMember g (vref: ValRef) = ValSpecIsCompiledAsInsta // Crack information about an F# object model call //--------------------------------------------------------------------------- -let GetMemberCallInfo g (vref:ValRef,vFlags) = +let GetMemberCallInfo g (vref:ValRef, vFlags) = match vref.MemberInfo with | Some(membInfo) when not vref.IsExtensionMember -> let numEnclTypeArgs = vref.MemberApparentParent.TyparsNoRange.Length @@ -7363,9 +7368,9 @@ let GetMemberCallInfo g (vref:ValRef,vFlags) = let takesInstanceArg = isCompiledAsInstance && not isNewObj let isPropGet = (membInfo.MemberFlags.MemberKind = MemberKind.PropertyGet) && (membInfo.MemberFlags.IsInstance = isCompiledAsInstance) let isPropSet = (membInfo.MemberFlags.MemberKind = MemberKind.PropertySet) && (membInfo.MemberFlags.IsInstance = isCompiledAsInstance) - numEnclTypeArgs, virtualCall,isNewObj,isSuperInit,isSelfInit ,takesInstanceArg,isPropGet,isPropSet + numEnclTypeArgs, virtualCall, isNewObj, isSuperInit, isSelfInit , takesInstanceArg, isPropGet, isPropSet | _ -> - 0,false,false,false,false,false,false,false + 0, false, false, false, false, false, false, false //--------------------------------------------------------------------------- // Active pattern name helpers @@ -7382,7 +7387,7 @@ let TryGetActivePatternInfo (vref:ValRef) = type ActivePatternElemRef with member x.Name = - let (APElemRef(_,vref,n)) = x + let (APElemRef(_, vref, n)) = x match TryGetActivePatternInfo vref with | None -> error(InternalError("not an active pattern name", vref.Range)) | Some apinfo -> @@ -7392,14 +7397,14 @@ type ActivePatternElemRef with let mkChoiceTyconRef (g:TcGlobals) m n = match n with - | 0 | 1 -> error(InternalError("mkChoiceTyconRef",m)) + | 0 | 1 -> error(InternalError("mkChoiceTyconRef", m)) | 2 -> g.choice2_tcr | 3 -> g.choice3_tcr | 4 -> g.choice4_tcr | 5 -> g.choice5_tcr | 6 -> g.choice6_tcr | 7 -> g.choice7_tcr - | _ -> error(Error(FSComp.SR.tastActivePatternsLimitedToSeven(),m)) + | _ -> error(Error(FSComp.SR.tastActivePatternsLimitedToSeven(), m)) let mkChoiceTy (g:TcGlobals) m tinst = match List.length tinst with @@ -7424,16 +7429,16 @@ type PrettyNaming.ActivePatternInfo with // Active pattern validation //--------------------------------------------------------------------------- -// check if an active pattern takes type parameters only bound by the return types, +// check if an active pattern takes type parameters only bound by the return types, // not by their argument types. let doesActivePatternHaveFreeTypars g (v:ValRef) = let vty = v.TauType let vtps = v.Typars |> Zset.ofList typarOrder if not (isFunTy g v.TauType) then - errorR(Error(FSComp.SR.activePatternIdentIsNotFunctionTyped(v.LogicalName),v.Range)) - let argtys,resty = stripFunTy g vty - let argtps,restps= (freeInTypes CollectTypars argtys).FreeTypars,(freeInType CollectTypars resty).FreeTypars - // Error if an active pattern is generic in type variables that only occur in the result Choice<_,...>. + errorR(Error(FSComp.SR.activePatternIdentIsNotFunctionTyped(v.LogicalName), v.Range)) + let argtys, resty = stripFunTy g vty + let argtps, restps= (freeInTypes CollectTypars argtys).FreeTypars, (freeInType CollectTypars resty).FreeTypars + // Error if an active pattern is generic in type variables that only occur in the result Choice<_, ...>. // Note: The test restricts to v.Typars since typars from the closure are considered fixed. not (Zset.isEmpty (Zset.inter (Zset.diff restps argtps) vtps)) @@ -7456,8 +7461,8 @@ let rec rewriteBind env bind = | None -> rewriteBindStructure env bind | None -> rewriteBindStructure env bind -and rewriteBindStructure env (TBind(v,e,letSeqPtOpt)) = - TBind(v,RewriteExpr env e,letSeqPtOpt) +and rewriteBindStructure env (TBind(v, e, letSeqPtOpt)) = + TBind(v, RewriteExpr env e, letSeqPtOpt) and rewriteBinds env binds = List.map (rewriteBind env) binds @@ -7487,57 +7492,59 @@ and rewriteExprStructure env expr = match expr with | Expr.Const _ | Expr.Val _ -> expr - | Expr.App(f0,f0ty,tyargs,args,m) -> + + | Expr.App(f0, f0ty, tyargs, args, m) -> let f0' = RewriteExpr env f0 let args' = rewriteExprs env args if f0 === f0' && args === args' then expr - else Expr.App(f0',f0ty,tyargs,args',m) + else Expr.App(f0', f0ty, tyargs, args', m) + + | Expr.Quote(ast, {contents=Some(typeDefs, argTypes, argExprs, data)}, isFromQueryExpression, m, ty) -> + Expr.Quote((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=Some(typeDefs, argTypes, rewriteExprs env argExprs, data)}, isFromQueryExpression, m, ty) - | Expr.Quote(ast,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty) -> - Expr.Quote((if env.IsUnderQuotations then RewriteExpr env ast else ast),{contents=Some(typeDefs,argTypes,rewriteExprs env argExprs,data)},isFromQueryExpression,m,ty) - | Expr.Quote(ast,{contents=None},isFromQueryExpression,m,ty) -> - Expr.Quote((if env.IsUnderQuotations then RewriteExpr env ast else ast),{contents=None},isFromQueryExpression,m,ty) + | Expr.Quote(ast, {contents=None}, isFromQueryExpression, m, ty) -> + Expr.Quote((if env.IsUnderQuotations then RewriteExpr env ast else ast), {contents=None}, isFromQueryExpression, m, ty) - | Expr.Obj (_,ty,basev,basecall,overrides,iimpls,m) -> - mkObjExpr(ty,basev,RewriteExpr env basecall,List.map (rewriteObjExprOverride env) overrides, - List.map (rewriteObjExprInterfaceImpl env) iimpls,m) + | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> + mkObjExpr(ty, basev, RewriteExpr env basecall, List.map (rewriteObjExprOverride env) overrides, + List.map (rewriteObjExprInterfaceImpl env) iimpls, m) | Expr.Link eref -> RewriteExpr env !eref - | Expr.Op (c,tyargs,args,m) -> + | Expr.Op (c, tyargs, args, m) -> let args' = rewriteExprs env args if args === args' then expr - else Expr.Op (c,tyargs,args',m) + else Expr.Op (c, tyargs, args', m) - | Expr.Lambda(_lambdaId,ctorThisValOpt,baseValOpt,argvs,body,m,rty) -> + | Expr.Lambda(_lambdaId, ctorThisValOpt, baseValOpt, argvs, body, m, rty) -> let body = RewriteExpr env body - rebuildLambda m ctorThisValOpt baseValOpt argvs (body,rty) + rebuildLambda m ctorThisValOpt baseValOpt argvs (body, rty) - | Expr.TyLambda(_lambdaId,argtyvs,body,m,rty) -> + | Expr.TyLambda(_lambdaId, argtyvs, body, m, rty) -> let body = RewriteExpr env body - mkTypeLambda m argtyvs (body,rty) + mkTypeLambda m argtyvs (body, rty) - | Expr.Match(spBind,exprm,dtree,targets,m,ty) -> + | Expr.Match(spBind, exprm, dtree, targets, m, ty) -> let dtree' = rewriteDecisionTree env dtree let targets' = rewriteTargets env targets mkAndSimplifyMatch spBind exprm m ty dtree' targets' - | Expr.LetRec (binds,e,m,_) -> + | Expr.LetRec (binds, e, m, _) -> let binds = rewriteBinds env binds let e' = RewriteExpr env e - Expr.LetRec(binds,e',m,NewFreeVarsCache()) + Expr.LetRec(binds, e', m, NewFreeVarsCache()) | Expr.Let _ -> failwith "unreachable - linear let" | Expr.Sequential _ -> failwith "unreachable - linear seq" - | Expr.StaticOptimization (constraints,e2,e3,m) -> + | Expr.StaticOptimization (constraints, e2, e3, m) -> let e2' = RewriteExpr env e2 let e3' = RewriteExpr env e3 - Expr.StaticOptimization(constraints,e2',e3',m) + Expr.StaticOptimization(constraints, e2', e3', m) - | Expr.TyChoose (a,b,m) -> - Expr.TyChoose(a,RewriteExpr env b,m) + | Expr.TyChoose (a, b, m) -> + Expr.TyChoose(a, RewriteExpr env b, m) and rewriteLinearExpr env expr contf = // schedule a rewrite on the way back up by adding to the continuation @@ -7546,21 +7553,21 @@ and rewriteLinearExpr env expr contf = | Some expr -> contf expr (* done - intercepted! *) | None -> match expr with - | Expr.Let (bind,body,m,_) -> + | Expr.Let (bind, body, m, _) -> let bind = rewriteBind env bind rewriteLinearExpr env body (contf << (fun body' -> mkLetBind m bind body')) - | Expr.Sequential (e1,e2,dir,spSeq,m) -> + | Expr.Sequential (e1, e2, dir, spSeq, m) -> let e1' = RewriteExpr env e1 rewriteLinearExpr env e2 (contf << (fun e2' -> if e1 === e1' && e2 === e2' then expr - else Expr.Sequential(e1',e2',dir,spSeq,m))) - | LinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty) -> + else Expr.Sequential(e1', e2', dir, spSeq, m))) + | LinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty) -> let dtree = rewriteDecisionTree env dtree let tg1 = rewriteTarget env tg1 // tailcall rewriteLinearExpr env e2 (contf << (fun e2 -> - rebuildLinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty))) + rebuildLinearMatchExpr (spBind, exprm, dtree, tg1, e2, sp2, m2, ty))) | _ -> (* no longer linear *) contf (RewriteExpr env expr) @@ -7570,51 +7577,51 @@ and rewriteFlatExprs env exprs = List.mapq (RewriteExpr env) exprs and rewriteDecisionTree env x = match x with - | TDSuccess (es,n) -> + | TDSuccess (es, n) -> let es' = rewriteFlatExprs env es if LanguagePrimitives.PhysicalEquality es es' then x - else TDSuccess(es',n) + else TDSuccess(es', n) - | TDSwitch (e,cases,dflt,m) -> + | TDSwitch (e, cases, dflt, m) -> let e' = RewriteExpr env e - let cases' = List.map (fun (TCase(discrim,e)) -> TCase(discrim,rewriteDecisionTree env e)) cases + let cases' = List.map (fun (TCase(discrim, e)) -> TCase(discrim, rewriteDecisionTree env e)) cases let dflt' = Option.map (rewriteDecisionTree env) dflt - TDSwitch (e',cases',dflt',m) + TDSwitch (e', cases', dflt', m) - | TDBind (bind,body) -> + | TDBind (bind, body) -> let bind' = rewriteBind env bind let body = rewriteDecisionTree env body - TDBind (bind',body) + TDBind (bind', body) -and rewriteTarget env (TTarget(vs,e,spTarget)) = TTarget(vs,RewriteExpr env e,spTarget) +and rewriteTarget env (TTarget(vs, e, spTarget)) = TTarget(vs, RewriteExpr env e, spTarget) and rewriteTargets env targets = List.map (rewriteTarget env) (Array.toList targets) -and rewriteObjExprOverride env (TObjExprMethod(slotsig,attribs,tps,vs,e,m)) = - TObjExprMethod(slotsig,attribs,tps,vs,RewriteExpr env e,m) +and rewriteObjExprOverride env (TObjExprMethod(slotsig, attribs, tps, vs, e, m)) = + TObjExprMethod(slotsig, attribs, tps, vs, RewriteExpr env e, m) -and rewriteObjExprInterfaceImpl env (ty,overrides) = +and rewriteObjExprInterfaceImpl env (ty, overrides) = (ty, List.map (rewriteObjExprOverride env) overrides) and rewriteModuleOrNamespaceExpr env x = match x with - (* | ModuleOrNamespaceExprWithSig(mty,e,m) -> ModuleOrNamespaceExprWithSig(mty,rewriteModuleOrNamespaceExpr env e,m) *) - | ModuleOrNamespaceExprWithSig(mty,def,m) -> ModuleOrNamespaceExprWithSig(mty,rewriteModuleOrNamespaceDef env def,m) + (* | ModuleOrNamespaceExprWithSig(mty, e, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceExpr env e, m) *) + | ModuleOrNamespaceExprWithSig(mty, def, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceDef env def, m) and rewriteModuleOrNamespaceDefs env x = List.map (rewriteModuleOrNamespaceDef env) x and rewriteModuleOrNamespaceDef env x = match x with - | TMDefRec(isRec,tycons,mbinds,m) -> TMDefRec(isRec,tycons,rewriteModuleOrNamespaceBindings env mbinds,m) - | TMDefLet(bind,m) -> TMDefLet(rewriteBind env bind,m) - | TMDefDo(e,m) -> TMDefDo(RewriteExpr env e,m) + | TMDefRec(isRec, tycons, mbinds, m) -> TMDefRec(isRec, tycons, rewriteModuleOrNamespaceBindings env mbinds, m) + | TMDefLet(bind, m) -> TMDefLet(rewriteBind env bind, m) + | TMDefDo(e, m) -> TMDefDo(RewriteExpr env e, m) | TMDefs defs -> TMDefs(rewriteModuleOrNamespaceDefs env defs) | TMAbstract mexpr -> TMAbstract(rewriteModuleOrNamespaceExpr env mexpr) and rewriteModuleOrNamespaceBinding env x = match x with | ModuleOrNamespaceBinding.Binding bind -> ModuleOrNamespaceBinding.Binding (rewriteBind env bind) - | ModuleOrNamespaceBinding.Module(nm, rhs) -> ModuleOrNamespaceBinding.Module(nm,rewriteModuleOrNamespaceDef env rhs) + | ModuleOrNamespaceBinding.Module(nm, rhs) -> ModuleOrNamespaceBinding.Module(nm, rewriteModuleOrNamespaceDef env rhs) and rewriteModuleOrNamespaceBindings env mbinds = List.map (rewriteModuleOrNamespaceBinding env) mbinds @@ -7637,7 +7644,7 @@ let MakeExportRemapping viewedCcu (mspec:ModuleOrNamespace) = if entity.IsNamespace then acc else - error(InternalError("Unexpected entity without a pubpath when remapping assembly data",entity.Range)) + error(InternalError("Unexpected entity without a pubpath when remapping assembly data", entity.Range)) let accValRemap (vspec:Val) acc = // The acc contains the entity remappings @@ -7645,7 +7652,7 @@ let MakeExportRemapping viewedCcu (mspec:ModuleOrNamespace) = | Some vref -> {acc with valRemap=acc.valRemap.Add vspec vref } | None -> - error(InternalError("Unexpected value without a pubpath when remapping assembly data",vspec.Range)) + error(InternalError("Unexpected value without a pubpath when remapping assembly data", vspec.Range)) let mty = mspec.ModuleOrNamespaceType let entities = allEntitiesOfModuleOrNamespaceTy mty @@ -7666,7 +7673,7 @@ let MakeExportRemapping viewedCcu (mspec:ModuleOrNamespace) = let rec remapEntityDataToNonLocal g tmenv (d: Entity) = - let tps',tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv (d.entity_typars.Force(d.entity_range)) + let tps', tmenvinner = tmenvCopyRemapAndBindTypars (remapAttribs g tmenv) tmenv (d.entity_typars.Force(d.entity_range)) { d with entity_typars = LazyWithContext.NotLazy tps'; @@ -7708,7 +7715,7 @@ let IsGenericValWithGenericContraints g (v:Val) = // Does a type support a given interface? type Entity with member tycon.HasInterface g ty = - tycon.TypeContents.tcaug_interfaces |> List.exists (fun (x,_,_) -> typeEquiv g ty x) + tycon.TypeContents.tcaug_interfaces |> List.exists (fun (x, _, _) -> typeEquiv g ty x) // Does a type have an override matching the given name and argument types? // Used to detect the presence of 'Equals' and 'GetHashCode' in type checking @@ -7740,9 +7747,9 @@ type EntityRef with member tcref.HasOverride g nm argtys = tcref.Deref.HasOverride g nm argtys member tcref.HasMember g nm argtys = tcref.Deref.HasMember g nm argtys -let mkFastForLoop g (spLet,m,idv:Val,start,dir,finish,body) = +let mkFastForLoop g (spLet, m, idv:Val, start, dir, finish, body) = let dir = if dir then FSharpForLoopUp else FSharpForLoopDown - mkFor g (spLet,idv,start,dir,finish,body,m) + mkFor g (spLet, idv, start, dir, finish, body, m) /// Accessing a binding of the form "let x = 1" or "let x = e" for any "e" satisfying the predicate @@ -7750,9 +7757,9 @@ let mkFastForLoop g (spLet,m,idv:Val,start,dir,finish,body) = let IsSimpleSyntacticConstantExpr g inputExpr = let rec checkExpr (vrefs: Set) x = match stripExpr x with - | Expr.Op (TOp.Coerce,_,[arg],_) + | Expr.Op (TOp.Coerce, _, [arg], _) -> checkExpr vrefs arg - | UnopExpr g (vref,arg) + | UnopExpr g (vref, arg) when (valRefEq g vref g.unchecked_unary_minus_vref || valRefEq g vref g.unchecked_unary_plus_vref || valRefEq g vref g.unchecked_unary_not_vref || @@ -7780,13 +7787,13 @@ let IsSimpleSyntacticConstantExpr g inputExpr = valRefEq g vref g.bitwise_or_vref) && (not (typeEquiv g (tyOfExpr g arg1) g.string_ty) && not (typeEquiv g (tyOfExpr g arg1) g.decimal_ty) ) -> checkExpr vrefs arg1 && checkExpr vrefs arg2 - | Expr.Val(vref,_,_) -> vref.Deref.IsCompiledAsStaticPropertyWithoutField || vrefs.Contains vref.Stamp - | Expr.Match(_,_,dtree,targets,_,_) -> checkDecisionTree vrefs dtree && targets |> Array.forall (checkDecisionTreeTarget vrefs) - | Expr.Let(b,e,_,_) -> checkExpr vrefs b.Expr && checkExpr (vrefs.Add b.Var.Stamp) e + | Expr.Val(vref, _, _) -> vref.Deref.IsCompiledAsStaticPropertyWithoutField || vrefs.Contains vref.Stamp + | Expr.Match(_, _, dtree, targets, _, _) -> checkDecisionTree vrefs dtree && targets |> Array.forall (checkDecisionTreeTarget vrefs) + | Expr.Let(b, e, _, _) -> checkExpr vrefs b.Expr && checkExpr (vrefs.Add b.Var.Stamp) e // Detect standard constants - | Expr.TyChoose (_,b,_) -> checkExpr vrefs b + | Expr.TyChoose (_, b, _) -> checkExpr vrefs b | Expr.Const _ - | Expr.Op (TOp.UnionCase _,_,[],_) // Nullary union cases + | Expr.Op (TOp.UnionCase _, _, [], _) // Nullary union cases | UncheckedDefaultOfExpr g _ | SizeOfExpr g _ | TypeOfExpr g _ -> true @@ -7795,12 +7802,12 @@ let IsSimpleSyntacticConstantExpr g inputExpr = and checkDecisionTree vrefs x = match x with - | TDSuccess (es,_n) -> es |> List.forall (checkExpr vrefs) - | TDSwitch (e,cases,dflt,_m) -> checkExpr vrefs e && cases |> List.forall (checkDecisionTreeCase vrefs) && dflt |> Option.forall (checkDecisionTree vrefs) - | TDBind (bind,body) -> checkExpr vrefs bind.Expr && checkDecisionTree (vrefs.Add bind.Var.Stamp) body - and checkDecisionTreeCase vrefs (TCase(discrim,dtree)) = + | TDSuccess (es, _n) -> es |> List.forall (checkExpr vrefs) + | TDSwitch (e, cases, dflt, _m) -> checkExpr vrefs e && cases |> List.forall (checkDecisionTreeCase vrefs) && dflt |> Option.forall (checkDecisionTree vrefs) + | TDBind (bind, body) -> checkExpr vrefs bind.Expr && checkDecisionTree (vrefs.Add bind.Var.Stamp) body + and checkDecisionTreeCase vrefs (TCase(discrim, dtree)) = (match discrim with DecisionTreeTest.Const _c -> true | _ -> false) && checkDecisionTree vrefs dtree - and checkDecisionTreeTarget vrefs (TTarget(vs,e,_)) = + and checkDecisionTreeTarget vrefs (TTarget(vs, e, _)) = let vrefs = ((vrefs, vs) ||> List.fold (fun s v -> s.Add v.Stamp)) checkExpr vrefs e @@ -7811,23 +7818,23 @@ let EvalArithBinOp (opInt8, opInt16, opInt32, opInt64, opUInt8, opUInt16, opUInt let m = unionRanges arg1.Range arg2.Range try match arg1, arg2 with - | Expr.Const(Const.Int32 x1,_,ty), Expr.Const(Const.Int32 x2,_,_) -> Expr.Const(Const.Int32 (opInt32 x1 x2),m,ty) - | Expr.Const(Const.SByte x1,_,ty), Expr.Const(Const.SByte x2,_,_) -> Expr.Const(Const.SByte (opInt8 x1 x2),m,ty) - | Expr.Const(Const.Int16 x1,_,ty), Expr.Const(Const.Int16 x2,_,_) -> Expr.Const(Const.Int16 (opInt16 x1 x2),m,ty) - | Expr.Const(Const.Int64 x1,_,ty), Expr.Const(Const.Int64 x2,_,_) -> Expr.Const(Const.Int64 (opInt64 x1 x2),m,ty) - | Expr.Const(Const.Byte x1,_,ty), Expr.Const(Const.Byte x2,_,_) -> Expr.Const(Const.Byte (opUInt8 x1 x2),m,ty) - | Expr.Const(Const.UInt16 x1,_,ty), Expr.Const(Const.UInt16 x2,_,_) -> Expr.Const(Const.UInt16 (opUInt16 x1 x2),m,ty) - | Expr.Const(Const.UInt32 x1,_,ty), Expr.Const(Const.UInt32 x2,_,_) -> Expr.Const(Const.UInt32 (opUInt32 x1 x2),m,ty) - | Expr.Const(Const.UInt64 x1,_,ty), Expr.Const(Const.UInt64 x2,_,_) -> Expr.Const(Const.UInt64 (opUInt64 x1 x2),m,ty) - | _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(),m)) - with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(),m)) + | Expr.Const(Const.Int32 x1, _, ty), Expr.Const(Const.Int32 x2, _, _) -> Expr.Const(Const.Int32 (opInt32 x1 x2), m, ty) + | Expr.Const(Const.SByte x1, _, ty), Expr.Const(Const.SByte x2, _, _) -> Expr.Const(Const.SByte (opInt8 x1 x2), m, ty) + | Expr.Const(Const.Int16 x1, _, ty), Expr.Const(Const.Int16 x2, _, _) -> Expr.Const(Const.Int16 (opInt16 x1 x2), m, ty) + | Expr.Const(Const.Int64 x1, _, ty), Expr.Const(Const.Int64 x2, _, _) -> Expr.Const(Const.Int64 (opInt64 x1 x2), m, ty) + | Expr.Const(Const.Byte x1, _, ty), Expr.Const(Const.Byte x2, _, _) -> Expr.Const(Const.Byte (opUInt8 x1 x2), m, ty) + | Expr.Const(Const.UInt16 x1, _, ty), Expr.Const(Const.UInt16 x2, _, _) -> Expr.Const(Const.UInt16 (opUInt16 x1 x2), m, ty) + | Expr.Const(Const.UInt32 x1, _, ty), Expr.Const(Const.UInt32 x2, _, _) -> Expr.Const(Const.UInt32 (opUInt32 x1 x2), m, ty) + | Expr.Const(Const.UInt64 x1, _, ty), Expr.Const(Const.UInt64 x2, _, _) -> Expr.Const(Const.UInt64 (opUInt64 x1 x2), m, ty) + | _ -> error (Error ( FSComp.SR.tastNotAConstantExpression(), m)) + with :? System.OverflowException -> error (Error ( FSComp.SR.tastConstantExpressionOverflow(), m)) // See also PostTypeCheckSemanticChecks.CheckAttribArgExpr, which must match this precisely let rec EvalAttribArgExpr g x = match x with // Detect standard constants - | Expr.Const(c,m,_) -> + | Expr.Const(c, m, _) -> match c with | Const.Bool _ | Const.Int32 _ @@ -7846,44 +7853,44 @@ let rec EvalAttribArgExpr g x = | Const.String _ -> x | Const.Decimal _ | Const.IntPtr _ | Const.UIntPtr _ | Const.Unit _ -> - errorR (Error ( FSComp.SR.tastNotAConstantExpression(),m)) + errorR (Error ( FSComp.SR.tastNotAConstantExpression(), m)) x | TypeOfExpr g _ -> x | TypeDefOfExpr g _ -> x - | Expr.Op (TOp.Coerce,_,[arg],_) -> + | Expr.Op (TOp.Coerce, _, [arg], _) -> EvalAttribArgExpr g arg | EnumExpr g arg1 -> EvalAttribArgExpr g arg1 // Detect bitwise or of attribute flags | AttribBitwiseOrExpr g (arg1, arg2) -> - EvalArithBinOp ((|||),(|||),(|||),(|||),(|||),(|||),(|||),(|||)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) + EvalArithBinOp ((|||), (|||), (|||), (|||), (|||), (|||), (|||), (|||)) (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) | SpecificBinopExpr g g.unchecked_addition_vref (arg1, arg2) -> // At compile-time we check arithmetic - let v1,v2 = EvalAttribArgExpr g arg1, EvalAttribArgExpr g arg2 - match v1,v2 with - | Expr.Const(Const.String x1,m,ty), Expr.Const(Const.String x2,_,_) -> Expr.Const(Const.String (x1 + x2),m,ty) + let v1, v2 = EvalAttribArgExpr g arg1, EvalAttribArgExpr g arg2 + match v1, v2 with + | Expr.Const(Const.String x1, m, ty), Expr.Const(Const.String x2, _, _) -> Expr.Const(Const.String (x1 + x2), m, ty) | _ -> #if ALLOW_ARITHMETIC_OPS_IN_LITERAL_EXPRESSIONS_AND_ATTRIBUTE_ARGS - EvalArithBinOp (Checked.(+),Checked.(+),Checked.(+),Checked.(+),Checked.(+),Checked.(+),Checked.(+),Checked.(+)) g v1 v2 + EvalArithBinOp (Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+), Checked.(+)) g v1 v2 #else - errorR (Error ( FSComp.SR.tastNotAConstantExpression(),x.Range)); + errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)); x #endif #if ALLOW_ARITHMETIC_OPS_IN_LITERAL_EXPRESSIONS_AND_ATTRIBUTE_ARGS | SpecificBinopExpr g g.unchecked_subtraction_vref (arg1, arg2) -> - EvalArithBinOp (Checked.(-),Checked.(-),Checked.(-),Checked.(-),Checked.(-),Checked.(-),Checked.(-),Checked.(-)) g (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) + EvalArithBinOp (Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-), Checked.(-)) g (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) | SpecificBinopExpr g g.unchecked_multiply_vref (arg1, arg2) -> - EvalArithBinOp (Checked.(*),Checked.(*),Checked.(*),Checked.(*),Checked.(*),Checked.(*),Checked.(*),Checked.(*)) g (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) + EvalArithBinOp (Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*), Checked.(*)) g (EvalAttribArgExpr g arg1) (EvalAttribArgExpr g arg2) #endif | _ -> - errorR (Error ( FSComp.SR.tastNotAConstantExpression(),x.Range)); + errorR (Error ( FSComp.SR.tastNotAConstantExpression(), x.Range)); x and EvaledAttribExprEquality g e1 e2 = - match e1,e2 with - | Expr.Const(c1,_,_),Expr.Const(c2,_,_) -> c1 = c2 + match e1, e2 with + | Expr.Const(c1, _, _), Expr.Const(c2, _, _) -> c1 = c2 | TypeOfExpr g ty1, TypeOfExpr g ty2 -> typeEquiv g ty1 ty2 | TypeDefOfExpr g ty1, TypeDefOfExpr g ty2 -> typeEquiv g ty1 ty2 | _ -> false @@ -7908,10 +7915,10 @@ let (|ConstToILFieldInit|_|) c = let EvalLiteralExprOrAttribArg g x = match x with - | Expr.Op (TOp.Coerce,_,[Expr.Op (TOp.Array,[elemTy],args,m)],_) - | Expr.Op (TOp.Array,[elemTy],args,m) -> + | Expr.Op (TOp.Coerce, _, [Expr.Op (TOp.Array, [elemTy], args, m)], _) + | Expr.Op (TOp.Array, [elemTy], args, m) -> let args = args |> List.map (EvalAttribArgExpr g) - Expr.Op (TOp.Array,[elemTy],args,m) + Expr.Op (TOp.Array, [elemTy], args, m) | _ -> EvalAttribArgExpr g x @@ -7925,20 +7932,20 @@ let EvalLiteralExprOrAttribArg g x = // below is a little ugly. let GetTypeOfIntrinsicMemberInCompiledForm g (vref:ValRef) = assert (not vref.IsExtensionMember) - let membInfo,topValInfo = checkMemberValRef vref - let tps,argInfos,rty,retInfo = GetTypeOfMemberInMemberForm g vref + let membInfo, topValInfo = checkMemberValRef vref + let tps, argInfos, rty, retInfo = GetTypeOfMemberInMemberForm g vref let argInfos = // Check if the thing is really an instance member compiled as a static member // If so, the object argument counts as a normal argument in the compiled form if membInfo.MemberFlags.IsInstance && not (ValRefIsCompiledAsInstanceMember g vref) then - let _,origArgInfos,_,_ = GetTopValTypeInFSharpForm g topValInfo vref.Type vref.Range + let _, origArgInfos, _, _ = GetTopValTypeInFSharpForm g topValInfo vref.Type vref.Range match origArgInfos with | [] -> - errorR(InternalError("value does not have a valid member type",vref.Range)); + errorR(InternalError("value does not have a valid member type", vref.Range)); argInfos | h::_ -> h ::argInfos else argInfos - tps,argInfos,rty,retInfo + tps, argInfos, rty, retInfo //-------------------------------------------------------------------------- @@ -7946,90 +7953,90 @@ let GetTypeOfIntrinsicMemberInCompiledForm g (vref:ValRef) = //------------------------------------------------------------------------ -let rec mkCompiledTuple g isStruct (argtys,args,m) = +let rec mkCompiledTuple g isStruct (argtys, args, m) = let n = List.length argtys if n <= 0 then failwith "mkCompiledTuple" elif n < maxTuple then (mkCompiledTupleTyconRef g isStruct n, argtys, args, m) else - let argtysA,argtysB = List.splitAfter goodTupleFields argtys - let argsA,argsB = List.splitAfter goodTupleFields args + let argtysA, argtysB = List.splitAfter goodTupleFields argtys + let argsA, argsB = List.splitAfter goodTupleFields args let ty8, v8 = - match argtysB,argsB with - | [ty8],[arg8] -> + match argtysB, argsB with + | [ty8], [arg8] -> match ty8 with // if it's already been nested or ended, pass it through | TType_app(tn, _) when (isCompiledTupleTyconRef g tn) -> - ty8,arg8 + ty8, arg8 | _ -> - let ty8enc = TType_app((if isStruct then g.struct_tuple1_tcr else g.ref_tuple1_tcr),[ty8]) - let v8enc = Expr.Op (TOp.Tuple (TupInfo.Const isStruct),[ty8],[arg8],m) - ty8enc,v8enc + let ty8enc = TType_app((if isStruct then g.struct_tuple1_tcr else g.ref_tuple1_tcr), [ty8]) + let v8enc = Expr.Op (TOp.Tuple (TupInfo.Const isStruct), [ty8], [arg8], m) + ty8enc, v8enc | _ -> - let a,b,c,d = mkCompiledTuple g isStruct (argtysB, argsB, m) - let ty8plus = TType_app(a,b) - let v8plus = Expr.Op (TOp.Tuple(TupInfo.Const isStruct),b,c,d) - ty8plus,v8plus + let a, b, c, d = mkCompiledTuple g isStruct (argtysB, argsB, m) + let ty8plus = TType_app(a, b) + let v8plus = Expr.Op (TOp.Tuple(TupInfo.Const isStruct), b, c, d) + ty8plus, v8plus let argtysAB = argtysA @ [ty8] - (mkCompiledTupleTyconRef g isStruct (List.length argtysAB), argtysAB,argsA @ [v8],m) + (mkCompiledTupleTyconRef g isStruct (List.length argtysAB), argtysAB, argsA @ [v8], m) let mkILMethodSpecForTupleItem (_g : TcGlobals) (typ:ILType) n = mkILNonGenericInstanceMethSpecInTy(typ, (if n < goodTupleFields then "get_Item"+(n+1).ToString() else "get_Rest"), [], mkILTyvarTy (uint16 n)) let mkILFieldSpecForTupleItem (typ:ILType) n = - mkILFieldSpecInTy (typ,(if n < goodTupleFields then "Item"+(n+1).ToString() else "Rest"), mkILTyvarTy (uint16 n)) + mkILFieldSpecInTy (typ, (if n < goodTupleFields then "Item"+(n+1).ToString() else "Rest"), mkILTyvarTy (uint16 n)) let mkGetTupleItemN g m n (typ:ILType) isStruct te retty = if isStruct then - mkAsmExpr([mkNormalLdfld (mkILFieldSpecForTupleItem typ n) ],[],[te],[retty],m) + mkAsmExpr([mkNormalLdfld (mkILFieldSpecForTupleItem typ n) ], [], [te], [retty], m) else - mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g typ n)],[],[te],[retty],m) + mkAsmExpr([IL.mkNormalCall(mkILMethodSpecForTupleItem g typ n)], [], [te], [retty], m) /// Match an Int32 constant expression let (|Int32Expr|_|) expr = match expr with - | Expr.Const(Const.Int32 n,_,_) -> Some n + | Expr.Const(Const.Int32 n, _, _) -> Some n | _ -> None /// 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) + | Expr.Op (TOp.TryFinally _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)], _) -> Some(e1, e2) | _ -> None // detect ONLY the while loops that result from compiling 'for ... in ... do ...' let (|WhileLoopForCompiledForEachExpr|_|) expr = match expr with - | Expr.Op (TOp.While (_, WhileLoopForCompiledForEachExprMarker),_,[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)],m) -> Some(e1,e2,m) + | Expr.Op (TOp.While (_, WhileLoopForCompiledForEachExprMarker), _, [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)], m) -> Some(e1, e2, m) | _ -> None let (|Let|_|) expr = match expr with - | Expr.Let(TBind(v,e1,sp),e2,_,_) -> Some(v,e1,sp,e2) + | Expr.Let(TBind(v, e1, sp), e2, _, _) -> Some(v, e1, sp, e2) | _ -> None let (|RangeInt32Step|_|) g expr = match expr with // detect 'n .. m' - | Expr.App(Expr.Val(vf,_,_),_,[tyarg],[startExpr;finishExpr],_) + | 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) // 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],_) + | Expr.App(Expr.Val(vf, _, _), _, [], [startExpr; Int32Expr n; finishExpr], _) when valRefEq g vf g.range_int32_op_vref -> Some(startExpr, n, finishExpr) | _ -> None let (|GetEnumeratorCall|_|) expr = match expr with - | Expr.Op (TOp.ILCall( _, _, _, _, _, _, _, iLMethodRef, _, _, _),_,[Expr.Val(vref,_,_) | Expr.Op(_, _, [Expr.Val(vref, ValUseFlag.NormalValUse, _)], _) ],_) -> + | 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 let (|CompiledForEachExpr|_|) g expr = match expr with - | Let (enumerableVar, enumerableExpr, _, - Let (enumeratorVar, GetEnumeratorCall enumerableVar2, enumeratorBind, - TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar,_,_,bodyExpr), _), _))) + | Let (enumerableVar, enumerableExpr, _, + Let (enumeratorVar, GetEnumeratorCall enumerableVar2, enumeratorBind, + TryFinally (WhileLoopForCompiledForEachExpr (_, Let (elemVar, _, _, bodyExpr), _), _))) // Apply correctness conditions to ensure this really is a compiled for-each expression. when valRefEq g (mkLocalValRef enumerableVar) enumerableVar2 && enumerableVar.IsCompilerGenerated && @@ -8043,7 +8050,7 @@ let (|CompiledForEachExpr|_|) g expr = let mBody = bodyExpr.Range let mWholeExpr = expr.Range - let spForLoop,mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart),spStart | _ -> NoSequencePointAtForLoop,mEnumExpr + let spForLoop, mForLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtForLoop(spStart), spStart | _ -> NoSequencePointAtForLoop, mEnumExpr let spWhileLoop = match enumeratorBind with SequencePointAtBinding(spStart) -> SequencePointAtWhileLoop(spStart)| _ -> NoSequencePointAtWhileLoop let enumerableTy = tyOfExpr g enumerableExpr @@ -8066,9 +8073,9 @@ let DetectAndOptimizeForExpression g option expr = | _, CompiledInt32RangeForEachExpr g (startExpr, (1 | -1 as step), finishExpr, elemVar, bodyExpr, ranges) -> let (_mEnumExpr, _mBody, spForLoop, _mForLoop, _spWhileLoop, mWholeExpr) = ranges - mkFastForLoop g (spForLoop,mWholeExpr,elemVar,startExpr,(step = 1),finishExpr,bodyExpr) + mkFastForLoop g (spForLoop, mWholeExpr, elemVar, startExpr, (step = 1), finishExpr, bodyExpr) - | OptimizeAllForExpressions,CompiledForEachExpr g (enumerableTy, enumerableExpr, elemVar, bodyExpr, ranges) -> + | OptimizeAllForExpressions, CompiledForEachExpr g (enumerableTy, enumerableExpr, elemVar, bodyExpr, ranges) -> let (mEnumExpr, mBody, spForLoop, mForLoop, spWhileLoop, mWholeExpr) = ranges @@ -8079,8 +8086,8 @@ let DetectAndOptimizeForExpression g option expr = // let elem = str.[idx] // body elem - let strVar ,strExpr = mkCompGenLocal mEnumExpr "str" enumerableTy - let idxVar ,idxExpr = mkCompGenLocal elemVar.Range "idx" g.int32_ty + let strVar , strExpr = mkCompGenLocal mEnumExpr "str" enumerableTy + let idxVar , idxExpr = mkCompGenLocal elemVar.Range "idx" g.int32_ty let lengthExpr = mkGetStringLength g mForLoop strExpr let charExpr = mkGetStringChar g mForLoop strExpr idxExpr @@ -8089,7 +8096,7 @@ let DetectAndOptimizeForExpression g option expr = let finishExpr = mkDecr g mForLoop lengthExpr let loopItemExpr = mkCoerceIfNeeded g elemVar.Type g.char_ty charExpr // for compat reasons, loop item over string is sometimes object, not char let bodyExpr = mkCompGenLet mForLoop elemVar loopItemExpr bodyExpr - let forExpr = mkFastForLoop g (spForLoop,mWholeExpr,idxVar,startExpr,true,finishExpr,bodyExpr) + let forExpr = mkFastForLoop g (spForLoop, mWholeExpr, idxVar, startExpr, true, finishExpr, bodyExpr) let expr = mkCompGenLet mEnumExpr strVar enumerableExpr forExpr expr @@ -8107,13 +8114,13 @@ let DetectAndOptimizeForExpression g option expr = let IndexHead = 0 let IndexTail = 1 - let currentVar ,currentExpr = mkMutableCompGenLocal mEnumExpr "current" enumerableTy - let nextVar ,nextExpr = mkMutableCompGenLocal mEnumExpr "next" enumerableTy + let currentVar , currentExpr = mkMutableCompGenLocal mEnumExpr "current" enumerableTy + let nextVar , nextExpr = mkMutableCompGenLocal mEnumExpr "next" enumerableTy let elemTy = destListTy g enumerableTy let guardExpr = mkNonNullTest g mForLoop nextExpr - let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr,g.cons_ucref,[elemTy],IndexHead,mForLoop) - let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr,g.cons_ucref,[elemTy],IndexTail,mForLoop) + let headOrDefaultExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexHead, mForLoop) + let tailOrNullExpr = mkUnionCaseFieldGetUnprovenViaExprAddr (currentExpr, g.cons_ucref, [elemTy], IndexTail, mForLoop) let bodyExpr = mkCompGenLet mForLoop elemVar headOrDefaultExpr (mkCompGenSequential mForLoop @@ -8147,10 +8154,10 @@ let (|InnerExprPat|) expr = stripExpr expr /// utility function related to this. let BindUnitVars g (mvs:Val list, paramInfos:ArgReprInfo list, body) = - match mvs,paramInfos with - | [v],[] -> + match mvs, paramInfos with + | [v], [] -> assert isUnitTy g v.Type [], mkLet NoSequencePointAtInvisibleBinding v.Range v (mkUnit g v.Range) body - | _ -> mvs,body + | _ -> mvs, body diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 42f484a7c0526a1bc5b56433a47e41b6026de4f5..6de317b9765077f1d9ec805c9ac20933464814e4 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -52,16 +52,16 @@ let isThreadOrContextStatic g attrs = HasFSharpAttributeOpt g g.attrib_ThreadStaticAttribute attrs || HasFSharpAttributeOpt g g.attrib_ContextStaticAttribute attrs -let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref,[ty],[],m) -let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref,[ty],[ph;pt],unionRanges ph.Range pt.Range) +let mkNilListPat (g: TcGlobals) m ty = TPat_unioncase(g.nil_ucref, [ty], [], m) +let mkConsListPat (g: TcGlobals) ty ph pt = TPat_unioncase(g.cons_ucref, [ty], [ph;pt], unionRanges ph.Range pt.Range) let mkCompGenLetIn m nm ty e f = - let v,ve = mkCompGenLocal m nm ty - mkCompGenLet m v e (f (v,ve)) + let v, ve = mkCompGenLocal m nm ty + mkCompGenLet m v e (f (v, ve)) let mkUnitDelayLambda (g: TcGlobals) m e = - let uv,_ = mkCompGenLocal m "unitVar" g.unit_ty - mkLambda m uv (e,tyOfExpr g e) + let uv, _ = mkCompGenLocal m "unitVar" g.unit_ty + mkLambda m uv (e, tyOfExpr g e) //------------------------------------------------------------------------- @@ -117,7 +117,7 @@ exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileNam // Identify any security attributes -let IsSecurityAttribute (g: TcGlobals) amap (casmap : Dictionary) (Attrib(tcref,_,_,_,_,_,_)) m = +let IsSecurityAttribute (g: TcGlobals) amap (casmap : Dictionary) (Attrib(tcref, _, _, _, _, _, _)) m = // There's no CAS on Silverlight, so we have to be careful here match g.attrib_SecurityAttribute with | None -> false @@ -133,32 +133,32 @@ let IsSecurityAttribute (g: TcGlobals) amap (casmap : Dictionary) (A exists | VNone -> false -let IsSecurityCriticalAttribute g (Attrib(tcref,_,_,_,_,_,_)) = +let IsSecurityCriticalAttribute g (Attrib(tcref, _, _, _, _, _, _)) = (tyconRefEq g tcref g.attrib_SecurityCriticalAttribute.TyconRef || tyconRefEq g tcref g.attrib_SecuritySafeCriticalAttribute.TyconRef) let RecdFieldInstanceChecks g amap ad m (rfinfo:RecdFieldInfo) = - if rfinfo.IsStatic then error (Error (FSComp.SR.tcStaticFieldUsedWhenInstanceFieldExpected(),m)) + if rfinfo.IsStatic then error (Error (FSComp.SR.tcStaticFieldUsedWhenInstanceFieldExpected(), m)) CheckRecdFieldInfoAttributes g rfinfo m |> CommitOperationResult CheckRecdFieldInfoAccessible amap m ad rfinfo let ILFieldInstanceChecks g amap ad m (finfo :ILFieldInfo) = - if finfo.IsStatic then error (Error (FSComp.SR.tcStaticFieldUsedWhenInstanceFieldExpected(),m)) + if finfo.IsStatic then error (Error (FSComp.SR.tcStaticFieldUsedWhenInstanceFieldExpected(), m)) CheckILFieldInfoAccessible g amap m ad finfo CheckILFieldAttributes g finfo m let MethInfoChecks g amap isInstance tyargsOpt objArgs ad m (minfo:MethInfo) = if minfo.IsInstance <> isInstance then if isInstance then - error (Error (FSComp.SR.csMethodIsNotAnInstanceMethod(minfo.LogicalName),m)) + error (Error (FSComp.SR.csMethodIsNotAnInstanceMethod(minfo.LogicalName), m)) else - error (Error (FSComp.SR.csMethodIsNotAStaticMethod(minfo.LogicalName),m)) + error (Error (FSComp.SR.csMethodIsNotAStaticMethod(minfo.LogicalName), m)) // keep the original accessibility domain to determine type accessibility let adOriginal = ad // Eliminate the 'protected' portion of the accessibility domain for instance accesses let ad = - match objArgs,ad with - | [objArg],AccessibleFrom(paths,Some tcref) -> + match objArgs, ad with + | [objArg], AccessibleFrom(paths, Some tcref) -> let objArgTy = tyOfExpr g objArg let ty = generalizedTyconRef tcref // We get to keep our rights if the type we're in subsumes the object argument type @@ -172,12 +172,12 @@ let MethInfoChecks g amap isInstance tyargsOpt objArgs ad m (minfo:MethInfo) = | _ -> ad if not (IsTypeAndMethInfoAccessible amap m adOriginal ad minfo) then - error (Error (FSComp.SR.tcMethodNotAccessible(minfo.LogicalName),m)) + error (Error (FSComp.SR.tcMethodNotAccessible(minfo.LogicalName), m)) CheckMethInfoAttributes g m tyargsOpt minfo |> CommitOperationResult let CheckRecdFieldMutation m denv (rfinfo:RecdFieldInfo) = - if not rfinfo.RecdField.IsMutable then error (FieldNotMutable(denv,rfinfo.RecdFieldRef,m)) + if not rfinfo.RecdField.IsMutable then error (FieldNotMutable(denv, rfinfo.RecdFieldRef, m)) //------------------------------------------------------------------------- // Information about object constructors @@ -254,7 +254,7 @@ type TcEnv = // see if an item is public or not // - Change fslib canonical module type to allow compiler references to these items // - Record the cpath for concrete modul_specs, tycon_specs and excon_specs so they can cache their generated IL representation where necessary - // - Record the pubpath of public, concrete {val,tycon,modul,excon}_specs. + // - Record the pubpath of public, concrete {val, tycon, modul, excon}_specs. // This information is used mainly when building non-local references // to public items. // @@ -378,7 +378,7 @@ let AddValListToNameEnv vs nenv = let addInternalsAccessibility env (ccu:CcuThunk) = - let compPath = CompPath (ccu.ILScopeRef,[]) + let compPath = CompPath (ccu.ILScopeRef, []) let eInternalsVisibleCompPaths = compPath :: env.eInternalsVisibleCompPaths { env with eAccessRights = computeAccessRights env.eAccessPath eInternalsVisibleCompPaths env.eFamilyType // update this computed field @@ -398,7 +398,7 @@ let AddLocalValMap tcSink scopem (vals:Val NameMap) env = else let env = ModifyNameResEnv (AddValMapToNameEnv vals) env { env with eUngeneralizableItems = NameMap.foldBackRange (typeOfVal >> addFreeItemOfTy) vals env.eUngeneralizableItems } - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddLocalVals tcSink scopem (vals:Val list) env = @@ -408,20 +408,20 @@ let AddLocalVals tcSink scopem (vals:Val list) env = else let env = ModifyNameResEnv (AddValListToNameEnv vals) env { env with eUngeneralizableItems = List.foldBack (typeOfVal >> addFreeItemOfTy) vals env.eUngeneralizableItems } - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddLocalVal tcSink scopem v env = let env = ModifyNameResEnv (fun nenv -> AddValRefToNameEnv nenv (mkLocalValRef v)) env let env = {env with eUngeneralizableItems = addFreeItemOfTy v.Type env.eUngeneralizableItems } - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddLocalExnDefnAndReport tcSink scopem env (exnc:Tycon) = let env = ModifyNameResEnv (fun nenv -> AddExceptionDeclsToNameEnv BulkAdd.No nenv (mkLocalEntityRef exnc)) env (* Also make VisualStudio think there is an identifier in scope at the range of the identifier text of its binding location *) - CallEnvSink tcSink (exnc.Range,env.NameEnv,env.eAccessRights) - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (exnc.Range, env.NameEnv, env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddLocalTyconRefs ownDefinition g amap m tcrefs env = @@ -434,7 +434,7 @@ let AddLocalTycons g amap m (tycons: Tycon list) env = let AddLocalTyconsAndReport tcSink scopem g amap m tycons env = let env = AddLocalTycons g amap m tycons env - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env //------------------------------------------------------------------------- @@ -445,7 +445,7 @@ let OpenModulesOrNamespaces tcSink g amap scopem root env mvvs = let env = if isNil mvvs then env else ModifyNameResEnv (fun nenv -> AddModulesAndNamespacesContentsToNameEnv g amap env.eAccessRights scopem root nenv mvvs) env - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddRootModuleOrNamespaceRefs g amap m env modrefs = @@ -460,7 +460,7 @@ let AddNonLocalCcu g amap scopem env assemblyName (ccu:CcuThunk, internalsVisib try System.Reflection.AssemblyName(visibleTo).Name = assemblyName with e -> - warning(InvalidInternalsVisibleToAssemblyName(visibleTo,ccu.FileName)) + warning(InvalidInternalsVisibleToAssemblyName(visibleTo, ccu.FileName)) false) let env = if internalsVisible then addInternalsAccessibility env ccu else env @@ -472,7 +472,7 @@ let AddNonLocalCcu g amap scopem env assemblyName (ccu:CcuThunk, internalsVisib let env = if isNil tcrefs then env else ModifyNameResEnv (fun nenv -> AddTyconRefsToNameEnv BulkAdd.Yes false g amap scopem true nenv tcrefs) env - //CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + //CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddLocalRootModuleOrNamespace tcSink g amap scopem env (mtyp:ModuleOrNamespaceType) = @@ -485,16 +485,16 @@ let AddLocalRootModuleOrNamespace tcSink g amap scopem env (mtyp:ModuleOrNamespa if isNil tcrefs then env else ModifyNameResEnv (fun nenv -> AddTyconRefsToNameEnv BulkAdd.No false g amap scopem true nenv tcrefs) env let env = { env with eUngeneralizableItems = addFreeItemOfModuleTy mtyp env.eUngeneralizableItems } - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let AddModuleAbbreviationAndReport tcSink scopem id modrefs env = let env = if isNil modrefs then env else ModifyNameResEnv (fun nenv -> AddModuleAbbrevToNameEnv id nenv modrefs) env - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) let item = Item.ModuleOrNamespaces modrefs - CallNameResolutionSink tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) env let AddLocalSubModule g amap m env (modul:ModuleOrNamespace) = @@ -504,7 +504,7 @@ let AddLocalSubModule g amap m env (modul:ModuleOrNamespace) = let AddLocalSubModuleAndReport tcSink scopem g amap m env (modul:ModuleOrNamespace) = let env = AddLocalSubModule g amap m env modul - CallEnvSink tcSink (scopem,env.NameEnv,env.eAccessRights) + CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights) env let RegisterDeclaredTypars typars env = @@ -568,10 +568,10 @@ type cenv = } - static member Create (g,isScript,niceNameGen,amap,topCcu,isSig,haveSig,conditionalDefines,tcSink, tcVal) = - let infoReader = new InfoReader(g,amap) + static member Create (g, isScript, niceNameGen, amap, topCcu, isSig, haveSig, conditionalDefines, tcSink, tcVal) = + let infoReader = new InfoReader(g, amap) let instantiationGenerator m tpsorig = ConstraintSolver.FreshenTypars m tpsorig - let nameResolver = new NameResolver(g,amap,infoReader,instantiationGenerator) + let nameResolver = new NameResolver(g, amap, infoReader, instantiationGenerator) { g = g amap = amap recUses = ValMultiMap<_>.Empty @@ -579,7 +579,7 @@ type cenv = createsGeneratedProvidedTypes = false topCcu = topCcu isScript = isScript - css = ConstraintSolverState.New(g,amap,infoReader,tcVal) + css = ConstraintSolverState.New(g, amap, infoReader, tcVal) infoReader = infoReader tcSink = tcSink nameResolver = nameResolver @@ -604,7 +604,7 @@ let UnifyTypes cenv (env: TcEnv) m expectedTy actualTy = let MakeInitialEnv env = // Note: here we allocate a new module type accumulator let mtypeAcc = ref (NewEmptyModuleOrNamespaceType Namespace) - { env with eModuleOrNamespaceTypeAccumulator = mtypeAcc },mtypeAcc + { env with eModuleOrNamespaceTypeAccumulator = mtypeAcc }, mtypeAcc let MakeInnerEnvWithAcc env nm mtypeAcc modKind = let path = env.ePath @ [nm] @@ -620,7 +620,7 @@ let MakeInnerEnvWithAcc env nm mtypeAcc modKind = let MakeInnerEnv env nm modKind = // Note: here we allocate a new module type accumulator let mtypeAcc = ref (NewEmptyModuleOrNamespaceType modKind) - MakeInnerEnvWithAcc env nm mtypeAcc modKind,mtypeAcc + MakeInnerEnvWithAcc env nm mtypeAcc modKind, mtypeAcc let MakeInnerEnvForTyconRef _cenv env tcref isExtrinsicExtension = @@ -658,14 +658,14 @@ let LocateEnv ccu env enclosingNamespacePath = env let BuildRootModuleType enclosingNamespacePath (cpath:CompilationPath) mtyp = - (enclosingNamespacePath,(cpath, (mtyp, None))) + (enclosingNamespacePath, (cpath, (mtyp, None))) ||> List.foldBack (fun id (cpath, (mtyp, mspec)) -> - let a,b = wrapModuleOrNamespaceTypeInNamespace id cpath.ParentCompPath mtyp + let a, b = wrapModuleOrNamespaceTypeInNamespace id cpath.ParentCompPath mtyp cpath.ParentCompPath, (a, match mspec with Some _ -> mspec | None -> Some b)) |> snd let BuildRootModuleExpr enclosingNamespacePath (cpath:CompilationPath) mexpr = - (enclosingNamespacePath,(cpath, mexpr)) + (enclosingNamespacePath, (cpath, mexpr)) ||> List.foldBack (fun id (cpath, mexpr) -> (cpath.ParentCompPath, wrapModuleOrNamespaceExprInNamespace id cpath.ParentCompPath mexpr)) |> snd @@ -674,9 +674,9 @@ let TryStripPrefixPath (g:TcGlobals) (enclosingNamespacePath: Ident list) = | p::rest when g.isInteractive && not (isNil rest) && - p.idText.StartsWith(FsiDynamicModulePrefix,System.StringComparison.Ordinal) && + p.idText.StartsWith(FsiDynamicModulePrefix, System.StringComparison.Ordinal) && p.idText.[FsiDynamicModulePrefix.Length..] |> String.forall System.Char.IsDigit - -> Some(p,rest) + -> Some(p, rest) | _ -> None let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = @@ -686,7 +686,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath env = // For F# interactive, skip "FSI_0002" prefixes when determining the path to open implicitly let enclosingNamespacePathToOpen = match TryStripPrefixPath g enclosingNamespacePath with - | Some(_,rest) -> rest + | Some(_, rest) -> rest | None -> enclosingNamespacePath let ad = env.eAccessRights @@ -739,7 +739,7 @@ let UnifyFunctionTypeUndoIfFailed cenv denv m ty = let domainTy = NewInferenceType () let resultTy = NewInferenceType () if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (domainTy --> resultTy) then - Some(domainTy,resultTy) + Some(domainTy, resultTy) else None | r -> r @@ -751,15 +751,15 @@ let UnifyFunctionType extraInfo cenv denv mFunExpr ty = | Some res -> res | None -> match extraInfo with - | Some argm -> error (NotAFunction(denv,ty,mFunExpr,argm)) - | None -> error (FunctionExpected(denv,ty,mFunExpr)) + | Some argm -> error (NotAFunction(denv, ty, mFunExpr, argm)) + | None -> error (FunctionExpected(denv, ty, mFunExpr)) let ReportImplicitlyIgnoredBoolExpression denv m ty expr = let checkExpr m exprOpt = match exprOpt with - | Expr.App(Expr.Val(vf,_,_),_,_,exprs,_) when vf.LogicalName = opNameEquals -> + | Expr.App(Expr.Val(vf, _, _), _, _, exprs, _) when vf.LogicalName = opNameEquals -> match exprs with - | Expr.App(Expr.Val(propRef,_,_),_,_,Expr.Val(vf,_,_) :: _,_) :: _ -> + | Expr.App(Expr.Val(propRef, _, _), _, _, Expr.Val(vf, _, _) :: _, _) :: _ -> if propRef.IsPropertyGetterMethod then let propertyName = propRef.PropertyName let hasCorrespondingSetter = @@ -770,28 +770,28 @@ let ReportImplicitlyIgnoredBoolExpression denv m ty expr = | _ -> false if hasCorrespondingSetter then - UnitTypeExpectedWithPossiblePropertySetter (denv,ty,vf.DisplayName,propertyName,m) + UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vf.DisplayName, propertyName, m) else - UnitTypeExpectedWithEquality (denv,ty,m) + UnitTypeExpectedWithEquality (denv, ty, m) else - UnitTypeExpectedWithEquality (denv,ty,m) - | Expr.Op(TOp.ILCall(_,_,_,_,_,_,_,methodRef,_,_,_),_,Expr.Val(vf,_,_) :: _,_) :: _ when methodRef.Name.StartsWith "get_"-> - UnitTypeExpectedWithPossiblePropertySetter (denv,ty,vf.DisplayName,PrettyNaming.ChopPropertyName(methodRef.Name),m) - | Expr.Val(vf,_,_) :: _ -> - UnitTypeExpectedWithPossibleAssignment (denv,ty,vf.IsMutable,vf.DisplayName,m) - | _ -> UnitTypeExpectedWithEquality (denv,ty,m) - | _ -> UnitTypeExpected (denv,ty,m) + UnitTypeExpectedWithEquality (denv, ty, m) + | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methodRef, _, _, _), _, Expr.Val(vf, _, _) :: _, _) :: _ when methodRef.Name.StartsWith "get_"-> + UnitTypeExpectedWithPossiblePropertySetter (denv, ty, vf.DisplayName, PrettyNaming.ChopPropertyName(methodRef.Name), m) + | Expr.Val(vf, _, _) :: _ -> + UnitTypeExpectedWithPossibleAssignment (denv, ty, vf.IsMutable, vf.DisplayName, m) + | _ -> UnitTypeExpectedWithEquality (denv, ty, m) + | _ -> UnitTypeExpected (denv, ty, m) match expr with - | Some(Expr.Let(_,Expr.Sequential(_,inner,_,_,_),_,_)) - | Some(Expr.Sequential(_,inner,_,_,_)) -> + | Some(Expr.Let(_, Expr.Sequential(_, inner, _, _, _), _, _)) + | Some(Expr.Sequential(_, inner, _, _, _)) -> let rec extractNext expr = match expr with - | Expr.Sequential(_,inner,_,_,_) -> extractNext inner + | Expr.Sequential(_, inner, _, _, _) -> extractNext inner | _ -> checkExpr expr.Range expr extractNext inner | Some expr -> checkExpr m expr - | _ -> UnitTypeExpected (denv,ty,m) + | _ -> UnitTypeExpected (denv, ty, m) let UnifyUnitType cenv denv m ty exprOpt = if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty cenv.g.unit_ty then @@ -800,10 +800,10 @@ let UnifyUnitType cenv denv m ty exprOpt = let domainTy = NewInferenceType () let resultTy = NewInferenceType () if AddCxTypeEqualsTypeUndoIfFailed denv cenv.css m ty (domainTy --> resultTy) then - warning (FunctionValueUnexpected(denv,ty,m)) + warning (FunctionValueUnexpected(denv, ty, m)) else if not (typeEquiv cenv.g cenv.g.bool_ty ty) then - warning (UnitTypeExpected (denv,ty,m)) + warning (UnitTypeExpected (denv, ty, m)) else warning (ReportImplicitlyIgnoredBoolExpression denv m ty exprOpt) false @@ -824,9 +824,9 @@ module AttributeTargets = let ForNewConstructors tcSink (env:TcEnv) mObjTy methodName meths = - let origItem = Item.CtorGroup(methodName,meths) - let callSink (item, minst) = CallNameResolutionSink tcSink (mObjTy,env.NameEnv,item,origItem,minst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) - let sendToSink minst refinedMeths = callSink (Item.CtorGroup(methodName,refinedMeths),minst) + let origItem = Item.CtorGroup(methodName, meths) + let callSink (item, minst) = CallNameResolutionSink tcSink (mObjTy, env.NameEnv, item, origItem, minst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) + let sendToSink minst refinedMeths = callSink (Item.CtorGroup(methodName, refinedMeths), minst) match meths with | [] -> AfterResolution.DoNothing @@ -834,7 +834,7 @@ let ForNewConstructors tcSink (env:TcEnv) mObjTy methodName meths = sendToSink emptyTyparInst meths AfterResolution.DoNothing | _ -> - AfterResolution.RecordResolution (None, (fun tpinst -> callSink (origItem,tpinst)), (fun (minfo,_,minst) -> sendToSink minst [minfo]), (fun () -> callSink (origItem,emptyTyparInst))) + AfterResolution.RecordResolution (None, (fun tpinst -> callSink (origItem, tpinst)), (fun (minfo, _, minst) -> sendToSink minst [minfo]), (fun () -> callSink (origItem, emptyTyparInst))) /// Typecheck rational constant terms in units-of-measure exponents @@ -842,14 +842,14 @@ let rec TcSynRationalConst c = match c with | SynRationalConst.Integer i -> intToRational i | SynRationalConst.Negate c' -> NegRational (TcSynRationalConst c') - | SynRationalConst.Rational(p,q,_) -> DivRational (intToRational p) (intToRational q) + | SynRationalConst.Rational(p, q, _) -> DivRational (intToRational p) (intToRational q) /// Typecheck constant terms in expressions and patterns let TcConst cenv ty m env c = let rec tcMeasure ms = match ms with | SynMeasure.One -> Measure.One - | SynMeasure.Named(tc,m) -> + | SynMeasure.Named(tc, m) -> let ad = env.eAccessRights let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Use OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) match tcref.TypeOrMeasureKind with @@ -857,22 +857,22 @@ let TcConst cenv ty m env c = | TyparKind.Measure -> Measure.Con tcref | SynMeasure.Power(ms, exponent, _) -> Measure.RationalPower (tcMeasure ms, TcSynRationalConst exponent) - | SynMeasure.Product(ms1,ms2,_) -> Measure.Prod(tcMeasure ms1, tcMeasure ms2) + | SynMeasure.Product(ms1, ms2, _) -> Measure.Prod(tcMeasure ms1, tcMeasure ms2) | SynMeasure.Divide(ms1, ((SynMeasure.Seq (_::(_::_), _)) as ms2), m) -> - warning(Error(FSComp.SR.tcImplicitMeasureFollowingSlash(),m)) + warning(Error(FSComp.SR.tcImplicitMeasureFollowingSlash(), m)) Measure.Prod(tcMeasure ms1, Measure.Inv (tcMeasure ms2)) - | SynMeasure.Divide(ms1,ms2,_) -> + | SynMeasure.Divide(ms1, ms2, _) -> Measure.Prod(tcMeasure ms1, Measure.Inv (tcMeasure ms2)) - | SynMeasure.Seq(mss,_) -> ProdMeasures (List.map tcMeasure mss) - | SynMeasure.Anon _ -> error(Error(FSComp.SR.tcUnexpectedMeasureAnon(),m)) - | SynMeasure.Var(_,m) -> error(Error(FSComp.SR.tcNonZeroConstantCannotHaveGenericUnit(),m)) + | SynMeasure.Seq(mss, _) -> ProdMeasures (List.map tcMeasure mss) + | SynMeasure.Anon _ -> error(Error(FSComp.SR.tcUnexpectedMeasureAnon(), m)) + | SynMeasure.Var(_, m) -> error(Error(FSComp.SR.tcNonZeroConstantCannotHaveGenericUnit(), m)) let unif ty2 = UnifyTypes cenv env m ty ty2 let unif_measure_arg iszero tcr c = let measureTy = match c with | SynConst.Measure(_, SynMeasure.Anon _) -> - (mkAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure,m,TyparRigidity.Anon,(if iszero then NoStaticReq else HeadTypeStaticReq),TyparDynamicReq.No)))]) + (mkAppTy tcr [TType_measure (Measure.Var (NewAnonTypar (TyparKind.Measure, m, TyparRigidity.Anon, (if iszero then NoStaticReq else HeadTypeStaticReq), TyparDynamicReq.No)))]) | SynConst.Measure(_, ms) -> mkAppTy tcr [TType_measure (tcMeasure ms)] | _ -> mkAppTy tcr [TType_measure Measure.One] @@ -900,12 +900,12 @@ let TcConst cenv ty m env c = | SynConst.Measure(SynConst.Int32 i, _) | SynConst.Int32 i -> unif_measure_arg (i=0) cenv.g.pint_tcr c; Const.Int32 i | SynConst.Measure(SynConst.Int64 i, _) | SynConst.Int64 i -> unif_measure_arg (i=0L) cenv.g.pint64_tcr c; Const.Int64 i | SynConst.Char c -> unif cenv.g.char_ty; Const.Char c - | SynConst.String (s,_) -> unif cenv.g.string_ty; Const.String s + | SynConst.String (s, _) -> unif cenv.g.string_ty; Const.String s | SynConst.UserNum _ -> error(InternalError(FSComp.SR.tcUnexpectedBigRationalConstant(), m)) | SynConst.Measure _ -> error(Error(FSComp.SR.tcInvalidTypeForUnitsOfMeasure(), m)) - | SynConst.UInt16s _ -> error(InternalError(FSComp.SR.tcUnexpectedConstUint16Array(),m)) - | SynConst.Bytes _ -> error(InternalError(FSComp.SR.tcUnexpectedConstByteArray(),m)) + | SynConst.UInt16s _ -> error(InternalError(FSComp.SR.tcUnexpectedConstUint16Array(), m)) + | SynConst.Bytes _ -> error(InternalError(FSComp.SR.tcUnexpectedConstByteArray(), m)) /// Convert an Abstract IL ILFieldInit value read from .NET metadata to a TAST constant let TcFieldInit (_m:range) lit = @@ -936,7 +936,7 @@ let TcFieldInit (_m:range) lit = // Adjust the arities that came from the parsing of the toptyp (arities) to be a valSynData. // This means replacing the "[unitArg]" arising from a "unit -> ty" with a "[]". -let AdjustValSynInfoInSignature g ty (SynValInfo(argsData,retData) as sigMD) = +let AdjustValSynInfoInSignature g ty (SynValInfo(argsData, retData) as sigMD) = if argsData.Length = 1 && argsData.Head.Length = 1 && isFunTy g ty && typeEquiv g g.unit_ty (domainOfFunTy g ty) then SynValInfo(argsData.Head.Tail :: argsData.Tail, retData) else @@ -945,11 +945,11 @@ let AdjustValSynInfoInSignature g ty (SynValInfo(argsData,retData) as sigMD) = /// The ValReprInfo for a value, except the number of typars is not yet inferred type PartialValReprInfo = PartialValReprInfo of ArgReprInfo list list * ArgReprInfo -let TranslateTopArgSynInfo isArg m tcAttributes (SynArgInfo(attrs,isOpt,nm)) = +let TranslateTopArgSynInfo isArg m tcAttributes (SynArgInfo(attrs, isOpt, nm)) = // Synthesize an artificial "OptionalArgument" attribute for the parameter let optAttrs = if isOpt then - [ ( { TypeName=LongIdentWithDots(pathToSynLid m ["Microsoft";"FSharp";"Core";"OptionalArgument"],[]) + [ ( { TypeName=LongIdentWithDots(pathToSynLid m ["Microsoft";"FSharp";"Core";"OptionalArgument"], []) ArgExpr=mkSynUnit m Target=None AppliesToGetterAndSetter=false @@ -958,10 +958,10 @@ let TranslateTopArgSynInfo isArg m tcAttributes (SynArgInfo(attrs,isOpt,nm)) = [] if isArg && not (isNil attrs) && Option.isNone nm then - errorR(Error(FSComp.SR.tcParameterRequiresName(),m)) + errorR(Error(FSComp.SR.tcParameterRequiresName(), m)) if not isArg && Option.isSome nm then - errorR(Error(FSComp.SR.tcReturnValuesCannotHaveNames(),m)) + errorR(Error(FSComp.SR.tcReturnValuesCannotHaveNames(), m)) // Call the attribute checking function let attribs = tcAttributes (optAttrs@attrs) @@ -973,12 +973,12 @@ let TranslateTopArgSynInfo isArg m tcAttributes (SynArgInfo(attrs,isOpt,nm)) = /// Hence remove all "zeros" from arity and replace them with 1 here. /// Note we currently use the compiled form for choosing unique names, to distinguish overloads because this must match up /// between signature and implementation, and the signature just has "unit". -let TranslateTopValSynInfo m tcAttributes (SynValInfo(argsData,retData)) = +let TranslateTopValSynInfo m tcAttributes (SynValInfo(argsData, retData)) = PartialValReprInfo (argsData |> List.mapSquared (TranslateTopArgSynInfo true m (tcAttributes AttributeTargets.Parameter)), retData |> TranslateTopArgSynInfo false m (tcAttributes AttributeTargets.ReturnValue)) -let TranslatePartialArity tps (PartialValReprInfo (argsData,retData)) = - ValReprInfo(ValReprInfo.InferTyparInfo tps,argsData,retData) +let TranslatePartialArity tps (PartialValReprInfo (argsData, retData)) = + ValReprInfo(ValReprInfo.InferTyparInfo tps, argsData, retData) //------------------------------------------------------------------------- @@ -991,20 +991,20 @@ let ComputeLogicalName (id:Ident) memberFlags = | MemberKind.Constructor -> ".ctor" | MemberKind.Member -> match id.idText with - | (".ctor" | ".cctor") as r -> errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(),id.idRange)); r + | (".ctor" | ".cctor") as r -> errorR(Error(FSComp.SR.tcInvalidMemberNameCtor(), id.idRange)); r | r -> r - | MemberKind.PropertyGetSet -> error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(),id.idRange)) + | MemberKind.PropertyGetSet -> error(InternalError(FSComp.SR.tcMemberKindPropertyGetSetNotExpected(), id.idRange)) | MemberKind.PropertyGet -> "get_" + id.idText | MemberKind.PropertySet -> "set_" + id.idText -/// ValMemberInfoTransient(memberInfo,logicalName,compiledName) +/// ValMemberInfoTransient(memberInfo, logicalName, compiledName) type ValMemberInfoTransient = ValMemberInfoTransient of ValMemberInfo * string * string /// Make the unique "name" for a member. // // optImplSlotTy = None (for classes) or Some ty (when implementing interface type ty) -let MakeMemberDataAndMangledNameForMemberVal(g,tcref,isExtrinsic,attrs,optImplSlotTys,memberFlags,valSynData,id,isCompGen) = +let MakeMemberDataAndMangledNameForMemberVal(g, tcref, isExtrinsic, attrs, optImplSlotTys, memberFlags, valSynData, id, isCompGen) = let logicalName = ComputeLogicalName id memberFlags let optIntfSlotTys = if optImplSlotTys |> List.forall (isInterfaceTy g) then optImplSlotTys else [] let memberInfo : ValMemberInfo = @@ -1014,7 +1014,7 @@ let MakeMemberDataAndMangledNameForMemberVal(g,tcref,isExtrinsic,attrs,optImplSl // NOTE: This value is initially only set for interface implementations and those overrides // where we manage to pre-infer which abstract is overridden by the method. It is filled in // properly when we check the allImplemented implementation checks at the end of the inference scope. - ImplementedSlotSigs=optImplSlotTys |> List.map (fun ity -> TSlotSig(logicalName,ity,[],[],[],None)) } + ImplementedSlotSigs=optImplSlotTys |> List.map (fun ity -> TSlotSig(logicalName, ity, [], [], [], None)) } let isInstance = MemberIsCompiledAsInstance g tcref isExtrinsic memberInfo attrs if (memberFlags.IsDispatchSlot || not (isNil optIntfSlotTys)) then if not isInstance then @@ -1038,17 +1038,17 @@ let MakeMemberDataAndMangledNameForMemberVal(g,tcref,isExtrinsic,attrs,optImplSl let name = DecompileOpName id.idText // Check symbolic members. Expect valSynData implied arity to be [[2]]. match SynInfo.AritiesOfArgs valSynData with - | [] | [0] -> warning(Error(FSComp.SR.memberOperatorDefinitionWithNoArguments(name),m)) + | [] | [0] -> warning(Error(FSComp.SR.memberOperatorDefinitionWithNoArguments(name), m)) | n :: otherArgs -> let opTakesThreeArgs = PrettyNaming.IsTernaryOperator name - if n<>2 && not opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonPairArgument(name,n),m)) - if n<>3 && opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(name,n),m)) - if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments(name),m)) + if n<>2 && not opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonPairArgument(name, n), m)) + if n<>3 && opTakesThreeArgs then warning(Error(FSComp.SR.memberOperatorDefinitionWithNonTripleArgument(name, n), m)) + if not (isNil otherArgs) then warning(Error(FSComp.SR.memberOperatorDefinitionWithCurriedArguments(name), m)) if isExtrinsic && IsMangledOpName id.idText then - warning(Error(FSComp.SR.tcMemberOperatorDefinitionInExtrinsic(),id.idRange)) + warning(Error(FSComp.SR.tcMemberOperatorDefinitionInExtrinsic(), id.idRange)) - ValMemberInfoTransient(memberInfo,logicalName,compiledName) + ValMemberInfoTransient(memberInfo, logicalName, compiledName) type OverridesOK = @@ -1060,21 +1060,21 @@ type OverridesOK = /// are given and what additional type parameters can be inferred, if any. /// /// The declared type parameters, e.g. let f<'a> (x:'a) = x, plus an indication -/// of whether additional polymorphism may be inferred, e.g. let f<'a,..> (x:'a) y = x +/// of whether additional polymorphism may be inferred, e.g. let f<'a, ..> (x:'a) y = x type ExplicitTyparInfo = ExplicitTyparInfo of Tast.Typars * Tast.Typars * bool let permitInferTypars = ExplicitTyparInfo ([], [], true) let dontInferTypars = ExplicitTyparInfo ([], [], false) type ArgAndRetAttribs = ArgAndRetAttribs of Tast.Attribs list list * Tast.Attribs -let noArgOrRetAttribs = ArgAndRetAttribs ([],[]) +let noArgOrRetAttribs = ArgAndRetAttribs ([], []) /// A flag to represent the sort of bindings are we processing. /// Processing "declaration" and "class" bindings that make up a module (such as "let x = 1 let y = 2") /// shares the same code paths (e.g. TcLetBinding and TcLetrec) as processing expression bindings (such as "let x = 1 in ...") /// Member bindings also use this path. // -/// However there are differences in how different bindings get processed, +/// However there are differences in how different bindings get processed, /// i.e. module bindings get published to the implicitly accumulated module type, but expression 'let' bindings don't. type DeclKind = | ModuleOrMemberBinding @@ -1172,8 +1172,8 @@ type PrelimValScheme1 = ArgAndRetAttribs * SynAccess option * bool - member x.Type = let (PrelimValScheme1(_,_,ty,_,_,_,_,_,_,_,_)) = x in ty - member x.Ident = let (PrelimValScheme1(id,_,_,_,_,_,_,_,_,_,_)) = x in id + member x.Type = let (PrelimValScheme1(_, _, ty, _, _, _, _, _, _, _, _)) = x in ty + member x.Ident = let (PrelimValScheme1(id, _, _, _, _, _, _, _, _, _, _)) = x in id /// The results of applying let-style generalization after type checking. type PrelimValScheme2 = @@ -1206,8 +1206,8 @@ type ValScheme = bool * // isIncrClass bool * // isTyFunc bool // hasDeclaredTypars - member x.GeneralizedTypars = let (ValScheme(_,TypeScheme(gtps,_),_,_,_,_,_,_,_,_,_,_)) = x in gtps - member x.TypeScheme = let (ValScheme(_,ts,_,_,_,_,_,_,_,_,_,_)) = x in ts + member x.GeneralizedTypars = let (ValScheme(_, TypeScheme(gtps, _), _, _, _, _, _, _, _, _, _, _)) = x in gtps + member x.TypeScheme = let (ValScheme(_, ts, _, _, _, _, _, _, _, _, _, _)) = x in ts //------------------------------------------------------------------------- // Data structures that track the whole process of taking a syntactic binding and @@ -1222,7 +1222,7 @@ type ValScheme = type TcPatPhase2Input = | TcPatPhase2Input of (Val * TypeScheme) NameMap * bool // Get an input indicating we are no longer on the left-most path through a disjunctive "or" pattern - member x.RightPath = (let (TcPatPhase2Input(a,_)) = x in TcPatPhase2Input(a,false)) + member x.RightPath = (let (TcPatPhase2Input(a, _)) = x in TcPatPhase2Input(a, false)) /// The first phase of checking and elaborating a binding leaves a whole goop of information. /// This is a bit of a mess: much of this information is carried on a per-value basis by the @@ -1243,18 +1243,18 @@ type CheckedBindingInfo = bool * // compiler generated? Const option * // literal value? bool // fixed? - member x.Expr = let (CheckedBindingInfo(_,_,_,_,_,_,expr,_,_,_,_,_,_,_)) = x in expr - member x.SeqPoint = let (CheckedBindingInfo(_,_,_,_,_,_,_,_,_,_,spBind,_,_,_)) = x in spBind + member x.Expr = let (CheckedBindingInfo(_, _, _, _, _, _, expr, _, _, _, _, _, _, _)) = x in expr + member x.SeqPoint = let (CheckedBindingInfo(_, _, _, _, _, _, _, _, _, _, spBind, _, _, _)) = x in spBind //------------------------------------------------------------------------- // Helpers related to type schemes //------------------------------------------------------------------------- let GeneralizedTypeForTypeScheme typeScheme = - let (TypeScheme(generalizedTypars,tau)) = typeScheme + let (TypeScheme(generalizedTypars, tau)) = typeScheme tryMkForallTy generalizedTypars tau -let NonGenericTypeScheme ty = TypeScheme([],ty) +let NonGenericTypeScheme ty = TypeScheme([], ty) //------------------------------------------------------------------------- // Helpers related to publishing values, types and members into the @@ -1276,7 +1276,7 @@ let PublishModuleDefn cenv env mspec = if intoFslibCcu then mty else mty.AddEntity mspec) let item = Item.ModuleOrNamespaces([mkLocalModRef mspec]) - CallNameResolutionSink cenv.tcSink (mspec.Range,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (mspec.Range, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights) let PublishTypeDefn cenv env tycon = UpdateAccModuleOrNamespaceType cenv env (fun _ mty -> @@ -1290,11 +1290,11 @@ let PublishValueDefn cenv env declKind (vspec:Val) = if (declKind = ModuleOrMemberBinding) && ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) && (Option.isNone vspec.MemberInfo) then - errorR(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),vspec.Range)) + errorR(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.Range)) if (declKind = ExtrinsicExtensionBinding) && ((GetCurrAccumulatedModuleOrNamespaceType env).ModuleOrNamespaceKind = Namespace) then - errorR(Error(FSComp.SR.tcNamespaceCannotContainExtensionMembers(),vspec.Range)) + errorR(Error(FSComp.SR.tcNamespaceCannotContainExtensionMembers(), vspec.Range)) // Publish the value to the module type being generated. match declKind with @@ -1321,7 +1321,7 @@ let CombineVisibilityAttribs vis1 vis2 m = match vis1 with | Some _ -> if Option.isSome vis2 then - errorR(Error(FSComp.SR.tcMultipleVisibilityAttributes(),m)) + errorR(Error(FSComp.SR.tcMultipleVisibilityAttributes(), m)) vis1 | _ -> vis2 @@ -1333,11 +1333,11 @@ let ComputeAccessAndCompPath env declKindOpt m vis overrideVis actualParent = | Some declKind -> DeclKind.IsAccessModifierPermitted declKind if Option.isSome vis && not accessModPermitted then - errorR(Error(FSComp.SR.tcMultipleVisibilityAttributesWithLet(),m)) + errorR(Error(FSComp.SR.tcMultipleVisibilityAttributesWithLet(), m)) let vis = match overrideVis, vis with - | Some v,_ -> v + | Some v, _ -> v | _, None -> taccessPublic (* a module or member binding defaults to "public" *) | _, Some SynAccess.Public -> taccessPublic | _, Some SynAccess.Private -> taccessPrivate accessPath @@ -1349,7 +1349,7 @@ let ComputeAccessAndCompPath env declKindOpt m vis overrideVis actualParent = | Parent tcref -> combineAccess vis tcref.Accessibility let cpath = if accessModPermitted then Some env.eCompPath else None - vis,cpath + vis, cpath let CheckForAbnormalOperatorNames cenv (idRange:range) opName isMember = if (idRange.EndColumn - idRange.StartColumn <= 5) && @@ -1358,28 +1358,28 @@ let CheckForAbnormalOperatorNames cenv (idRange:range) opName isMember = match opName with | PrettyNaming.Relational -> if isMember then - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForRelationalOperator(opName, (CompileOpName opName)),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForRelationalOperator(opName, (CompileOpName opName)), idRange)) else - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionRelational(opName),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionRelational(opName), idRange)) | PrettyNaming.Equality -> if isMember then - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForEquality(opName, (CompileOpName opName)),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMethodNameForEquality(opName, (CompileOpName opName)), idRange)) else - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionEquality(opName),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinitionEquality(opName), idRange)) | PrettyNaming.Control -> if isMember then - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberName(opName, (CompileOpName opName)),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberName(opName, (CompileOpName opName)), idRange)) else - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinition(opName),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidOperatorDefinition(opName), idRange)) | PrettyNaming.Indexer -> if not isMember then - error(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidIndexOperatorDefinition(opName),idRange)) + error(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidIndexOperatorDefinition(opName), idRange)) | PrettyNaming.FixedTypes -> if isMember then - warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberNameFixedTypes(opName),idRange)) + warning(StandardOperatorRedefinitionWarning(FSComp.SR.tcInvalidMemberNameFixedTypes(opName), idRange)) | PrettyNaming.Other -> () -let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(id,typeScheme,topValData,memberInfoOpt,isMutable,inlineFlag,baseOrThis,vis,compgen,isIncrClass,isTyFunc,hasDeclaredTypars)),attrs,doc,konst,isGeneratedEventVal) = +let MakeAndPublishVal cenv env (altActualParent, inSig, declKind, vrec, (ValScheme(id, typeScheme, topValData, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, compgen, isIncrClass, isTyFunc, hasDeclaredTypars)), attrs, doc, konst, isGeneratedEventVal) = let ty = GeneralizedTypeForTypeScheme typeScheme let m = id.idRange @@ -1395,9 +1395,9 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i // Use the parent of the member if it's available // If it's an extrinsic extension member or not a member then use the containing module. match memberInfoOpt with - | Some (ValMemberInfoTransient(memberInfo,_,_)) when not isExtrinsic -> + | Some (ValMemberInfoTransient(memberInfo, _, _)) when not isExtrinsic -> if memberInfo.ApparentParent.IsModuleOrNamespace then - errorR(InternalError(FSComp.SR.tcExpectModuleOrNamespaceParent(id.idText),m)) + errorR(InternalError(FSComp.SR.tcExpectModuleOrNamespaceParent(id.idText), m)) // Members of interface implementations have the accessibility of the interface // they are implementing. @@ -1405,24 +1405,24 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i if Tastops.MemberIsExplicitImpl cenv.g memberInfo then let slotSig = List.head memberInfo.ImplementedSlotSigs match slotSig.ImplementedType with - | TType_app (tyconref,_) -> Some tyconref.Accessibility + | TType_app (tyconref, _) -> Some tyconref.Accessibility | _ -> None else None Parent(memberInfo.ApparentParent), vis | _ -> altActualParent, None - let vis,_ = ComputeAccessAndCompPath env (Some declKind) id.idRange vis overrideVis actualParent + let vis, _ = ComputeAccessAndCompPath env (Some declKind) id.idRange vis overrideVis actualParent let inlineFlag = if HasFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute attrs then if inlineFlag = ValInline.PseudoVal || inlineFlag = ValInline.Always then - errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(),m)) + errorR(Error(FSComp.SR.tcDllImportStubsCannotBeInlined(), m)) ValInline.Never else let implflags = match TryFindFSharpAttribute cenv.g cenv.g.attrib_MethodImplAttribute attrs with - | Some (Attrib(_,_,[ AttribInt32Arg flags ],_,_,_,_)) -> flags + | Some (Attrib(_, _, [ AttribInt32Arg flags ], _, _, _, _)) -> flags | _ -> 0x0 // MethodImplOptions.NoInlining = 0x8 let NO_INLINING = 0x8 @@ -1435,17 +1435,17 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i let compiledNameAttrib = TryFindFSharpStringAttribute cenv.g cenv.g.attrib_CompiledNameAttribute attrs if Option.isSome compiledNameAttrib then match memberInfoOpt with - | Some (ValMemberInfoTransient(memberInfo,_,_)) -> + | Some (ValMemberInfoTransient(memberInfo, _, _)) -> if memberInfo.MemberFlags.IsDispatchSlot || memberInfo.MemberFlags.IsOverrideOrExplicitImpl then - errorR(Error(FSComp.SR.tcCompiledNameAttributeMisused(),m)) + errorR(Error(FSComp.SR.tcCompiledNameAttributeMisused(), m)) | None -> match altActualParent with - | ParentNone -> errorR(Error(FSComp.SR.tcCompiledNameAttributeMisused(),m)) + | ParentNone -> errorR(Error(FSComp.SR.tcCompiledNameAttributeMisused(), m)) | _ -> () let compiledNameIsOnProp = match memberInfoOpt with - | Some (ValMemberInfoTransient(memberInfo,_,_)) -> + | Some (ValMemberInfoTransient(memberInfo, _, _)) -> memberInfo.MemberFlags.MemberKind = MemberKind.PropertyGet || memberInfo.MemberFlags.MemberKind = MemberKind.PropertySet || memberInfo.MemberFlags.MemberKind = MemberKind.PropertyGetSet @@ -1457,30 +1457,30 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i | Some _ when not compiledNameIsOnProp -> compiledNameAttrib | _ -> match memberInfoOpt with - | Some (ValMemberInfoTransient(_,_,compiledName)) -> + | Some (ValMemberInfoTransient(_, _, compiledName)) -> Some compiledName | None -> None let logicalName = match memberInfoOpt with - | Some (ValMemberInfoTransient(_,logicalName,_)) -> + | Some (ValMemberInfoTransient(_, logicalName, _)) -> logicalName | None -> id.idText let memberInfoOpt = match memberInfoOpt with - | Some (ValMemberInfoTransient(memberInfo,_,_)) -> + | Some (ValMemberInfoTransient(memberInfo, _, _)) -> Some memberInfo | None -> None let vspec = - NewVal (logicalName,id.idRange,compiledName,ty, - (if ((* (isByrefTy cenv.g ty) || *) isMutable) then Mutable else Immutable), - compgen,topValData,vis,vrec,memberInfoOpt,baseOrThis,attrs,inlineFlag,doc,isTopBinding,isExtrinsic,isIncrClass,isTyFunc, - (hasDeclaredTypars || inSig),isGeneratedEventVal,konst,actualParent) + NewVal (logicalName, id.idRange, compiledName, ty, + (if ((* (isByrefTy cenv.g ty) || *) isMutable) then Mutable else Immutable), + compgen, topValData, vis, vrec, memberInfoOpt, baseOrThis, attrs, inlineFlag, doc, isTopBinding, isExtrinsic, isIncrClass, isTyFunc, + (hasDeclaredTypars || inSig), isGeneratedEventVal, konst, actualParent) CheckForAbnormalOperatorNames cenv id.idRange (DecompileOpName vspec.CoreDisplayName) (Option.isSome memberInfoOpt) @@ -1499,23 +1499,23 @@ let MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,(ValScheme(i | None when vspec.BaseOrThisInfo = ValBaseOrThisInfo.MemberThisVal && vspec.LogicalName = "__" -> () | _ -> let nenv = AddFakeNamedValRefToNameEnv vspec.DisplayName env.NameEnv (mkLocalValRef vspec) - CallEnvSink cenv.tcSink (vspec.Range,nenv,env.eAccessRights) + CallEnvSink cenv.tcSink (vspec.Range, nenv, env.eAccessRights) let item = Item.Value(mkLocalValRef vspec) - CallNameResolutionSink cenv.tcSink (vspec.Range,nenv,item,item,emptyTyparInst,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (vspec.Range, nenv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights) vspec -let MakeAndPublishVals cenv env (altActualParent,inSig,declKind,vrec,valSchemes,attrs,doc,konst) = +let MakeAndPublishVals cenv env (altActualParent, inSig, declKind, vrec, valSchemes, attrs, doc, konst) = Map.foldBack (fun name (valscheme:ValScheme) values -> - Map.add name (MakeAndPublishVal cenv env (altActualParent,inSig,declKind,vrec,valscheme,attrs,doc,konst,false), valscheme.TypeScheme) values) + Map.add name (MakeAndPublishVal cenv env (altActualParent, inSig, declKind, vrec, valscheme, attrs, doc, konst, false), valscheme.TypeScheme) values) valSchemes Map.empty let MakeAndPublishBaseVal cenv env baseIdOpt ty = baseIdOpt |> Option.map (fun (id:Ident) -> - let valscheme = ValScheme(id,NonGenericTypeScheme(ty),None,None,false,ValInline.Never,BaseVal,None,false,false,false,false) - MakeAndPublishVal cenv env (ParentNone,false,ExpressionBinding,ValNotInRecScope,valscheme,[],XmlDoc.Empty,None,false)) + let valscheme = ValScheme(id, NonGenericTypeScheme(ty), None, None, false, ValInline.Never, BaseVal, None, false, false, false, false) + MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valscheme, [], XmlDoc.Empty, None, false)) let InstanceMembersNeedSafeInitCheck cenv m thisTy = ExistsInEntireHierarchyOfType @@ -1527,7 +1527,7 @@ let InstanceMembersNeedSafeInitCheck cenv m thisTy = thisTy let MakeSafeInitField (g: TcGlobals) env m isStatic = - let id = ident(globalNng.FreshCompilerGeneratedName("init",m),m) + let id = ident(globalNng.FreshCompilerGeneratedName("init", m), m) let taccess = TAccess [env.eAccessPath] NewRecdField isStatic None id g.int_ty true true [] [] XmlDoc.Empty taccess true @@ -1547,9 +1547,9 @@ let MakeAndPublishSafeThisVal cenv env (thisIdOpt: Ident option) thisTy = | Some thisId -> // for structs, thisTy is a byref if not (isFSharpObjModelTy cenv.g thisTy) then - errorR(Error(FSComp.SR.tcStructsCanOnlyBindThisAtMemberDeclaration(),thisId.idRange)) + errorR(Error(FSComp.SR.tcStructsCanOnlyBindThisAtMemberDeclaration(), thisId.idRange)) - let valScheme = ValScheme(thisId,NonGenericTypeScheme(mkRefCellTy cenv.g thisTy),None,None,false,ValInline.Never,CtorThisVal,None,false,false,false,false) + let valScheme = ValScheme(thisId, NonGenericTypeScheme(mkRefCellTy cenv.g thisTy), None, None, false, ValInline.Never, CtorThisVal, None, false, false, false, false) Some(MakeAndPublishVal cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valScheme, [], XmlDoc.Empty, None, false)) | None -> @@ -1563,7 +1563,7 @@ let MakeAndPublishSafeThisVal cenv env (thisIdOpt: Ident option) thisTy = /// Fixup the type instantiation at recursive references. Used after the bindings have been /// checked. The fixups are applied by using mutation. let AdjustAndForgetUsesOfRecValue cenv (vrefTgt: ValRef) (valScheme : ValScheme) = - let (TypeScheme(generalizedTypars,_)) = valScheme.TypeScheme + let (TypeScheme(generalizedTypars, _)) = valScheme.TypeScheme let fty = GeneralizedTypeForTypeScheme valScheme.TypeScheme let lvrefTgt = vrefTgt.Deref if not (isNil generalizedTypars) then @@ -1571,20 +1571,20 @@ let AdjustAndForgetUsesOfRecValue cenv (vrefTgt: ValRef) (valScheme : ValScheme) // at those points in order to record the inferred type parameters. let recUses = cenv.recUses.Find lvrefTgt recUses - |> List.iter (fun (fixupPoint,m,isComplete) -> + |> List.iter (fun (fixupPoint, m, isComplete) -> if not isComplete then // Keep any values for explicit type arguments let fixedUpExpr = - let vrefFlags,tyargs0 = + let vrefFlags, tyargs0 = match fixupPoint.Value with - | Expr.App(Expr.Val (_,vrefFlags,_),_,tyargs0,[],_) -> vrefFlags,tyargs0 - | Expr.Val(_,vrefFlags,_) -> vrefFlags,[] + | Expr.App(Expr.Val (_, vrefFlags, _), _, tyargs0, [], _) -> vrefFlags, tyargs0 + | Expr.Val(_, vrefFlags, _) -> vrefFlags, [] | _ -> - errorR(Error(FSComp.SR.tcUnexpectedExprAtRecInfPoint(),m)) - NormalValUse,[] + errorR(Error(FSComp.SR.tcUnexpectedExprAtRecInfPoint(), m)) + NormalValUse, [] let ityargs = generalizeTypars (List.drop (List.length tyargs0) generalizedTypars) - primMkApp (Expr.Val (vrefTgt,vrefFlags,m),fty) (tyargs0 @ ityargs) [] m + primMkApp (Expr.Val (vrefTgt, vrefFlags, m), fty) (tyargs0 @ ityargs) [] m fixupPoint.Value <- fixedUpExpr) vrefTgt.Deref.SetValRec ValNotInRecScope @@ -1592,7 +1592,7 @@ let AdjustAndForgetUsesOfRecValue cenv (vrefTgt: ValRef) (valScheme : ValScheme) /// Set the properties of recursive values that are only fully known after inference is complete -let AdjustRecType _cenv (vspec:Val) (ValScheme(_,typeScheme,topValData,_,_,_,_,_,_,_,_,_)) = +let AdjustRecType _cenv (vspec:Val) (ValScheme(_, typeScheme, topValData, _, _, _, _, _, _, _, _, _)) = let fty = GeneralizedTypeForTypeScheme typeScheme vspec.SetType fty vspec.SetValReprInfo topValData @@ -1605,7 +1605,7 @@ let RecordUseOfRecValue cenv vrec (vrefTgt: ValRef) vexp m = match vrec with | ValInRecScope isComplete -> let fixupPoint = ref vexp - cenv.recUses <- cenv.recUses.Add (vrefTgt.Deref, (fixupPoint,m,isComplete)) + cenv.recUses <- cenv.recUses.Add (vrefTgt.Deref, (fixupPoint, m, isComplete)) Expr.Link (fixupPoint) | ValNotInRecScope -> vexp @@ -1614,7 +1614,7 @@ type RecursiveUseFixupPoints = RecursiveUseFixupPoints of (Expr ref * range) lis /// Get all recursive references, for fixing up delayed recursion using laziness let GetAllUsesOfRecValue cenv vrefTgt = - RecursiveUseFixupPoints (cenv.recUses.Find vrefTgt |> List.map (fun (fixupPoint,m,_) -> (fixupPoint,m))) + RecursiveUseFixupPoints (cenv.recUses.Find vrefTgt |> List.map (fun (fixupPoint, m, _) -> (fixupPoint, m))) //------------------------------------------------------------------------- @@ -1625,21 +1625,21 @@ let ChooseCanonicalDeclaredTyparsAfterInference g denv declaredTypars m = declaredTypars |> List.iter (fun tp -> let ty = mkTyparTy tp if not (isAnyParTy g ty) then - error(Error(FSComp.SR.tcLessGenericBecauseOfAnnotation(tp.Name,NicePrint.prettyStringOfTy denv ty),tp.Range))) + error(Error(FSComp.SR.tcLessGenericBecauseOfAnnotation(tp.Name, NicePrint.prettyStringOfTy denv ty), tp.Range))) let declaredTypars = NormalizeDeclaredTyparsForEquiRecursiveInference g declaredTypars if (ListSet.setify typarEq declaredTypars).Length <> declaredTypars.Length then - errorR(Error(FSComp.SR.tcConstrainedTypeVariableCannotBeGeneralized(),m)) + errorR(Error(FSComp.SR.tcConstrainedTypeVariableCannotBeGeneralized(), m)) declaredTypars let ChooseCanonicalValSchemeAfterInference g denv valscheme m = - let (ValScheme(id,typeScheme,arityInfo,memberInfoOpt,isMutable,inlineFlag,baseOrThis,vis,compgen,isIncrClass,isTyFunc,hasDeclaredTypars)) = valscheme - let (TypeScheme(generalizedTypars,ty)) = typeScheme + let (ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, compgen, isIncrClass, isTyFunc, hasDeclaredTypars)) = valscheme + let (TypeScheme(generalizedTypars, ty)) = typeScheme let generalizedTypars = ChooseCanonicalDeclaredTyparsAfterInference g denv generalizedTypars m - let typeScheme = TypeScheme(generalizedTypars,ty) - let valscheme = ValScheme(id,typeScheme,arityInfo,memberInfoOpt,isMutable,inlineFlag,baseOrThis,vis,compgen,isIncrClass,isTyFunc,hasDeclaredTypars) + let typeScheme = TypeScheme(generalizedTypars, ty) + let valscheme = ValScheme(id, typeScheme, arityInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, compgen, isIncrClass, isTyFunc, hasDeclaredTypars) valscheme let PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars = @@ -1650,15 +1650,15 @@ let SetTyparRigid _g denv m (tp:Typar) = | None -> () | Some ty -> if tp.IsCompilerGenerated then - errorR(Error(FSComp.SR.tcGenericParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty),m)) + errorR(Error(FSComp.SR.tcGenericParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty), m)) else - errorR(Error(FSComp.SR.tcTypeParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty),tp.Range)) + errorR(Error(FSComp.SR.tcTypeParameterHasBeenConstrained(NicePrint.prettyStringOfTy denv ty), tp.Range)) tp.SetRigidity TyparRigidity.Rigid let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBinding - (PrelimValScheme1(id,iflex,ty,partialValReprInfo,memberInfoOpt,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen)) = + (PrelimValScheme1(id, iflex, ty, partialValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen)) = - let (ExplicitTyparInfo(_rigidCopyOfDeclaredTypars,declaredTypars,_)) = iflex + let (ExplicitTyparInfo(_rigidCopyOfDeclaredTypars, declaredTypars, _)) = iflex let m = id.idRange @@ -1668,7 +1668,7 @@ let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBind // Trim out anything not in type of the value (as opposed to the type of the r.h.s) // This is important when a single declaration binds // multiple generic items, where each item does not use all the polymorphism - // of the r.h.s. , e.g. let x,y = None,[] + // of the r.h.s. , e.g. let x, y = None, [] let computeRelevantTypars thruFlag = let ftps = freeInTypeLeftToRight cenv.g thruFlag ty let generalizedTypars = generalizedTyparsForThisBinding |> List.filter (fun tp -> ListSet.contains typarEq tp ftps) @@ -1683,28 +1683,28 @@ let GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTyparsForThisBind if not (generalizedTypars.Length = generalizedTyparsLookingThroughTypeAbbreviations.Length && List.forall2 typarEq generalizedTypars generalizedTyparsLookingThroughTypeAbbreviations) then - warning(Error(FSComp.SR.tcTypeParametersInferredAreNotStable(),m)) + warning(Error(FSComp.SR.tcTypeParametersInferredAreNotStable(), m)) let hasDeclaredTypars = not (isNil declaredTypars) // This is just about the only place we form a TypeScheme let tyScheme = TypeScheme(generalizedTypars, ty) - PrelimValScheme2(id,tyScheme,partialValReprInfo,memberInfoOpt,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen,hasDeclaredTypars) + PrelimValScheme2(id, tyScheme, partialValReprInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen, hasDeclaredTypars) let GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars types = NameMap.map (GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTypars) types let DontGeneralizeVals types = - let dontGeneralizeVal (PrelimValScheme1(id,_,ty,partialValReprInfoOpt,memberInfoOpt,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen)) = - PrelimValScheme2(id, NonGenericTypeScheme(ty), partialValReprInfoOpt,memberInfoOpt,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen,false) + let dontGeneralizeVal (PrelimValScheme1(id, _, ty, partialValReprInfoOpt, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen)) = + PrelimValScheme2(id, NonGenericTypeScheme(ty), partialValReprInfoOpt, memberInfoOpt, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen, false) NameMap.map dontGeneralizeVal types -let InferGenericArityFromTyScheme (TypeScheme(generalizedTypars,_)) partialValReprInfo = +let InferGenericArityFromTyScheme (TypeScheme(generalizedTypars, _)) partialValReprInfo = TranslatePartialArity generalizedTypars partialValReprInfo -let ComputeIsTyFunc(id:Ident,hasDeclaredTypars,arityInfo:ValReprInfo option) = +let ComputeIsTyFunc(id:Ident, hasDeclaredTypars, arityInfo:ValReprInfo option) = hasDeclaredTypars && (match arityInfo with - | None -> error(Error(FSComp.SR.tcExplicitTypeParameterInvalid(),id.idRange)) + | None -> error(Error(FSComp.SR.tcExplicitTypeParameterInvalid(), id.idRange)) | Some info -> info.NumCurriedArgs = 0) let UseSyntacticArity declKind typeScheme partialValReprInfo = @@ -1718,7 +1718,7 @@ let UseSyntacticArity declKind typeScheme partialValReprInfo = // The F# spec says that we infer arities from declaration forms and types. // // For example -// let f (a,b) c = 1 // gets arity [2;1] +// let f (a, b) c = 1 // gets arity [2;1] // let f (a:int*int) = 1 // gets arity [2], based on type // let f () = 1 // gets arity [0] // let f = (fun (x:int) (y:int) -> 1) // gets arity [1;1] @@ -1747,53 +1747,53 @@ let UseSyntacticArity declKind typeScheme partialValReprInfo = // member x.M(v:unit) = () } // let CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme = - let (PrelimValScheme2(_,typeScheme,partialValReprInfoOpt,memberInfoOpt,isMutable,_,_,ArgAndRetAttribs(argAttribs,retAttribs),_,_,_)) = prelimScheme + let (PrelimValScheme2(_, typeScheme, partialValReprInfoOpt, memberInfoOpt, isMutable, _, _, ArgAndRetAttribs(argAttribs, retAttribs), _, _, _)) = prelimScheme match partialValReprInfoOpt, DeclKind.MustHaveArity declKind with - | _ ,false -> None - | None ,true -> Some(PartialValReprInfo([],ValReprInfo.unnamedRetVal)) + | _ , false -> None + | None , true -> Some(PartialValReprInfo([], ValReprInfo.unnamedRetVal)) // Don't use any expression information for members, where syntax dictates the arity completely | _ when memberInfoOpt.IsSome -> partialValReprInfoOpt - | Some(partialValReprInfoFromSyntax),true -> - let (PartialValReprInfo(curriedArgInfosFromSyntax,retInfoFromSyntax)) = partialValReprInfoFromSyntax + | Some(partialValReprInfoFromSyntax), true -> + let (PartialValReprInfo(curriedArgInfosFromSyntax, retInfoFromSyntax)) = partialValReprInfoFromSyntax let partialArityInfo = if isMutable then - PartialValReprInfo ([],retInfoFromSyntax) + PartialValReprInfo ([], retInfoFromSyntax) else - let (ValReprInfo (_,curriedArgInfosFromExpression,_)) = + let (ValReprInfo (_, curriedArgInfosFromExpression, _)) = InferArityOfExpr g AllowTypeDirectedDetupling.Yes (GeneralizedTypeForTypeScheme typeScheme) argAttribs retAttribs rhsExpr // Choose between the syntactic arity and the expression-inferred arity // If the syntax specifies an eliminated unit arg, then use that let choose ai1 ai2 = - match ai1,ai2 with - | [],_ -> [] + match ai1, ai2 with + | [], _ -> [] // Dont infer eliminated unit args from the expression if they don't occur syntactically. - | ai,[] -> ai + | ai, [] -> ai // If we infer a tupled argument from the expression and/or type then use that | _ when ai1.Length < ai2.Length -> ai2 | _ -> ai1 let rec loop ais1 ais2 = - match ais1,ais2 with + match ais1, ais2 with // If the expression infers additional arguments then use those (this shouldn't happen, since the // arity inference done on the syntactic form should give identical results) - | [],ais | ais,[] -> ais - | (h1::t1),(h2::t2) -> choose h1 h2 :: loop t1 t2 + | [], ais | ais, [] -> ais + | (h1::t1), (h2::t2) -> choose h1 h2 :: loop t1 t2 let curriedArgInfos = loop curriedArgInfosFromSyntax curriedArgInfosFromExpression - PartialValReprInfo (curriedArgInfos,retInfoFromSyntax) + PartialValReprInfo (curriedArgInfos, retInfoFromSyntax) Some(partialArityInfo) let BuildValScheme declKind partialArityInfoOpt prelimScheme = - let (PrelimValScheme2(id,typeScheme,_,memberInfoOpt,isMutable,inlineFlag,baseOrThis,_,vis,compgen,hasDeclaredTypars)) = prelimScheme + let (PrelimValScheme2(id, typeScheme, _, memberInfoOpt, isMutable, inlineFlag, baseOrThis, _, vis, compgen, hasDeclaredTypars)) = prelimScheme let topValInfo = if DeclKind.MustHaveArity declKind then Option.map (InferGenericArityFromTyScheme typeScheme) partialArityInfoOpt else None - let isTyFunc = ComputeIsTyFunc(id,hasDeclaredTypars,topValInfo) - ValScheme(id,typeScheme,topValInfo,memberInfoOpt,isMutable,inlineFlag,baseOrThis,vis,compgen,false,isTyFunc,hasDeclaredTypars) + let isTyFunc = ComputeIsTyFunc(id, hasDeclaredTypars, topValInfo) + ValScheme(id, typeScheme, topValInfo, memberInfoOpt, isMutable, inlineFlag, baseOrThis, vis, compgen, false, isTyFunc, hasDeclaredTypars) let UseCombinedArity g declKind rhsExpr prelimScheme = let partialArityInfoOpt = CombineSyntacticAndInferredArities g declKind rhsExpr prelimScheme @@ -1805,13 +1805,13 @@ let UseNoArity prelimScheme = let MakeSimpleVals cenv env names = let tyschemes = DontGeneralizeVals names let valSchemes = NameMap.map UseNoArity tyschemes - let values = MakeAndPublishVals cenv env (ParentNone,false,ExpressionBinding,ValNotInRecScope,valSchemes,[],XmlDoc.Empty,None) + let values = MakeAndPublishVals cenv env (ParentNone, false, ExpressionBinding, ValNotInRecScope, valSchemes, [], XmlDoc.Empty, None) let vspecMap = NameMap.map fst values - values,vspecMap + values, vspecMap let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = - let values,vspecMap = + let values, vspecMap = if not mergeNamesInOneNameresEnv then MakeSimpleVals cenv env names else // reason: now during typecheck we create new name resolution environment for all components of tupled arguments in lambda. @@ -1828,7 +1828,7 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = // what we do here is override this default behavior and capture only all name resolution notifications // later we'll process them and create one name resolution env that will contain names from all notifications let nameResolutions = ResizeArray() - let values,vspecMap = + let values, vspecMap = let sink = { new ITypecheckResultsSink with member this.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports @@ -1856,12 +1856,12 @@ let MakeAndPublishSimpleVals cenv env m names mergeNamesInOneNameresEnv = CallEnvSink cenv.tcSink (mergedRange, mergedNameEnv, ad) // call CallNameResolutionSink for all captured name resolutions using mergedNameEnv for (_, item, itemGroup, itemTyparInst, occurence, denv, _nenv, ad, m, _replacing) in nameResolutions do - CallNameResolutionSink cenv.tcSink (m, mergedNameEnv, item, itemGroup, itemTyparInst, occurence, denv, ad) + CallNameResolutionSink cenv.tcSink (m, mergedNameEnv, item, itemGroup, itemTyparInst, occurence, denv, ad) - values,vspecMap + values, vspecMap let envinner = AddLocalValMap cenv.tcSink m vspecMap env - envinner,values,vspecMap + envinner, values, vspecMap @@ -1876,22 +1876,22 @@ let FreshenTyconRef m rigid (tcref:TyconRef) declaredTyconTypars = if rigid <> TyparRigidity.Rigid then tps |> List.iter (fun tp -> tp.SetRigidity rigid) - let renaming,tinst = FixupNewTypars m [] [] tpsorig tps - (TType_app(tcref,List.map mkTyparTy tpsorig), tps, renaming, TType_app(tcref,tinst)) + let renaming, tinst = FixupNewTypars m [] [] tpsorig tps + (TType_app(tcref, List.map mkTyparTy tpsorig), tps, renaming, TType_app(tcref, tinst)) let FreshenPossibleForallTy g m rigid ty = - let tpsorig,tau = tryDestForallTy g ty + let tpsorig, tau = tryDestForallTy g ty if isNil tpsorig then - [],[],[],tau + [], [], [], tau else // tps may be have been equated to other tps in equi-recursive type inference and units-of-measure type inference. Normalize them here let tpsorig = NormalizeDeclaredTyparsForEquiRecursiveInference g tpsorig - let tps,renaming,tinst = CopyAndFixupTypars m rigid tpsorig - tpsorig,tps,tinst,instType renaming tau + let tps, renaming, tinst = CopyAndFixupTypars m rigid tpsorig + tpsorig, tps, tinst, instType renaming tau let infoOfTyconRef m (tcref:TyconRef) = - let tps,renaming,tinst = FreshenTypeInst m (tcref.Typars m) - tps,renaming,tinst,TType_app (tcref,tinst) + let tps, renaming, tinst = FreshenTypeInst m (tcref.Typars m) + tps, renaming, tinst, TType_app (tcref, tinst) /// Given a abstract method, which may be a generic method, freshen the type in preparation @@ -1905,16 +1905,16 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = let typarsFromAbsSlotAreRigid = match synTyparDecls with - | SynValTyparDecls(synTypars,infer,_) -> + | SynValTyparDecls(synTypars, infer, _) -> if infer && not (isNil synTypars) then - errorR(Error(FSComp.SR.tcOverridingMethodRequiresAllOrNoTypeParameters(),m)) + errorR(Error(FSComp.SR.tcOverridingMethodRequiresAllOrNoTypeParameters(), m)) isNil synTypars - let (CompiledSig (argtys,retTy,fmtps,_)) = CompiledSigOfMeth g amap m absMethInfo + let (CompiledSig (argtys, retTy, fmtps, _)) = CompiledSigOfMeth g amap m absMethInfo // If the virtual method is a generic method then copy its type parameters - let typarsFromAbsSlot,typarInstFromAbsSlot,_ = + let typarsFromAbsSlot, typarInstFromAbsSlot, _ = let ttps = absMethInfo.GetFormalTyparsOfDeclaringType m let ttinst = argsOfAppTy g absMethInfo.EnclosingType let rigid = if typarsFromAbsSlotAreRigid then TyparRigidity.Rigid else TyparRigidity.Flexible @@ -1923,7 +1923,7 @@ let FreshenAbstractSlot g amap m synTyparDecls absMethInfo = // Work out the required type of the member let argTysFromAbsSlot = argtys |> List.mapSquared (instType typarInstFromAbsSlot) let retTyFromAbsSlot = retTy |> GetFSharpViewOfReturnType g |> instType typarInstFromAbsSlot - typarsFromAbsSlotAreRigid,typarsFromAbsSlot,argTysFromAbsSlot, retTyFromAbsSlot + typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot //------------------------------------------------------------------------- @@ -1935,21 +1935,21 @@ let BuildFieldMap cenv env isPartial ty flds m = if isNil flds then invalidArg "flds" "BuildFieldMap" let frefSets = - let allFields = flds |> List.map (fun ((_,ident),_) -> ident) + let allFields = flds |> List.map (fun ((_, ident), _) -> ident) flds - |> List.map (fun (fld,fldExpr) -> + |> List.map (fun (fld, fldExpr) -> let frefSet = ResolveField cenv.tcSink cenv.nameResolver env.eNameResEnv ad ty fld allFields - fld,frefSet,fldExpr) + fld, frefSet, fldExpr) let relevantTypeSets = - frefSets |> List.map (fun (_,frefSet,_) -> frefSet |> List.map (fun (FieldResolution(rfref,_)) -> rfref.TyconRef)) + frefSets |> List.map (fun (_, frefSet, _) -> frefSet |> List.map (fun (FieldResolution(rfref, _)) -> rfref.TyconRef)) let tcref = match List.fold (ListSet.intersect (tyconRefEq cenv.g)) (List.head relevantTypeSets) (List.tail relevantTypeSets) with | [tcref] -> tcref | tcrefs -> if isPartial then - warning (Error(FSComp.SR.tcFieldsDoNotDetermineUniqueRecordType(),m)) + warning (Error(FSComp.SR.tcFieldsDoNotDetermineUniqueRecordType(), m)) // try finding a record type with the same number of fields as the ones that are given. match tcrefs |> List.tryFind (fun tc -> tc.TrueFieldsAsList.Length = flds.Length) with @@ -1958,38 +1958,38 @@ let BuildFieldMap cenv env isPartial ty flds m = // OK, there isn't a unique, good type dictated by the intersection for the field refs. // We're going to get an error of some kind below. // Just choose one field ref and let the error come later - let (_,frefSet1,_) = List.head frefSets - let (FieldResolution(fref1,_)) = List.head frefSet1 + let (_, frefSet1, _) = List.head frefSets + let (FieldResolution(fref1, _)) = List.head frefSet1 fref1.TyconRef - let fldsmap,rfldsList = - ((Map.empty,[]), frefSets) ||> List.fold (fun (fs,rfldsList) (fld,frefs,fldExpr) -> - match frefs |> List.filter (fun (FieldResolution(fref2,_)) -> tyconRefEq cenv.g tcref fref2.TyconRef) with - | [FieldResolution(fref2,showDeprecated)] -> + let fldsmap, rfldsList = + ((Map.empty, []), frefSets) ||> List.fold (fun (fs, rfldsList) (fld, frefs, fldExpr) -> + match frefs |> List.filter (fun (FieldResolution(fref2, _)) -> tyconRefEq cenv.g tcref fref2.TyconRef) with + | [FieldResolution(fref2, showDeprecated)] -> // Record the precise resolution of the field for intellisense let item = FreshenRecdFieldRef cenv.nameResolver m fref2 - CallNameResolutionSink cenv.tcSink ((snd fld).idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,ad) + CallNameResolutionSink cenv.tcSink ((snd fld).idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad) CheckRecdFieldAccessible cenv.amap m env.eAccessRights fref2 |> ignore CheckFSharpAttributes cenv.g fref2.PropertyAttribs m |> CommitOperationResult if Map.containsKey fref2.FieldName fs then - errorR (Error(FSComp.SR.tcFieldAppearsTwiceInRecord(fref2.FieldName),m)) + errorR (Error(FSComp.SR.tcFieldAppearsTwiceInRecord(fref2.FieldName), m)) if showDeprecated then - warning(Deprecated(FSComp.SR.nrRecordTypeNeedsQualifiedAccess(fref2.FieldName,fref2.Tycon.DisplayName) |> snd,m)) + warning(Deprecated(FSComp.SR.nrRecordTypeNeedsQualifiedAccess(fref2.FieldName, fref2.Tycon.DisplayName) |> snd, m)) if not (tyconRefEq cenv.g tcref fref2.TyconRef) then - let (_,frefSet1,_) = List.head frefSets - let (FieldResolution(fref1,_)) = List.head frefSet1 - errorR (FieldsFromDifferentTypes(env.DisplayEnv,fref1,fref2,m)) - fs,rfldsList + let (_, frefSet1, _) = List.head frefSets + let (FieldResolution(fref1, _)) = List.head frefSet1 + errorR (FieldsFromDifferentTypes(env.DisplayEnv, fref1, fref2, m)) + fs, rfldsList else - Map.add fref2.FieldName fldExpr fs,(fref2.FieldName,fldExpr)::rfldsList + Map.add fref2.FieldName fldExpr fs, (fref2.FieldName, fldExpr)::rfldsList - | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(),m))) - tcref,fldsmap,List.rev rfldsList + | _ -> error(Error(FSComp.SR.tcRecordFieldInconsistentTypes(), m))) + tcref, fldsmap, List.rev rfldsList -let rec ApplyUnionCaseOrExn (makerForUnionCase,makerForExnTag) m cenv env overallTy item = +let rec ApplyUnionCaseOrExn (makerForUnionCase, makerForExnTag) m cenv env overallTy item = let ad = env.eAccessRights match item with | Item.ExnCase ecref -> @@ -1997,11 +1997,11 @@ let rec ApplyUnionCaseOrExn (makerForUnionCase,makerForExnTag) m cenv env overal UnifyTypes cenv env m overallTy cenv.g.exn_ty CheckTyconAccessible cenv.amap m ad ecref |> ignore let mkf = makerForExnTag ecref - mkf,recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f.Id ] + mkf, recdFieldTysOfExnDefRef ecref, [ for f in (recdFieldsOfExnDefRef ecref) -> f.Id ] - | Item.UnionCase(ucinfo,showDeprecated) -> + | Item.UnionCase(ucinfo, showDeprecated) -> if showDeprecated then - warning(Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(ucinfo.Name,ucinfo.Tycon.DisplayName) |> snd,m)) + warning(Deprecated(FSComp.SR.nrUnionTypeNeedsQualifiedAccess(ucinfo.Name, ucinfo.Tycon.DisplayName) |> snd, m)) let ucref = ucinfo.UnionCaseRef CheckUnionCaseAttributes cenv.g ucref m |> CommitOperationResult @@ -2009,33 +2009,33 @@ let rec ApplyUnionCaseOrExn (makerForUnionCase,makerForExnTag) m cenv env overal let gtyp2 = actualResultTyOfUnionCase ucinfo.TypeInst ucref let inst = mkTyparInst ucref.TyconRef.TyparsNoRange ucinfo.TypeInst UnifyTypes cenv env m overallTy gtyp2 - let mkf = makerForUnionCase(ucref,ucinfo.TypeInst) - mkf,actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f.Id ] + let mkf = makerForUnionCase(ucref, ucinfo.TypeInst) + mkf, actualTysOfUnionCaseFields inst ucref, [ for f in ucref.AllFieldsAsList -> f.Id ] | _ -> invalidArg "item" "not a union case or exception reference" let ApplyUnionCaseOrExnTypes m cenv env overallTy c = - ApplyUnionCaseOrExn ((fun (a,b) mArgs args -> mkUnionCaseExpr(a,b,args,unionRanges m mArgs)), - (fun a mArgs args -> mkExnExpr (a,args,unionRanges m mArgs))) m cenv env overallTy c + ApplyUnionCaseOrExn ((fun (a, b) mArgs args -> mkUnionCaseExpr(a, b, args, unionRanges m mArgs)), + (fun a mArgs args -> mkExnExpr (a, args, unionRanges m mArgs))) m cenv env overallTy c let ApplyUnionCaseOrExnTypesForPat m cenv env overallTy c = - ApplyUnionCaseOrExn ((fun (a,b) mArgs args -> TPat_unioncase(a,b,args,unionRanges m mArgs)), - (fun a mArgs args -> TPat_exnconstr(a,args,unionRanges m mArgs))) m cenv env overallTy c + ApplyUnionCaseOrExn ((fun (a, b) mArgs args -> TPat_unioncase(a, b, args, unionRanges m mArgs)), + (fun a mArgs args -> TPat_exnconstr(a, args, unionRanges m mArgs))) m cenv env overallTy c let UnionCaseOrExnCheck (env: TcEnv) nargtys nargs m = - if nargs <> nargtys then error (UnionCaseWrongArguments(env.DisplayEnv,nargtys,nargs,m)) + if nargs <> nargtys then error (UnionCaseWrongArguments(env.DisplayEnv, nargtys, nargs, m)) let TcUnionCaseOrExnField cenv (env: TcEnv) ty1 m c n funcs = let ad = env.eAccessRights - let mkf,argtys, _argNames = + let mkf, argtys, _argNames = match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver AllIdsOK false m ad env.eNameResEnv TypeNameResolutionInfo.Default c with | (Item.UnionCase _ | Item.ExnCase _) as item -> ApplyUnionCaseOrExn funcs m cenv env ty1 item - | _ -> error(Error(FSComp.SR.tcUnknownUnion(),m)) + | _ -> error(Error(FSComp.SR.tcUnknownUnion(), m)) let argstysLength = List.length argtys if n >= argstysLength then - error (UnionCaseWrongNumberOfArgs(env.DisplayEnv,argstysLength,n,m)) + error (UnionCaseWrongNumberOfArgs(env.DisplayEnv, argstysLength, n, m)) let ty2 = List.item n argtys - mkf,ty2 + mkf, ty2 //------------------------------------------------------------------------- // Environment of explicit type parameters, e.g. 'a in "(x : 'a)" @@ -2100,41 +2100,41 @@ module GeneralizationHelpers = | Expr.Lambda _ | Expr.TyLambda _ | Expr.Const _ | Expr.Val _ -> true // Look through coercion nodes corresponding to introduction of subsumption - | Expr.Op(TOp.Coerce,[inputTy;actualTy],[e1],_) when isFunTy g actualTy && isFunTy g inputTy -> + | Expr.Op(TOp.Coerce, [inputTy;actualTy], [e1], _) when isFunTy g actualTy && isFunTy g inputTy -> IsGeneralizableValue g e1 - | Expr.Op(op,_,args,_) -> + | Expr.Op(op, _, args, _) -> match op with | TOp.Tuple _ -> true | TOp.UnionCase uc -> not (isUnionCaseRefAllocObservable uc) - | TOp.Recd(ctorInfo,tcref) -> + | TOp.Recd(ctorInfo, tcref) -> match ctorInfo with | RecdExpr -> not (isRecdOrUnionOrStructTyconRefAllocObservable g tcref) | RecdExprIsObjInit -> false | TOp.Array -> isNil args | TOp.ExnConstr ec -> not (isExnAllocObservable ec) - | TOp.ILAsm([],_) -> true + | TOp.ILAsm([], _) -> true | _ -> false && List.forall (IsGeneralizableValue g) args - | Expr.LetRec(binds,body,_,_) -> + | Expr.LetRec(binds, body, _, _) -> binds |> List.forall (fun b -> not b.Var.IsMutable) && binds |> List.forall (fun b -> IsGeneralizableValue g b.Expr) && IsGeneralizableValue g body - | Expr.Let(bind,body,_,_) -> + | Expr.Let(bind, body, _, _) -> not bind.Var.IsMutable && IsGeneralizableValue g bind.Expr && IsGeneralizableValue g body // Applications of type functions are _not_ normally generalizable unless explicitly marked so - | Expr.App(Expr.Val (vref,_,_),_,_,[],_) when vref.IsTypeFunction -> + | Expr.App(Expr.Val (vref, _, _), _, _, [], _) when vref.IsTypeFunction -> HasFSharpAttribute g g.attrib_GeneralizableValueAttribute vref.Attribs - | Expr.App(e1,_,_,[],_) -> IsGeneralizableValue g e1 - | Expr.TyChoose(_,b,_) -> IsGeneralizableValue g b - | Expr.Obj (_,ty,_,_,_,_,_) -> isInterfaceTy g ty || isDelegateTy g ty + | Expr.App(e1, _, _, [], _) -> IsGeneralizableValue g e1 + | Expr.TyChoose(_, b, _) -> IsGeneralizableValue g b + | Expr.Obj (_, ty, _, _, _, _, _) -> isInterfaceTy g ty || isDelegateTy g ty | Expr.Link eref -> IsGeneralizableValue g !eref | _ -> false @@ -2150,18 +2150,18 @@ module GeneralizationHelpers = /// into the set that are considered free in the environment. let rec TrimUngeneralizableTypars genConstrainedTyparFlag inlineFlag (generalizedTypars:Typar list) freeInEnv = // Do not generalize type variables with a static requirement unless function is marked 'inline' - let generalizedTypars,ungeneralizableTypars1 = - if inlineFlag = ValInline.PseudoVal then generalizedTypars,[] + let generalizedTypars, ungeneralizableTypars1 = + if inlineFlag = ValInline.PseudoVal then generalizedTypars, [] else generalizedTypars |> List.partition (fun tp -> tp.StaticReq = NoStaticReq) // Do not generalize type variables which would escape their scope // because they are free in the environment - let generalizedTypars,ungeneralizableTypars2 = + let generalizedTypars, ungeneralizableTypars2 = List.partition (fun x -> not (Zset.contains x freeInEnv)) generalizedTypars // Some situations, e.g. implicit class constructions that represent functions as fields, // do not allow generalisation over constrained typars. (since they can not be represented as fields) - let generalizedTypars,ungeneralizableTypars3 = + let generalizedTypars, ungeneralizableTypars3 = generalizedTypars |> List.partition (fun tp -> genConstrainedTyparFlag = CanGeneralizeConstrainedTypars || @@ -2183,7 +2183,7 @@ module GeneralizationHelpers = // The type of the value is ty11 * ... * ty1N -> ... -> tyM1 * ... * tyMM -> retTy // This is computed REGARDLESS of the arity of the expression. - let curriedArgTys,retTy = stripFunTy cenv.g tauTy + let curriedArgTys, retTy = stripFunTy cenv.g tauTy let allUntupledArgTys = curriedArgTys |> List.collect (tryDestRefTupleTy cenv.g) // Compute the type variables in 'retTy' @@ -2193,7 +2193,7 @@ module GeneralizationHelpers = let relevantUniqueSubtypeConstraint (tp:Typar) = // Find a single subtype constraint match tp.Constraints |> List.partition (function (TyparConstraint.CoercesTo _) -> true | _ -> false) with - | [TyparConstraint.CoercesTo(cxty,_)], others -> + | [TyparConstraint.CoercesTo(cxty, _)], others -> // Throw away null constraints if they are implied if others |> List.exists (function (TyparConstraint.SupportsNull(_)) -> not (TypeSatisfiesNullConstraint cenv.g m cxty) | _ -> true) then None @@ -2223,8 +2223,8 @@ module GeneralizationHelpers = // A condensation typar can't be used in the constraints of any candidate condensation typars not (ListSet.contains typarEq tp lhsConstraintTypars) && // A condensation typar must occur precisely once in tyIJ, and must not occur free in any other tyIJ - (match allUntupledArgTysWithFreeVars |> List.partition (fun (ty,_) -> match tryDestTyparTy cenv.g ty with Some destTypar -> typarEq destTypar tp | _ -> false) with - | [_], rest -> not (rest |> List.exists (fun (_,fvs) -> ListSet.contains typarEq tp fvs)) + (match allUntupledArgTysWithFreeVars |> List.partition (fun (ty, _) -> match tryDestTyparTy cenv.g ty with Some destTypar -> typarEq destTypar tp | _ -> false) with + | [_], rest -> not (rest |> List.exists (fun (_, fvs) -> ListSet.contains typarEq tp fvs)) | _ -> false) let condensationTypars, generalizedTypars = generalizedTypars |> List.partition IsCondensationTypar @@ -2234,24 +2234,24 @@ module GeneralizationHelpers = ConstraintSolver.ChooseTyparSolutionAndSolve cenv.css denv tp) generalizedTypars - let CanonicalizePartialInferenceProblem (cenv,denv,m) tps = + let CanonicalizePartialInferenceProblem (cenv, denv, m) tps = // Canonicalize constraints prior to generalization let csenv = (MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denv) TryD (fun () -> ConstraintSolver.CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps) - (fun res -> ErrorD (ErrorFromAddingConstraint(denv,res,m))) + (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult - let ComputeAndGeneralizeGenericTypars (cenv, - denv:DisplayEnv, - m, - freeInEnv:FreeTypars, - canInferTypars, - genConstrainedTyparFlag, - inlineFlag, - exprOpt, - allDeclaredTypars: Typars, - maxInferredTypars: Typars, - tauTy, + let ComputeAndGeneralizeGenericTypars (cenv, + denv:DisplayEnv, + m, + freeInEnv:FreeTypars, + canInferTypars, + genConstrainedTyparFlag, + inlineFlag, + exprOpt, + allDeclaredTypars: Typars, + maxInferredTypars: Typars, + tauTy, resultFirst) = let allDeclaredTypars = NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g allDeclaredTypars @@ -2260,14 +2260,14 @@ module GeneralizationHelpers = then (ListSet.unionFavourLeft typarEq allDeclaredTypars maxInferredTypars) else allDeclaredTypars - let generalizedTypars,freeInEnv = + let generalizedTypars, freeInEnv = TrimUngeneralizableTypars genConstrainedTyparFlag inlineFlag typarsToAttemptToGeneralize freeInEnv allDeclaredTypars |> List.iter (fun tp -> if Zset.memberOf freeInEnv tp then let ty = mkTyparTy tp - error(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty),m))) + error(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty), m))) let generalizedTypars = CondenseTypars(cenv, denv, generalizedTypars, tauTy, m) @@ -2278,7 +2278,7 @@ module GeneralizationHelpers = let allConstraints = List.collect (fun (tp:Typar) -> tp.Constraints) generalizedTypars let generalizedTypars = ConstraintSolver.SimplifyMeasuresInTypeScheme cenv.g resultFirst generalizedTypars tauTy allConstraints - // Generalization turns inference type variables into rigid, quantified type variables, + // Generalization turns inference type variables into rigid, quantified type variables, // (they may be rigid already) generalizedTypars |> List.iter (SetTyparRigid cenv.g denv m) @@ -2304,10 +2304,10 @@ module GeneralizationHelpers = | MemberKind.PropertyGet | MemberKind.PropertySet -> if not (isNil declaredTypars) then - errorR(Error(FSComp.SR.tcPropertyRequiresExplicitTypeParameters(),m)) + errorR(Error(FSComp.SR.tcPropertyRequiresExplicitTypeParameters(), m)) | MemberKind.Constructor -> if not (isNil declaredTypars) then - errorR(Error(FSComp.SR.tcConstructorCannotHaveTypeParameters(),m)) + errorR(Error(FSComp.SR.tcConstructorCannotHaveTypeParameters(), m)) | _ -> () /// Properties and Constructors may only generalize the variables associated with the containing class (retrieved from the 'this' pointer) @@ -2349,7 +2349,7 @@ let ComputeInlineFlag memFlagsOption isInline isMutable m = elif isInline then ValInline.PseudoVal else ValInline.Optional if isInline && (inlineFlag <> ValInline.PseudoVal) then - errorR(Error(FSComp.SR.tcThisValueMayNotBeInlined(),m)) + errorR(Error(FSComp.SR.tcThisValueMayNotBeInlined(), m)) inlineFlag @@ -2392,9 +2392,9 @@ let ComputeInlineFlag memFlagsOption isInline isMutable m = type NormalizedBindingRhs = | NormalizedBindingRhs of SynSimplePats list * SynBindingReturnInfo option * SynExpr -let PushOnePatternToRhs (cenv:cenv) isMember p (NormalizedBindingRhs(spatsL,rtyOpt,rhsExpr)) = - let spats,rhsExpr = PushPatternToExpr cenv.synArgNameGenerator isMember p rhsExpr - NormalizedBindingRhs(spats::spatsL, rtyOpt,rhsExpr) +let PushOnePatternToRhs (cenv:cenv) isMember p (NormalizedBindingRhs(spatsL, rtyOpt, rhsExpr)) = + let spats, rhsExpr = PushPatternToExpr cenv.synArgNameGenerator isMember p rhsExpr + NormalizedBindingRhs(spats::spatsL, rtyOpt, rhsExpr) type NormalizedBindingPatternInfo = NormalizedBindingPat of SynPat * NormalizedBindingRhs * SynValData * SynValTyparDecls @@ -2427,91 +2427,91 @@ type IsObjExprBinding = module BindingNormalization = /// Push a bunch of pats at once. They may contain patterns, e.g. let f (A x) (B y) = ... /// In this case the semantics is let f a b = let A x = a in let B y = b - let private PushMultiplePatternsToRhs (cenv:cenv) isMember ps (NormalizedBindingRhs(spatsL,rtyOpt,rhsExpr)) = - let spatsL2,rhsExpr = PushCurriedPatternsToExpr cenv.synArgNameGenerator rhsExpr.Range isMember ps rhsExpr + let private PushMultiplePatternsToRhs (cenv:cenv) isMember ps (NormalizedBindingRhs(spatsL, rtyOpt, rhsExpr)) = + let spatsL2, rhsExpr = PushCurriedPatternsToExpr cenv.synArgNameGenerator rhsExpr.Range isMember ps rhsExpr NormalizedBindingRhs(spatsL2@spatsL, rtyOpt, rhsExpr) let private MakeNormalizedStaticOrValBinding cenv isObjExprBinding id vis typars args rhsExpr valSynData = - let (SynValData(memberFlagsOpt,_,_)) = valSynData - NormalizedBindingPat(mkSynPatVar vis id, PushMultiplePatternsToRhs cenv ((isObjExprBinding = ObjExprBinding) || Option.isSome memberFlagsOpt) args rhsExpr,valSynData,typars) + let (SynValData(memberFlagsOpt, _, _)) = valSynData + NormalizedBindingPat(mkSynPatVar vis id, PushMultiplePatternsToRhs cenv ((isObjExprBinding = ObjExprBinding) || Option.isSome memberFlagsOpt) args rhsExpr, valSynData, typars) let private MakeNormalizedInstanceMemberBinding cenv thisId memberId toolId vis m typars args rhsExpr valSynData = - NormalizedBindingPat(SynPat.InstanceMember(thisId,memberId,toolId,vis,m), PushMultiplePatternsToRhs cenv true args rhsExpr,valSynData,typars) + NormalizedBindingPat(SynPat.InstanceMember(thisId, memberId, toolId, vis, m), PushMultiplePatternsToRhs cenv true args rhsExpr, valSynData, typars) let private NormalizeStaticMemberBinding cenv memberFlags valSynData id vis typars args m rhsExpr = - let (SynValData(_,valSynInfo,thisIdOpt)) = valSynData + let (SynValData(_, valSynInfo, thisIdOpt)) = valSynData if memberFlags.IsInstance then // instance method without adhoc "this" argument - error(Error(FSComp.SR.tcInstanceMemberRequiresTarget(),m)) + error(Error(FSComp.SR.tcInstanceMemberRequiresTarget(), m)) match args, memberFlags.MemberKind with - | _,MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertyInSyntaxTree(),m)) - | [],MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcStaticInitializerRequiresArgument(),m)) - | [],MemberKind.Constructor -> error(Error(FSComp.SR.tcObjectConstructorRequiresArgument(),m)) - | [_],MemberKind.ClassConstructor - | [_],MemberKind.Constructor -> MakeNormalizedStaticOrValBinding cenv ValOrMemberBinding id vis typars args rhsExpr valSynData + | _, MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertyInSyntaxTree(), m)) + | [], MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcStaticInitializerRequiresArgument(), m)) + | [], MemberKind.Constructor -> error(Error(FSComp.SR.tcObjectConstructorRequiresArgument(), m)) + | [_], MemberKind.ClassConstructor + | [_], MemberKind.Constructor -> MakeNormalizedStaticOrValBinding cenv ValOrMemberBinding id vis typars args rhsExpr valSynData // Static property declared using 'static member P = expr': transformed to a method taking a "unit" argument // static property: these transformed into methods taking one "unit" argument - | [],MemberKind.Member -> + | [], MemberKind.Member -> let memberFlags = {memberFlags with MemberKind = MemberKind.PropertyGet} - let valSynData = SynValData(Some memberFlags,valSynInfo,thisIdOpt) - NormalizedBindingPat(mkSynPatVar vis id, - PushOnePatternToRhs cenv true (SynPat.Const(SynConst.Unit,m)) rhsExpr, - valSynData, + let valSynData = SynValData(Some memberFlags, valSynInfo, thisIdOpt) + NormalizedBindingPat(mkSynPatVar vis id, + PushOnePatternToRhs cenv true (SynPat.Const(SynConst.Unit, m)) rhsExpr, + valSynData, typars) | _ -> MakeNormalizedStaticOrValBinding cenv ValOrMemberBinding id vis typars args rhsExpr valSynData let private NormalizeInstanceMemberBinding cenv memberFlags valSynData thisId memberId (toolId:Ident option) vis typars args m rhsExpr = - let (SynValData(_,valSynInfo,thisIdOpt)) = valSynData + let (SynValData(_, valSynInfo, thisIdOpt)) = valSynData if not memberFlags.IsInstance then // static method with adhoc "this" argument - error(Error(FSComp.SR.tcStaticMemberShouldNotHaveThis(),m)) + error(Error(FSComp.SR.tcStaticMemberShouldNotHaveThis(), m)) match args, memberFlags.MemberKind with - | _,MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcExplicitStaticInitializerSyntax(),m)) - | _,MemberKind.Constructor -> error(Error(FSComp.SR.tcExplicitObjectConstructorSyntax(),m)) - | _,MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertySpec(),m)) + | _, MemberKind.ClassConstructor -> error(Error(FSComp.SR.tcExplicitStaticInitializerSyntax(), m)) + | _, MemberKind.Constructor -> error(Error(FSComp.SR.tcExplicitObjectConstructorSyntax(), m)) + | _, MemberKind.PropertyGetSet -> error(Error(FSComp.SR.tcUnexpectedPropertySpec(), m)) // Instance property declared using 'x.Member': transformed to methods taking a "this" and a "unit" argument // We push across the 'this' arg in mk_rec_binds - | [],MemberKind.Member -> + | [], MemberKind.Member -> let memberFlags = {memberFlags with MemberKind = MemberKind.PropertyGet} NormalizedBindingPat - (SynPat.InstanceMember(thisId,memberId,toolId,vis,m), - PushOnePatternToRhs cenv true (SynPat.Const(SynConst.Unit,m)) rhsExpr, + (SynPat.InstanceMember(thisId, memberId, toolId, vis, m), + PushOnePatternToRhs cenv true (SynPat.Const(SynConst.Unit, m)) rhsExpr, // Update the member info to record that this is a MemberKind.PropertyGet - SynValData(Some memberFlags,valSynInfo,thisIdOpt), + SynValData(Some memberFlags, valSynInfo, thisIdOpt), typars) | _ -> MakeNormalizedInstanceMemberBinding cenv thisId memberId toolId vis m typars args rhsExpr valSynData let private NormalizeBindingPattern cenv nameResolver isObjExprBinding (env: TcEnv) valSynData pat rhsExpr = let ad = env.eAccessRights - let (SynValData(memberFlagsOpt,_,_)) = valSynData + let (SynValData(memberFlagsOpt, _, _)) = valSynData let rec normPattern pat = // One major problem with versions of F# prior to 1.9.x was that data constructors easily 'pollute' the namespace // of available items, to the point that you can't even define a function with the same name as an existing union case. match pat with - | SynPat.FromParseError(p,_) -> normPattern p - | SynPat.LongIdent (LongIdentWithDots(longId,_), toolId, tyargs, SynConstructorArgs.Pats args, vis, m) -> + | SynPat.FromParseError(p, _) -> normPattern p + | SynPat.LongIdent (LongIdentWithDots(longId, _), toolId, tyargs, SynConstructorArgs.Pats args, vis, m) -> let typars = match tyargs with None -> inferredTyparDecls | Some typars -> typars match memberFlagsOpt with | None -> match ResolvePatternLongIdent cenv.tcSink nameResolver AllIdsOK true m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with | Item.NewDef id -> if id.idText = opNameCons then - NormalizedBindingPat(pat,rhsExpr,valSynData,typars) + NormalizedBindingPat(pat, rhsExpr, valSynData, typars) else if isObjExprBinding = ObjExprBinding then - errorR(Deprecated(FSComp.SR.tcObjectExpressionFormDeprecated(),m)) + errorR(Deprecated(FSComp.SR.tcObjectExpressionFormDeprecated(), m)) MakeNormalizedStaticOrValBinding cenv isObjExprBinding id vis typars args rhsExpr valSynData | _ -> - error(Error(FSComp.SR.tcInvalidDeclaration(),m)) + error(Error(FSComp.SR.tcInvalidDeclaration(), m)) | Some memberFlags -> match longId with // x.Member in member binding patterns. | [thisId;memberId] -> NormalizeInstanceMemberBinding cenv memberFlags valSynData thisId memberId toolId vis typars args m rhsExpr | [memberId] -> NormalizeStaticMemberBinding cenv memberFlags valSynData memberId vis typars args m rhsExpr - | _ -> NormalizedBindingPat(pat,rhsExpr,valSynData,typars) + | _ -> NormalizedBindingPat(pat, rhsExpr, valSynData, typars) // Object constructors are normalized in TcLetrec // Here we are normalizing member definitions with simple (not long) ids, @@ -2525,23 +2525,23 @@ module BindingNormalization = memberFlags.MemberKind <> MemberKind.ClassConstructor) -> NormalizeStaticMemberBinding cenv (Option.get memberFlagsOpt) valSynData id vis inferredTyparDecls [] m rhsExpr - | SynPat.Typed(pat',x,y) -> - let (NormalizedBindingPat(pat'',e'',valSynData,typars)) = normPattern pat' - NormalizedBindingPat(SynPat.Typed(pat'',x,y), e'',valSynData,typars) + | SynPat.Typed(pat', x, y) -> + let (NormalizedBindingPat(pat'', e'', valSynData, typars)) = normPattern pat' + NormalizedBindingPat(SynPat.Typed(pat'', x, y), e'', valSynData, typars) - | SynPat.Attrib(_,_,m) -> - error(Error(FSComp.SR.tcAttributesInvalidInPatterns(),m)) + | SynPat.Attrib(_, _, m) -> + error(Error(FSComp.SR.tcAttributesInvalidInPatterns(), m)) | _ -> - NormalizedBindingPat(pat,rhsExpr,valSynData,inferredTyparDecls) + NormalizedBindingPat(pat, rhsExpr, valSynData, inferredTyparDecls) normPattern pat let NormalizeBinding isObjExprBinding cenv (env: TcEnv) b = match b with - | Binding (vis,bkind,isInline,isMutable,attrs,doc,valSynData,p,retInfo,rhsExpr,mBinding,spBind) -> - let (NormalizedBindingPat(pat,rhsExpr,valSynData,typars)) = + | Binding (vis, bkind, isInline, isMutable, attrs, doc, valSynData, p, retInfo, rhsExpr, mBinding, spBind) -> + let (NormalizedBindingPat(pat, rhsExpr, valSynData, typars)) = NormalizeBindingPattern cenv cenv.nameResolver isObjExprBinding env valSynData p (NormalizedBindingRhs ([], retInfo, rhsExpr)) - NormalizedBinding(vis,bkind,isInline,isMutable,attrs,doc.ToXmlDoc(),typars,valSynData,pat,rhsExpr,mBinding,spBind) + NormalizedBinding(vis, bkind, isInline, isMutable, attrs, doc.ToXmlDoc(), typars, valSynData, pat, rhsExpr, mBinding, spBind) //------------------------------------------------------------------------- // input is: @@ -2552,7 +2552,7 @@ module BindingNormalization = // member x.remove_P< >(argName) = (e).RemoveHandler(argName) module EventDeclarationNormalization = - let ConvertSynInfo m (SynValInfo(argInfos,retInfo)) = + let ConvertSynInfo m (SynValInfo(argInfos, retInfo)) = // reconstitute valSynInfo by adding the argument let argInfos = match argInfos with @@ -2561,7 +2561,7 @@ module EventDeclarationNormalization = | _ -> error(BadEventTransformation(m)) // reconstitute valSynInfo - SynValInfo(argInfos,retInfo) + SynValInfo(argInfos, retInfo) // The property x.P becomes methods x.add_P and x.remove_P let ConvertMemberFlags memberFlags = { memberFlags with MemberKind = MemberKind.Member } @@ -2572,54 +2572,54 @@ module EventDeclarationNormalization = | _ -> error(BadEventTransformation(m)) let private ConvertSynData m valSynData = - let (SynValData(memberFlagsOpt,valSynInfo,thisIdOpt)) = valSynData + let (SynValData(memberFlagsOpt, valSynInfo, thisIdOpt)) = valSynData let memberFlagsOpt = ConvertMemberFlagsOpt m memberFlagsOpt let valSynInfo = ConvertSynInfo m valSynInfo - SynValData(memberFlagsOpt,valSynInfo,thisIdOpt) + SynValData(memberFlagsOpt, valSynInfo, thisIdOpt) let rec private RenameBindingPattern f declPattern = match declPattern with - | SynPat.FromParseError(p,_) -> RenameBindingPattern f p - | SynPat.Typed(pat',_,_) -> RenameBindingPattern f pat' - | SynPat.Named (SynPat.Wild m1, id,x2,vis2,m) -> SynPat.Named (SynPat.Wild m1, ident(f id.idText,id.idRange) ,x2,vis2,m) - | SynPat.InstanceMember(thisId,id,toolId,vis2,m) -> SynPat.InstanceMember(thisId,ident(f id.idText,id.idRange),toolId,vis2,m) - | _ -> error(Error(FSComp.SR.tcOnlySimplePatternsInLetRec(),declPattern.Range)) + | SynPat.FromParseError(p, _) -> RenameBindingPattern f p + | SynPat.Typed(pat', _, _) -> RenameBindingPattern f pat' + | SynPat.Named (SynPat.Wild m1, id, x2, vis2, m) -> SynPat.Named (SynPat.Wild m1, ident(f id.idText, id.idRange) , x2, vis2, m) + | SynPat.InstanceMember(thisId, id, toolId, vis2, m) -> SynPat.InstanceMember(thisId, ident(f id.idText, id.idRange), toolId, vis2, m) + | _ -> error(Error(FSComp.SR.tcOnlySimplePatternsInLetRec(), declPattern.Range)) /// Some F# bindings syntactically imply additional bindings, notably properties /// annotated with [] - let GenerateExtraBindings cenv (bindingAttribs,binding) = + let GenerateExtraBindings cenv (bindingAttribs, binding) = let (NormalizedBinding(vis1, bindingKind, isInline, isMutable, _, bindingXmlDoc, _synTyparDecls, valSynData, declPattern, bindingRhs, mBinding, spBind)) = binding if CompileAsEvent cenv.g bindingAttribs then - let MakeOne (prefix,target) = + let MakeOne (prefix, target) = let declPattern = RenameBindingPattern (fun s -> prefix^s) declPattern let argName = "handler" // modify the rhs and argument data - let bindingRhs,valSynData = - let (NormalizedBindingRhs(_,_,rhsExpr)) = bindingRhs + let bindingRhs, valSynData = + let (NormalizedBindingRhs(_, _, rhsExpr)) = bindingRhs let m = rhsExpr.Range // reconstitute valSynInfo by adding the argument let valSynData = ConvertSynData m valSynData match rhsExpr with // Detect 'fun () -> e' which results from the compilation of a property getter - | SynExpr.Lambda (_,_,SynSimplePats.SimplePats([],_), trueRhsExpr,m) -> - let rhsExpr = mkSynApp1 (SynExpr.DotGet(SynExpr.Paren(trueRhsExpr,range0,None,m),range0,LongIdentWithDots([ident(target,m)],[]),m)) (SynExpr.Ident(ident(argName,m))) m + | SynExpr.Lambda (_, _, SynSimplePats.SimplePats([], _), trueRhsExpr, m) -> + let rhsExpr = mkSynApp1 (SynExpr.DotGet(SynExpr.Paren(trueRhsExpr, range0, None, m), range0, LongIdentWithDots([ident(target, m)], []), m)) (SynExpr.Ident(ident(argName, m))) m // reconstitute rhsExpr - let bindingRhs = NormalizedBindingRhs([],None,rhsExpr) + let bindingRhs = NormalizedBindingRhs([], None, rhsExpr) // add the argument to the expression - let bindingRhs = PushOnePatternToRhs cenv true (mkSynPatVar None (ident (argName,mBinding))) bindingRhs + let bindingRhs = PushOnePatternToRhs cenv true (mkSynPatVar None (ident (argName, mBinding))) bindingRhs - bindingRhs,valSynData + bindingRhs, valSynData | _ -> error(BadEventTransformation(m)) // reconstitute the binding - NormalizedBinding(vis1,bindingKind,isInline,isMutable,[],bindingXmlDoc,noInferredTypars,valSynData,declPattern,bindingRhs,mBinding,spBind) + NormalizedBinding(vis1, bindingKind, isInline, isMutable, [], bindingXmlDoc, noInferredTypars, valSynData, declPattern, bindingRhs, mBinding, spBind) - [ MakeOne ("add_","AddHandler"); MakeOne ("remove_","RemoveHandler") ] + [ MakeOne ("add_", "AddHandler"); MakeOne ("remove_", "RemoveHandler") ] else [] @@ -2629,9 +2629,9 @@ module EventDeclarationNormalization = /// Also adjust the "this" type to take into account whether the type is a struct. let FreshenObjectArgType cenv m rigid tcref isExtrinsic declaredTyconTypars = #if EXTENDED_EXTENSION_MEMBERS // indicates if extension members can add additional constraints to type parameters - let tcrefObjTy,enclosingDeclaredTypars,renaming,objTy = FreshenTyconRef m (if isExtrinsic then TyparRigidity.Flexible else rigid) tcref declaredTyconTypars + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy = FreshenTyconRef m (if isExtrinsic then TyparRigidity.Flexible else rigid) tcref declaredTyconTypars #else - let tcrefObjTy,enclosingDeclaredTypars,renaming,objTy = FreshenTyconRef m rigid tcref declaredTyconTypars + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy = FreshenTyconRef m rigid tcref declaredTyconTypars #endif // Struct members have a byref 'this' type (unless they are extrinsic extension members) let thisTy = @@ -2639,7 +2639,7 @@ let FreshenObjectArgType cenv m rigid tcref isExtrinsic declaredTyconTypars = mkByrefTy cenv.g objTy else objTy - tcrefObjTy,enclosingDeclaredTypars,renaming,objTy,thisTy + tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy // The early generalization rule of F# 2.0 can be unsound for members in generic types (Bug DevDiv2 10649). @@ -2652,10 +2652,10 @@ let FreshenObjectArgType cenv m rigid tcref isExtrinsic declaredTyconTypars = // // At this point A is generalized early to "Forall T. unit -> ?X" // static member B1() = C.A() // // At this point during type inference, the return type of C.A() is '?X' -// // After type inference, the return type of C.A() is 'string' +// // After type inference, the return type of C.A() is 'string' // static member B2() = C.A() // // At this point during type inference, the return type of C.A() is '?X' -// // After type inference, the return type of C.A() is 'int' +// // After type inference, the return type of C.A() is 'int' // member this.C() = (x : 'T) // // At this point during type inference the type of 'x' is inferred to be 'T' // @@ -2674,7 +2674,7 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env:TcEnv) (v:Val, vrec, tins //printfn "running post-inference check for '%s'" v.DisplayName //printfn "tau = '%s'" (DebugPrint.showType tau) //printfn "vty = '%s'" (DebugPrint.showType vty) - let tpsorig,tau2 = tryDestForallTy cenv.g vty + let tpsorig, tau2 = tryDestForallTy cenv.g vty //printfn "tau2 = '%s'" (DebugPrint.showType tau2) if not (isNil tpsorig) then let tpsorig = NormalizeDeclaredTyparsForEquiRecursiveInference cenv.g tpsorig @@ -2682,7 +2682,7 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env:TcEnv) (v:Val, vrec, tins //printfn "tau3 = '%s'" (DebugPrint.showType tau3) if not (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m tau tau3) then let txt = bufs (fun buf -> NicePrint.outputQualifiedValSpec env.DisplayEnv buf v) - error(Error(FSComp.SR.tcInferredGenericTypeGivesRiseToInconsistency(v.DisplayName, txt),m))) + error(Error(FSComp.SR.tcInferredGenericTypeGivesRiseToInconsistency(v.DisplayName, txt), m))) | _ -> () @@ -2699,7 +2699,7 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env:TcEnv) (v:Val, vrec, tins /// | CtorValUsedAsSelfInit "new() = new OwnType(3)" /// | VSlotDirectCall "base.OnClick(eventArgs)" let TcVal checkAttributes cenv env tpenv (vref:ValRef) optInst optAfterResolution m = - let (tpsorig,_, _, _, tinst, _) as res = + let (tpsorig, _, _, _, tinst, _) as res = let v = vref.Deref let vrec = v.RecursiveValInfo v.SetHasBeenReferenced() @@ -2719,8 +2719,8 @@ let TcVal checkAttributes cenv env tpenv (vref:ValRef) optInst optAfterResolutio // The value may still be generic, e.g. // [] // let Null = null - let tpsorig,_,tinst,tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty - tpsorig, Expr.Const(c,m,tau),isSpecial,tau,tinst,tpenv + let tpsorig, _, tinst, tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty + tpsorig, Expr.Const(c, m, tau), isSpecial, tau, tinst, tpenv | None -> // References to 'this' in classes get dereferenced from their implicit reference cell and poked @@ -2734,56 +2734,56 @@ let TcVal checkAttributes cenv env tpenv (vref:ValRef) optInst optAfterResolutio [], mkCallCheckThis cenv.g m ty (mkRefCellGet cenv.g m ty exprForVal), isSpecial, ty, [], tpenv else // Instantiate the value - let tpsorig,vrefFlags,tinst,tau,tpenv = + let tpsorig, vrefFlags, tinst, tau, tpenv = // Have we got an explicit instantiation? match optInst with // No explicit instantiation (the normal case) | None -> if HasFSharpAttribute cenv.g cenv.g.attrib_RequiresExplicitTypeArgumentsAttribute v.Attribs then - errorR(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(v.DisplayName),m)) + errorR(Error(FSComp.SR.tcFunctionRequiresExplicitTypeArguments(v.DisplayName), m)) match vrec with | ValInRecScope false -> - let tpsorig,tau = vref.TypeScheme + let tpsorig, tau = vref.TypeScheme let tinst = tpsorig |> List.map mkTyparTy - tpsorig,NormalValUse,tinst,tau,tpenv + tpsorig, NormalValUse, tinst, tau, tpenv | ValInRecScope true | ValNotInRecScope -> - let tpsorig,_,tinst,tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty - tpsorig,NormalValUse,tinst,tau,tpenv + let tpsorig, _, tinst, tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty + tpsorig, NormalValUse, tinst, tau, tpenv // If we have got an explicit instantiation then use that - | Some(vrefFlags,checkTys) -> + | Some(vrefFlags, checkTys) -> let checkInst (tinst:TypeInst) = if not v.IsMember && not v.PermitsExplicitTypeInstantiation && tinst.Length > 0 && v.Typars.Length > 0 then - warning(Error(FSComp.SR.tcDoesNotAllowExplicitTypeArguments(v.DisplayName),m)) + warning(Error(FSComp.SR.tcDoesNotAllowExplicitTypeArguments(v.DisplayName), m)) match vrec with | ValInRecScope false -> - let tpsorig,tau = vref.TypeScheme - let (tinst:TypeInst),tpenv = checkTys tpenv (tpsorig |> List.map (fun tp -> tp.Kind)) + let tpsorig, tau = vref.TypeScheme + let (tinst:TypeInst), tpenv = checkTys tpenv (tpsorig |> List.map (fun tp -> tp.Kind)) checkInst tinst - if tpsorig.Length <> tinst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tpsorig.Length, tinst.Length),m)) + if tpsorig.Length <> tinst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tpsorig.Length, tinst.Length), m)) let tau2 = instType (mkTyparInst tpsorig tinst) tau (tpsorig, tinst) ||> List.iter2 (fun tp ty -> try UnifyTypes cenv env m (mkTyparTy tp) ty - with _ -> error (Recursion(env.DisplayEnv,v.Id,tau2,tau,m))) - tpsorig,vrefFlags,tinst,tau2,tpenv + with _ -> error (Recursion(env.DisplayEnv, v.Id, tau2, tau, m))) + tpsorig, vrefFlags, tinst, tau2, tpenv | ValInRecScope true | ValNotInRecScope -> - let tpsorig,tps,tptys,tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty + let tpsorig, tps, tptys, tau = FreshenPossibleForallTy cenv.g m TyparRigidity.Flexible vty //dprintfn "After Freshen: tau = %s" (Layout.showL (typeL tau)) - let (tinst:TypeInst),tpenv = checkTys tpenv (tps |> List.map (fun tp -> tp.Kind)) + let (tinst:TypeInst), tpenv = checkTys tpenv (tps |> List.map (fun tp -> tp.Kind)) checkInst tinst //dprintfn "After Check: tau = %s" (Layout.showL (typeL tau)) - if tptys.Length <> tinst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, tinst.Length),m)) + if tptys.Length <> tinst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, tinst.Length), m)) List.iter2 (UnifyTypes cenv env m) tptys tinst TcValEarlyGeneralizationConsistencyCheck cenv env (v, vrec, tinst, vty, tau, m) //dprintfn "After Unify: tau = %s" (Layout.showL (typeL tau)) - tpsorig,vrefFlags,tinst,tau,tpenv + tpsorig, vrefFlags, tinst, tau, tpenv - let exprForVal = Expr.Val (vref,vrefFlags,m) - let exprForVal = mkTyAppExpr m (exprForVal,vty) tinst + let exprForVal = Expr.Val (vref, vrefFlags, m) + let exprForVal = mkTyAppExpr m (exprForVal, vty) tinst let isSpecial = (match vrefFlags with NormalValUse | PossibleConstrainedCall _ -> false | _ -> true) || valRefEq cenv.g vref cenv.g.splice_expr_vref || @@ -2809,18 +2809,18 @@ let LightweightTcValForUsingInBuildMethodCall g (vref:ValRef) vrefFlags (vrefTyp else match v.LiteralValue with | Some c -> - let _,_,_,tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vty - Expr.Const(c,m,tau),tau + let _, _, _, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vty + Expr.Const(c, m, tau), tau | None -> // Instantiate the value let tau = // If we have got an explicit instantiation then use that - let _,tps,tptys,tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vty - if tptys.Length <> vrefTypeInst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, vrefTypeInst.Length),m)); + let _, tps, tptys, tau = FreshenPossibleForallTy g m TyparRigidity.Flexible vty + if tptys.Length <> vrefTypeInst.Length then error(Error(FSComp.SR.tcTypeParameterArityMismatch(tps.Length, vrefTypeInst.Length), m)); instType (mkTyparInst tps vrefTypeInst) tau - let exprForVal = Expr.Val (vref,vrefFlags,m) - let exprForVal = mkTyAppExpr m (exprForVal,vty) vrefTypeInst + let exprForVal = Expr.Val (vref, vrefFlags, m) + let exprForVal = mkTyAppExpr m (exprForVal, vty) vrefTypeInst exprForVal, tau /// Mark points where we decide whether an expression will support automatic @@ -2837,27 +2837,27 @@ type ApplicableExpr = bool member x.Range = match x with - | ApplicableExpr (_,e,_) -> e.Range + | ApplicableExpr (_, e, _) -> e.Range member x.Type = match x with - | ApplicableExpr (cenv,e,_) -> tyOfExpr cenv.g e - member x.SupplyArgument(e2,m) = - let (ApplicableExpr (cenv,fe,first)) = x + | ApplicableExpr (cenv, e, _) -> tyOfExpr cenv.g e + member x.SupplyArgument(e2, m) = + let (ApplicableExpr (cenv, fe, first)) = x let combinedExpr = match fe with - | Expr.App(e1,e1ty,tyargs1,args1,e1m) when + | Expr.App(e1, e1ty, tyargs1, args1, e1m) when (not first || isNil args1) && - (not (isForallTy cenv.g e1ty) || isFunTy cenv.g (applyTys cenv.g e1ty (tyargs1,args1))) -> - Expr.App(e1,e1ty,tyargs1,args1@[e2],unionRanges e1m m) + (not (isForallTy cenv.g e1ty) || isFunTy cenv.g (applyTys cenv.g e1ty (tyargs1, args1))) -> + Expr.App(e1, e1ty, tyargs1, args1@[e2], unionRanges e1m m) | _ -> - Expr.App(fe,tyOfExpr cenv.g fe,[],[e2],m) - ApplicableExpr(cenv, combinedExpr,false) + Expr.App(fe, tyOfExpr cenv.g fe, [], [e2], m) + ApplicableExpr(cenv, combinedExpr, false) member x.Expr = match x with - | ApplicableExpr(_,e,_) -> e + | ApplicableExpr(_, e, _) -> e let MakeApplicableExprNoFlex cenv expr = - ApplicableExpr (cenv,expr,true) + ApplicableExpr (cenv, expr, true) /// This function reverses the effect of condensation for a named function value (indeed it can /// work for any expression, though we only invoke it immediately after a call to TcVal). @@ -2880,7 +2880,7 @@ let MakeApplicableExprNoFlex cenv expr = /// Sealed types and 'obj' do not introduce generic flexibility when functions are used as first class /// values. /// -/// For 'obj' this is because introducing this flexibility would NOT be the reverse of condensation, +/// For 'obj' this is because introducing this flexibility would NOT be the reverse of condensation, /// since we don't condense /// f : 'a -> unit /// to @@ -2896,13 +2896,13 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = let isNonFlexibleType ty = isSealedTy cenv.g ty - let argTys,retTy = stripFunTy cenv.g exprTy + let argTys, retTy = stripFunTy cenv.g exprTy let curriedActualTypes = argTys |> List.map (tryDestRefTupleTy cenv.g) if (curriedActualTypes.IsEmpty || curriedActualTypes |> List.exists (List.exists (isByrefTy cenv.g)) || curriedActualTypes |> List.forall (List.forall isNonFlexibleType)) then - ApplicableExpr (cenv,expr,true) + ApplicableExpr (cenv, expr, true) else let curriedFlexibleTypes = curriedActualTypes |> List.mapSquared (fun actualType -> @@ -2914,8 +2914,8 @@ let MakeApplicableExprWithFlex cenv (env: TcEnv) expr = flexibleType) // Create a coercion to represent the expansion of the application - let expr = mkCoerceExpr (expr,mkIteratedFunTy (List.map (mkRefTupledTy cenv.g) curriedFlexibleTypes) retTy,m,exprTy) - ApplicableExpr (cenv,expr,true) + let expr = mkCoerceExpr (expr, mkIteratedFunTy (List.map (mkRefTupledTy cenv.g) curriedFlexibleTypes) retTy, m, exprTy) + ApplicableExpr (cenv, expr, true) /// Checks, warnings and constraint assertions for downcasts @@ -2924,10 +2924,10 @@ let TcRuntimeTypeTest isCast isOperator cenv denv m tgty srcTy = warning(TypeTestUnnecessary(m)) if isTyparTy cenv.g srcTy then - error(IndeterminateRuntimeCoercion(denv,srcTy,tgty,m)) + error(IndeterminateRuntimeCoercion(denv, srcTy, tgty, m)) if isSealedTy cenv.g srcTy then - error(RuntimeCoercionSourceSealed(denv,srcTy,m)) + error(RuntimeCoercionSourceSealed(denv, srcTy, m)) if isSealedTy cenv.g tgty || isTyparTy cenv.g tgty || not (isInterfaceTy cenv.g srcTy) then if isCast then @@ -2944,15 +2944,15 @@ let TcRuntimeTypeTest isCast isOperator cenv denv m tgty srcTy = getErasedTypes cenv.g tgty |> List.iter (fun ety -> if isMeasureTy cenv.g ety then warning(Error(FSComp.SR.tcTypeTestLosesMeasures(NicePrint.minimalStringOfType denv ety), m)) - else warning(Error(FSComp.SR.tcTypeTestLossy(NicePrint.minimalStringOfType denv ety, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll cenv.g ety)),m))) + else warning(Error(FSComp.SR.tcTypeTestLossy(NicePrint.minimalStringOfType denv ety, NicePrint.minimalStringOfType denv (stripTyEqnsWrtErasure EraseAll cenv.g ety)), m))) /// Checks, warnings and constraint assertions for upcasts let TcStaticUpcast cenv denv m tgty srcTy = if isTyparTy cenv.g tgty then - error(IndeterminateStaticCoercion(denv,srcTy,tgty,m)) + error(IndeterminateStaticCoercion(denv, srcTy, tgty, m)) if isSealedTy cenv.g tgty then - warning(CoercionTargetSealed(denv,tgty,m)) + warning(CoercionTargetSealed(denv, tgty, m)) if typeEquiv cenv.g srcTy tgty then warning(UpcastUnnecessary(m)) @@ -2977,9 +2977,9 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF | _ -> #if EXTENSIONTYPING match minfo with - | ProvidedMeth(_, mi, _,_) -> + | ProvidedMeth(_, mi, _, _) -> // BuildInvokerExpressionForProvidedMethodCall converts references to F# intrinsics back to values - // and uses TcVal to do this. However we don't want to check attributes again for provided references to values, + // and uses TcVal to do this. However we don't want to check attributes again for provided references to values, // so we pass 'false' for 'checkAttributes'. let tcVal = LightweightTcValForUsingInBuildMethodCall cenv.g let _, retExpt, retTy = ProvidedMethodCalls.BuildInvokerExpressionForProvidedMethodCall tcVal (cenv.g, cenv.amap, mi, objArgs, isMutable, isProp, valUseFlags, args, m) @@ -2994,7 +2994,7 @@ let BuildPossiblyConditionalMethodCall cenv env isMutable m isProp minfo valUseF let TryFindIntrinsicOrExtensionMethInfo (cenv:cenv) (env: TcEnv) m ad nm ty = - AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (Some(nm),ad) IgnoreOverrides m ty + AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (Some(nm), ad) IgnoreOverrides m ty /// Build the 'test and dispose' part of a 'use' statement let BuildDisposableCleanup cenv env m (v:Val) = @@ -3003,7 +3003,7 @@ let BuildDisposableCleanup cenv env m (v:Val) = let disposeMethod = match TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Dispose" cenv.g.system_IDisposable_typ with | [x] -> x - | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(),m)) + | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) // For struct types the test is simpler: we can determine if IDisposable is supported, and even when it is, we can avoid doing the type test @@ -3012,14 +3012,14 @@ let BuildDisposableCleanup cenv env m (v:Val) = if TypeFeasiblySubsumesType 0 cenv.g cenv.amap m cenv.g.system_IDisposable_typ CanCoerce v.Type then // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive // copy of it. - let disposeExpr,_ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] disposeExpr else mkUnit cenv.g m else - let disposeObjVar,disposeObjExpr = Tastops.mkCompGenLocal m "objectToDispose" cenv.g.system_IDisposable_typ - let disposeExpr,_ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] - let inpe = mkCoerceExpr(exprForVal v.Range v,cenv.g.obj_ty,m,v.Type) + let disposeObjVar, disposeObjExpr = Tastops.mkCompGenLocal m "objectToDispose" cenv.g.system_IDisposable_typ + let disposeExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let inpe = mkCoerceExpr(exprForVal v.Range v, cenv.g.obj_ty, m, v.Type) mkIsInstConditional cenv.g m cenv.g.system_IDisposable_typ inpe disposeObjVar disposeExpr (mkUnit cenv.g m) /// Build call to get_OffsetToStringData as part of 'fixed' @@ -3028,9 +3028,9 @@ let BuildOffsetToStringData cenv env m = let offsetToStringDataMethod = match TryFindIntrinsicOrExtensionMethInfo cenv env m ad "get_OffsetToStringData" cenv.g.system_RuntimeHelpers_typ with | [x] -> x - | _ -> error(Error(FSComp.SR.tcCouldNotFindOffsetToStringData(),m)) + | _ -> error(Error(FSComp.SR.tcCouldNotFindOffsetToStringData(), m)) - let offsetExpr,_ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] + let offsetExpr, _ = BuildPossiblyConditionalMethodCall cenv env NeverMutates m false offsetToStringDataMethod NormalValUse [] [] [] offsetExpr let BuildILFieldGet g amap m objExpr (finfo:ILFieldInfo) = @@ -3038,7 +3038,7 @@ let BuildILFieldGet g amap m objExpr (finfo:ILFieldInfo) = let isValueType = finfo.IsValueType let valu = if isValueType then AsValue else AsObject let tinst = finfo.TypeInst - let fieldType = finfo.FieldType (amap,m) + let fieldType = finfo.FieldType (amap, m) #if EXTENSIONTYPING let ty = tyOfExpr g objExpr match finfo with @@ -3048,16 +3048,16 @@ let BuildILFieldGet g amap m objExpr (finfo:ILFieldInfo) = | None -> error (Error(FSComp.SR.tcTPFieldMustBeLiteral(), m)) | Some lit -> - Expr.Const(TcFieldInit m lit,m,fieldType) + Expr.Const(TcFieldInit m lit, m, fieldType) | _ -> #endif - let wrap,objExpr = mkExprAddrOfExpr g isValueType false NeverMutates objExpr None m + let wrap, objExpr = mkExprAddrOfExpr g isValueType false NeverMutates objExpr None m // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. * - let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) + let fspec = mkILFieldSpec(fref, mkILNamedTy valu fref.EnclosingTypeRef []) // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. - wrap (mkAsmExpr (([ mkNormalLdfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else [])), tinst,[objExpr],[fieldType],m)) + wrap (mkAsmExpr (([ mkNormalLdfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else [])), tinst, [objExpr], [fieldType], m)) let BuildILFieldSet g m objExpr (finfo:ILFieldInfo) argExpr = let fref = finfo.ILFieldRef @@ -3067,10 +3067,10 @@ let BuildILFieldSet g m objExpr (finfo:ILFieldInfo) argExpr = // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. * - let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) - if finfo.IsInitOnly then error (Error (FSComp.SR.tcFieldIsReadonly(),m)) - let wrap,objExpr = mkExprAddrOfExpr g isValueType false DefinitelyMutates objExpr None m - wrap (mkAsmExpr ([ mkNormalStfld fspec ], tinst,[objExpr; argExpr],[],m)) + let fspec = mkILFieldSpec(fref, mkILNamedTy valu fref.EnclosingTypeRef []) + if finfo.IsInitOnly then error (Error (FSComp.SR.tcFieldIsReadonly(), m)) + let wrap, objExpr = mkExprAddrOfExpr g isValueType false DefinitelyMutates objExpr None m + wrap (mkAsmExpr ([ mkNormalStfld fspec ], tinst, [objExpr; argExpr], [], m)) let BuildILStaticFieldSet m (finfo:ILFieldInfo) argExpr = let fref = finfo.ILFieldRef @@ -3080,16 +3080,16 @@ let BuildILStaticFieldSet m (finfo:ILFieldInfo) argExpr = // The empty instantiation on the AbstractIL fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. - let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) - if finfo.IsInitOnly then error (Error (FSComp.SR.tcFieldIsReadonly(),m)) - mkAsmExpr ([ mkNormalStsfld fspec ], tinst,[argExpr],[],m) + let fspec = mkILFieldSpec(fref, mkILNamedTy valu fref.EnclosingTypeRef []) + if finfo.IsInitOnly then error (Error (FSComp.SR.tcFieldIsReadonly(), m)) + mkAsmExpr ([ mkNormalStsfld fspec ], tinst, [argExpr], [], m) let BuildRecdFieldSet g m objExpr (rfinfo:RecdFieldInfo) argExpr = let tgty = rfinfo.EnclosingType let valu = isStructTy g tgty - let objExpr = if valu then objExpr else mkCoerceExpr(objExpr,tgty,m,tyOfExpr g objExpr) - let wrap,objExpr = mkExprAddrOfExpr g valu false DefinitelyMutates objExpr None m - wrap (mkRecdFieldSetViaExprAddr (objExpr,rfinfo.RecdFieldRef,rfinfo.TypeInst,argExpr,m) ) + let objExpr = if valu then objExpr else mkCoerceExpr(objExpr, tgty, m, tyOfExpr g objExpr) + let wrap, objExpr = mkExprAddrOfExpr g valu false DefinitelyMutates objExpr None m + wrap (mkRecdFieldSetViaExprAddr (objExpr, rfinfo.RecdFieldRef, rfinfo.TypeInst, argExpr, m) ) //------------------------------------------------------------------------- @@ -3098,15 +3098,15 @@ let BuildRecdFieldSet g m objExpr (rfinfo:RecdFieldInfo) argExpr = let (|BinOpExpr|_|) e = match e with - | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent opId, a, _), b, _) -> Some (opId,a,b) + | SynExpr.App (_, _, SynExpr.App(_, _, SingleIdent opId, a, _), b, _) -> Some (opId, a, b) | _ -> None let (|SimpleEqualsExpr|_|) e = match e with - | BinOpExpr(opId,a,b) when opId.idText = opNameEquals -> Some (a,b) + | BinOpExpr(opId, a, b) when opId.idText = opNameEquals -> Some (a, b) | _ -> None -// For join clauses that join on nullable, we syntactically insert the creation of nullable values on the appropriate side of the condition, +// 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 (e:SynExpr) = let m = e.Range @@ -3114,26 +3114,26 @@ let (|JoinRelation|_|) cenv env (e:SynExpr) = let isOpName opName vref s = (s = opName) && - match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName,m)] with + match ResolveExprLongIdent cenv.tcSink cenv.nameResolver m ad env.eNameResEnv TypeNameResolutionInfo.Default [ident(opName, m)] with | Item.Value vref2, [] -> valRefEq cenv.g vref vref2 | _ -> false match e 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 -> Some (a, b) - | BinOpExpr(opId,a,b) when isOpName opNameEqualsNullable cenv.g.equals_nullable_operator_vref opId.idText -> + | 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) + let a = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet a.Range [MangledGlobalName;"System"] "Nullable", a, a.Range) + Some (a, b) - | BinOpExpr(opId,a,b) when isOpName opNameNullableEquals cenv.g.nullable_equals_operator_vref opId.idText -> + | 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) + let b = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet b.Range [MangledGlobalName;"System"] "Nullable", b, b.Range) + Some (a, b) - | BinOpExpr(opId,a,b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> + | BinOpExpr(opId, a, b) when isOpName opNameNullableEqualsNullable cenv.g.nullable_equals_nullable_operator_vref opId.idText -> - Some (a,b) + Some (a, b) | _ -> None @@ -3141,29 +3141,29 @@ let (|JoinRelation|_|) cenv env (e:SynExpr) = /// Detect a named argument at a callsite let TryGetNamedArg e = match e with - | SimpleEqualsExpr(LongOrSingleIdent(isOpt,LongIdentWithDots([a],_),None,_),b) -> Some(isOpt,a,b) + | SimpleEqualsExpr(LongOrSingleIdent(isOpt, LongIdentWithDots([a], _), None, _), b) -> Some(isOpt, a, b) | _ -> None let inline IsNamedArg e = match e with - | SimpleEqualsExpr(LongOrSingleIdent(_,LongIdentWithDots([_],_),None,_),_) -> true + | SimpleEqualsExpr(LongOrSingleIdent(_, LongIdentWithDots([_], _), None, _), _) -> true | _ -> false /// Get the method arguments at a callsite, taking into account named and optional arguments let GetMethodArgs arg = let args = match arg with - | SynExpr.Const (SynConst.Unit,_) -> [] - | SynExprParen(SynExpr.Tuple (args,_,_),_,_,_) | SynExpr.Tuple (args,_,_) -> args - | SynExprParen(arg,_,_,_) | arg -> [arg] - let unnamedCallerArgs,namedCallerArgs = + | SynExpr.Const (SynConst.Unit, _) -> [] + | SynExprParen(SynExpr.Tuple (args, _, _), _, _, _) | SynExpr.Tuple (args, _, _) -> args + | SynExprParen(arg, _, _, _) | arg -> [arg] + let unnamedCallerArgs, namedCallerArgs = args |> List.takeUntil IsNamedArg let namedCallerArgs = namedCallerArgs |> List.choose (fun e -> match TryGetNamedArg e with | None -> - // ignore errors to avoid confusing error messages in cases like foo(a = 1,) + // 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 e with | SynExpr.ArbitraryAfterError _ -> None @@ -3176,8 +3176,8 @@ let GetMethodArgs arg = // Helpers dealing with pattern match compilation //------------------------------------------------------------------------- -let CompilePatternForMatch cenv (env: TcEnv) mExpr matchm warnOnUnused actionOnFailure (v,generalizedTypars) clauses inputTy resultTy = - let dtree,targets = CompilePattern cenv.g env.DisplayEnv cenv.amap mExpr matchm warnOnUnused actionOnFailure (v,generalizedTypars) clauses inputTy resultTy +let CompilePatternForMatch cenv (env: TcEnv) mExpr matchm warnOnUnused actionOnFailure (v, generalizedTypars) clauses inputTy resultTy = + let dtree, targets = CompilePattern cenv.g env.DisplayEnv cenv.amap mExpr matchm warnOnUnused actionOnFailure (v, generalizedTypars) clauses inputTy resultTy mkAndSimplifyMatch NoSequencePointAtInvisibleBinding mExpr matchm resultTy dtree targets /// Compile a pattern @@ -3185,13 +3185,13 @@ let CompilePatternForMatchClauses cenv env mExpr matchm warnOnUnused actionOnFai // Avoid creating a dummy in the common cases where we are about to bind a name for the expression // CLEANUP: avoid code duplication with code further below, i.e.all callers should call CompilePatternForMatch match tclauses with - | [TClause(TPat_as (pat1,PBind (v,TypeScheme(generalizedTypars,_)),_),None,TTarget(vs,e,spTarget),m2)] -> - let expr = CompilePatternForMatch cenv env mExpr matchm warnOnUnused actionOnFailure (v,generalizedTypars) [TClause(pat1,None,TTarget(ListSet.remove valEq v vs,e,spTarget),m2)] inputTy resultTy - v,expr + | [TClause(TPat_as (pat1, PBind (v, TypeScheme(generalizedTypars, _)), _), None, TTarget(vs, e, spTarget), m2)] -> + let expr = CompilePatternForMatch cenv env mExpr matchm warnOnUnused actionOnFailure (v, generalizedTypars) [TClause(pat1, None, TTarget(ListSet.remove valEq v vs, e, spTarget), m2)] inputTy resultTy + v, expr | _ -> - let idv,_ = Tastops.mkCompGenLocal mExpr "matchValue" inputTy - let expr = CompilePatternForMatch cenv env mExpr matchm warnOnUnused actionOnFailure (idv,[]) tclauses inputTy resultTy - idv,expr + let idv, _ = Tastops.mkCompGenLocal mExpr "matchValue" inputTy + let expr = CompilePatternForMatch cenv env mExpr matchm warnOnUnused actionOnFailure (idv, []) tclauses inputTy resultTy + idv, expr @@ -3211,7 +3211,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let err k ty = let txt = NicePrint.minimalStringOfType env.DisplayEnv ty let msg = if k then FSComp.SR.tcTypeCannotBeEnumerated(txt) else FSComp.SR.tcEnumTypeCannotBeEnumerated(txt) - Exception(Error(msg,m)) + Exception(Error(msg, m)) let findMethInfo k m nm ty = match TryFindIntrinsicOrExtensionMethInfo cenv env m ad nm ty with @@ -3225,7 +3225,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr | [[]] -> false | _ -> true - let tryType (exprToSearchForGetEnumeratorAndItem,tyToSearchForGetEnumeratorAndItem) = + let tryType (exprToSearchForGetEnumeratorAndItem, tyToSearchForGetEnumeratorAndItem) = match findMethInfo true m "GetEnumerator" tyToSearchForGetEnumeratorAndItem with | Exception e -> Exception e | Result getEnumerator_minfo -> @@ -3256,7 +3256,7 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr // Like C#, we detect the 'GetEnumerator' pattern for .NET version 1.x abstractions that don't // support the correct generic interface. However unlike C# we also go looking for a 'get_Item' or 'Item' method // with a single integer indexer argument to try to get a strong type for the enumeration should the Enumerator - // not provide anything useful. To enable interop with some legacy COM APIs, + // not provide anything useful. To enable interop with some legacy COM APIs, // the single integer indexer argument is allowed to have type 'object'. let enumElemTy = @@ -3296,13 +3296,13 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let isEnumeratorTypeStruct = isStructTy cenv.g retTypeOfGetEnumerator let originalRetTypeOfGetEnumerator = retTypeOfGetEnumerator - let (enumeratorVar,enumeratorExpr), retTypeOfGetEnumerator = + let (enumeratorVar, enumeratorExpr), retTypeOfGetEnumerator = if isEnumeratorTypeStruct then if localAlloc then Tastops.mkMutableCompGenLocal m "enumerator" retTypeOfGetEnumerator, retTypeOfGetEnumerator else let refCellTyForRetTypeOfGetEnumerator = mkRefCellTy cenv.g retTypeOfGetEnumerator - let v,e = Tastops.mkMutableCompGenLocal m "enumerator" refCellTyForRetTypeOfGetEnumerator + let v, e = Tastops.mkMutableCompGenLocal m "enumerator" refCellTyForRetTypeOfGetEnumerator (v, mkRefCellGet cenv.g m retTypeOfGetEnumerator e), refCellTyForRetTypeOfGetEnumerator else @@ -3317,19 +3317,19 @@ let AnalyzeArbitraryExprAsEnumerable cenv (env: TcEnv) localAlloc m exprty expr let getEnumTy = mkRefCellTy cenv.g getEnumTy getEnumExpr, getEnumTy - let guardExpr ,guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] - let currentExpr,currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] - let betterCurrentExpr = mkCoerceExpr(currentExpr,enumElemTy,currentExpr.Range,currentTy) - Result(enumeratorVar, enumeratorExpr,retTypeOfGetEnumerator,enumElemTy,getEnumExpr,getEnumTy, guardExpr,guardTy, betterCurrentExpr) + let guardExpr , guardTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m false moveNext_minfo NormalValUse moveNext_minst [enumeratorExpr] [] + let currentExpr, currentTy = BuildPossiblyConditionalMethodCall cenv env DefinitelyMutates m true get_Current_minfo NormalValUse get_Current_minst [enumeratorExpr] [] + let betterCurrentExpr = mkCoerceExpr(currentExpr, enumElemTy, currentExpr.Range, currentTy) + Result(enumeratorVar, enumeratorExpr, retTypeOfGetEnumerator, enumElemTy, getEnumExpr, getEnumTy, guardExpr, guardTy, betterCurrentExpr) // First try the original known static type - match (if isArray1DTy cenv.g exprty then Exception (Failure "") else tryType (expr,exprty)) with + match (if isArray1DTy cenv.g exprty then Exception (Failure "") else tryType (expr, exprty)) with | Result res -> res | Exception e -> let probe ty = if (AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m ty exprty) then - match tryType (mkCoerceExpr(expr,ty,expr.Range,exprty),ty) with + match tryType (mkCoerceExpr(expr, ty, expr.Range, exprty), ty) with | Result res -> Some res | Exception e -> PreserveStackTrace(e) @@ -3356,19 +3356,19 @@ let ConvertArbitraryExprToEnumerable cenv ty (env: TcEnv) (expr:Expr) = let m = expr.Range let enumElemTy = NewInferenceType () if AddCxTypeMustSubsumeTypeUndoIfFailed env.DisplayEnv cenv.css m ( mkSeqTy cenv.g enumElemTy) ty then - expr,enumElemTy + expr, enumElemTy else - let enumerableVar,enumerableExpr = mkCompGenLocal m "inputSequence" ty - let enumeratorVar, _,retTypeOfGetEnumerator,enumElemTy,getEnumExpr,_,guardExpr,guardTy,betterCurrentExpr = + let enumerableVar, enumerableExpr = mkCompGenLocal m "inputSequence" ty + let enumeratorVar, _, retTypeOfGetEnumerator, enumElemTy, getEnumExpr, _, guardExpr, guardTy, betterCurrentExpr = AnalyzeArbitraryExprAsEnumerable cenv env false m ty enumerableExpr let expr = mkCompGenLet m enumerableVar expr (mkCallSeqOfFunctions cenv.g m retTypeOfGetEnumerator enumElemTy (mkUnitDelayLambda cenv.g m getEnumExpr) - (mkLambda m enumeratorVar (guardExpr,guardTy)) - (mkLambda m enumeratorVar (betterCurrentExpr,enumElemTy))) - expr,enumElemTy + (mkLambda m enumeratorVar (guardExpr, guardTy)) + (mkLambda m enumeratorVar (betterCurrentExpr, enumElemTy))) + expr, enumElemTy let mkSeqEmpty cenv env m genTy = // We must discover the 'zero' of the monadic algebra being generated in order to compile failing matches. @@ -3413,20 +3413,20 @@ let mkSeqFinally cenv env m genTy e1 e2 = let e1 = mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g genResultTy) (tyOfExpr cenv.g e1) e1 mkCallSeqFinally cenv.g m genResultTy e1 e2 -let mkSeqExprMatchClauses (pat',vspecs) innerExpr = - [TClause(pat',None,TTarget(vspecs, innerExpr,SequencePointAtTarget),pat'.Range) ] +let mkSeqExprMatchClauses (pat', vspecs) innerExpr = + [TClause(pat', None, TTarget(vspecs, innerExpr, SequencePointAtTarget), pat'.Range) ] let compileSeqExprMatchClauses cenv env inputExprMark (pat':Pattern, vspecs) innerExpr bindPatTy genInnerTy = let patMark = pat'.Range - let tclauses = mkSeqExprMatchClauses (pat',vspecs) innerExpr + let tclauses = mkSeqExprMatchClauses (pat', vspecs) innerExpr CompilePatternForMatchClauses cenv env inputExprMark patMark false ThrowIncompleteMatchException bindPatTy genInnerTy tclauses -let elimFastIntegerForLoop (spBind,id,start,dir,finish,innerExpr,m) = +let elimFastIntegerForLoop (spBind, id, start, dir, finish, innerExpr, m) = let pseudoEnumExpr = if dir then mkSynInfix m start ".." finish else mkSynTrifix m ".. .." start (SynExpr.Const(SynConst.Int32 -1, start.Range)) finish - SynExpr.ForEach (spBind,SeqExprOnly false,true,mkSynPatVar None id,pseudoEnumExpr,innerExpr,m) + SynExpr.ForEach (spBind, SeqExprOnly false, true, mkSynPatVar None id, pseudoEnumExpr, innerExpr, m) let (|ExprAsPat|_|) (f:SynExpr) = match f with @@ -3447,15 +3447,15 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c = let rec YieldFree expr = match expr with - | SynExpr.Sequential (_,_,e1,e2,_) -> YieldFree e1 && YieldFree e2 - | SynExpr.IfThenElse (_,e2,e3opt,_,_,_,_) -> YieldFree e2 && Option.forall YieldFree e3opt - | SynExpr.TryWith (e1,_,clauses,_,_,_,_) -> YieldFree e1 && clauses |> List.forall (fun (Clause(_,_,e,_,_)) -> YieldFree e) - | SynExpr.Match (_,_,clauses,_,_) -> clauses |> List.forall (fun (Clause(_,_,e,_,_)) -> YieldFree e) - | SynExpr.For (_,_,_,_,_,body,_) - | SynExpr.TryFinally (body,_,_,_,_) - | SynExpr.LetOrUse (_,_,_,body,_) - | SynExpr.While (_,_,body,_) - | SynExpr.ForEach (_,_,_,_,_,body,_) -> YieldFree body + | SynExpr.Sequential (_, _, e1, e2, _) -> YieldFree e1 && YieldFree e2 + | SynExpr.IfThenElse (_, e2, e3opt, _, _, _, _) -> YieldFree e2 && Option.forall YieldFree e3opt + | SynExpr.TryWith (e1, _, clauses, _, _, _, _) -> YieldFree e1 && clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) + | SynExpr.Match (_, _, clauses, _, _) -> clauses |> List.forall (fun (Clause(_, _, e, _, _)) -> YieldFree e) + | SynExpr.For (_, _, _, _, _, body, _) + | SynExpr.TryFinally (body, _, _, _, _) + | SynExpr.LetOrUse (_, _, _, body, _) + | SynExpr.While (_, _, body, _) + | SynExpr.ForEach (_, _, _, _, _, body, _) -> YieldFree body | SynExpr.YieldOrReturnFrom _ | SynExpr.YieldOrReturn _ | SynExpr.LetOrUseBang _ @@ -3483,7 +3483,7 @@ let (|SimpleSemicolonSequence|_|) acceptDeprecated c = let rec GetSimpleSemicolonSequenceOfComprehension expr acc = match expr with - | SynExpr.Sequential(_,true,e1,e2,_) -> + | SynExpr.Sequential(_, true, e1, e2, _) -> if IsSimpleSemicolonSequenceElement e1 then GetSimpleSemicolonSequenceOfComprehension e2 (e1::acc) else @@ -3521,7 +3521,7 @@ module MutRecShapes = | MutRecShape.ModuleAbbrev b -> MutRecShape.ModuleAbbrev b | MutRecShape.Tycon a -> MutRecShape.Tycon (f1 a) | MutRecShape.Lets b -> MutRecShape.Lets (f2 b) - | MutRecShape.Module (c,d) -> MutRecShape.Module (f3 c, map f1 f2 f3 d)) + | MutRecShape.Module (c, d) -> MutRecShape.Module (f3 c, map f1 f2 f3 d)) let mapTycons f1 xs = map f1 id id xs @@ -3535,7 +3535,7 @@ module MutRecShapes = | MutRecShape.ModuleAbbrev a -> MutRecShape.ModuleAbbrev a | MutRecShape.Tycon a -> MutRecShape.Tycon (fTycon env a) | MutRecShape.Lets b -> MutRecShape.Lets (fLets env b) - | MutRecShape.Module ((c, env2),d) -> MutRecShape.Module ((c,env2), mapWithEnv fTycon fLets env2 d)) + | MutRecShape.Module ((c, env2), d) -> MutRecShape.Module ((c, env2), mapWithEnv fTycon fLets env2 d)) let mapTyconsWithEnv f1 env xs = mapWithEnv f1 (fun _env x -> x) env xs @@ -3545,7 +3545,7 @@ module MutRecShapes = | MutRecShape.ModuleAbbrev a -> MutRecShape.ModuleAbbrev a | MutRecShape.Tycon a -> MutRecShape.Tycon (f2 parent a) | MutRecShape.Lets b -> MutRecShape.Lets (f3 parent b) - | MutRecShape.Module (c,d) -> + | MutRecShape.Module (c, d) -> let c2, parent2 = f1 parent c d MutRecShape.Module (c2, mapWithParent parent2 f1 f2 f3 d)) @@ -3557,18 +3557,18 @@ module MutRecShapes = | MutRecShape.ModuleAbbrev a -> MutRecShape.ModuleAbbrev a | MutRecShape.Tycon a -> MutRecShape.Tycon a | MutRecShape.Lets b -> MutRecShape.Lets b - | MutRecShape.Module (c,ds) -> + | MutRecShape.Module (c, ds) -> let env2 = f1 env c let env3, ds2 = computeEnvs f1 f2 env2 ds - MutRecShape.Module ((c,env3), ds2)) + MutRecShape.Module ((c, env3), ds2)) let rec extendEnvs f1 (env: 'Env) xs = let env = f1 env xs env, xs |> List.map (function - | MutRecShape.Module ((c,env),ds) -> + | MutRecShape.Module ((c, env), ds) -> let env2, ds2 = extendEnvs f1 env ds - MutRecShape.Module ((c,env2), ds2) + MutRecShape.Module ((c, env2), ds2) | x -> x) let dropEnvs xs = xs |> mapModules fst @@ -3583,21 +3583,21 @@ module MutRecShapes = [MutRecShape.Lets (List.concat preBinds)] @ (xs |> List.map (fun elem -> match elem with - | MutRecShape.Module ((c,env2),d) -> MutRecShape.Module ((c,env2), expandTyconsWithEnv f1 env2 d) + | MutRecShape.Module ((c, env2), d) -> MutRecShape.Module ((c, env2), expandTyconsWithEnv f1 env2 d) | _ -> elem)) @ [MutRecShape.Lets (List.concat postBinds)] let rec mapFoldWithEnv f1 z env xs = - (z,xs) ||> List.mapFold (fun z x -> + (z, xs) ||> List.mapFold (fun z x -> match x with - | MutRecShape.Module ((c,env2),ds) -> let ds2,z = mapFoldWithEnv f1 z env2 ds in MutRecShape.Module ((c, env2), ds2),z - | _ -> let x2,z = f1 z env x in x2, z) + | MutRecShape.Module ((c, env2), ds) -> let ds2, z = mapFoldWithEnv f1 z env2 ds in MutRecShape.Module ((c, env2), ds2), z + | _ -> let x2, z = f1 z env x in x2, z) let rec collectTycons x = x |> List.collect (function | MutRecShape.Tycon a -> [a] - | MutRecShape.Module (_,d) -> collectTycons d + | MutRecShape.Module (_, d) -> collectTycons d | _ -> []) let topTycons x = @@ -3607,7 +3607,7 @@ module MutRecShapes = x |> List.iter (function | MutRecShape.Tycon a -> f1 a | MutRecShape.Lets b -> f2 b - | MutRecShape.Module (c,d) -> f3 c; iter f1 f2 f3 f4 f5 d + | MutRecShape.Module (c, d) -> f3 c; iter f1 f2 f3 f4 f5 d | MutRecShape.Open a -> f4 a | MutRecShape.ModuleAbbrev a -> f5 a) @@ -3619,7 +3619,7 @@ module MutRecShapes = x |> List.iter (function | MutRecShape.Tycon a -> f1 env a | MutRecShape.Lets b -> f2 env b - | MutRecShape.Module ((_,env),d) -> iterWithEnv f1 f2 f3 f4 env d + | MutRecShape.Module ((_, env), d) -> iterWithEnv f1 f2 f3 f4 env d | MutRecShape.Open a -> f3 env a | MutRecShape.ModuleAbbrev a -> f4 env a) @@ -3649,11 +3649,11 @@ let EliminateInitializationGraphs (getLetBinds: 'LetDataIn list -> PreInitializationGraphEliminationBinding list) (morphLetBinds: (PreInitializationGraphEliminationBinding list -> Binding list) -> 'LetDataIn list -> Binding list) g mustHaveArity denv - (fixupsAndBindingsWithoutLaziness : MutRecShape<_,_,_,_,_> list) bindsm = + (fixupsAndBindingsWithoutLaziness : MutRecShape<_, _, _, _, _> list) bindsm = let recursiveVals = let hash = ValHash.Create() - let add (pgrbind: PreInitializationGraphEliminationBinding) = let c = pgrbind.Binding.Var in hash.Add(c,c) + let add (pgrbind: PreInitializationGraphEliminationBinding) = let c = pgrbind.Binding.Var in hash.Add(c, c) fixupsAndBindingsWithoutLaziness |> MutRecShapes.iterTyconsAndLets (getTyconBinds >> List.iter add) (getLetBinds >> List.iter add) hash @@ -3666,7 +3666,7 @@ let EliminateInitializationGraphs let rec stripChooseAndExpr e = match stripExpr e with - | Expr.TyChoose(_,b,_) -> stripChooseAndExpr b + | Expr.TyChoose(_, b, _) -> stripChooseAndExpr b | e -> e let availIfInOrder = ValHash<_>.Create() @@ -3687,7 +3687,7 @@ let EliminateInitializationGraphs let rec CheckExpr st e = match stripChooseAndExpr e with // Expressions with some lazy parts - | Expr.Lambda (_,_,_,_,b,_,_) -> checkDelayed st b + | Expr.Lambda (_, _, _, _, b, _, _) -> checkDelayed st b // Type-lambdas are analyzed as if they are strict. // @@ -3696,68 +3696,68 @@ let EliminateInitializationGraphs // are analyzed. Although we give type "x : 'T" to these, from the users point of view // any use of "x" will result in an infinite recursion. Type instantiation is implicit in F# // because of type inference, which makes it reasonable to check generic bindings strictly. - | Expr.TyLambda (_,_,b,_,_) -> CheckExpr st b + | Expr.TyLambda (_, _, b, _, _) -> CheckExpr st b - | Expr.Obj (_,ty,_,e,overrides,extraImpls,_) -> + | Expr.Obj (_, ty, _, e, overrides, extraImpls, _) -> // NOTE: we can't fixup recursive references inside delegates since the closure delegee of a delegate is not accessible // from outside. Object expressions implementing interfaces can, on the other hand, be fixed up. See FSharp 1.0 bug 1469 if isInterfaceTy g ty then - List.iter (fun (TObjExprMethod(_,_,_,_,e,_)) -> checkDelayed st e) overrides - List.iter (snd >> List.iter (fun (TObjExprMethod(_,_,_,_,e,_)) -> checkDelayed st e)) extraImpls + List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e) overrides + List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> checkDelayed st e)) extraImpls else CheckExpr (strict st) e - List.iter (fun (TObjExprMethod(_,_,_,_,e,_)) -> CheckExpr (lzy (strict st)) e) overrides - List.iter (snd >> List.iter (fun (TObjExprMethod(_,_,_,_,e,_)) -> CheckExpr (lzy (strict st)) e)) extraImpls + List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> CheckExpr (lzy (strict st)) e) overrides + List.iter (snd >> List.iter (fun (TObjExprMethod(_, _, _, _, e, _)) -> CheckExpr (lzy (strict st)) e)) extraImpls // Expressions where fixups may be needed - | Expr.Val (v,_,m) -> CheckValRef st v m + | Expr.Val (v, _, m) -> CheckValRef st v m // Expressions where subparts may be fixable - | Expr.Op((TOp.Tuple _ | TOp.UnionCase _ | TOp.Recd _),_,args,_) -> + | Expr.Op((TOp.Tuple _ | TOp.UnionCase _ | TOp.Recd _), _, args, _) -> List.iter (CheckExpr (fixable st)) args // Composite expressions | Expr.Const _ -> () - | Expr.LetRec (binds,e,_,_) -> + | Expr.LetRec (binds, e, _, _) -> binds |> List.iter (CheckBinding (strict st)) CheckExpr (strict st) e - | Expr.Let (bind,e,_,_) -> + | Expr.Let (bind, e, _, _) -> CheckBinding (strict st) bind CheckExpr (strict st) e - | Expr.Match (_,_,pt,targets,_,_) -> + | Expr.Match (_, _, pt, targets, _, _) -> CheckDecisionTree (strict st) pt Array.iter (CheckDecisionTreeTarget (strict st)) targets - | Expr.App(e1,_,_,args,_) -> + | Expr.App(e1, _, _, args, _) -> CheckExpr (strict st) e1 List.iter (CheckExpr (strict st)) args // Binary expressions - | Expr.Sequential (e1,e2,_,_,_) - | Expr.StaticOptimization (_,e1,e2,_) -> + | Expr.Sequential (e1, e2, _, _, _) + | Expr.StaticOptimization (_, e1, e2, _) -> CheckExpr (strict st) e1; CheckExpr (strict st) e2 // n-ary expressions - | Expr.Op(op,_,args,m) -> CheckExprOp st op m; List.iter (CheckExpr (strict st)) args + | Expr.Op(op, _, args, m) -> CheckExprOp st op m; List.iter (CheckExpr (strict st)) args // misc | Expr.Link(eref) -> CheckExpr st !eref - | Expr.TyChoose (_,b,_) -> CheckExpr st b + | Expr.TyChoose (_, b, _) -> CheckExpr st b | Expr.Quote _ -> () - and CheckBinding st (TBind(_,e,_)) = CheckExpr st e + and CheckBinding st (TBind(_, e, _)) = CheckExpr st e and CheckDecisionTree st = function - | TDSwitch(e1,csl,dflt,_) -> CheckExpr st e1; List.iter (fun (TCase(_,d)) -> CheckDecisionTree st d) csl; Option.iter (CheckDecisionTree st) dflt - | TDSuccess (es,_) -> es |> List.iter (CheckExpr st) - | TDBind(bind,e) -> CheckBinding st bind; CheckDecisionTree st e - and CheckDecisionTreeTarget st (TTarget(_,e,_)) = CheckExpr st e + | TDSwitch(e1, csl, dflt, _) -> CheckExpr st e1; List.iter (fun (TCase(_, d)) -> CheckDecisionTree st d) csl; Option.iter (CheckDecisionTree st) dflt + | TDSuccess (es, _) -> es |> List.iter (CheckExpr st) + | TDBind(bind, e) -> CheckBinding st bind; CheckDecisionTree st e + and CheckDecisionTreeTarget st (TTarget(_, e, _)) = CheckExpr st e and CheckExprOp st op m = match op with - | TOp.LValueOp (_,lvr) -> CheckValRef (strict st) lvr m + | TOp.LValueOp (_, lvr) -> CheckValRef (strict st) lvr m | _ -> () and CheckValRef st (v: ValRef) m = match st with | MaybeLazy -> if recursiveVals.TryFind v.Deref |> Option.isSome then - warning (RecursiveUseCheckedAtRuntime (denv,v,m)) + warning (RecursiveUseCheckedAtRuntime (denv, v, m)) if not !reportedEager then (warning (LetRecCheckedAtRuntime m); reportedEager := true) runtimeChecks := true @@ -3765,11 +3765,11 @@ let EliminateInitializationGraphs | Top | DefinitelyStrict -> if recursiveVals.TryFind v.Deref |> Option.isSome then if availIfInOrder.TryFind v.Deref |> Option.isNone then - warning (LetRecEvaluatedOutOfOrder (denv,boundv,v,m)) + warning (LetRecEvaluatedOutOfOrder (denv, boundv, v, m)) outOfOrder := true if not !reportedEager then (warning (LetRecCheckedAtRuntime m); reportedEager := true) - definiteDependencies := (boundv,v) :: !definiteDependencies + definiteDependencies := (boundv, v) :: !definiteDependencies | InnerTop -> if recursiveVals.TryFind v.Deref |> Option.isSome then directRecursiveData := true @@ -3786,7 +3786,7 @@ let EliminateInitializationGraphs // Check the bindings one by one, each w.r.t. the previously available set of binding begin let checkBind (pgrbind: PreInitializationGraphEliminationBinding) = - let (TBind(v,e,_)) = pgrbind.Binding + let (TBind(v, e, _)) = pgrbind.Binding check (mkLocalValRef v) e availIfInOrder.Add(v, 1) fixupsAndBindingsWithoutLaziness |> MutRecShapes.iterTyconsAndLets (getTyconBinds >> List.iter checkBind) (getLetBinds >> List.iter checkBind) @@ -3795,40 +3795,40 @@ let EliminateInitializationGraphs // ddg = definiteDependencyGraph let ddgNodes = recursiveVals.Values |> Seq.toList |> List.map mkLocalValRef let ddg = Graph((fun v -> v.Stamp), ddgNodes, !definiteDependencies ) - ddg.IterateCycles (fun path -> error (LetRecUnsound (denv,path,path.Head.Range))) + ddg.IterateCycles (fun path -> error (LetRecUnsound (denv, path, path.Head.Range))) let requiresLazyBindings = !runtimeChecks || !outOfOrder if !directRecursiveData && requiresLazyBindings then - error(Error(FSComp.SR.tcInvalidMixtureOfRecursiveForms(),bindsm)) + error(Error(FSComp.SR.tcInvalidMixtureOfRecursiveForms(), bindsm)) if requiresLazyBindings then let morphBinding (pgrbind: PreInitializationGraphEliminationBinding) = let (RecursiveUseFixupPoints(fixupPoints)) = pgrbind.FixupPoints - let (TBind(v,e,seqPtOpt)) = pgrbind.Binding + let (TBind(v, e, seqPtOpt)) = pgrbind.Binding match stripChooseAndExpr e with | Expr.Lambda _ | Expr.TyLambda _ -> - [],[mkInvisibleBind v e] + [], [mkInvisibleBind v e] | _ -> let ty = v.Type let m = v.Range let vty = (mkLazyTy g ty) let fty = (g.unit_ty --> ty) - let flazy,felazy = Tastops.mkCompGenLocal m v.LogicalName fty + let flazy, felazy = Tastops.mkCompGenLocal m v.LogicalName fty let frhs = mkUnitDelayLambda g m e if mustHaveArity then flazy.SetValReprInfo (Some(InferArityOfExpr g AllowTypeDirectedDetupling.Yes fty [] [] frhs)) - let vlazy,velazy = Tastops.mkCompGenLocal m v.LogicalName vty + let vlazy, velazy = Tastops.mkCompGenLocal m v.LogicalName vty let vrhs = (mkLazyDelayed g m ty felazy) if mustHaveArity then vlazy.SetValReprInfo (Some(InferArityOfExpr g AllowTypeDirectedDetupling.Yes vty [] [] vrhs)) - fixupPoints |> List.iter (fun (fp,_) -> fp := mkLazyForce g (!fp).Range ty velazy) + fixupPoints |> List.iter (fun (fp, _) -> fp := mkLazyForce g (!fp).Range ty velazy) - [mkInvisibleBind flazy frhs; mkInvisibleBind vlazy vrhs], + [mkInvisibleBind flazy frhs; mkInvisibleBind vlazy vrhs], [mkBind seqPtOpt v (mkLazyForce g m ty velazy)] let newTopBinds = ResizeArray<_>() - let morphBindings pgrbinds = pgrbinds |> List.map morphBinding |> List.unzip |> (fun (a,b) -> newTopBinds.Add (List.concat a); List.concat b) + let morphBindings pgrbinds = pgrbinds |> List.map morphBinding |> List.unzip |> (fun (a, b) -> newTopBinds.Add (List.concat a); List.concat b) let res = fixupsAndBindingsWithoutLaziness |> MutRecShapes.map (morphTyconBinds morphBindings) (morphLetBinds morphBindings) id if newTopBinds.Count = 0 then res @@ -3844,11 +3844,11 @@ let EliminateInitializationGraphs let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = let m = ctorLambaExpr.Range - let tps,vsl,body,returnTy = stripTopLambda (ctorLambaExpr,tyOfExpr g ctorLambaExpr) + let tps, vsl, body, returnTy = stripTopLambda (ctorLambaExpr, tyOfExpr g ctorLambaExpr) // Rewrite legitimate self-construction calls to CtorValUsedAsSelfInit let error (expr:Expr) = - errorR(Error(FSComp.SR.tcInvalidObjectConstructionExpression(),expr.Range)) + errorR(Error(FSComp.SR.tcInvalidObjectConstructionExpression(), expr.Range)) expr // Build an assignment into the safeThisValOpt mutable reference cell that holds recursive references to 'this' @@ -3864,7 +3864,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = let ty = tyOfExpr g recdExpr let thisExpr = mkGetArg0 m ty let setExpr = mkRefCellSet g m ty (exprForValRef m (mkLocalValRef safeInitVal)) thisExpr - Expr.Sequential(recdExpr,setExpr,ThenDoSeq,SuppressSequencePointOnExprOfSequential,m) + Expr.Sequential(recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) let recdExpr = match ctorInfo.safeInitInfo with | NoSafeInitInfo -> recdExpr @@ -3873,7 +3873,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = let thisExpr = mkGetArg0 m thisTy let thisTyInst = argsOfAppTy g thisTy let setExpr = mkRecdFieldSetViaExprAddr (thisExpr, rfref, thisTyInst, mkOne g m, m) - Expr.Sequential(recdExpr,setExpr,ThenDoSeq,SuppressSequencePointOnExprOfSequential,m) + Expr.Sequential(recdExpr, setExpr, ThenDoSeq, SuppressSequencePointOnExprOfSequential, m) recdExpr @@ -3881,28 +3881,28 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = match expr with // = { fields } // The constructor ends in an object initialization expression - good - | Expr.Op(TOp.Recd(RecdExprIsObjInit,_),_,_,_) -> rewriteConstruction expr + | Expr.Op(TOp.Recd(RecdExprIsObjInit, _), _, _, _) -> rewriteConstruction expr // = "a; " - | Expr.Sequential(a,body,NormalSeq,spSeq,b) -> Expr.Sequential(a,checkAndRewrite body,NormalSeq,spSeq,b) + | Expr.Sequential(a, body, NormalSeq, spSeq, b) -> Expr.Sequential(a, checkAndRewrite body, NormalSeq, spSeq, b) // = " then " - | Expr.Sequential(body,a,ThenDoSeq,spSeq,b) -> Expr.Sequential(checkAndRewrite body,a,ThenDoSeq,spSeq,b) + | Expr.Sequential(body, a, ThenDoSeq, spSeq, b) -> Expr.Sequential(checkAndRewrite body, a, ThenDoSeq, spSeq, b) // = "let pat = expr in " - | Expr.Let(bind,body,m,_) -> mkLetBind m bind (checkAndRewrite body) + | Expr.Let(bind, body, m, _) -> mkLetBind m bind (checkAndRewrite body) // The constructor is a sequence "let pat = expr in " - | Expr.Match(spBind,a,b,targets,c,d) -> Expr.Match(spBind,a,b, (targets |> Array.map (fun (TTarget(vs,body,spTarget)) -> TTarget(vs, checkAndRewrite body,spTarget))),c,d) + | Expr.Match(spBind, a, b, targets, c, d) -> Expr.Match(spBind, a, b, (targets |> Array.map (fun (TTarget(vs, body, spTarget)) -> TTarget(vs, checkAndRewrite body, spTarget))), c, d) // = "let rec binds in " - | Expr.LetRec(a,body,_,_) -> Expr.LetRec (a,checkAndRewrite body ,m,NewFreeVarsCache()) + | Expr.LetRec(a, body, _, _) -> Expr.LetRec (a, checkAndRewrite body , m, NewFreeVarsCache()) // = "new C(...)" - | Expr.App(f,b,c,d,m) -> + | Expr.App(f, b, c, d, m) -> // The application had better be an application of a ctor let f = checkAndRewriteCtorUsage f - let expr = Expr.App(f,b,c,d,m) + let expr = Expr.App(f, b, c, d, m) rewriteConstruction expr | _ -> @@ -3918,12 +3918,12 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = // Type applications are ok, e.g. // type C<'a>(x:int) = // new() = C<'a>(3) - | Expr.App(f,fty,tyargs,[],m) -> + | Expr.App(f, fty, tyargs, [], m) -> let f = checkAndRewriteCtorUsage f - Expr.App(f,fty,tyargs,[],m) + Expr.App(f, fty, tyargs, [], m) // Self-calls are OK and get rewritten. - | Expr.Val(vref,NormalValUse,a) -> + | Expr.Val(vref, NormalValUse, a) -> let isCtor = match vref.MemberInfo with | None -> false @@ -3932,7 +3932,7 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = if not isCtor then error expr else - Expr.Val(vref,CtorValUsedAsSelfInit,a) + Expr.Val(vref, CtorValUsedAsSelfInit, a) | _ -> error(expr) @@ -3944,28 +3944,28 @@ let CheckAndRewriteObjectCtor g env (ctorLambaExpr:Expr) = /// Post-typechecking normalizations to enforce semantic constraints /// lazy and, lazy or, rethrow, address-of let buildApp cenv expr exprty arg m = - match expr,arg with - | ApplicableExpr(_, Expr.App(Expr.Val(vf,_,_),_,_,[x0],_),_) , _ + match expr, arg with + | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [x0], _), _) , _ when valRefEq cenv.g vf cenv.g.and_vref || valRefEq cenv.g vf cenv.g.and2_vref -> MakeApplicableExprNoFlex cenv (mkLazyAnd cenv.g m x0 arg) - | ApplicableExpr(_, Expr.App(Expr.Val(vf,_,_),_,_,[x0],_),_), _ + | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [x0], _), _), _ when valRefEq cenv.g vf cenv.g.or_vref || valRefEq cenv.g vf cenv.g.or2_vref -> MakeApplicableExprNoFlex cenv (mkLazyOr cenv.g m x0 arg ) - | ApplicableExpr(_, Expr.App(Expr.Val(vf,_,_),_,_,[],_),_), _ + | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _), _ when valRefEq cenv.g vf cenv.g.reraise_vref -> // exprty is of type: "unit -> 'a". Break it and store the 'a type here, used later as return type. - let _unit_ty,rtn_ty = destFunTy cenv.g exprty + let _unit_ty, rtn_ty = destFunTy cenv.g exprty MakeApplicableExprNoFlex cenv (mkCompGenSequential m arg (mkReraise m rtn_ty)) - | ApplicableExpr(_, Expr.App(Expr.Val(vf,_,_),_,_,[],_),_), _ + | ApplicableExpr(_, Expr.App(Expr.Val(vf, _, _), _, _, [], _), _), _ when (valRefEq cenv.g vf cenv.g.addrof_vref || valRefEq cenv.g vf cenv.g.addrof2_vref) -> if valRefEq cenv.g vf cenv.g.addrof2_vref then warning(UseOfAddressOfOperator(m)) - let wrap,e1a' = mkExprAddrOfExpr cenv.g true false DefinitelyMutates arg (Some(vf)) m + let wrap, e1a' = mkExprAddrOfExpr cenv.g true false DefinitelyMutates arg (Some(vf)) m MakeApplicableExprNoFlex cenv (wrap(e1a')) | _ -> - expr.SupplyArgument(arg,m) + expr.SupplyArgument(arg, m) //------------------------------------------------------------------------- // Additional data structures used by type checking @@ -4030,15 +4030,15 @@ type ContainerInfo = // For members: MemberOrValContainerInfo option member x.ParentRef = - let (ContainerInfo(v,_)) = x + let (ContainerInfo(v, _)) = x v /// Indicates a declaration is contained in an expression -let ExprContainerInfo = ContainerInfo(ParentNone,None) +let ExprContainerInfo = ContainerInfo(ParentNone, None) /// Indicates a declaration is contained in the given module -let ModuleOrNamespaceContainerInfo modref = ContainerInfo(Parent(modref),Some(MemberOrValContainerInfo(modref,None,None,NoSafeInitInfo,[]))) +let ModuleOrNamespaceContainerInfo modref = ContainerInfo(Parent(modref), Some(MemberOrValContainerInfo(modref, None, None, NoSafeInitInfo, []))) /// Indicates a declaration is contained in the given type definition in the given module -let TyconContainerInfo (parent, tcref, declaredTyconTypars, safeInitInfo) = ContainerInfo(parent,Some(MemberOrValContainerInfo(tcref,None,None,safeInitInfo,declaredTyconTypars))) +let TyconContainerInfo (parent, tcref, declaredTyconTypars, safeInitInfo) = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, None, None, safeInitInfo, declaredTyconTypars))) type NormalizedRecBindingDefn = NormalizedRecBindingDefn of ContainerInfo * NewSlotsOK * DeclKind * NormalizedBinding @@ -4064,7 +4064,7 @@ type MutRecDefnsPhase1Data = MutRecShape unit) type MutRecDefnsPhase2DataForModule = MutRecDefnsPhase2DataForModule of ModuleOrNamespaceType ref * ModuleOrNamespace -type MutRecDefnsPhase2Data = MutRecShape list +type MutRecDefnsPhase2Data = MutRecShape list type MutRecDefnsPhase2InfoForTycon = MutRecDefnsPhase2InfoForTycon of Tycon option * TyconRef * Typars * DeclKind * TyconBindingDefn list * fixupFinalAttrs: (unit -> unit) type MutRecDefnsPhase2Info = MutRecShape list @@ -4088,13 +4088,13 @@ type RecursiveBindingInfo = TType * DeclKind - member x.EnclosingDeclaredTypars = let (RBInfo(_,_,enclosingDeclaredTypars,_,_,_,_,_,_,_,_,_,_,_)) = x in enclosingDeclaredTypars - member x.Val = let (RBInfo(_,_,_,_,vspec,_,_,_,_,_,_,_,_,_)) = x in vspec - member x.ExplicitTyparInfo = let (RBInfo(_,_,_,_,_,flex,_,_,_,_,_,_,_,_)) = x in flex - member x.DeclaredTypars = let (ExplicitTyparInfo(_,declaredTypars,_)) = x.ExplicitTyparInfo in declaredTypars - member x.Index = let (RBInfo(i,_,_,_,_,_,_,_,_,_,_,_,_,_)) = x in i - member x.ContainerInfo = let (RBInfo(_,c,_,_,_,_,_,_,_,_,_,_,_,_)) = x in c - member x.DeclKind = let (RBInfo(_,_,_,_,_,_,_,_,_,_,_,_,_,declKind)) = x in declKind + member x.EnclosingDeclaredTypars = let (RBInfo(_, _, enclosingDeclaredTypars, _, _, _, _, _, _, _, _, _, _, _)) = x in enclosingDeclaredTypars + member x.Val = let (RBInfo(_, _, _, _, vspec, _, _, _, _, _, _, _, _, _)) = x in vspec + member x.ExplicitTyparInfo = let (RBInfo(_, _, _, _, _, flex, _, _, _, _, _, _, _, _)) = x in flex + member x.DeclaredTypars = let (ExplicitTyparInfo(_, declaredTypars, _)) = x.ExplicitTyparInfo in declaredTypars + member x.Index = let (RBInfo(i, _, _, _, _, _, _, _, _, _, _, _, _, _)) = x in i + member x.ContainerInfo = let (RBInfo(_, c, _, _, _, _, _, _, _, _, _, _, _, _)) = x in c + member x.DeclKind = let (RBInfo(_, _, _, _, _, _, _, _, _, _, _, _, _, declKind)) = x in declKind type PreCheckingRecursiveBinding = { SyntacticBinding : NormalizedBinding @@ -4119,21 +4119,21 @@ type PostBindCtorThisVarRefCellRecursiveBinding = let CanInferExtraGeneralizedTyparsForRecBinding (pgrbind: PreGeneralizationRecursiveBinding) = let flex = pgrbind.RecBindingInfo.ExplicitTyparInfo - let (ExplicitTyparInfo(_,_,canInferTypars)) = flex + let (ExplicitTyparInfo(_, _, canInferTypars)) = flex let memFlagsOpt = pgrbind.RecBindingInfo.Val.MemberInfo |> Option.map (fun memInfo -> memInfo.MemberFlags) let canInferTypars = GeneralizationHelpers.ComputeCanInferExtraGeneralizableTypars (pgrbind.RecBindingInfo.ContainerInfo.ParentRef, canInferTypars, memFlagsOpt) canInferTypars /// Get the "this" variable from an instance member binding -let GetInstanceMemberThisVariable (v:Val,x) = +let GetInstanceMemberThisVariable (v:Val, x) = // Skip over LAM tps. Choose 'a. if v.IsInstanceMember then let rec firstArg e = match e with - | Expr.TyLambda (_,_,b,_,_) -> firstArg b - | Expr.TyChoose (_,b,_) -> firstArg b - | Expr.Lambda (_,_,_,[v],_,_,_) -> Some v + | Expr.TyLambda (_, _, b, _, _) -> firstArg b + | Expr.TyChoose (_, b, _) -> firstArg b + | Expr.Lambda (_, _, _, [v], _, _, _) -> Some v | _ -> failwith "GetInstanceMemberThisVariable: instance member did not have expected internal form" firstArg x @@ -4146,73 +4146,73 @@ let GetInstanceMemberThisVariable (v:Val,x) = /// Check specifications of constraints on type parameters let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c = let checkSimpleConstraint tp m constraintAdder = - let tp',tpenv = TcTypar cenv env newOk tpenv tp + let tp', tpenv = TcTypar cenv env newOk tpenv tp constraintAdder env.DisplayEnv cenv.css m NoTrace (mkTyparTy tp') tpenv match c with - | WhereTyparDefaultsToType(tp,ty,m) -> - let ty',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty - let tp',tpenv = TcTypar cenv env newOk tpenv tp + | WhereTyparDefaultsToType(tp, ty, m) -> + let ty', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty + let tp', tpenv = TcTypar cenv env newOk tpenv tp let csenv = MakeConstraintSolverEnv env.eContextInfo cenv.css m env.DisplayEnv - AddConstraint csenv 0 m NoTrace tp' (TyparConstraint.DefaultsTo(ridx,ty',m)) |> CommitOperationResult + AddConstraint csenv 0 m NoTrace tp' (TyparConstraint.DefaultsTo(ridx, ty', m)) |> CommitOperationResult tpenv - | WhereTyparSubtypeOfType(tp,ty,m) -> - let ty',tpenv = TcTypeAndRecover cenv newOk checkCxs ItemOccurence.UseInType env tpenv ty - let tp',tpenv = TcTypar cenv env newOk tpenv tp + | WhereTyparSubtypeOfType(tp, ty, m) -> + let ty', tpenv = TcTypeAndRecover cenv newOk checkCxs ItemOccurence.UseInType env tpenv ty + let tp', tpenv = TcTypar cenv env newOk tpenv tp if newOk = NoNewTypars && isSealedTy cenv.g ty' then - errorR(Error(FSComp.SR.tcInvalidConstraintTypeSealed(),m)) + errorR(Error(FSComp.SR.tcInvalidConstraintTypeSealed(), m)) AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp') tpenv - | WhereTyparSupportsNull(tp,m) -> checkSimpleConstraint tp m AddCxTypeMustSupportNull + | WhereTyparSupportsNull(tp, m) -> checkSimpleConstraint tp m AddCxTypeMustSupportNull - | WhereTyparIsComparable(tp,m) -> checkSimpleConstraint tp m AddCxTypeMustSupportComparison + | WhereTyparIsComparable(tp, m) -> checkSimpleConstraint tp m AddCxTypeMustSupportComparison - | WhereTyparIsEquatable(tp,m) -> checkSimpleConstraint tp m AddCxTypeMustSupportEquality + | WhereTyparIsEquatable(tp, m) -> checkSimpleConstraint tp m AddCxTypeMustSupportEquality - | WhereTyparIsReferenceType(tp,m) -> checkSimpleConstraint tp m AddCxTypeIsReferenceType + | WhereTyparIsReferenceType(tp, m) -> checkSimpleConstraint tp m AddCxTypeIsReferenceType - | WhereTyparIsValueType(tp,m) -> checkSimpleConstraint tp m AddCxTypeIsValueType + | WhereTyparIsValueType(tp, m) -> checkSimpleConstraint tp m AddCxTypeIsValueType - | WhereTyparIsUnmanaged(tp,m) -> checkSimpleConstraint tp m AddCxTypeIsUnmanaged + | WhereTyparIsUnmanaged(tp, m) -> checkSimpleConstraint tp m AddCxTypeIsUnmanaged - | WhereTyparIsEnum(tp,tyargs,m) -> - let tp',tpenv = TcTypar cenv env newOk tpenv tp + | WhereTyparIsEnum(tp, tyargs, m) -> + let tp', tpenv = TcTypar cenv env newOk tpenv tp let tpenv = match tyargs with | [underlying] -> - let underlying',tpenv = TcTypeAndRecover cenv newOk checkCxs ItemOccurence.UseInType env tpenv underlying + let underlying', tpenv = TcTypeAndRecover cenv newOk checkCxs ItemOccurence.UseInType env tpenv underlying AddCxTypeIsEnum env.DisplayEnv cenv.css m NoTrace (mkTyparTy tp') underlying' tpenv | _ -> - errorR(Error(FSComp.SR.tcInvalidEnumConstraint(),m)) + errorR(Error(FSComp.SR.tcInvalidEnumConstraint(), m)) tpenv tpenv - | WhereTyparIsDelegate(tp,tyargs,m) -> - let tp',tpenv = TcTypar cenv env newOk tpenv tp + | WhereTyparIsDelegate(tp, tyargs, m) -> + let tp', tpenv = TcTypar cenv env newOk tpenv tp match tyargs with | [a;b] -> - let a',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv a - let b',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv b + let a', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv a + let b', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv b AddCxTypeIsDelegate env.DisplayEnv cenv.css m NoTrace (mkTyparTy tp') a' b' tpenv | _ -> - errorR(Error(FSComp.SR.tcInvalidEnumConstraint(),m)) + errorR(Error(FSComp.SR.tcInvalidEnumConstraint(), m)) tpenv - | WhereTyparSupportsMember(tps,memSpfn,m) -> - let traitInfo,tpenv = TcPseudoMemberSpec cenv newOk env tps tpenv memSpfn m + | WhereTyparSupportsMember(tps, memSpfn, m) -> + let traitInfo, tpenv = TcPseudoMemberSpec cenv newOk env tps tpenv memSpfn m match traitInfo with - | TTrait(objtys,".ctor",memberFlags,argtys,returnTy,_) when memberFlags.MemberKind = MemberKind.Constructor -> - match objtys,argtys with - | [ty],[] when typeEquiv cenv.g ty (GetFSharpViewOfReturnType cenv.g returnTy) -> + | TTrait(objtys, ".ctor", memberFlags, argtys, returnTy, _) when memberFlags.MemberKind = MemberKind.Constructor -> + match objtys, argtys with + | [ty], [] when typeEquiv cenv.g ty (GetFSharpViewOfReturnType cenv.g returnTy) -> AddCxTypeMustSupportDefaultCtor env.DisplayEnv cenv.css m NoTrace ty tpenv | _ -> - errorR(Error(FSComp.SR.tcInvalidNewConstraint(),m)) + errorR(Error(FSComp.SR.tcInvalidNewConstraint(), m)) tpenv | _ -> AddCxMethodConstraint env.DisplayEnv cenv.css m NoTrace traitInfo @@ -4220,49 +4220,49 @@ let rec TcTyparConstraint ridx cenv newOk checkCxs occ (env: TcEnv) tpenv c = and TcPseudoMemberSpec cenv newOk env synTypes tpenv memSpfn m = #if ALLOW_MEMBER_CONSTRAINTS_ON_MEASURES - let tps,tpenv = List.mapFold (TcTyparOrMeasurePar None cenv env newOk) tpenv synTypars + let tps, tpenv = List.mapFold (TcTyparOrMeasurePar None cenv env newOk) tpenv synTypars #else - let tys,tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType env) tpenv synTypes + let tys, tpenv = List.mapFold (TcTypeAndRecover cenv newOk CheckCxs ItemOccurence.UseInType env) tpenv synTypes #endif match memSpfn with - | SynMemberSig.Member (valSpfn,memberFlags,m) -> + | SynMemberSig.Member (valSpfn, memberFlags, m) -> // REVIEW: Test pseudo constraints cannot refer to polymorphic methods. // REVIEW: Test pseudo constraints cannot be curried. - let members,tpenv = TcValSpec cenv env ModuleOrMemberBinding newOk (ExprContainerInfo) (Some memberFlags) (Some (List.head tys)) tpenv valSpfn [] + let members, tpenv = TcValSpec cenv env ModuleOrMemberBinding newOk (ExprContainerInfo) (Some memberFlags) (Some (List.head tys)) tpenv valSpfn [] match members with - | [ValSpecResult(_,_,id,_,_,memberConstraintTy,partialValReprInfo,_)] -> - let memberConstraintTypars,_ = tryDestForallTy cenv.g memberConstraintTy + | [ValSpecResult(_, _, id, _, _, memberConstraintTy, partialValReprInfo, _)] -> + let memberConstraintTypars, _ = tryDestForallTy cenv.g memberConstraintTy let topValInfo = TranslatePartialArity memberConstraintTypars partialValReprInfo - let _,curriedArgInfos,returnTy,_ = GetTopValTypeInCompiledForm cenv.g topValInfo memberConstraintTy m - //if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcInvalidConstraint(),m)) + let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g topValInfo memberConstraintTy m + //if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcInvalidConstraint(), m)) let argtys = List.concat curriedArgInfos let argtys = List.map fst argtys let logicalCompiledName = ComputeLogicalName id memberFlags let item = Item.ArgName (id, memberConstraintTy, None) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) - TTrait(tys,logicalCompiledName,memberFlags,argtys,returnTy, ref None),tpenv - | _ -> error(Error(FSComp.SR.tcInvalidConstraint(),m)) - | _ -> error(Error(FSComp.SR.tcInvalidConstraint(),m)) + TTrait(tys, logicalCompiledName, memberFlags, argtys, returnTy, ref None), tpenv + | _ -> error(Error(FSComp.SR.tcInvalidConstraint(), m)) + | _ -> error(Error(FSComp.SR.tcInvalidConstraint(), m)) /// Check a value specification, e.g. in a signature, interface declaration or a constraint and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv valSpfn attrs = let (ValSpfn(_, id, SynValTyparDecls(synTypars, _, synTyparConstraints), ty, valSynInfo, _, _, _, _, _, m)) = valSpfn let declaredTypars = TcTyparDecls cenv env synTypars - let (ContainerInfo(altActualParent,tcrefContainerInfo)) = containerInfo - let enclosingDeclaredTypars,memberContainerInfo,thisTyOpt,declKind = + let (ContainerInfo(altActualParent, tcrefContainerInfo)) = containerInfo + let enclosingDeclaredTypars, memberContainerInfo, thisTyOpt, declKind = match tcrefContainerInfo with - | Some(MemberOrValContainerInfo(tcref,_,_,_,declaredTyconTypars)) -> + | Some(MemberOrValContainerInfo(tcref, _, _, _, declaredTyconTypars)) -> let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let _,enclosingDeclaredTypars,_,_,thisTy = FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars + let _, enclosingDeclaredTypars, _, _, thisTy = FreshenObjectArgType cenv m TyparRigidity.Rigid tcref isExtrinsic declaredTyconTypars // An implemented interface type is in terms of the type's type parameters. // We need a signature in terms of the values' type parameters. // let optIntfSlotTy = Option.map (instType renaming) optIntfSlotTy in - enclosingDeclaredTypars,Some(tcref),Some thisTy,declKind + enclosingDeclaredTypars, Some(tcref), Some thisTy, declKind | None -> - [],None,thisTyOpt, ModuleOrMemberBinding + [], None, thisTyOpt, ModuleOrMemberBinding let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars let envinner = AddDeclaredTypars NoCheckForDuplicateTypars allDeclaredTypars env let checkCxs = CheckCxs @@ -4274,7 +4274,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv // val FastGenericComparer<'T> : IComparer<'T> when 'T : comparison let tpenv = match ty with - | SynType.WithGlobalConstraints(_,wcs,_) -> + | SynType.WithGlobalConstraints(_, wcs, _) -> TcTyparConstraints cenv newOk checkCxs ItemOccurence.UseInType envinner tpenv wcs | _ -> tpenv @@ -4282,48 +4282,48 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv // Enforce "no undeclared constraints allowed on declared typars" allDeclaredTypars |> List.iter (SetTyparRigid cenv.g env.DisplayEnv m) // Process the type, including any constraints - let declaredTy,tpenv = TcTypeAndRecover cenv newOk checkCxs ItemOccurence.UseInType envinner tpenv ty + let declaredTy, tpenv = TcTypeAndRecover cenv newOk checkCxs ItemOccurence.UseInType envinner tpenv ty - match memFlagsOpt,thisTyOpt with + match memFlagsOpt, thisTyOpt with | Some memberFlags, Some thisTy -> let generateOneMember(memberFlags) = // Decode members in the signature - let ty',valSynInfo = + let ty', valSynInfo = match memberFlags.MemberKind with | MemberKind.ClassConstructor | MemberKind.Constructor | MemberKind.Member -> - declaredTy,valSynInfo + declaredTy, valSynInfo | MemberKind.PropertyGet | MemberKind.PropertySet -> let fakeArgReprInfos = [ for n in SynInfo.AritiesOfArgs valSynInfo do yield [ for _ in 1 .. n do yield ValReprInfo.unnamedTopArg1 ] ] - let arginfos,returnTy = GetTopTauTypeInFSharpForm cenv.g fakeArgReprInfos declaredTy m - if arginfos.Length > 1 then error(Error(FSComp.SR.tcInvalidPropertyType(),m)) + let arginfos, returnTy = GetTopTauTypeInFSharpForm cenv.g fakeArgReprInfos declaredTy m + if arginfos.Length > 1 then error(Error(FSComp.SR.tcInvalidPropertyType(), m)) match memberFlags.MemberKind with | MemberKind.PropertyGet -> if SynInfo.HasNoArgs valSynInfo then (cenv.g.unit_ty --> declaredTy), (SynInfo.IncorporateEmptyTupledArgForPropertyGetter valSynInfo) else - declaredTy,valSynInfo + declaredTy, valSynInfo | _ -> let setterTy = (mkRefTupledTy cenv.g (List.map fst (List.concat arginfos) @ [returnTy]) --> cenv.g.unit_ty) let synInfo = SynInfo.IncorporateSetterArg valSynInfo setterTy, synInfo | MemberKind.PropertyGetSet -> - error(InternalError("Unexpected MemberKind.PropertyGetSet from signature parsing",m)) + error(InternalError("Unexpected MemberKind.PropertyGetSet from signature parsing", m)) // Take "unit" into account in the signature let valSynInfo = AdjustValSynInfoInSignature cenv.g ty' valSynInfo - let ty',valSynInfo = + let ty', valSynInfo = if memberFlags.IsInstance then (thisTy --> ty'), (SynInfo.IncorporateSelfArg valSynInfo) else - ty',valSynInfo + ty', valSynInfo - let reallyGenerateOneMember(id:Ident,valSynInfo,ty',memberFlags) = - let (PartialValReprInfo(argsData,_)) as partialValReprInfo = + let reallyGenerateOneMember(id:Ident, valSynInfo, ty', memberFlags) = + let (PartialValReprInfo(argsData, _)) as partialValReprInfo = TranslateTopValSynInfo id.idRange (TcAttributes cenv env) valSynInfo @@ -4333,12 +4333,12 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv let ty' = if SynInfo.HasOptionalArgs valSynInfo then - let argtysl,returnTy = GetTopTauTypeInFSharpForm cenv.g argsData ty' m + let argtysl, returnTy = GetTopTauTypeInFSharpForm cenv.g argsData ty' m let argtysl = (List.zip (List.mapSquared fst argtysl) valSynInfo.ArgInfos) - |> List.map (fun (argtys,argInfos) -> + |> List.map (fun (argtys, argInfos) -> (List.zip argtys argInfos) - |> List.map (fun (argty,argInfo) -> + |> List.map (fun (argty, argInfo) -> if SynInfo.IsOptionalArg argInfo then mkOptionTy cenv.g argty else argty)) mkIteratedFunTy (List.map (mkRefTupledTy cenv.g) argtysl) returnTy @@ -4348,14 +4348,14 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv match memberContainerInfo with | Some tcref -> let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let memberInfoTransient = MakeMemberDataAndMangledNameForMemberVal(cenv.g,tcref,isExtrinsic,attrs,[],memberFlags,valSynInfo,id,false) + let memberInfoTransient = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, isExtrinsic, attrs, [], memberFlags, valSynInfo, id, false) Some memberInfoTransient | None -> None - ValSpecResult(altActualParent,memberInfoOpt,id,enclosingDeclaredTypars,declaredTypars,ty',partialValReprInfo,declKind) + ValSpecResult(altActualParent, memberInfoOpt, id, enclosingDeclaredTypars, declaredTypars, ty', partialValReprInfo, declKind) - [ yield reallyGenerateOneMember(id,valSynInfo,ty',memberFlags) + [ yield reallyGenerateOneMember(id, valSynInfo, ty', memberFlags) if CompileAsEvent cenv.g attrs then let valSynInfo = EventDeclarationNormalization.ConvertSynInfo id.idRange valSynInfo let memberFlags = EventDeclarationNormalization.ConvertMemberFlags memberFlags @@ -4365,8 +4365,8 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv thisTy --> (delTy --> cenv.g.unit_ty) else (delTy --> cenv.g.unit_ty) - yield reallyGenerateOneMember(ident("add_" + id.idText,id.idRange),valSynInfo,ty,memberFlags) - yield reallyGenerateOneMember(ident("remove_" + id.idText,id.idRange),valSynInfo,ty,memberFlags) ] + yield reallyGenerateOneMember(ident("add_" + id.idText, id.idRange), valSynInfo, ty, memberFlags) + yield reallyGenerateOneMember(ident("remove_" + id.idText, id.idRange), valSynInfo, ty, memberFlags) ] @@ -4383,7 +4383,7 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv | _ -> let valSynInfo = AdjustValSynInfoInSignature cenv.g declaredTy valSynInfo let partialValReprInfo = TranslateTopValSynInfo id.idRange (TcAttributes cenv env) valSynInfo - [ ValSpecResult(altActualParent,None,id,enclosingDeclaredTypars,declaredTypars,declaredTy,partialValReprInfo,declKind) ], tpenv + [ ValSpecResult(altActualParent, None, id, enclosingDeclaredTypars, declaredTypars, declaredTy, partialValReprInfo, declKind) ], tpenv //------------------------------------------------------------------------- @@ -4394,16 +4394,16 @@ and TcValSpec cenv env declKind newOk containerInfo memFlagsOpt thisTyOpt tpenv /// If optKind=Some kind, then this is the kind we're expecting (we're in *analysis* mode) /// If optKind=None, we need to determine the kind (we're in *synthesis* mode) /// -and TcTyparOrMeasurePar optKind cenv (env:TcEnv) newOk tpenv (Typar(id,_,_) as tp) = +and TcTyparOrMeasurePar optKind cenv (env:TcEnv) newOk tpenv (Typar(id, _, _) as tp) = let checkRes (res:Typar) = match optKind, res.Kind with | Some TyparKind.Measure, TyparKind.Type -> error (Error(FSComp.SR.tcExpectedUnitOfMeasureMarkWithAttribute(), id.idRange)); res, tpenv | Some TyparKind.Type, TyparKind.Measure -> error (Error(FSComp.SR.tcExpectedTypeParameter(), id.idRange)); res, tpenv | _, _ -> let item = Item.TypeVar(id.idText, res) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.UseInType, env.DisplayEnv, env.eAccessRights) // record the ' as well for tokenization - // CallNameResolutionSink cenv.tcSink (tp.Range.StartRange,env.NameEnv,item,item,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights) + // CallNameResolutionSink cenv.tcSink (tp.Range.StartRange, env.NameEnv, item, item, ItemOccurence.UseInType, env.DisplayEnv, env.eAccessRights) res, tpenv let key = id.idText match env.eNameResEnv.eTypars.TryFind key with @@ -4428,33 +4428,33 @@ and TcTyparOrMeasurePar optKind cenv (env:TcEnv) newOk tpenv (Typar(id,_,_) as t Set.union predictions1 predictions2 - let reportedId = Ident("'" + id.idText,id.idRange) - error (UndefinedName(0,FSComp.SR.undefinedNameTypeParameter,reportedId,predictTypeParameters)) + let reportedId = Ident("'" + id.idText, id.idRange) + error (UndefinedName(0, FSComp.SR.undefinedNameTypeParameter, reportedId, predictTypeParameters)) // OK, this is an implicit declaration of a type parameter // The kind defaults to Type - let tp' = NewTypar ((match optKind with None -> TyparKind.Type | Some kind -> kind), TyparRigidity.WarnIfNotRigid,tp,false,TyparDynamicReq.Yes,[],false,false) + let tp' = NewTypar ((match optKind with None -> TyparKind.Type | Some kind -> kind), TyparRigidity.WarnIfNotRigid, tp, false, TyparDynamicReq.Yes, [], false, false) let item = Item.TypeVar(id.idText, tp') - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights) - tp',AddUnscopedTypar key tp' tpenv + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.UseInType, env.DisplayEnv, env.eAccessRights) + tp', AddUnscopedTypar key tp' tpenv and TcTypar cenv env newOk tpenv tp = TcTyparOrMeasurePar (Some TyparKind.Type) cenv env newOk tpenv tp -and TcTyparDecl cenv env (TyparDecl(synAttrs,(Typar(id,_,_) as stp))) = +and TcTyparDecl cenv env (TyparDecl(synAttrs, (Typar(id, _, _) as stp))) = let attrs = TcAttributes cenv env AttributeTargets.GenericParameter synAttrs let hasMeasureAttr = HasFSharpAttribute cenv.g cenv.g.attrib_MeasureAttribute attrs let hasEqDepAttr = HasFSharpAttribute cenv.g cenv.g.attrib_EqualityConditionalOnAttribute attrs let hasCompDepAttr = HasFSharpAttribute cenv.g cenv.g.attrib_ComparisonConditionalOnAttribute attrs let attrs = attrs |> List.filter (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_MeasureAttribute >> not) - let tp = NewTypar ((if hasMeasureAttr then TyparKind.Measure else TyparKind.Type), TyparRigidity.WarnIfNotRigid,stp,false,TyparDynamicReq.Yes,attrs,hasEqDepAttr,hasCompDepAttr) + let tp = NewTypar ((if hasMeasureAttr then TyparKind.Measure else TyparKind.Type), TyparRigidity.WarnIfNotRigid, stp, false, TyparDynamicReq.Yes, attrs, hasEqDepAttr, hasCompDepAttr) match TryFindFSharpStringAttribute cenv.g cenv.g.attrib_CompiledNameAttribute attrs with | Some compiledName -> tp.typar_il_name <- Some compiledName | None -> () let item = Item.TypeVar(id.idText, tp) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.UseInType,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.UseInType, env.DisplayEnv, env.eAccessRights) tp @@ -4467,10 +4467,10 @@ and TcTyparDecls cenv env synTypars = List.map (TcTyparDecl cenv env) synTypars and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscopedTyparEnv) ty = match ty with - | SynType.LongIdent(LongIdentWithDots([],_)) -> + | SynType.LongIdent(LongIdentWithDots([], _)) -> // special case when type name is absent - i.e. empty inherit part in type declaration cenv.g.obj_ty, tpenv - | SynType.LongIdent(LongIdentWithDots(tc,_) as lidwd) -> + | SynType.LongIdent(LongIdentWithDots(tc, _) as lidwd) -> let m = lidwd.Range let ad = env.eAccessRights let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver occ OpenQualified env.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No) @@ -4486,7 +4486,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscoped | _, TyparKind.Type -> TcTypeApp cenv newOk checkCxs occ env tpenv m tcref [] [] - | SynType.App (SynType.LongIdent(LongIdentWithDots(tc,_)),_,args,_commas,_,postfix,m) -> + | SynType.App (SynType.LongIdent(LongIdentWithDots(tc, _)), _, args, _commas, _, postfix, m) -> let ad = env.eAccessRights let tcref = ForceRaise(ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified env.eNameResEnv ad tc (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length) PermitDirectReferenceToGeneratedType.No) match optKind, tcref.TypeOrMeasureKind with @@ -4501,68 +4501,68 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscoped then error(Error(FSComp.SR.tcInvalidUnitsOfMeasurePrefix(), m)) TcTypeApp cenv newOk checkCxs occ env tpenv m tcref [] args | _, TyparKind.Measure -> - match args,postfix with + match args, postfix with | [arg], true -> - let ms,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg m + let ms, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg m TType_measure (Measure.Prod(Measure.Con tcref, ms)), tpenv | _, _ -> errorR(Error(FSComp.SR.tcUnitsOfMeasureInvalidInTypeConstructor(), m)) NewErrorType (), tpenv - | SynType.LongIdentApp (ltyp,LongIdentWithDots(longId,_),_,args,_commas,_,m) -> + | SynType.LongIdentApp (ltyp, LongIdentWithDots(longId, _), _, args, _commas, _, m) -> let ad = env.eAccessRights - let ltyp,tpenv = TcType cenv newOk checkCxs occ env tpenv ltyp + let ltyp, tpenv = TcType cenv newOk checkCxs occ env tpenv ltyp match ltyp with - | AppTy cenv.g (tcref,tinst) -> + | AppTy cenv.g (tcref, tinst) -> let tcref = ResolveTypeLongIdentInTyconRef cenv.tcSink cenv.nameResolver env.eNameResEnv (TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.FromTyArgs args.Length)) ad m tcref longId TcTypeApp cenv newOk checkCxs occ env tpenv m tcref tinst args - | _ -> error(Error(FSComp.SR.tcTypeHasNoNestedTypes(),m)) + | _ -> error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), m)) - | SynType.Tuple(args,m) -> - let isMeasure = match optKind with Some TyparKind.Measure -> true | None -> List.exists (fun (isquot,_) -> isquot) args | _ -> false + | SynType.Tuple(args, m) -> + let isMeasure = match optKind with Some TyparKind.Measure -> true | None -> List.exists (fun (isquot, _) -> isquot) args | _ -> false if isMeasure then - let ms,tpenv = TcMeasuresAsTuple cenv newOk checkCxs occ env tpenv args m - TType_measure ms,tpenv + let ms, tpenv = TcMeasuresAsTuple cenv newOk checkCxs occ env tpenv args m + TType_measure ms, tpenv else - let args',tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m - TType_tuple(tupInfoRef,args'),tpenv + let args', tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m + TType_tuple(tupInfoRef, args'), tpenv - | SynType.StructTuple(args,m) -> - let args',tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m - TType_tuple(tupInfoStruct,args'),tpenv + | SynType.StructTuple(args, m) -> + let args', tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m + TType_tuple(tupInfoStruct, args'), tpenv - | SynType.Fun(domainTy,resultTy,_) -> - let domainTy',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv domainTy - let resultTy',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv resultTy + | SynType.Fun(domainTy, resultTy, _) -> + let domainTy', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv domainTy + let resultTy', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv resultTy (domainTy' --> resultTy'), tpenv - | SynType.Array (n,elemTy,m) -> - let elemTy,tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv elemTy + | SynType.Array (n, elemTy, m) -> + let elemTy, tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv elemTy mkArrayTy cenv.g n elemTy m, tpenv - | SynType.Var (tp,_) -> - let tp',tpenv = TcTyparOrMeasurePar optKind cenv env newOk tpenv tp + | SynType.Var (tp, _) -> + let tp', tpenv = TcTyparOrMeasurePar optKind cenv env newOk tpenv tp match tp'.Kind with | TyparKind.Measure -> TType_measure (Measure.Var tp'), tpenv - | TyparKind.Type -> mkTyparTy tp',tpenv + | TyparKind.Type -> mkTyparTy tp', tpenv // _ types | SynType.Anon m -> let tp:Typar = TcAnonTypeOrMeasure optKind cenv TyparRigidity.Anon TyparDynamicReq.No newOk m match tp.Kind with | TyparKind.Measure -> TType_measure (Measure.Var tp), tpenv - | TyparKind.Type -> mkTyparTy tp,tpenv + | TyparKind.Type -> mkTyparTy tp, tpenv - | SynType.WithGlobalConstraints(ty,wcs,_) -> - let cty,tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty + | SynType.WithGlobalConstraints(ty, wcs, _) -> + let cty, tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty let tpenv = TcTyparConstraints cenv newOk checkCxs occ env tpenv wcs - cty,tpenv + cty, tpenv // #typ - | SynType.HashConstraint(ty,m) -> + | SynType.HashConstraint(ty, m) -> let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m - let ty',tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty + let ty', tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty' (mkTyparTy tp) tp.AsType, tpenv @@ -4576,8 +4576,8 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscoped | _ -> errorR(Error(FSComp.SR.parsInvalidLiteralInType(), m)) NewErrorType (), tpenv - | SynType.StaticConstantNamed (_,_,m) - | SynType.StaticConstantExpr (_,m) -> + | SynType.StaticConstantNamed (_, _, m) + | SynType.StaticConstantExpr (_, m) -> errorR(Error(FSComp.SR.parsInvalidLiteralInType(), m)) NewErrorType (), tpenv @@ -4588,7 +4588,7 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscoped errorR(Error(FSComp.SR.tcUnexpectedSymbolInTypeExpression("^"), m)) NewErrorType (), tpenv | _ -> - let ms,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ m + let ms, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ m TType_measure (Measure.RationalPower (ms, TcSynRationalConst exponent)), tpenv | SynType.MeasureDivide(typ1, typ2, m) -> @@ -4597,15 +4597,15 @@ and TcTypeOrMeasure optKind cenv newOk checkCxs occ env (tpenv:SyntacticUnscoped errorR(Error(FSComp.SR.tcUnexpectedSymbolInTypeExpression("/"), m)) NewErrorType (), tpenv | _ -> - let ms1,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ1 m - let ms2,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ2 m - TType_measure (Measure.Prod(ms1,Measure.Inv ms2)), tpenv + let ms1, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ1 m + let ms2, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ2 m + TType_measure (Measure.Prod(ms1, Measure.Inv ms2)), tpenv - | SynType.App((SynType.Var(_,m1) | SynType.MeasurePower(_,_,m1)) as arg1,_,args,_commas,_,postfix,m) -> + | SynType.App((SynType.Var(_, m1) | SynType.MeasurePower(_, _, m1)) as arg1, _, args, _commas, _, postfix, m) -> match optKind, args, postfix with | (None | Some TyparKind.Measure), [arg2], true -> - let ms1,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg1 m1 - let ms2,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg2 m + let ms1, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg1 m1 + let ms2, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv arg2 m TType_measure (Measure.Prod(ms1, ms2)), tpenv | _, _, _ -> @@ -4626,39 +4626,39 @@ and TcMeasure cenv newOk checkCxs occ env (tpenv:SyntacticUnscopedTyparEnv) ty m NewErrorMeasure (), tpenv | _ -> match TcTypeOrMeasure (Some TyparKind.Measure) cenv newOk checkCxs occ env tpenv ty with - | TType_measure ms, tpenv -> ms,tpenv + | TType_measure ms, tpenv -> ms, tpenv | _, _ -> error(Error(FSComp.SR.tcExpectedUnitOfMeasureNotType(), m)) NewErrorMeasure (), tpenv and TcAnonTypeOrMeasure optKind _cenv rigid dyn newOk m = - if newOk = NoNewTypars then errorR (Error(FSComp.SR.tcAnonymousTypeInvalidInDeclaration(),m)) + if newOk = NoNewTypars then errorR (Error(FSComp.SR.tcAnonymousTypeInvalidInDeclaration(), m)) let rigid = (if rigid = TyparRigidity.Anon && newOk = NewTyparsOKButWarnIfNotRigid then TyparRigidity.WarnIfNotRigid else rigid) let kind = match optKind with Some TyparKind.Measure -> TyparKind.Measure | _ -> TyparKind.Type - NewAnonTypar (kind,m,rigid,NoStaticReq,dyn) + NewAnonTypar (kind, m, rigid, NoStaticReq, dyn) and TcTypes cenv newOk checkCxs occ env tpenv args = List.mapFold (TcTypeAndRecover cenv newOk checkCxs occ env) tpenv args and TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m = match args with - | [] -> error(InternalError("empty tuple type",m)) - | [(_,typ)] -> let typ,tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv typ in [typ],tpenv - | (isquot,typ)::args -> - let ty,tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv typ - let tys,tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m - if isquot then errorR(Error(FSComp.SR.tcUnexpectedSlashInType(),m)) - ty::tys,tpenv + | [] -> error(InternalError("empty tuple type", m)) + | [(_, typ)] -> let typ, tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv typ in [typ], tpenv + | (isquot, typ)::args -> + let ty, tpenv = TcTypeAndRecover cenv newOk checkCxs occ env tpenv typ + let tys, tpenv = TcTypesAsTuple cenv newOk checkCxs occ env tpenv args m + if isquot then errorR(Error(FSComp.SR.tcUnexpectedSlashInType(), m)) + ty::tys, tpenv // Type-check a list of measures separated by juxtaposition, * or / and TcMeasuresAsTuple cenv newOk checkCxs occ env (tpenv:SyntacticUnscopedTyparEnv) args m = let rec gather args tpenv isquot acc = match args with - | [] -> acc,tpenv - | (nextisquot,typ)::args -> - let ms1,tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ m - gather args tpenv nextisquot (if isquot then Measure.Prod(acc,Measure.Inv ms1) else Measure.Prod(acc,ms1)) + | [] -> acc, tpenv + | (nextisquot, typ)::args -> + let ms1, tpenv = TcMeasure cenv newOk checkCxs occ env tpenv typ m + gather args tpenv nextisquot (if isquot then Measure.Prod(acc, Measure.Inv ms1) else Measure.Prod(acc, ms1)) gather args tpenv false Measure.One @@ -4668,24 +4668,24 @@ and TcTypesOrMeasures optKinds cenv newOk checkCxs occ env tpenv args m = List.mapFold (TcTypeOrMeasure None cenv newOk checkCxs occ env) tpenv args | Some kinds -> if List.length kinds = List.length args then - List.mapFold (fun tpenv (arg,kind) -> TcTypeOrMeasure (Some kind) cenv newOk checkCxs occ env tpenv arg) tpenv (List.zip args kinds) + List.mapFold (fun tpenv (arg, kind) -> TcTypeOrMeasure (Some kind) cenv newOk checkCxs occ env tpenv arg) tpenv (List.zip args kinds) elif isNil kinds then error(Error(FSComp.SR.tcUnexpectedTypeArguments(), m)) else error(Error(FSComp.SR.tcTypeParameterArityMismatch((List.length kinds), (List.length args)), m)) and TcTyparConstraints cenv newOk checkCxs occ env tpenv wcs = // Mark up default constraints with a priority in reverse order: last gets 0, second // last gets 1 etc. See comment on TyparConstraint.DefaultsTo - let _,tpenv = List.fold (fun (ridx,tpenv) tc -> ridx - 1, TcTyparConstraint ridx cenv newOk checkCxs occ env tpenv tc) (List.length wcs - 1, tpenv) wcs + let _, tpenv = List.fold (fun (ridx, tpenv) tc -> ridx - 1, TcTyparConstraint ridx cenv newOk checkCxs occ env tpenv tc) (List.length wcs - 1, tpenv) wcs tpenv #if EXTENSIONTYPING and TcStaticConstantParameter cenv (env:TcEnv) tpenv kind (v:SynType) idOpt container = - let fail() = error(Error(FSComp.SR.etInvalidStaticArgument(NicePrint.minimalStringOfType env.DisplayEnv kind),v.Range)) + let fail() = error(Error(FSComp.SR.etInvalidStaticArgument(NicePrint.minimalStringOfType env.DisplayEnv kind), v.Range)) let record ttype = match idOpt with | Some id -> let item = Item.ArgName (id, ttype, Some container) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) | _ -> () match v with @@ -4704,21 +4704,21 @@ and TcStaticConstantParameter cenv (env:TcEnv) tpenv kind (v:SynType) idOpt cont | SynConst.Single n when typeEquiv cenv.g cenv.g.float32_ty kind -> record(cenv.g.float32_ty); box (n:single) | SynConst.Double n when typeEquiv cenv.g cenv.g.float_ty kind -> record(cenv.g.float_ty); box (n:double) | SynConst.Char n when typeEquiv cenv.g cenv.g.char_ty kind -> record(cenv.g.char_ty); box (n:char) - | SynConst.String (s,_) when s <> null && typeEquiv cenv.g cenv.g.string_ty kind -> record(cenv.g.string_ty); box (s:string) + | SynConst.String (s, _) when s <> null && typeEquiv cenv.g cenv.g.string_ty kind -> record(cenv.g.string_ty); box (s:string) | SynConst.Bool b when typeEquiv cenv.g cenv.g.bool_ty kind -> record(cenv.g.bool_ty); box (b:bool) | _ -> fail() v, tpenv | SynType.StaticConstantExpr(e, _ ) -> // If an error occurs, don't try to recover, since the constant expression will be nothing like what we need - let te,tpenv' = TcExprNoRecover cenv kind env tpenv e + let te, tpenv' = TcExprNoRecover cenv kind env tpenv e // Evaluate the constant expression using static attribute argument rules let te = EvalLiteralExprOrAttribArg cenv.g te let v = match stripExpr te with // Check we have a residue constant. We know the type was correct because we checked the expression with this type. - | Expr.Const(c,_,_) -> + | Expr.Const(c, _, _) -> match c with | Const.Byte n -> record(cenv.g.byte_ty); box (n:byte) | Const.Int16 n -> record(cenv.g.int16_ty); box (n:int16) @@ -4736,18 +4736,18 @@ and TcStaticConstantParameter cenv (env:TcEnv) tpenv kind (v:SynType) idOpt cont | Const.String s -> record(cenv.g.string_ty); box (s:string) | Const.Bool b -> record(cenv.g.bool_ty); box (b:bool) | _ -> fail() - | _ -> error(Error(FSComp.SR.tcInvalidConstantExpression(),v.Range)) + | _ -> error(Error(FSComp.SR.tcInvalidConstantExpression(), v.Range)) v, tpenv' | SynType.LongIdent(lidwd) -> let m = lidwd.Range - TcStaticConstantParameter cenv env tpenv kind (SynType.StaticConstantExpr(SynExpr.LongIdent(false,lidwd,None,m),m)) idOpt container + TcStaticConstantParameter cenv env tpenv kind (SynType.StaticConstantExpr(SynExpr.LongIdent(false, lidwd, None, m), m)) idOpt container | _ -> fail() and CrackStaticConstantArgs cenv env tpenv (staticParameters: Tainted[], args: SynType list, container, containerName, m) = let args = args |> List.map (function - | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id],_)),v,_) -> Some id, v + | SynType.StaticConstantNamed(SynType.LongIdent(LongIdentWithDots([id], _)), v, _) -> Some id, v | v -> None, v) let unnamedArgs = args |> Seq.takeWhile (fst >> Option.isNone) |> Seq.toArray |> Array.map snd @@ -4755,21 +4755,21 @@ and CrackStaticConstantArgs cenv env tpenv (staticParameters: Tainted List.takeWhile (fst >> Option.isSome) |> List.map (map1Of2 Option.get) let otherArgs = otherArgs |> List.skipWhile (fst >> Option.isSome) if not otherArgs.IsEmpty then - error (Error(FSComp.SR.etBadUnnamedStaticArgs(),m)) + error (Error(FSComp.SR.etBadUnnamedStaticArgs(), m)) let indexedStaticParameters = staticParameters |> Array.toList |> List.indexed - for (n,_) in namedArgs do - match indexedStaticParameters |> List.filter (fun (j,sp) -> j >= unnamedArgs.Length && n.idText = sp.PUntaint((fun sp -> sp.Name), m)) with + for (n, _) in namedArgs do + match indexedStaticParameters |> List.filter (fun (j, sp) -> j >= unnamedArgs.Length && n.idText = sp.PUntaint((fun sp -> sp.Name), m)) with | [] -> if staticParameters |> Array.exists (fun sp -> n.idText = sp.PUntaint((fun sp -> sp.Name), n.idRange)) then - error (Error(FSComp.SR.etStaticParameterAlreadyHasValue n.idText,n.idRange)) + error (Error(FSComp.SR.etStaticParameterAlreadyHasValue n.idText, n.idRange)) else - error (Error(FSComp.SR.etNoStaticParameterWithName n.idText,n.idRange)) + error (Error(FSComp.SR.etNoStaticParameterWithName n.idText, n.idRange)) | [_] -> () - | _ -> error (Error(FSComp.SR.etMultipleStaticParameterWithName n.idText,n.idRange)) + | _ -> error (Error(FSComp.SR.etMultipleStaticParameterWithName n.idText, n.idRange)) if staticParameters.Length < namedArgs.Length + unnamedArgs.Length then - error (Error(FSComp.SR.etTooManyStaticParameters(staticParameters.Length,unnamedArgs.Length,namedArgs.Length),m)) + error (Error(FSComp.SR.etTooManyStaticParameters(staticParameters.Length, unnamedArgs.Length, namedArgs.Length), m)) let argsInStaticParameterOrderIncludingDefaults = staticParameters |> Array.mapi (fun i sp -> @@ -4780,19 +4780,19 @@ and CrackStaticConstantArgs cenv env tpenv (staticParameters: Tainted List.filter (fun (n,_) -> n.idText = spName) with - | [(n,v)] -> + match namedArgs |> List.filter (fun (n, _) -> n.idText = spName) with + | [(n, v)] -> let v, _tpenv = TcStaticConstantParameter cenv env tpenv spKind v (Some n) container v | [] -> if sp.PUntaint((fun sp -> sp.IsOptional), m) then match sp.PUntaint((fun sp -> sp.RawDefaultValue), m) with - | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName) ,m)) + | null -> error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName) , m)) | v -> v else - error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName),m)) + error (Error(FSComp.SR.etStaticParameterRequiresAValue (spName, containerName, containerName, spName), m)) | ps -> - error (Error(FSComp.SR.etMultipleStaticParameterWithName spName,(fst (List.last ps)).idRange))) + error (Error(FSComp.SR.etMultipleStaticParameterWithName spName, (fst (List.last ps)).idRange))) argsInStaticParameterOrderIncludingDefaults @@ -4802,7 +4802,7 @@ and TcProvidedTypeAppToStaticConstantArgs cenv env optGeneratedTypePath tpenv (t | TProvidedTypeExtensionPoint info -> info.ProvidedType | _ -> failwith "unreachable" - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments,provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m) let argsInStaticParameterOrderIncludingDefaults = CrackStaticConstantArgs cenv env tpenv (staticParameters, args, ArgumentContainer.Type tcref, tcref.DisplayName, m) @@ -4810,8 +4810,8 @@ and TcProvidedTypeAppToStaticConstantArgs cenv env optGeneratedTypePath tpenv (t // Take the static arguments (as SynType's) and convert them to objects of the appropriate type, based on the expected kind. let providedTypeAfterStaticArguments, checkTypeName = match ExtensionTyping.TryApplyProvidedType(typeBeforeArguments, optGeneratedTypePath, argsInStaticParameterOrderIncludingDefaults, m) with - | None -> error(Error(FSComp.SR.etErrorApplyingStaticArgumentsToType(),m)) - | Some (ty,checkTypeName) -> (ty, checkTypeName) + | None -> error(Error(FSComp.SR.etErrorApplyingStaticArgumentsToType(), m)) + | Some (ty, checkTypeName) -> (ty, checkTypeName) let hasNoArgs = (argsInStaticParameterOrderIncludingDefaults.Length = 0) hasNoArgs, providedTypeAfterStaticArguments, checkTypeName @@ -4819,11 +4819,11 @@ and TcProvidedTypeAppToStaticConstantArgs cenv env optGeneratedTypePath tpenv (t and TryTcMethodAppToStaticConstantArgs cenv env tpenv (minfos: MethInfo list, argsOpt, mExprAndArg, mItem) = match minfos, argsOpt with - | [minfo], Some (args,_) -> + | [minfo], Some (args, _) -> match minfo.ProvidedStaticParameterInfo with | Some (methBeforeArguments, staticParams) -> let providedMethAfterStaticArguments = TcProvidedMethodAppToStaticConstantArgs cenv env tpenv (minfo, methBeforeArguments, staticParams, args, mExprAndArg) - let minfoAfterStaticArguments = ProvidedMeth(cenv.amap,providedMethAfterStaticArguments,minfo.ExtensionMemberPriorityOption,mItem) + let minfoAfterStaticArguments = ProvidedMeth(cenv.amap, providedMethAfterStaticArguments, minfo.ExtensionMemberPriorityOption, mItem) Some minfoAfterStaticArguments | _ -> None | _ -> None @@ -4834,20 +4834,20 @@ and TcProvidedMethodAppToStaticConstantArgs cenv env tpenv (minfo, methBeforeArg let providedMethAfterStaticArguments = match ExtensionTyping.TryApplyProvidedMethod(methBeforeArguments, argsInStaticParameterOrderIncludingDefaults, m) with - | None -> error(Error(FSComp.SR.etErrorApplyingStaticArgumentsToMethod(),m)) + | None -> error(Error(FSComp.SR.etErrorApplyingStaticArgumentsToMethod(), m)) | Some meth -> meth providedMethAfterStaticArguments and TcProvidedTypeApp cenv env tpenv tcref args m = - let hasNoArgs,providedTypeAfterStaticArguments,checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv env None tpenv tcref args m + let hasNoArgs, providedTypeAfterStaticArguments, checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv env None tpenv tcref args m - let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased),m) + let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased), m) //printfn "adding entity for provided type '%s', isDirectReferenceToGenerated = %b, isGenerated = %b" (st.PUntaint((fun st -> st.Name), m)) isDirectReferenceToGenerated isGenerated let isDirectReferenceToGenerated = isGenerated && ExtensionTyping.IsGeneratedTypeDirectReference (providedTypeAfterStaticArguments, m) if isDirectReferenceToGenerated then - error(Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName),m)) + error(Error(FSComp.SR.etDirectReferenceToGeneratedTypeNotAllowed(tcref.DisplayName), m)) // We put the type name check after the 'isDirectReferenceToGenerated' check because we need the 'isDirectReferenceToGenerated' error to be shown for generated types checkTypeName() @@ -4855,7 +4855,7 @@ and TcProvidedTypeApp cenv env tpenv tcref args m = mkAppTy tcref [], tpenv else let typ = Import.ImportProvidedType cenv.amap m providedTypeAfterStaticArguments - typ,tpenv + typ, tpenv #endif /// Typecheck an application of a generic type to type arguments. @@ -4873,15 +4873,15 @@ and TcTypeApp cenv newOk checkCxs occ env tpenv m tcref pathTypeArgs (synArgTys: if tcref.Deref.IsProvided then TcProvidedTypeApp cenv env tpenv tcref synArgTys m else #endif - let tps,_,tinst,_ = infoOfTyconRef m tcref + let tps, _, tinst, _ = infoOfTyconRef m tcref // If we're not checking constraints, i.e. when we first assert the super/interfaces of a type definition, then just // clear the constraint lists of the freshly generated type variables. A little ugly but fairly localized. if checkCxs = NoCheckCxs then tps |> List.iter (fun tp -> tp.typar_constraints <- []) if tinst.Length <> pathTypeArgs.Length + synArgTys.Length then - error (TyconBadArgs(env.DisplayEnv,tcref,pathTypeArgs.Length + synArgTys.Length,m)) + error (TyconBadArgs(env.DisplayEnv, tcref, pathTypeArgs.Length + synArgTys.Length, m)) - let argTys,tpenv = + let argTys, tpenv = // Get the suffix of typars let tpsForArgs = List.drop (tps.Length - synArgTys.Length) tps let kindsForArgs = tpsForArgs |> List.map (fun tp -> tp.Kind) @@ -4912,19 +4912,19 @@ and TcTypeOrMeasureAndRecover optKind cenv newOk checkCxs occ env tpenv ty = | Some TyparKind.Measure, _ -> TType_measure (NewErrorMeasure ()) | _, NoNewTypars -> cenv.g.obj_ty | _ -> NewErrorType () - rty,tpenv + rty, tpenv and TcTypeAndRecover cenv newOk checkCxs occ env tpenv ty = TcTypeOrMeasureAndRecover (Some TyparKind.Type) cenv newOk checkCxs occ env tpenv ty and TcNestedTypeApplication cenv newOk checkCxs occ env tpenv mWholeTypeApp typ tyargs = - if not (isAppTy cenv.g typ) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(),mWholeTypeApp)) + if not (isAppTy cenv.g typ) then error(Error(FSComp.SR.tcTypeHasNoNestedTypes(), mWholeTypeApp)) match typ with - | TType_app(tcref,tinst) -> + | TType_app(tcref, tinst) -> let pathTypeArgs = List.take (max (tinst.Length - tcref.Typars(mWholeTypeApp).Length) 0) tinst TcTypeApp cenv newOk checkCxs occ env tpenv mWholeTypeApp tcref pathTypeArgs tyargs - | _ -> error(InternalError("TcNestedTypeApplication: expected type application",mWholeTypeApp)) + | _ -> error(InternalError("TcNestedTypeApplication: expected type application", mWholeTypeApp)) and TryAdjustHiddenVarNameToCompGenName cenv env (id:Ident) altNameRefCellOpt = @@ -4937,66 +4937,66 @@ and TryAdjustHiddenVarNameToCompGenName cenv env (id:Ident) altNameRefCellOpt = | None -> None /// Bind the patterns used in a lambda. Not clear why we don't use TcPat. -and TcSimplePat optArgsOK checkCxs cenv ty env (tpenv,names,takenNames) p = +and TcSimplePat optArgsOK checkCxs cenv ty env (tpenv, names, takenNames) p = match p with - | SynSimplePat.Id (id,altNameRefCellOpt,compgen,isMemberThis,isOpt,m) -> + | SynSimplePat.Id (id, altNameRefCellOpt, compgen, isMemberThis, isOpt, m) -> // Check to see if pattern translation decides to use an alternative identifier. match TryAdjustHiddenVarNameToCompGenName cenv env id altNameRefCellOpt with - | Some altId -> TcSimplePat optArgsOK checkCxs cenv ty env (tpenv,names,takenNames) (SynSimplePat.Id (altId,None,compgen,isMemberThis,isOpt,m) ) + | Some altId -> TcSimplePat optArgsOK checkCxs cenv ty env (tpenv, names, takenNames) (SynSimplePat.Id (altId, None, compgen, isMemberThis, isOpt, m) ) | None -> if isOpt then if not optArgsOK then - errorR(Error(FSComp.SR.tcOptionalArgsOnlyOnMembers(),m)) + errorR(Error(FSComp.SR.tcOptionalArgsOnlyOnMembers(), m)) let tyarg = NewInferenceType () UnifyTypes cenv env m ty (mkOptionTy cenv.g tyarg) - let _,names,takenNames = TcPatBindingName cenv env id ty isMemberThis None None (ValInline.Optional,permitInferTypars,noArgOrRetAttribs,false,None,compgen) (names,takenNames) + let _, names, takenNames = TcPatBindingName cenv env id ty isMemberThis None None (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, compgen) (names, takenNames) id.idText, - (tpenv,names,takenNames) + (tpenv, names, takenNames) - | SynSimplePat.Typed (p,cty,m) -> - let cty',tpenv = TcTypeAndRecover cenv NewTyparsOK checkCxs ItemOccurence.UseInType env tpenv cty + | SynSimplePat.Typed (p, cty, m) -> + let cty', tpenv = TcTypeAndRecover cenv NewTyparsOK checkCxs ItemOccurence.UseInType env tpenv cty match p with // Optional arguments on members - | SynSimplePat.Id(_,_,_,_,true,_) -> UnifyTypes cenv env m ty (mkOptionTy cenv.g cty') + | SynSimplePat.Id(_, _, _, _, true, _) -> UnifyTypes cenv env m ty (mkOptionTy cenv.g cty') | _ -> UnifyTypes cenv env m ty cty' - TcSimplePat optArgsOK checkCxs cenv ty env (tpenv,names,takenNames) p + TcSimplePat optArgsOK checkCxs cenv ty env (tpenv, names, takenNames) p - | SynSimplePat.Attrib (p,_,_) -> - TcSimplePat optArgsOK checkCxs cenv ty env (tpenv,names,takenNames) p + | SynSimplePat.Attrib (p, _, _) -> + TcSimplePat optArgsOK checkCxs cenv ty env (tpenv, names, takenNames) p // raise an error if any optional args precede any non-optional args and ValidateOptArgOrder (spats : SynSimplePats) = let rec getPats spats = match spats with - | SynSimplePats.SimplePats(p,m) -> p,m - | SynSimplePats.Typed(p,_,_) -> getPats p + | SynSimplePats.SimplePats(p, m) -> p, m + | SynSimplePats.Typed(p, _, _) -> getPats p let rec isOptArg pat = match pat with - | SynSimplePat.Id (_,_,_,_,isOpt,_) -> isOpt - | SynSimplePat.Typed (p,_,_) -> isOptArg p - | SynSimplePat.Attrib (p,_,_) -> isOptArg p + | SynSimplePat.Id (_, _, _, _, isOpt, _) -> isOpt + | SynSimplePat.Typed (p, _, _) -> isOptArg p + | SynSimplePat.Attrib (p, _, _) -> isOptArg p - let pats,m = getPats spats + let pats, m = getPats spats let hitOptArg = ref false - List.iter (fun pat -> if isOptArg pat then hitOptArg := true elif !hitOptArg then error(Error(FSComp.SR.tcOptionalArgsMustComeAfterNonOptionalArgs(),m))) pats + List.iter (fun pat -> if isOptArg pat then hitOptArg := true elif !hitOptArg then error(Error(FSComp.SR.tcOptionalArgsMustComeAfterNonOptionalArgs(), m))) pats /// Bind the patterns used in argument position for a function, method or lambda. -and TcSimplePats cenv optArgsOK checkCxs ty env (tpenv,names,takenNames:Set<_>) p = +and TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames:Set<_>) p = // validate optional argument declaration ValidateOptArgOrder p match p with - | SynSimplePats.SimplePats ([],m) -> - // Unit "()" patterns in argument position become SynSimplePats.SimplePats([],_) in the + | SynSimplePats.SimplePats ([], m) -> + // Unit "()" patterns in argument position become SynSimplePats.SimplePats([], _) in the // syntactic translation when building bindings. This is done because the // use of "()" has special significance for arity analysis and argument counting. // @@ -5004,73 +5004,73 @@ and TcSimplePats cenv optArgsOK checkCxs ty env (tpenv,names,takenNames:Set<_>) // This is a little awkward since it would be nice if this was // uniform with the process where we give names to other (more complex) // patterns used in argument position, e.g. "let f (D(x)) = ..." - let id = ident("unitVar" + string takenNames.Count,m) + let id = ident("unitVar" + string takenNames.Count, m) UnifyTypes cenv env m ty cenv.g.unit_ty - let _,names,takenNames = TcPatBindingName cenv env id ty false None None (ValInline.Optional,permitInferTypars,noArgOrRetAttribs,false,None,true) (names,takenNames) - [id.idText],(tpenv,names,takenNames) + let _, names, takenNames = TcPatBindingName cenv env id ty false None None (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, true) (names, takenNames) + [id.idText], (tpenv, names, takenNames) - | SynSimplePats.SimplePats ([p],_) -> - let v,(tpenv,names,takenNames) = TcSimplePat optArgsOK checkCxs cenv ty env (tpenv,names,takenNames) p - [v],(tpenv,names,takenNames) + | SynSimplePats.SimplePats ([p], _) -> + let v, (tpenv, names, takenNames) = TcSimplePat optArgsOK checkCxs cenv ty env (tpenv, names, takenNames) p + [v], (tpenv, names, takenNames) - | SynSimplePats.SimplePats (ps,m) -> + | SynSimplePats.SimplePats (ps, m) -> let ptys = UnifyRefTupleType env.eContextInfo cenv env.DisplayEnv m ty ps - let ps',(tpenv,names,takenNames) = List.mapFold (fun tpenv (ty,e) -> TcSimplePat optArgsOK checkCxs cenv ty env tpenv e) (tpenv,names,takenNames) (List.zip ptys ps) - ps',(tpenv,names,takenNames) + let ps', (tpenv, names, takenNames) = List.mapFold (fun tpenv (ty, e) -> TcSimplePat optArgsOK checkCxs cenv ty env tpenv e) (tpenv, names, takenNames) (List.zip ptys ps) + ps', (tpenv, names, takenNames) - | SynSimplePats.Typed (p,cty,m) -> - let cty',tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + | SynSimplePats.Typed (p, cty, m) -> + let cty', tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty match p with // Solitary optional arguments on members - | SynSimplePats.SimplePats([SynSimplePat.Id(_,_,_,_,true,_)],_) -> UnifyTypes cenv env m ty (mkOptionTy cenv.g cty') + | SynSimplePats.SimplePats([SynSimplePat.Id(_, _, _, _, true, _)], _) -> UnifyTypes cenv env m ty (mkOptionTy cenv.g cty') | _ -> UnifyTypes cenv env m ty cty' - TcSimplePats cenv optArgsOK checkCxs ty env (tpenv,names,takenNames) p + TcSimplePats cenv optArgsOK checkCxs ty env (tpenv, names, takenNames) p and TcSimplePatsOfUnknownType cenv optArgsOK checkCxs env tpenv spats = let argty = NewInferenceType () - TcSimplePats cenv optArgsOK checkCxs argty env (tpenv,NameMap.empty,Set.empty) spats + TcSimplePats cenv optArgsOK checkCxs argty env (tpenv, NameMap.empty, Set.empty) spats -and TcPatBindingName cenv env id ty isMemberThis vis1 topValData (inlineFlag,declaredTypars,argAttribs,isMutable,vis2,compgen) (names,takenNames:Set) = +and TcPatBindingName cenv env id ty isMemberThis vis1 topValData (inlineFlag, declaredTypars, argAttribs, isMutable, vis2, compgen) (names, takenNames:Set) = let vis = if Option.isSome vis1 then vis1 else vis2 if takenNames.Contains id.idText then errorR (VarBoundTwice id) let baseOrThis = if isMemberThis then MemberThisVal else NormalVal - let names = Map.add id.idText (PrelimValScheme1(id,declaredTypars,ty,topValData,None,isMutable,inlineFlag,baseOrThis,argAttribs,vis,compgen)) names + let names = Map.add id.idText (PrelimValScheme1(id, declaredTypars, ty, topValData, None, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen)) names let takenNames = Set.add id.idText takenNames (fun (TcPatPhase2Input (values, isLeftMost)) -> - let (vspec,typeScheme) = + let (vspec, typeScheme) = match values.TryFind id.idText with | Some value -> let name = id.idText if not (String.IsNullOrEmpty name) && Char.IsLower(name.[0]) then match TryFindPatternByName name env.eNameResEnv with | Some (Item.Value vref) when vref.LiteralValue.IsSome -> - warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern(id.idText),id.idRange)) + warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern(id.idText), id.idRange)) | Some _ | None -> () value - | None -> error(Error(FSComp.SR.tcNameNotBoundInPattern(id.idText),id.idRange)) + | None -> error(Error(FSComp.SR.tcNameNotBoundInPattern(id.idText), id.idRange)) // isLeftMost indicates we are processing the left-most path through a disjunctive or pattern. // For those binding locations, CallNameResolutionSink is called in MakeAndPublishValue, like all other bindings // For non-left-most paths, we register the name resolutions here if not isLeftMost && not vspec.IsCompilerGenerated && not (String.hasPrefix vspec.LogicalName "_") then let item = Item.Value(mkLocalValRef vspec) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights) - PBind(vspec,typeScheme)), - names,takenNames + PBind(vspec, typeScheme)), + names, takenNames -and TcPatAndRecover warnOnUpper cenv (env:TcEnv) topValInfo vFlags (tpenv,names,takenNames) ty (pat:SynPat) = +and TcPatAndRecover warnOnUpper cenv (env:TcEnv) topValInfo vFlags (tpenv, names, takenNames) ty (pat:SynPat) = try - TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat + TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty pat with e -> // Error recovery - return some rubbish expression, but replace/annotate // the type of the current expression with a type variable that indicates an error let m = pat.Range errorRecovery e m //solveTypAsError cenv env.DisplayEnv m ty - (fun _ -> TPat_wild m), (tpenv,names,takenNames) + (fun _ -> TPat_wild m), (tpenv, names, takenNames) /// Typecheck a pattern. Patterns are type-checked in three phases: /// 1. TcPat builds a List.map from simple variable names to inferred types for @@ -5080,74 +5080,74 @@ and TcPatAndRecover warnOnUpper cenv (env:TcEnv) topValInfo vFlags (tpenv,names, /// variables are to be generalized. The caller hands this information to /// the second-phase function in terms of a List.map from names to actual /// value specifications. -and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat = +and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty pat = let ad = env.eAccessRights match pat with - | SynPat.Const (c,m) -> + | SynPat.Const (c, m) -> match c with - | SynConst.Bytes (bytes,m) -> + | SynConst.Bytes (bytes, m) -> UnifyTypes cenv env m ty (mkByteArrayTy cenv.g) - TcPat warnOnUpper cenv env None vFlags (tpenv,names,takenNames) ty (SynPat.ArrayOrList (true,[ for b in bytes -> SynPat.Const(SynConst.Byte b,m) ],m)) + TcPat warnOnUpper cenv env None vFlags (tpenv, names, takenNames) ty (SynPat.ArrayOrList (true, [ for b in bytes -> SynPat.Const(SynConst.Byte b, m) ], m)) | SynConst.UserNum _ -> - error(Error(FSComp.SR.tcInvalidNonPrimitiveLiteralInPatternMatch(),m)) + error(Error(FSComp.SR.tcInvalidNonPrimitiveLiteralInPatternMatch(), m)) | _ -> let c' = TcConst cenv ty m env c - (fun (_:TcPatPhase2Input) -> TPat_const(c',m)),(tpenv,names,takenNames) + (fun (_:TcPatPhase2Input) -> TPat_const(c', m)), (tpenv, names, takenNames) | SynPat.Wild m -> - (fun _ -> TPat_wild m), (tpenv,names,takenNames) + (fun _ -> TPat_wild m), (tpenv, names, takenNames) - | SynPat.IsInst(cty,m) - | SynPat.Named (SynPat.IsInst(cty,m),_,_,_,_) -> + | SynPat.IsInst(cty, m) + | SynPat.Named (SynPat.IsInst(cty, m), _, _, _, _) -> let srcTy = ty - let tgty,tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType env tpenv cty + let tgty, tpenv = TcTypeAndRecover cenv NewTyparsOKButWarnIfNotRigid CheckCxs ItemOccurence.UseInType env tpenv cty TcRuntimeTypeTest (*isCast*)false (*isOperator*)true cenv env.DisplayEnv m tgty srcTy match pat with - | SynPat.IsInst(_,m) -> - (fun _ -> TPat_isinst (srcTy,tgty,None,m)),(tpenv,names,takenNames) - | SynPat.Named (SynPat.IsInst _,id,isMemberThis,vis,m) -> - let bindf,names,takenNames = TcPatBindingName cenv env id tgty isMemberThis vis None vFlags (names,takenNames) - (fun values -> TPat_isinst (srcTy,tgty,Some(bindf values),m)), - (tpenv,names,takenNames) + | SynPat.IsInst(_, m) -> + (fun _ -> TPat_isinst (srcTy, tgty, None, m)), (tpenv, names, takenNames) + | SynPat.Named (SynPat.IsInst _, id, isMemberThis, vis, m) -> + let bindf, names, takenNames = TcPatBindingName cenv env id tgty isMemberThis vis None vFlags (names, takenNames) + (fun values -> TPat_isinst (srcTy, tgty, Some(bindf values), m)), + (tpenv, names, takenNames) | _ -> failwith "TcPat" - | SynPat.OptionalVal (_,m) -> - error(Error(FSComp.SR.tcOptionalArgsOnlyOnMembers(),m)) + | SynPat.OptionalVal (_, m) -> + error(Error(FSComp.SR.tcOptionalArgsOnlyOnMembers(), m)) - | SynPat.Named (p,id,isMemberThis,vis,m) -> - let bindf,names,takenNames = TcPatBindingName cenv env id ty isMemberThis vis topValInfo vFlags (names,takenNames) - let pat',acc = TcPat warnOnUpper cenv env None vFlags (tpenv,names,takenNames) ty p - (fun values -> TPat_as (pat' values,bindf values,m)), + | SynPat.Named (p, id, isMemberThis, vis, m) -> + let bindf, names, takenNames = TcPatBindingName cenv env id ty isMemberThis vis topValInfo vFlags (names, takenNames) + let pat', acc = TcPat warnOnUpper cenv env None vFlags (tpenv, names, takenNames) ty p + (fun values -> TPat_as (pat' values, bindf values, m)), acc - | SynPat.Typed (p,cty,m) -> - let cty',tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + | SynPat.Typed (p, cty, m) -> + let cty', tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty UnifyTypes cenv env m ty cty' - TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty p + TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p - | SynPat.Attrib (_,_,m) -> - error(Error(FSComp.SR.tcAttributesInvalidInPatterns(),m)) + | SynPat.Attrib (_, _, m) -> + error(Error(FSComp.SR.tcAttributesInvalidInPatterns(), m)) - | SynPat.Or (pat1,pat2,m) -> - let pat1',(tpenv,names1,takenNames1) = TcPat warnOnUpper cenv env None vFlags (tpenv,names,takenNames) ty pat1 - let pat2',(tpenv,names2,takenNames2) = TcPat warnOnUpper cenv env None vFlags (tpenv,names,takenNames) ty pat2 + | SynPat.Or (pat1, pat2, m) -> + let pat1', (tpenv, names1, takenNames1) = TcPat warnOnUpper cenv env None vFlags (tpenv, names, takenNames) ty pat1 + let pat2', (tpenv, names2, takenNames2) = TcPat warnOnUpper cenv env None vFlags (tpenv, names, takenNames) ty pat2 if not (takenNames1 = takenNames2) then // We don't try to recover from this error since we get later bad internal errors during pattern // matching error (UnionPatternsBindDifferentNames m) - names1 |> Map.iter (fun _ (PrelimValScheme1(id1,_,ty1,_,_,_,_,_,_,_,_)) -> + names1 |> Map.iter (fun _ (PrelimValScheme1(id1, _, ty1, _, _, _, _, _, _, _, _)) -> match Map.tryFind id1.idText names2 with | None -> () - | Some (PrelimValScheme1(_,_,ty2,_,_,_,_,_,_,_,_)) -> + | Some (PrelimValScheme1(_, _, ty2, _, _, _, _, _, _, _, _)) -> UnifyTypes cenv env m ty1 ty2) - (fun values -> TPat_disjs ([pat1' values;pat2' values.RightPath],m)), (tpenv,names1,takenNames1) + (fun values -> TPat_disjs ([pat1' values;pat2' values.RightPath], m)), (tpenv, names1, takenNames1) - | SynPat.Ands (pats,m) -> - let pats',acc = TcPatterns warnOnUpper cenv env vFlags (tpenv,names,takenNames) (List.map (fun _ -> ty) pats) pats - (fun values -> TPat_conjs(List.map (fun f -> f values) pats',m)), acc + | SynPat.Ands (pats, m) -> + let pats', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) (List.map (fun _ -> ty) pats) pats + (fun values -> TPat_conjs(List.map (fun f -> f values) pats', m)), acc - | SynPat.LongIdent (LongIdentWithDots(longId,_),_,tyargs,args,vis,m) -> - if Option.isSome tyargs then errorR(Error(FSComp.SR.tcInvalidTypeArgumentUsage(),m)) + | SynPat.LongIdent (LongIdentWithDots(longId, _), _, tyargs, args, vis, m) -> + if Option.isSome tyargs then errorR(Error(FSComp.SR.tcInvalidTypeArgumentUsage(), m)) let warnOnUpperForId = match args with | SynConstructorArgs.Pats [] -> warnOnUpper @@ -5158,61 +5158,61 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat match args with | SynConstructorArgs.Pats args -> args.Length | SynConstructorArgs.NamePatPairs (pairs, _) -> pairs.Length - if nargs <> 0 then error(Error(FSComp.SR.tcLiteralDoesNotTakeArguments(),m)) + if nargs <> 0 then error(Error(FSComp.SR.tcLiteralDoesNotTakeArguments(), m)) match ResolvePatternLongIdent cenv.tcSink cenv.nameResolver warnOnUpperForId false m ad env.eNameResEnv TypeNameResolutionInfo.Default longId with | Item.NewDef id -> match args with | SynConstructorArgs.Pats [] - | SynConstructorArgs.NamePatPairs ([], _)-> TcPat warnOnUpperForId cenv env topValInfo vFlags (tpenv,names,takenNames) ty (mkSynPatVar vis id) - | _ -> error (UndefinedName(0,FSComp.SR.undefinedNamePatternDiscriminator,id,NoSuggestions)) + | SynConstructorArgs.NamePatPairs ([], _)-> TcPat warnOnUpperForId cenv env topValInfo vFlags (tpenv, names, takenNames) ty (mkSynPatVar vis id) + | _ -> error (UndefinedName(0, FSComp.SR.undefinedNamePatternDiscriminator, id, NoSuggestions)) - | Item.ActivePatternCase(APElemRef(apinfo,vref,idx)) as item -> - let args = match args with SynConstructorArgs.Pats args -> args | _ -> error(Error(FSComp.SR.tcNamedActivePattern(apinfo.ActiveTags.[idx]),m)) + | Item.ActivePatternCase(APElemRef(apinfo, vref, idx)) as item -> + let args = match args with SynConstructorArgs.Pats args -> args | _ -> error(Error(FSComp.SR.tcNamedActivePattern(apinfo.ActiveTags.[idx]), m)) // TOTAL/PARTIAL ACTIVE PATTERNS let _, vexp, _, _, tinst, _ = TcVal true cenv env tpenv vref None None m let vexp = MakeApplicableExprWithFlex cenv env vexp let vexpty = vexp.Type - let activePatArgsAsSynPats,patarg = + let activePatArgsAsSynPats, patarg = match args with - | [] -> [],SynPat.Const(SynConst.Unit,m) + | [] -> [], SynPat.Const(SynConst.Unit, m) | _ -> // This bit of type-directed analysis ensures that parameterized partial active patterns returning unit do not need to take an argument // See FSharp 1.0 3502 - let dtys,rty = stripFunTy cenv.g vexpty + let dtys, rty = stripFunTy cenv.g vexpty if dtys.Length = args.Length + 1 && isOptionTy cenv.g rty && isUnitTy cenv.g (destOptionTy cenv.g rty) then - args,SynPat.Const(SynConst.Unit,m) + args, SynPat.Const(SynConst.Unit, m) else List.frontAndBack args if not (isNil activePatArgsAsSynPats) && apinfo.ActiveTags.Length <> 1 then - error(Error(FSComp.SR.tcRequireActivePatternWithOneResult(),m)) + error(Error(FSComp.SR.tcRequireActivePatternWithOneResult(), m)) // Parse the arguments to an active pattern // Note we parse arguments to parameterized pattern labels as patterns, not expressions. // This means the range of syntactic expression forms that can be used here is limited. let rec convSynPatToSynExpr x = match x with - | SynPat.FromParseError(p,_) -> convSynPatToSynExpr p - | SynPat.Const (c,m) -> SynExpr.Const(c,m) - | SynPat.Named (SynPat.Wild _,id,_,None,_) -> SynExpr.Ident(id) - | SynPat.Typed (p,cty,m) -> SynExpr.Typed (convSynPatToSynExpr p,cty,m) - | SynPat.LongIdent (LongIdentWithDots(longId,dotms) as lidwd,_,_tyargs,args,None,m) -> + | SynPat.FromParseError(p, _) -> convSynPatToSynExpr p + | SynPat.Const (c, m) -> SynExpr.Const(c, m) + | SynPat.Named (SynPat.Wild _, id, _, None, _) -> SynExpr.Ident(id) + | SynPat.Typed (p, cty, m) -> SynExpr.Typed (convSynPatToSynExpr p, cty, m) + | SynPat.LongIdent (LongIdentWithDots(longId, dotms) as lidwd, _, _tyargs, args, None, m) -> let args = match args with SynConstructorArgs.Pats args -> args | _ -> failwith "impossible: active patterns can be used only with SynConstructorArgs.Pats" let e = if dotms.Length = longId.Length then - let e = SynExpr.LongIdent(false,LongIdentWithDots(longId, List.take (dotms.Length - 1) dotms),None,m) + let e = SynExpr.LongIdent(false, LongIdentWithDots(longId, List.take (dotms.Length - 1) dotms), None, m) SynExpr.DiscardAfterMissingQualificationAfterDot(e, unionRanges e.Range (List.last dotms)) - else SynExpr.LongIdent(false,lidwd,None,m) + else SynExpr.LongIdent(false, lidwd, None, m) List.fold (fun f x -> mkSynApp1 f (convSynPatToSynExpr x) m) e args - | SynPat.Tuple (args,m) -> SynExpr.Tuple(List.map convSynPatToSynExpr args,[],m) - | SynPat.Paren (p,_) -> convSynPatToSynExpr p - | SynPat.ArrayOrList (isArray,args,m) -> SynExpr.ArrayOrList(isArray,List.map convSynPatToSynExpr args,m) - | SynPat.QuoteExpr (e,_) -> e + | SynPat.Tuple (args, m) -> SynExpr.Tuple(List.map convSynPatToSynExpr args, [], m) + | SynPat.Paren (p, _) -> convSynPatToSynExpr p + | SynPat.ArrayOrList (isArray, args, m) -> SynExpr.ArrayOrList(isArray, List.map convSynPatToSynExpr args, m) + | SynPat.QuoteExpr (e, _) -> e | SynPat.Null m -> SynExpr.Null(m) - | _ -> error(Error(FSComp.SR.tcInvalidArgForParameterizedPattern(),x.Range)) + | _ -> error(Error(FSComp.SR.tcInvalidArgForParameterizedPattern(), x.Range)) let activePatArgsAsSynExprs = List.map convSynPatToSynExpr activePatArgsAsSynPats let activePatResTys = NewInferenceTypes apinfo.Names @@ -5221,23 +5221,23 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat let delayed = activePatArgsAsSynExprs |> List.map (fun arg -> DelayedApp(ExprAtomicFlag.NonAtomic, arg, unionRanges (rangeOfLid longId) arg.Range)) let activePatExpr, tpenv = PropagateThenTcDelayed cenv activePatType env tpenv m vexp vexpty ExprAtomicFlag.NonAtomic delayed - if idx >= activePatResTys.Length then error(Error(FSComp.SR.tcInvalidIndexIntoActivePatternArray(),m)) + if idx >= activePatResTys.Length then error(Error(FSComp.SR.tcInvalidIndexIntoActivePatternArray(), m)) let argty = List.item idx activePatResTys - let arg',(tpenv,names,takenNames) = TcPat warnOnUpper cenv env None vFlags (tpenv,names,takenNames) argty patarg + let arg', (tpenv, names, takenNames) = TcPat warnOnUpper cenv env None vFlags (tpenv, names, takenNames) argty patarg // The identity of an active pattern consists of its value and the types it is applied to. // If there are any expression args then we've lost identity. let activePatIdentity = if isNil activePatArgsAsSynExprs then Some (vref, tinst) else None (fun values -> // Report information about the 'active recognizer' occurrence to IDE - CallNameResolutionSink cenv.tcSink (rangeOfLid longId,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Pattern,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (rangeOfLid longId, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.eAccessRights) TPat_query((activePatExpr, activePatResTys, activePatIdentity, idx, apinfo), arg' values, m)), - (tpenv,names,takenNames) + (tpenv, names, takenNames) | (Item.UnionCase _ | Item.ExnCase _) as item -> // DATA MATCH CONSTRUCTORS - let mkf,argtys, argNames = ApplyUnionCaseOrExnTypesForPat m cenv env ty item + let mkf, argtys, argNames = ApplyUnionCaseOrExnTypesForPat m cenv env ty item let nargtys = argtys.Length let args = @@ -5255,7 +5255,7 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat | None -> let caseName = match item with - | Item.UnionCase(uci,_) -> uci.Name + | Item.UnionCase(uci, _) -> uci.Name | Item.ExnCase tcref -> tcref.DisplayName | _ -> failwith "impossible" error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(caseName, id.idText), id.idRange)) @@ -5264,11 +5264,11 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat | null -> result.[idx] <- pat let argContainerOpt = match item with - | Item.UnionCase(uci,_) -> Some(ArgumentContainer.UnionCase(uci)) + | Item.UnionCase(uci, _) -> Some(ArgumentContainer.UnionCase(uci)) | Item.ExnCase tref -> Some(ArgumentContainer.Type(tref)) | _ -> None let argItem = Item.ArgName (argNames.[idx], argtys.[idx], argContainerOpt) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,argItem,argItem,emptyTyparInst,ItemOccurence.Pattern,env.DisplayEnv,ad) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, argItem, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, ad) | _ -> error(Error(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce(id.idText), id.idRange)) for i = 0 to nargtys - 1 do @@ -5283,39 +5283,39 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat match args with | []-> [] // note: the next will always be parenthesized - | [SynPatErrorSkip(SynPat.Tuple (args,_)) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Tuple (args,_)),_))] when nargtys > 1 -> args + | [SynPatErrorSkip(SynPat.Tuple (args, _)) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Tuple (args, _)), _))] when nargtys > 1 -> args // note: we allow both 'C _' and 'C (_)' regardless of number of argument of the pattern - | [SynPatErrorSkip(SynPat.Wild _ as e) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Wild _ as e),_))] -> Array.toList (Array.create nargtys e) + | [SynPatErrorSkip(SynPat.Wild _ as e) | SynPatErrorSkip(SynPat.Paren(SynPatErrorSkip(SynPat.Wild _ as e), _))] -> Array.toList (Array.create nargtys e) | [arg] -> [arg] - | _ when nargtys = 0 -> error(Error(FSComp.SR.tcUnionCaseDoesNotTakeArguments(),m)) - | _ when nargtys = 1 -> error(Error(FSComp.SR.tcUnionCaseRequiresOneArgument(),m)) - | _ -> error(Error(FSComp.SR.tcUnionCaseExpectsTupledArguments(nargtys),m)) + | _ when nargtys = 0 -> error(Error(FSComp.SR.tcUnionCaseDoesNotTakeArguments(), m)) + | _ when nargtys = 1 -> error(Error(FSComp.SR.tcUnionCaseRequiresOneArgument(), m)) + | _ -> error(Error(FSComp.SR.tcUnionCaseExpectsTupledArguments(nargtys), m)) UnionCaseOrExnCheck env nargtys args.Length m - let args',acc = TcPatterns warnOnUpper cenv env vFlags (tpenv,names,takenNames) argtys args + let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) argtys args (fun values -> // Report information about the case occurrence to IDE - CallNameResolutionSink cenv.tcSink (rangeOfLid longId,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Pattern,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (rangeOfLid longId, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.eAccessRights) mkf m (List.map (fun f -> f values) args')), acc | Item.ILField finfo -> // LITERAL .NET FIELDS CheckILFieldInfoAccessible cenv.g cenv.amap m env.eAccessRights finfo - if not finfo.IsStatic then errorR (Error (FSComp.SR.tcFieldIsNotStatic(finfo.FieldName),m)) + if not finfo.IsStatic then errorR (Error (FSComp.SR.tcFieldIsNotStatic(finfo.FieldName), m)) CheckILFieldAttributes cenv.g finfo m match finfo.LiteralValue with | None -> error (Error(FSComp.SR.tcFieldNotLiteralCannotBeUsedInPattern(), m)) | Some lit -> checkNoArgsForLiteral() - UnifyTypes cenv env m ty (finfo.FieldType(cenv.amap,m)) + UnifyTypes cenv env m ty (finfo.FieldType(cenv.amap, m)) let c' = TcFieldInit m lit - (fun _ -> TPat_const (c',m)),(tpenv,names,takenNames) + (fun _ -> TPat_const (c', m)), (tpenv, names, takenNames) | Item.RecdField rfinfo -> // LITERAL F# FIELDS CheckRecdFieldInfoAccessible cenv.amap m env.eAccessRights rfinfo - if not rfinfo.IsStatic then errorR (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.Name),m)) + if not rfinfo.IsStatic then errorR (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.Name), m)) CheckRecdFieldInfoAttributes cenv.g rfinfo m |> CommitOperationResult match rfinfo.LiteralValue with | None -> error (Error(FSComp.SR.tcFieldNotLiteralCannotBeUsedInPattern(), m)) @@ -5325,8 +5325,8 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat let item = Item.RecdField(rfinfo) // FUTURE: can we do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (m,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Pattern,env.DisplayEnv,env.AccessRights) - (fun _ -> TPat_const (lit,m)),(tpenv,names,takenNames) + CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Pattern, env.DisplayEnv, env.AccessRights) + (fun _ -> TPat_const (lit, m)), (tpenv, names, takenNames) | Item.Value vref -> match vref.LiteralValue with @@ -5337,69 +5337,69 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) ty pat CheckFSharpAttributes cenv.g vref.Attribs m |> CommitOperationResult checkNoArgsForLiteral() UnifyTypes cenv env m ty vexpty - (fun _ -> TPat_const (lit,m)),(tpenv,names,takenNames) + (fun _ -> TPat_const (lit, m)), (tpenv, names, takenNames) - | _ -> error (Error(FSComp.SR.tcRequireVarConstRecogOrLiteral(),m)) + | _ -> error (Error(FSComp.SR.tcRequireVarConstRecogOrLiteral(), m)) - | SynPat.QuoteExpr(_,m) -> error (Error(FSComp.SR.tcInvalidPattern(),m)) + | SynPat.QuoteExpr(_, m) -> error (Error(FSComp.SR.tcInvalidPattern(), m)) - | SynPat.Tuple (args,m) -> + | SynPat.Tuple (args, m) -> let argtys = NewInferenceTypes args UnifyTypes cenv env m ty (TType_tuple (tupInfoRef, argtys)) - let args',acc = TcPatterns warnOnUpper cenv env vFlags (tpenv,names,takenNames) argtys args - (fun values -> TPat_tuple(tupInfoRef,List.map (fun f -> f values) args',argtys,m)), acc + let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) argtys args + (fun values -> TPat_tuple(tupInfoRef, List.map (fun f -> f values) args', argtys, m)), acc - | SynPat.StructTuple (args,m) -> + | SynPat.StructTuple (args, m) -> let argtys = NewInferenceTypes args UnifyTypes cenv env m ty (TType_tuple (tupInfoStruct, argtys)) - let args',acc = TcPatterns warnOnUpper cenv env vFlags (tpenv,names,takenNames) argtys args - (fun values -> TPat_tuple(tupInfoStruct,List.map (fun f -> f values) args',argtys,m)), acc + let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) argtys args + (fun values -> TPat_tuple(tupInfoStruct, List.map (fun f -> f values) args', argtys, m)), acc - | SynPat.Paren (p,_) -> - TcPat warnOnUpper cenv env None vFlags (tpenv,names,takenNames) ty p + | SynPat.Paren (p, _) -> + TcPat warnOnUpper cenv env None vFlags (tpenv, names, takenNames) ty p - | SynPat.ArrayOrList (isArray,args,m) -> + | SynPat.ArrayOrList (isArray, args, m) -> let argty = NewInferenceType () UnifyTypes cenv env m ty (if isArray then mkArrayType cenv.g argty else Tastops.mkListTy cenv.g argty) - let args',acc = TcPatterns warnOnUpper cenv env vFlags (tpenv,names,takenNames) (List.map (fun _ -> argty) args) args + let args', acc = TcPatterns warnOnUpper cenv env vFlags (tpenv, names, takenNames) (List.map (fun _ -> argty) args) args (fun values -> let args' = List.map (fun f -> f values) args' if isArray then TPat_array(args', argty, m) else List.foldBack (mkConsListPat cenv.g argty) args' (mkNilListPat cenv.g m argty)), acc - | SynPat.Record (flds,m) -> - let tcref,fldsmap,_fldsList = BuildFieldMap cenv env true ty flds m + | SynPat.Record (flds, m) -> + let tcref, fldsmap, _fldsList = BuildFieldMap cenv env true ty flds m // REVIEW: use _fldsList to type check pattern in code order not field defn order - let _,inst,tinst,gtyp = infoOfTyconRef m tcref + let _, inst, tinst, gtyp = infoOfTyconRef m tcref UnifyTypes cenv env m ty gtyp let fields = tcref.TrueInstanceFieldsAsList - let ftys = fields |> List.map (fun fsp -> actualTyOfRecdField inst fsp,fsp) - let fldsmap',acc = - ((tpenv,names,takenNames), ftys) ||> List.mapFold (fun s (ty,fsp) -> + let ftys = fields |> List.map (fun fsp -> actualTyOfRecdField inst fsp, fsp) + let fldsmap', acc = + ((tpenv, names, takenNames), ftys) ||> List.mapFold (fun s (ty, fsp) -> match Map.tryFind fsp.rfield_id.idText fldsmap with | Some v -> TcPat warnOnUpper cenv env None vFlags s ty v - | None -> (fun _ -> TPat_wild m),s) - (fun values -> TPat_recd (tcref,tinst,List.map (fun f -> f values) fldsmap',m)), + | None -> (fun _ -> TPat_wild m), s) + (fun values -> TPat_recd (tcref, tinst, List.map (fun f -> f values) fldsmap', m)), acc - | SynPat.DeprecatedCharRange (c1,c2,m) -> - errorR(Deprecated(FSComp.SR.tcUseWhenPatternGuard(),m)) + | SynPat.DeprecatedCharRange (c1, c2, m) -> + errorR(Deprecated(FSComp.SR.tcUseWhenPatternGuard(), m)) UnifyTypes cenv env m ty (cenv.g.char_ty) - (fun _ -> TPat_range(c1,c2,m)),(tpenv,names,takenNames) + (fun _ -> TPat_range(c1, c2, m)), (tpenv, names, takenNames) | SynPat.Null m -> AddCxTypeMustSupportNull env.DisplayEnv cenv.css m NoTrace ty - (fun _ -> TPat_null m),(tpenv,names,takenNames) + (fun _ -> TPat_null m), (tpenv, names, takenNames) - | SynPat.InstanceMember (_,_,_,_,m) -> - errorR(Error(FSComp.SR.tcIllegalPattern(),pat.Range)) - (fun _ -> TPat_wild m), (tpenv,names,takenNames) - | SynPat.FromParseError (pat,_) -> - suppressErrorReporting (fun () -> TcPatAndRecover warnOnUpper cenv env topValInfo vFlags (tpenv,names,takenNames) (NewErrorType()) pat) + | SynPat.InstanceMember (_, _, _, _, m) -> + errorR(Error(FSComp.SR.tcIllegalPattern(), pat.Range)) + (fun _ -> TPat_wild m), (tpenv, names, takenNames) + | SynPat.FromParseError (pat, _) -> + suppressErrorReporting (fun () -> TcPatAndRecover warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) (NewErrorType()) pat) and TcPatterns warnOnUpper cenv env vFlags s argtys args = assert (List.length args = List.length argtys) - List.mapFold (fun s (ty,pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argtys args) + List.mapFold (fun s (ty, pat) -> TcPat warnOnUpper cenv env None vFlags s ty pat) s (List.zip argtys args) and solveTypAsError cenv denv m ty = @@ -5447,16 +5447,16 @@ and UnifyTypesAndRecover cenv env m expectedTy actualTy = and TcExprOfUnknownType cenv env tpenv expr = let exprty = NewInferenceType () - let expr',tpenv = TcExpr cenv exprty env tpenv expr - expr',exprty,tpenv + let expr', tpenv = TcExpr cenv exprty env tpenv expr + expr', exprty, tpenv and TcExprFlex cenv flex ty (env: TcEnv) tpenv (e: SynExpr) = if flex then let argty = NewInferenceType () AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css e.Range NoTrace ty argty - let e',tpenv = TcExpr cenv argty env tpenv e + let e', tpenv = TcExpr cenv argty env tpenv e let e' = mkCoerceIfNeeded cenv.g ty argty e' - e',tpenv + e', tpenv else TcExpr cenv ty env tpenv e @@ -5491,7 +5491,7 @@ and TcExprNoRecover cenv ty (env: TcEnv) tpenv (expr: SynExpr) = // through TcExprOfUnknownType, TcExpr and TcExprNoRecover and TcExprOfUnknownTypeThen cenv env tpenv expr delayed = let exprty = NewInferenceType () - let expr',tpenv = + let expr', tpenv = try TcExprThen cenv exprty env tpenv expr delayed with e -> @@ -5499,14 +5499,14 @@ and TcExprOfUnknownTypeThen cenv env tpenv expr delayed = errorRecovery e m solveTypAsError cenv env.DisplayEnv m exprty mkThrow m exprty (mkOne cenv.g m), tpenv - expr',exprty,tpenv + expr', exprty, tpenv /// This is used to typecheck legitimate 'main body of constructor' expressions and TcExprThatIsCtorBody safeInitInfo cenv overallTy env tpenv expr = let env = {env with eCtorInfo = Some (InitialExplicitCtorInfo safeInitInfo) } - let expr,tpenv = TcExpr cenv overallTy env tpenv expr + let expr, tpenv = TcExpr cenv overallTy env tpenv expr let expr = CheckAndRewriteObjectCtor cenv.g env expr - expr,tpenv + expr, tpenv /// This is used to typecheck all ordinary expressions including constituent /// parts of ctor. @@ -5525,29 +5525,29 @@ and TcStmtThatCantBeCtorBody cenv env tpenv expr = TcStmt cenv env tpenv expr and TcStmt cenv env tpenv synExpr = - let expr,ty,tpenv = TcExprOfUnknownType cenv env tpenv synExpr + let expr, ty, tpenv = TcExprOfUnknownType cenv env tpenv synExpr let m = synExpr.Range let wasUnit = UnifyUnitType cenv env.DisplayEnv m ty (Some expr) if wasUnit then - expr,tpenv + expr, tpenv else - mkCompGenSequential m expr (mkUnit cenv.g m),tpenv + mkCompGenSequential m expr (mkUnit cenv.g m), tpenv -/// During checking of expressions of the form (x(y)).z(w1,w2) +/// During checking of expressions of the form (x(y)).z(w1, w2) /// keep a stack of things on the right. This lets us recognize /// method applications and other item-based syntax. and TcExprThen cenv overallTy env tpenv synExpr delayed = match synExpr with - | LongOrSingleIdent (isOpt,longId,altNameRefCellOpt,mLongId) -> - if isOpt then errorR(Error(FSComp.SR.tcSyntaxErrorUnexpectedQMark(),mLongId)) + | LongOrSingleIdent (isOpt, longId, altNameRefCellOpt, mLongId) -> + if isOpt then errorR(Error(FSComp.SR.tcSyntaxErrorUnexpectedQMark(), mLongId)) // Check to see if pattern translation decided to use an alternative identifier. match altNameRefCellOpt with - | Some {contents = Decided altId} -> TcExprThen cenv overallTy env tpenv (SynExpr.LongIdent(isOpt,LongIdentWithDots([altId],[]),None,mLongId)) delayed + | Some {contents = Decided altId} -> TcExprThen cenv overallTy env tpenv (SynExpr.LongIdent(isOpt, LongIdentWithDots([altId], []), None, mLongId)) delayed | _ -> TcLongIdentThen cenv overallTy env tpenv longId delayed // f x - | SynExpr.App (hpa,_,func,arg,mFuncAndArg) -> + | SynExpr.App (hpa, _, func, arg, mFuncAndArg) -> TcExprThen cenv overallTy env tpenv func ((DelayedApp (hpa, arg, mFuncAndArg)):: delayed) // e @@ -5557,38 +5557,38 @@ and TcExprThen cenv overallTy env tpenv synExpr delayed = // e1.id1 // e1.id1.id2 // etc. - | SynExpr.DotGet (e1,_,LongIdentWithDots(longId,_),_) -> - TcExprThen cenv overallTy env tpenv e1 ((DelayedDotLookup (longId,synExpr.RangeSansAnyExtraDot))::delayed) + | SynExpr.DotGet (e1, _, LongIdentWithDots(longId, _), _) -> + TcExprThen cenv overallTy env tpenv e1 ((DelayedDotLookup (longId, synExpr.RangeSansAnyExtraDot))::delayed) // e1.[e2] - // e1.[e21,...,e2n] + // e1.[e21, ..., e2n] // etc. - | SynExpr.DotIndexedGet (e1,e2,mDot,mWholeExpr) -> + | SynExpr.DotIndexedGet (e1, e2, mDot, mWholeExpr) -> TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv synExpr e1 e2 delayed // e1.[e2] <- e3 - // e1.[e21,...,e2n] <- e3 + // e1.[e21, ..., e2n] <- e3 // etc. - | SynExpr.DotIndexedSet (e1,e2,_,_,mDot,mWholeExpr) -> + | SynExpr.DotIndexedSet (e1, e2, _, _, mDot, mWholeExpr) -> TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv synExpr e1 e2 delayed | _ -> match delayed with | [] -> TcExprUndelayed cenv overallTy env tpenv synExpr | _ -> - let expr,exprty,tpenv = TcExprUndelayedNoType cenv env tpenv synExpr + let expr, exprty, tpenv = TcExprUndelayedNoType cenv env tpenv synExpr PropagateThenTcDelayed cenv overallTy env tpenv synExpr.Range (MakeApplicableExprNoFlex cenv expr) exprty ExprAtomicFlag.NonAtomic delayed and TcExprs cenv env m tpenv flexes argtys args = - if List.length args <> List.length argtys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argtys), (List.length args)),m)) - (tpenv, List.zip3 flexes argtys args) ||> List.mapFold (fun tpenv (flex,ty,e) -> + if List.length args <> List.length argtys then error(Error(FSComp.SR.tcExpressionCountMisMatch((List.length argtys), (List.length args)), m)) + (tpenv, List.zip3 flexes argtys args) ||> List.mapFold (fun tpenv (flex, ty, e) -> TcExprFlex cenv flex ty env tpenv e) and CheckSuperInit cenv objTy m = // Check the type is not abstract match tryDestAppTy cenv.g objTy with | Some tcref when isAbstractTycon tcref.Deref -> - errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(),m)) + errorR(Error(FSComp.SR.tcAbstractTypeCannotBeInstantiated(), m)) | _ -> () //------------------------------------------------------------------------- @@ -5597,36 +5597,36 @@ and CheckSuperInit cenv objTy m = and TcExprUndelayedNoType cenv env tpenv expr : Expr * TType * _ = let exprty = NewInferenceType () - let expr',tpenv = TcExprUndelayed cenv exprty env tpenv expr - expr',exprty,tpenv + let expr', tpenv = TcExprUndelayed cenv exprty env tpenv expr + expr', exprty, tpenv and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = match expr with - | SynExpr.Paren (expr2,_,_,mWholeExprIncludingParentheses) -> + | SynExpr.Paren (expr2, _, _, mWholeExprIncludingParentheses) -> // We invoke CallExprHasTypeSink for every construct which is atomic in the syntax, i.e. where a '.' immediately following the // construct is a dot-lookup for the result of the construct. - CallExprHasTypeSink cenv.tcSink (mWholeExprIncludingParentheses,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) + CallExprHasTypeSink cenv.tcSink (mWholeExprIncludingParentheses, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) TcExpr cenv overallTy env tpenv expr2 | SynExpr.DotIndexedGet _ | SynExpr.DotIndexedSet _ | SynExpr.TypeApp _ | SynExpr.Ident _ | SynExpr.LongIdent _ | SynExpr.App _ | SynExpr.DotGet _ -> error(Error(FSComp.SR.tcExprUndelayed(), expr.Range)) - | SynExpr.Const (SynConst.String (s,m),_) -> - CallExprHasTypeSink cenv.tcSink (m,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) + | SynExpr.Const (SynConst.String (s, m), _) -> + CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) TcConstStringExpr cenv overallTy env m tpenv s - | SynExpr.Const (c,m) -> - CallExprHasTypeSink cenv.tcSink (m,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) + | SynExpr.Const (c, m) -> + CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) TcConstExpr cenv overallTy env m tpenv c | SynExpr.Lambda _ -> TcIteratedLambdas cenv true env overallTy Set.empty tpenv expr - | SynExpr.Match (spMatch,x,matches,isExnMatch,_m) -> + | SynExpr.Match (spMatch, x, matches, isExnMatch, _m) -> - let x',inputTy,tpenv = TcExprOfUnknownType cenv env tpenv x + let x', inputTy, tpenv = TcExprOfUnknownType cenv env tpenv x let mExpr = x'.Range - let v,e, tpenv = TcAndPatternCompileMatchClauses mExpr mExpr (if isExnMatch then Throw else ThrowIncompleteMatchException) cenv inputTy overallTy env tpenv matches - (mkLet spMatch mExpr v x' e,tpenv) + let v, e, tpenv = TcAndPatternCompileMatchClauses mExpr mExpr (if isExnMatch then Throw else ThrowIncompleteMatchException) cenv inputTy overallTy env tpenv matches + (mkLet spMatch mExpr v x' e, tpenv) // (function[spMatch] pat1 -> expr1 ... | patN -> exprN) // @@ -5638,33 +5638,33 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = // is // Lambda (_arg2, Let (x, _arg2, x)) - | SynExpr.MatchLambda (isExnMatch,argm,clauses,spMatch,m) -> // (spMatch,x,matches,isExnMatch,m) -> + | SynExpr.MatchLambda (isExnMatch, argm, clauses, spMatch, m) -> // (spMatch, x, matches, isExnMatch, m) -> - let domainTy,resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy - let idv1,idve1 = mkCompGenLocal argm (cenv.synArgNameGenerator.New()) domainTy + let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy + let idv1, idve1 = mkCompGenLocal argm (cenv.synArgNameGenerator.New()) domainTy let envinner = ExitFamilyRegion env - let idv2,matchExpr, tpenv = TcAndPatternCompileMatchClauses m argm (if isExnMatch then Throw else ThrowIncompleteMatchException) cenv domainTy resultTy envinner tpenv clauses - let overallExpr = mkMultiLambda m [idv1] ((mkLet spMatch m idv2 idve1 matchExpr),resultTy) - overallExpr,tpenv + let idv2, matchExpr, tpenv = TcAndPatternCompileMatchClauses m argm (if isExnMatch then Throw else ThrowIncompleteMatchException) cenv domainTy resultTy envinner tpenv clauses + let overallExpr = mkMultiLambda m [idv1] ((mkLet spMatch m idv2 idve1 matchExpr), resultTy) + overallExpr, tpenv - | SynExpr.Assert (x,m) -> + | SynExpr.Assert (x, m) -> TcAssertExpr cenv overallTy env m tpenv x - | SynExpr.Fixed (_,m) -> - error(Error(FSComp.SR.tcFixedNotAllowed(),m)) + | SynExpr.Fixed (_, m) -> + error(Error(FSComp.SR.tcFixedNotAllowed(), m)) // e : ty - | SynExpr.Typed (e,cty,m) -> - let tgty,tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty + | SynExpr.Typed (e, cty, m) -> + let tgty, tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv cty UnifyTypes cenv env m overallTy tgty - let e',tpenv = TcExpr cenv overallTy env tpenv e - e',tpenv + let e', tpenv = TcExpr cenv overallTy env tpenv e + e', tpenv // e :? ty - | SynExpr.TypeTest (e,tgty,m) -> - let e',srcTy,tpenv = TcExprOfUnknownType cenv env tpenv e + | SynExpr.TypeTest (e, tgty, m) -> + let e', srcTy, tpenv = TcExprOfUnknownType cenv env tpenv e UnifyTypes cenv env m overallTy cenv.g.bool_ty - let tgty,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty + let tgty, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty TcRuntimeTypeTest (*isCast*)false (*isOperator*)true cenv env.DisplayEnv m tgty srcTy let e' = mkCallTypeTest cenv.g m tgty e' e', tpenv @@ -5672,66 +5672,66 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = // SynExpr.AddressOf is noted in the syntax ast in order to recognize it as concrete type information // during type checking, in particular prior to resolving overloads. This helps distinguish // its use at method calls from the use of the conflicting 'ref' mechanism for passing byref parameters - | SynExpr.AddressOf(byref,e,opm,m) -> + | SynExpr.AddressOf(byref, e, opm, m) -> TcExpr cenv overallTy env tpenv (mkSynPrefix opm m (if byref then "~&" else "~&&") e) - | SynExpr.Upcast (e,_,m) | SynExpr.InferredUpcast (e,m) -> - let e',srcTy,tpenv = TcExprOfUnknownType cenv env tpenv e - let tgty,tpenv = + | SynExpr.Upcast (e, _, m) | SynExpr.InferredUpcast (e, m) -> + let e', srcTy, tpenv = TcExprOfUnknownType cenv env tpenv e + let tgty, tpenv = match expr with - | SynExpr.Upcast (_,tgty,m) -> - let tgty,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty + | SynExpr.Upcast (_, tgty, m) -> + let tgty, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty UnifyTypes cenv env m tgty overallTy - tgty,tpenv + tgty, tpenv | SynExpr.InferredUpcast _ -> - overallTy,tpenv + overallTy, tpenv | _ -> failwith "upcast" TcStaticUpcast cenv env.DisplayEnv m tgty srcTy - mkCoerceExpr(e',tgty,m,srcTy),tpenv + mkCoerceExpr(e', tgty, m, srcTy), tpenv - | SynExpr.Downcast(e,_,m) | SynExpr.InferredDowncast (e,m) -> - let e',srcTy,tpenv = TcExprOfUnknownType cenv env tpenv e - let tgty,tpenv,isOperator = + | SynExpr.Downcast(e, _, m) | SynExpr.InferredDowncast (e, m) -> + let e', srcTy, tpenv = TcExprOfUnknownType cenv env tpenv e + let tgty, tpenv, isOperator = match expr with - | SynExpr.Downcast (_,tgty,m) -> - let tgty,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty + | SynExpr.Downcast (_, tgty, m) -> + let tgty, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tgty UnifyTypes cenv env m tgty overallTy - tgty,tpenv,true - | SynExpr.InferredDowncast _ -> overallTy,tpenv,false + tgty, tpenv, true + | SynExpr.InferredDowncast _ -> overallTy, tpenv, false | _ -> failwith "downcast" TcRuntimeTypeTest (*isCast*)true isOperator cenv env.DisplayEnv m tgty srcTy // TcRuntimeTypeTest ensures tgty is a nominal type. Hence we can insert a check here // based on the nullness semantics of the nominal type. let e' = mkCallUnbox cenv.g m tgty e' - e',tpenv + e', tpenv | SynExpr.Null m -> AddCxTypeMustSupportNull env.DisplayEnv cenv.css m NoTrace overallTy - mkNull m overallTy,tpenv + mkNull m overallTy, tpenv - | SynExpr.Lazy (e,m) -> + | SynExpr.Lazy (e, m) -> let ety = NewInferenceType () UnifyTypes cenv env m overallTy (mkLazyTy cenv.g ety) - let e',tpenv = TcExpr cenv ety env tpenv e + let e', tpenv = TcExpr cenv ety env tpenv e mkLazyDelayed cenv.g m ety (mkUnitDelayLambda cenv.g m e'), tpenv - | SynExpr.Tuple (args,_,m) -> + | SynExpr.Tuple (args, _, m) -> let argtys = UnifyRefTupleType env.eContextInfo cenv env.DisplayEnv m overallTy args // No subsumption at tuple construction let flexes = argtys |> List.map (fun _ -> false) - let args',tpenv = TcExprs cenv env m tpenv flexes argtys args + let args', tpenv = TcExprs cenv env m tpenv flexes argtys args mkRefTupled cenv.g m args' argtys, tpenv - | SynExpr.StructTuple (args,_,m) -> + | SynExpr.StructTuple (args, _, m) -> let argtys = UnifyStructTupleType env.eContextInfo cenv env.DisplayEnv m overallTy args // No subsumption at tuple construction let flexes = argtys |> List.map (fun _ -> false) - let args',tpenv = TcExprs cenv env m tpenv flexes argtys args + let args', tpenv = TcExprs cenv env m tpenv flexes argtys args mkAnyTupled cenv.g m tupInfoStruct args' argtys, tpenv - | SynExpr.ArrayOrList (isArray,args,m) -> - CallExprHasTypeSink cenv.tcSink (m,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) + | SynExpr.ArrayOrList (isArray, args, m) -> + CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) let argty = NewInferenceType () UnifyTypes cenv env m overallTy (if isArray then mkArrayType cenv.g argty else Tastops.mkListTy cenv.g argty) @@ -5744,91 +5744,91 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = first := false env else - { env with eContextInfo = ContextInfo.CollectionElement (isArray,m) } + { env with eContextInfo = ContextInfo.CollectionElement (isArray, m) } - let args',tpenv = List.mapFold (fun tpenv (x:SynExpr) -> TcExprFlex cenv flex argty (getInitEnv x.Range) tpenv x) tpenv args + let args', tpenv = List.mapFold (fun tpenv (x:SynExpr) -> TcExprFlex cenv flex argty (getInitEnv x.Range) tpenv x) tpenv args let expr = - if isArray then Expr.Op(TOp.Array, [argty],args',m) + if isArray then Expr.Op(TOp.Array, [argty], args', m) else List.foldBack (mkCons cenv.g argty) args' (mkNil cenv.g m argty) - expr,tpenv + expr, tpenv - | SynExpr.New (superInit,synObjTy,arg,mNewExpr) -> - let objTy,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use env tpenv synObjTy + | SynExpr.New (superInit, synObjTy, arg, mNewExpr) -> + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.Use env tpenv synObjTy UnifyTypes cenv env mNewExpr overallTy objTy TcNewExpr cenv env tpenv objTy (Some synObjTy.Range) superInit arg mNewExpr - | SynExpr.ObjExpr(objTy,argopt,binds,extraImpls,mNewExpr,m) -> - CallExprHasTypeSink cenv.tcSink (m,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) - TcObjectExpr cenv overallTy env tpenv (objTy,argopt,binds,extraImpls,mNewExpr,m) + | SynExpr.ObjExpr(objTy, argopt, binds, extraImpls, mNewExpr, m) -> + CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) + TcObjectExpr cenv overallTy env tpenv (objTy, argopt, binds, extraImpls, mNewExpr, m) | SynExpr.Record (inherits, optOrigExpr, flds, mWholeExpr) -> - CallExprHasTypeSink cenv.tcSink (mWholeExpr,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) - TcRecdExpr cenv overallTy env tpenv (inherits,optOrigExpr,flds,mWholeExpr) + CallExprHasTypeSink cenv.tcSink (mWholeExpr, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) + TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr) - | SynExpr.While (spWhile,e1,e2,m) -> + | SynExpr.While (spWhile, e1, e2, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty - let e1',tpenv = TcExpr cenv (cenv.g.bool_ty) env tpenv e1 - let e2',tpenv = TcStmt cenv env tpenv e2 - mkWhile cenv.g (spWhile,NoSpecialWhileLoopMarker,e1',e2',m),tpenv + let e1', tpenv = TcExpr cenv (cenv.g.bool_ty) env tpenv e1 + let e2', tpenv = TcStmt cenv env tpenv e2 + mkWhile cenv.g (spWhile, NoSpecialWhileLoopMarker, e1', e2', m), tpenv - | SynExpr.For (spBind,id,start,dir,finish,body,m) -> + | SynExpr.For (spBind, id, start, dir, finish, body, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty - let startExpr ,tpenv = TcExpr cenv (cenv.g.int_ty) env tpenv start - let finishExpr,tpenv = TcExpr cenv (cenv.g.int_ty) env tpenv finish - let idv,_ = mkLocal id.idRange id.idText cenv.g.int_ty + let startExpr , tpenv = TcExpr cenv (cenv.g.int_ty) env tpenv start + let finishExpr, tpenv = TcExpr cenv (cenv.g.int_ty) env tpenv finish + let idv, _ = mkLocal id.idRange id.idText cenv.g.int_ty let envinner = AddLocalVal cenv.tcSink m idv env // notify name resolution sink about loop variable let item = Item.Value(mkLocalValRef idv) CallNameResolutionSink cenv.tcSink (idv.Range, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights) - let bodyExpr,tpenv = TcStmt cenv envinner tpenv body - mkFastForLoop cenv.g (spBind,m,idv,startExpr,dir,finishExpr,bodyExpr), tpenv + let bodyExpr, tpenv = TcStmt cenv envinner tpenv body + mkFastForLoop cenv.g (spBind, m, idv, startExpr, dir, finishExpr, bodyExpr), tpenv | SynExpr.ForEach (spForLoop, SeqExprOnly seqExprOnly, isFromSource, pat, enumSynExpr, bodySynExpr, m) -> assert isFromSource - if seqExprOnly then warning (Error(FSComp.SR.tcExpressionRequiresSequence(),m)) - TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,m,spForLoop) + if seqExprOnly then warning (Error(FSComp.SR.tcExpressionRequiresSequence(), m)) + TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, m, spForLoop) - | SynExpr.CompExpr (isArrayOrList,isNotNakedRefCell,comp,m) -> + | SynExpr.CompExpr (isArrayOrList, isNotNakedRefCell, comp, m) -> let env = ExitFamilyRegion env if not isArrayOrList then match comp with | SynExpr.New _ -> - errorR(Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm(),m)) + errorR(Error(FSComp.SR.tcInvalidObjectExpressionSyntaxForm(), m)) | SimpleSemicolonSequence false _ -> - errorR(Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression(),m)) + errorR(Error(FSComp.SR.tcInvalidObjectSequenceOrRecordExpression(), m)) | _ -> () if not !isNotNakedRefCell && not cenv.g.compilingFslib then - error(Error(FSComp.SR.tcInvalidSequenceExpressionSyntaxForm(),m)) + error(Error(FSComp.SR.tcInvalidSequenceExpressionSyntaxForm(), m)) TcComputationOrSequenceExpression cenv env overallTy m None tpenv comp - | SynExpr.ArrayOrListOfSeqExpr (isArray,comp,m) -> - CallExprHasTypeSink cenv.tcSink (m,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) + | SynExpr.ArrayOrListOfSeqExpr (isArray, comp, m) -> + CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) match comp with - | SynExpr.CompExpr(_,_,(SimpleSemicolonSequence true elems as body),_) -> + | SynExpr.CompExpr(_, _, (SimpleSemicolonSequence true elems as body), _) -> match body with | SimpleSemicolonSequence false _ -> () | _ -> - errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(),m)) + errorR(Deprecated(FSComp.SR.tcExpressionWithIfRequiresParenthesis(), m)) let replacementExpr = if isArray then // This are to improve parsing/processing speed for parser tables by converting to an array blob ASAP let nelems = elems.Length - if nelems > 0 && List.forall (function SynExpr.Const(SynConst.UInt16 _,_) -> true | _ -> false) elems - then SynExpr.Const (SynConst.UInt16s (Array.ofList (List.map (function SynExpr.Const(SynConst.UInt16 x,_) -> x | _ -> failwith "unreachable") elems)), m) - elif nelems > 0 && List.forall (function SynExpr.Const(SynConst.Byte _,_) -> true | _ -> false) elems - then SynExpr.Const (SynConst.Bytes (Array.ofList (List.map (function SynExpr.Const(SynConst.Byte x,_) -> x | _ -> failwith "unreachable") elems), m), m) + if nelems > 0 && List.forall (function SynExpr.Const(SynConst.UInt16 _, _) -> true | _ -> false) elems + then SynExpr.Const (SynConst.UInt16s (Array.ofList (List.map (function SynExpr.Const(SynConst.UInt16 x, _) -> x | _ -> failwith "unreachable") elems)), m) + elif nelems > 0 && List.forall (function SynExpr.Const(SynConst.Byte _, _) -> true | _ -> false) elems + then SynExpr.Const (SynConst.Bytes (Array.ofList (List.map (function SynExpr.Const(SynConst.Byte x, _) -> x | _ -> failwith "unreachable") elems), m), m) else SynExpr.ArrayOrList(isArray, elems, m) else if elems.Length > 500 then - error(Error(FSComp.SR.tcListLiteralMaxSize(),m)) + error(Error(FSComp.SR.tcListLiteralMaxSize(), m)) SynExpr.ArrayOrList(isArray, elems, m) TcExprUndelayed cenv overallTy env tpenv replacementExpr @@ -5839,70 +5839,70 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = let exprty = NewInferenceType () let genEnumTy = mkSeqTy cenv.g genCollElemTy AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genEnumTy exprty - let expr,tpenv = TcExpr cenv exprty env tpenv comp + let expr, tpenv = TcExpr cenv exprty env tpenv comp let expr = mkCoerceIfNeeded cenv.g genEnumTy (tyOfExpr cenv.g expr) expr (if isArray then mkCallSeqToArray else mkCallSeqToList) cenv.g m genCollElemTy // 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. ((if cenv.g.compilingFslib then id else mkCallSeq cenv.g m genCollElemTy) - (mkCoerceExpr(expr,genEnumTy,expr.Range,exprty))),tpenv + (mkCoerceExpr(expr, genEnumTy, expr.Range, exprty))), tpenv | SynExpr.LetOrUse _ -> TcLinearExprs (TcExprThatCanBeCtorBody cenv) cenv env overallTy tpenv false expr (fun x -> x) - | SynExpr.TryWith (e1,_mTryToWith,clauses,mWithToLast,mTryToLast,spTry,spWith) -> - let e1',tpenv = TcExpr cenv overallTy env tpenv e1 + | SynExpr.TryWith (e1, _mTryToWith, clauses, mWithToLast, mTryToLast, spTry, spWith) -> + let e1', tpenv = TcExpr cenv overallTy env tpenv e1 // Compile the pattern twice, once as a List.filter with all succeeding targets returning "1", and once as a proper catch block. - let filterClauses = clauses |> List.map (function (Clause(pat,optWhenExpr,_,m,_)) -> Clause(pat,optWhenExpr,(SynExpr.Const(SynConst.Int32 1,m)),m,SuppressSequencePointAtTarget)) + let filterClauses = clauses |> List.map (function (Clause(pat, optWhenExpr, _, m, _)) -> Clause(pat, optWhenExpr, (SynExpr.Const(SynConst.Int32 1, m)), m, SuppressSequencePointAtTarget)) let checkedFilterClauses, tpenv = TcMatchClauses cenv cenv.g.exn_ty cenv.g.int_ty env tpenv filterClauses let checkedHandlerClauses, tpenv = TcMatchClauses cenv cenv.g.exn_ty overallTy env tpenv clauses - let v1,filter_expr = CompilePatternForMatchClauses cenv env mWithToLast mWithToLast true FailFilter cenv.g.exn_ty cenv.g.int_ty checkedFilterClauses - let v2,handler_expr = CompilePatternForMatchClauses cenv env mWithToLast mWithToLast true Rethrow cenv.g.exn_ty overallTy checkedHandlerClauses - mkTryWith cenv.g (e1',v1,filter_expr,v2,handler_expr,mTryToLast,overallTy,spTry,spWith),tpenv + let v1, filter_expr = CompilePatternForMatchClauses cenv env mWithToLast mWithToLast true FailFilter cenv.g.exn_ty cenv.g.int_ty checkedFilterClauses + let v2, handler_expr = CompilePatternForMatchClauses cenv env mWithToLast mWithToLast true Rethrow cenv.g.exn_ty overallTy checkedHandlerClauses + mkTryWith cenv.g (e1', v1, filter_expr, v2, handler_expr, mTryToLast, overallTy, spTry, spWith), tpenv - | SynExpr.TryFinally (e1,e2,mTryToLast,spTry,spFinally) -> - let e1',tpenv = TcExpr cenv overallTy env tpenv e1 - let e2',tpenv = TcStmt cenv env tpenv e2 - mkTryFinally cenv.g (e1',e2',mTryToLast,overallTy,spTry,spFinally),tpenv + | SynExpr.TryFinally (e1, e2, mTryToLast, spTry, spFinally) -> + let e1', tpenv = TcExpr cenv overallTy env tpenv e1 + let e2', tpenv = TcStmt cenv env tpenv e2 + mkTryFinally cenv.g (e1', e2', mTryToLast, overallTy, spTry, spFinally), tpenv - | SynExpr.JoinIn(e1,mInToken,e2,mAll) -> - errorR(Error(FSComp.SR.parsUnfinishedExpression("in"),mInToken)) - let _,_,tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv e1) - let _,_,tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv e2) - mkDefault(mAll,overallTy), tpenv + | SynExpr.JoinIn(e1, mInToken, e2, mAll) -> + errorR(Error(FSComp.SR.parsUnfinishedExpression("in"), mInToken)) + let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv e1) + let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv e2) + mkDefault(mAll, overallTy), tpenv | SynExpr.ArbitraryAfterError(_debugStr, m) -> //solveTypAsError cenv env.DisplayEnv m overallTy - mkDefault(m,overallTy), tpenv + mkDefault(m, overallTy), tpenv // expr. (already reported as an error) - | SynExpr.DiscardAfterMissingQualificationAfterDot (e1,m) -> - let _,_,tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownTypeThen cenv env tpenv e1 [DelayedDot]) - mkDefault(m,overallTy),tpenv + | SynExpr.DiscardAfterMissingQualificationAfterDot (e1, m) -> + let _, _, tpenv = suppressErrorReporting (fun () -> TcExprOfUnknownTypeThen cenv env tpenv e1 [DelayedDot]) + mkDefault(m, overallTy), tpenv - | SynExpr.FromParseError (e1,m) -> + | SynExpr.FromParseError (e1, m) -> //solveTypAsError cenv env.DisplayEnv m overallTy - let _,tpenv = suppressErrorReporting (fun () -> TcExpr cenv overallTy env tpenv e1) - mkDefault(m,overallTy),tpenv + let _, tpenv = suppressErrorReporting (fun () -> TcExpr cenv overallTy env tpenv e1) + mkDefault(m, overallTy), tpenv - | SynExpr.Sequential (sp,dir,e1,e2,m) -> + | SynExpr.Sequential (sp, dir, e1, e2, m) -> if dir then TcLinearExprs (TcExprThatCanBeCtorBody cenv) cenv env overallTy tpenv false expr (fun x -> x) else // Constructors using "new (...) = then " - let e1',tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv e1 + let e1', tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv e1 if (GetCtorShapeCounter env) <> 1 then - errorR(Error(FSComp.SR.tcExpressionFormRequiresObjectConstructor(),m)) - let e2',tpenv = TcStmtThatCantBeCtorBody cenv env tpenv e2 - Expr.Sequential(e1',e2',ThenDoSeq,sp,m),tpenv + errorR(Error(FSComp.SR.tcExpressionFormRequiresObjectConstructor(), m)) + let e2', tpenv = TcStmtThatCantBeCtorBody cenv env tpenv e2 + Expr.Sequential(e1', e2', ThenDoSeq, sp, m), tpenv - | SynExpr.Do (e1,m) -> + | SynExpr.Do (e1, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty TcStmtThatCantBeCtorBody cenv env tpenv e1 - | SynExpr.IfThenElse (e1,e2,e3opt,spIfToThen,isRecovery,mIfToThen,m) -> - let e1',tpenv = TcExprThatCantBeCtorBody cenv cenv.g.bool_ty env tpenv e1 - let e2',tpenv = + | SynExpr.IfThenElse (e1, e2, e3opt, spIfToThen, isRecovery, mIfToThen, m) -> + let e1', tpenv = TcExprThatCantBeCtorBody cenv cenv.g.bool_ty env tpenv e1 + let e2', tpenv = let env = match env.eContextInfo with | ContextInfo.ElseBranchResult _ -> { env with eContextInfo = ContextInfo.ElseBranchResult e2.Range } @@ -5916,47 +5916,47 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = TcExprThatCanBeCtorBody cenv overallTy env tpenv e2 - let e3',sp2,tpenv = + let e3', sp2, tpenv = match e3opt with | None -> - mkUnit cenv.g mIfToThen,SuppressSequencePointAtTarget, tpenv // the fake 'unit' value gets exactly the same range as spIfToThen + mkUnit cenv.g mIfToThen, SuppressSequencePointAtTarget, tpenv // the fake 'unit' value gets exactly the same range as spIfToThen | Some e3 -> let env = { env with eContextInfo = ContextInfo.ElseBranchResult e3.Range } - let e3',tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv e3 - e3',SequencePointAtTarget,tpenv + let e3', tpenv = TcExprThatCanBeCtorBody cenv overallTy env tpenv e3 + e3', SequencePointAtTarget, tpenv primMkCond spIfToThen SequencePointAtTarget sp2 m overallTy e1' e2' e3', tpenv // This is for internal use in the libraries only - | SynExpr.LibraryOnlyStaticOptimization (constraints,e2,e3,m) -> - let constraints',tpenv = List.mapFold (TcStaticOptimizationConstraint cenv env) tpenv constraints + | SynExpr.LibraryOnlyStaticOptimization (constraints, e2, e3, m) -> + let constraints', tpenv = List.mapFold (TcStaticOptimizationConstraint cenv env) tpenv constraints // Do not force the types of the two expressions to be equal // This means uses of this construct have to be very carefully written - let e2',_, tpenv = TcExprOfUnknownType cenv env tpenv e2 - let e3',tpenv = TcExpr cenv overallTy env tpenv e3 - Expr.StaticOptimization(constraints',e2',e3',m), tpenv + let e2', _, tpenv = TcExprOfUnknownType cenv env tpenv e2 + let e3', tpenv = TcExpr cenv overallTy env tpenv e3 + Expr.StaticOptimization(constraints', e2', e3', m), tpenv /// e1.longId <- e2 - | SynExpr.DotSet (e1,(LongIdentWithDots(longId,_) as lidwd),e2,mStmt) -> + | SynExpr.DotSet (e1, (LongIdentWithDots(longId, _) as lidwd), e2, mStmt) -> if lidwd.ThereIsAnExtraDotAtTheEnd then // just drop rhs on the floor let mExprAndDotLookup = unionRanges e1.Range (rangeOfLid longId) - TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId,mExprAndDotLookup)] + TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId, mExprAndDotLookup)] else let mExprAndDotLookup = unionRanges e1.Range (rangeOfLid longId) - TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId,mExprAndDotLookup); MakeDelayedSet(e2,mStmt)] + TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId, mExprAndDotLookup); MakeDelayedSet(e2, mStmt)] /// e1.longId(e2) <- e3, very rarely used named property setters - | SynExpr.DotNamedIndexedPropertySet (e1,(LongIdentWithDots(longId,_) as lidwd),e2,e3,mStmt) -> + | SynExpr.DotNamedIndexedPropertySet (e1, (LongIdentWithDots(longId, _) as lidwd), e2, e3, mStmt) -> if lidwd.ThereIsAnExtraDotAtTheEnd then // just drop rhs on the floor let mExprAndDotLookup = unionRanges e1.Range (rangeOfLid longId) - TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId,mExprAndDotLookup)] + TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId, mExprAndDotLookup)] else let mExprAndDotLookup = unionRanges e1.Range (rangeOfLid longId) - TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId,mExprAndDotLookup); DelayedApp(ExprAtomicFlag.Atomic, e2, mStmt); MakeDelayedSet(e3,mStmt)] + TcExprThen cenv overallTy env tpenv e1 [DelayedDotLookup(longId, mExprAndDotLookup); DelayedApp(ExprAtomicFlag.Atomic, e2, mStmt); MakeDelayedSet(e3, mStmt)] - | SynExpr.LongIdentSet (lidwd,e2,m) -> + | SynExpr.LongIdentSet (lidwd, e2, m) -> if lidwd.ThereIsAnExtraDotAtTheEnd then // just drop rhs on the floor TcLongIdentThen cenv overallTy env tpenv lidwd [ ] @@ -5964,97 +5964,97 @@ and TcExprUndelayed cenv overallTy env tpenv (expr: SynExpr) = TcLongIdentThen cenv overallTy env tpenv lidwd [ MakeDelayedSet(e2, m) ] // Type.Items(e1) <- e2 - | SynExpr.NamedIndexedPropertySet (lidwd,e1,e2,mStmt) -> + | SynExpr.NamedIndexedPropertySet (lidwd, e1, e2, mStmt) -> if lidwd.ThereIsAnExtraDotAtTheEnd then // just drop rhs on the floor TcLongIdentThen cenv overallTy env tpenv lidwd [ ] else - TcLongIdentThen cenv overallTy env tpenv lidwd [ DelayedApp(ExprAtomicFlag.Atomic, e1, mStmt); MakeDelayedSet(e2,mStmt) ] + TcLongIdentThen cenv overallTy env tpenv lidwd [ DelayedApp(ExprAtomicFlag.Atomic, e1, mStmt); MakeDelayedSet(e2, mStmt) ] - | SynExpr.TraitCall(tps,memSpfn,arg,m) -> - let synTypes = tps |> List.map (fun tp -> SynType.Var(tp,m)) - let (TTrait(_,logicalCompiledName,_,argtys,returnTy,_) as traitInfo),tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv memSpfn m + | SynExpr.TraitCall(tps, memSpfn, arg, m) -> + let synTypes = tps |> List.map (fun tp -> SynType.Var(tp, m)) + let (TTrait(_, logicalCompiledName, _, argtys, returnTy, _) as traitInfo), tpenv = TcPseudoMemberSpec cenv NewTyparsOK env synTypes tpenv memSpfn m if BakedInTraitConstraintNames.Contains logicalCompiledName then - warning(BakedInMemberConstraintName(logicalCompiledName,m)) + warning(BakedInMemberConstraintName(logicalCompiledName, m)) let returnTy = GetFSharpViewOfReturnType cenv.g returnTy - let args,namedCallerArgs = GetMethodArgs arg - if not (isNil namedCallerArgs) then errorR(Error(FSComp.SR.tcNamedArgumentsCannotBeUsedInMemberTraits(),m)) + let args, namedCallerArgs = GetMethodArgs arg + if not (isNil namedCallerArgs) then errorR(Error(FSComp.SR.tcNamedArgumentsCannotBeUsedInMemberTraits(), m)) // Subsumption at trait calls if arguments have nominal type prior to unification of any arguments or return type let flexes = argtys |> List.map (isTyparTy cenv.g >> not) - let args',tpenv = TcExprs cenv env m tpenv flexes argtys args + let args', tpenv = TcExprs cenv env m tpenv flexes argtys args AddCxMethodConstraint env.DisplayEnv cenv.css m NoTrace traitInfo UnifyTypes cenv env m overallTy returnTy Expr.Op(TOp.TraitCall(traitInfo), [], args', m), tpenv - | SynExpr.LibraryOnlyUnionCaseFieldGet (e1,c,n,m) -> - let e1',ty1,tpenv = TcExprOfUnknownType cenv env tpenv e1 - let mkf,ty2 = TcUnionCaseOrExnField cenv env ty1 m c n - ((fun (a,b) n -> mkUnionCaseFieldGetUnproven cenv.g (e1',a,b,n,m)), - (fun a n -> mkExnCaseFieldGet(e1',a,n,m))) + | SynExpr.LibraryOnlyUnionCaseFieldGet (e1, c, n, m) -> + let e1', ty1, tpenv = TcExprOfUnknownType cenv env tpenv e1 + let mkf, ty2 = TcUnionCaseOrExnField cenv env ty1 m c n + ((fun (a, b) n -> mkUnionCaseFieldGetUnproven cenv.g (e1', a, b, n, m)), + (fun a n -> mkExnCaseFieldGet(e1', a, n, m))) UnifyTypes cenv env m overallTy ty2 - mkf n,tpenv + mkf n, tpenv - | SynExpr.LibraryOnlyUnionCaseFieldSet (e1,c,n,e2,m) -> + | SynExpr.LibraryOnlyUnionCaseFieldSet (e1, c, n, e2, m) -> UnifyTypes cenv env m overallTy cenv.g.unit_ty - let e1',ty1,tpenv = TcExprOfUnknownType cenv env tpenv e1 - let mkf,ty2 = TcUnionCaseOrExnField cenv env ty1 m c n - ((fun (a,b) n e2' -> - if not (isUnionCaseFieldMutable cenv.g a n) then errorR(Error(FSComp.SR.tcFieldIsNotMutable(),m)) - mkUnionCaseFieldSet(e1',a,b,n,e2',m)), + let e1', ty1, tpenv = TcExprOfUnknownType cenv env tpenv e1 + let mkf, ty2 = TcUnionCaseOrExnField cenv env ty1 m c n + ((fun (a, b) n e2' -> + if not (isUnionCaseFieldMutable cenv.g a n) then errorR(Error(FSComp.SR.tcFieldIsNotMutable(), m)) + mkUnionCaseFieldSet(e1', a, b, n, e2', m)), (fun a n e2' -> - if not (isExnFieldMutable a n) then errorR(Error(FSComp.SR.tcFieldIsNotMutable(),m)) - mkExnCaseFieldSet(e1',a,n,e2',m))) - let e2',tpenv = TcExpr cenv ty2 env tpenv e2 - mkf n e2',tpenv + if not (isExnFieldMutable a n) then errorR(Error(FSComp.SR.tcFieldIsNotMutable(), m)) + mkExnCaseFieldSet(e1', a, n, e2', m))) + let e2', tpenv = TcExpr cenv ty2 env tpenv e2 + mkf n e2', tpenv - | SynExpr.LibraryOnlyILAssembly (s,tyargs,args,rtys,m) -> + | SynExpr.LibraryOnlyILAssembly (s, tyargs, args, rtys, m) -> let argtys = NewInferenceTypes args - let tyargs',tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tyargs + let tyargs', tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tyargs // No subsumption at uses of IL assembly code let flexes = argtys |> List.map (fun _ -> false) - let args',tpenv = TcExprs cenv env m tpenv flexes argtys args - let rtys',tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv rtys + let args', tpenv = TcExprs cenv env m tpenv flexes argtys args + let rtys', tpenv = TcTypes cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv rtys let returnTy = match rtys' with | [] -> cenv.g.unit_ty | [ returnTy ] -> returnTy - | _ -> error(InternalError("Only zero or one pushed items are permitted in IL assembly code",m)) + | _ -> error(InternalError("Only zero or one pushed items are permitted in IL assembly code", m)) UnifyTypes cenv env m overallTy returnTy - mkAsmExpr(Array.toList s,tyargs',args',rtys',m),tpenv - - | SynExpr.Quote(oper,raw,ast,isFromQueryExpression,m) -> - CallExprHasTypeSink cenv.tcSink (m,env.NameEnv,overallTy, env.DisplayEnv,env.eAccessRights) - TcQuotationExpr cenv overallTy env tpenv (oper,raw,ast,isFromQueryExpression,m) - - | SynExpr.YieldOrReturn ((isTrueYield,_),_,m) - | SynExpr.YieldOrReturnFrom ((isTrueYield,_),_,m) when isTrueYield -> - error(Error(FSComp.SR.tcConstructRequiresListArrayOrSequence(),m)) - | SynExpr.YieldOrReturn ((_,isTrueReturn),_,m) - | SynExpr.YieldOrReturnFrom ((_,isTrueReturn),_,m) when isTrueReturn -> - error(Error(FSComp.SR.tcConstructRequiresComputationExpressions(),m)) - | SynExpr.YieldOrReturn (_,_,m) - | SynExpr.YieldOrReturnFrom (_,_,m) + mkAsmExpr(Array.toList s, tyargs', args', rtys', m), tpenv + + | SynExpr.Quote(oper, raw, ast, isFromQueryExpression, m) -> + CallExprHasTypeSink cenv.tcSink (m, env.NameEnv, overallTy, env.DisplayEnv, env.eAccessRights) + TcQuotationExpr cenv overallTy env tpenv (oper, raw, ast, isFromQueryExpression, m) + + | SynExpr.YieldOrReturn ((isTrueYield, _), _, m) + | SynExpr.YieldOrReturnFrom ((isTrueYield, _), _, m) when isTrueYield -> + error(Error(FSComp.SR.tcConstructRequiresListArrayOrSequence(), m)) + | SynExpr.YieldOrReturn ((_, isTrueReturn), _, m) + | SynExpr.YieldOrReturnFrom ((_, isTrueReturn), _, m) when isTrueReturn -> + error(Error(FSComp.SR.tcConstructRequiresComputationExpressions(), m)) + | SynExpr.YieldOrReturn (_, _, m) + | SynExpr.YieldOrReturnFrom (_, _, m) | SynExpr.ImplicitZero m -> - error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(),m)) - | SynExpr.DoBang (_,m) - | SynExpr.LetOrUseBang (_,_,_,_,_,_,m) -> - error(Error(FSComp.SR.tcConstructRequiresComputationExpression(),m)) + error(Error(FSComp.SR.tcConstructRequiresSequenceOrComputations(), m)) + | SynExpr.DoBang (_, m) + | SynExpr.LetOrUseBang (_, _, _, _, _, _, m) -> + error(Error(FSComp.SR.tcConstructRequiresComputationExpression(), m)) /// Check lambdas as a group, to catch duplicate names in patterns and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = match e with - | SynExpr.Lambda (isMember,isSubsequent,spats,bodyExpr,m) when isMember || isFirst || isSubsequent -> - let domainTy,resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy - let vs, (tpenv,names,takenNames) = TcSimplePats cenv isMember CheckCxs domainTy env (tpenv,Map.empty,takenNames) spats - let envinner,_,vspecMap = MakeAndPublishSimpleVals cenv env m names true + | SynExpr.Lambda (isMember, isSubsequent, spats, bodyExpr, m) when isMember || isFirst || isSubsequent -> + let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m overallTy + let vs, (tpenv, names, takenNames) = TcSimplePats cenv isMember CheckCxs domainTy env (tpenv, Map.empty, takenNames) spats + let envinner, _, vspecMap = MakeAndPublishSimpleVals cenv env m names true let byrefs = vspecMap |> Map.map (fun _ v -> isByrefTy cenv.g v.Type, v) let envinner = if isMember then envinner else ExitFamilyRegion envinner - let bodyExpr,tpenv = TcIteratedLambdas cenv false envinner resultTy takenNames tpenv bodyExpr + let bodyExpr, tpenv = TcIteratedLambdas cenv false envinner resultTy takenNames tpenv bodyExpr // See bug 5758: Non-monotonicity in inference: need to ensure that parameters are never inferred to have byref type, instead it is always declared - byrefs |> Map.iter (fun _ (orig,v) -> - if not orig && isByrefTy cenv.g v.Type then errorR(Error(FSComp.SR.tcParameterInferredByref v.DisplayName,v.Range))) - mkMultiLambda m (List.map (fun nm -> NameMap.find nm vspecMap) vs) (bodyExpr,resultTy),tpenv + byrefs |> Map.iter (fun _ (orig, v) -> + if not orig && isByrefTy cenv.g v.Type then errorR(Error(FSComp.SR.tcParameterInferredByref v.DisplayName, v.Range))) + mkMultiLambda m (List.map (fun nm -> NameMap.find nm vspecMap) vs) (bodyExpr, resultTy), tpenv | e -> // Dive into the expression to check for syntax errors and suppress them if they show. conditionallySuppressErrorReporting (not isFirst && synExprContainsError e) (fun () -> @@ -6068,7 +6068,7 @@ and TcIteratedLambdas cenv isFirst (env: TcEnv) overallTy takenNames tpenv e = // do the right thing in each case. and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArgs delayed = let ad = env.eAccessRights - let e1',e1ty,tpenv = TcExprOfUnknownType cenv env tpenv e1 + let e1', e1ty, tpenv = TcExprOfUnknownType cenv env tpenv e1 // Find the first type in the effective hierarchy that either has a DefaultMember attribute OR // has a member called 'Item' @@ -6104,8 +6104,8 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg let MakeIndexParam vopt = match indexArgs with | [] -> failwith "unexpected empty index list" - | [SynIndexerArg.One h] -> SynExpr.Paren(h,range0,None,idxRange) - | _ -> SynExpr.Paren(SynExpr.Tuple(GetIndexArgs indexArgs @ Option.toList vopt,[],idxRange),range0,None,idxRange) + | [SynIndexerArg.One h] -> SynExpr.Paren(h, range0, None, idxRange) + | _ -> SynExpr.Paren(SynExpr.Tuple(GetIndexArgs indexArgs @ Option.toList vopt, [], idxRange), range0, None, idxRange) let attemptArrayString = if isArray || isString then @@ -6113,39 +6113,39 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg let indexOpPath = ["Microsoft";"FSharp";"Core";"LanguagePrimitives";"IntrinsicFunctions"] let sliceOpPath = ["Microsoft";"FSharp";"Core";"Operators";"OperatorIntrinsics"] let info = - match isString,isArray,wholeExpr with - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.One(SynExpr.Tuple ([_;_] as idxs,_,_))],_,_) -> Some (indexOpPath,"GetArray2D", idxs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.One(SynExpr.Tuple ([_;_;_] as idxs,_,_))],_,_) -> Some (indexOpPath,"GetArray3D", idxs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.One(SynExpr.Tuple ([_;_;_;_] as idxs,_,_))],_,_) -> Some (indexOpPath,"GetArray4D", idxs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.One idx],_,_) -> Some (indexOpPath,"GetArray", [idx]) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.One(SynExpr.Tuple ([_;_] as idxs,_,_))] ,e3,_,_,_) -> Some (indexOpPath,"SetArray2D", (idxs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.One(SynExpr.Tuple ([_;_;_] as idxs,_,_))] ,e3,_,_,_) -> Some (indexOpPath,"SetArray3D", (idxs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.One(SynExpr.Tuple ([_;_;_;_] as idxs,_,_))] ,e3,_,_,_) -> Some (indexOpPath,"SetArray4D", (idxs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.One _],e3,_,_,_) -> Some (indexOpPath,"SetArray", (GetIndexArgs indexArgs @ [e3])) - | true,false,SynExpr.DotIndexedGet(_,[SynIndexerArg.Two _],_,_) -> Some (sliceOpPath,"GetStringSlice", GetIndexArgs indexArgs) - | true,false,SynExpr.DotIndexedGet(_,[SynIndexerArg.One _],_,_) -> Some (indexOpPath,"GetString", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.Two _],_,_) -> Some (sliceOpPath,"GetArraySlice", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.One _;SynIndexerArg.Two _],_,_) -> Some (sliceOpPath,"GetArraySlice2DFixed1", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.Two _;SynIndexerArg.One _],_,_) -> Some (sliceOpPath,"GetArraySlice2DFixed2", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.Two _;SynIndexerArg.Two _],_,_) -> Some (sliceOpPath,"GetArraySlice2D", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _],_,_) -> Some (sliceOpPath,"GetArraySlice3D", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedGet(_,[SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _],_,_) -> Some (sliceOpPath,"GetArraySlice4D", GetIndexArgs indexArgs) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.Two _],e3,_,_,_) -> Some (sliceOpPath,"SetArraySlice", (GetIndexArgs indexArgs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.Two _;SynIndexerArg.Two _],e3,_,_,_) -> Some (sliceOpPath,"SetArraySlice2D", (GetIndexArgs indexArgs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.One _;SynIndexerArg.Two _],e3,_,_,_) -> Some (sliceOpPath,"SetArraySlice2DFixed1", (GetIndexArgs indexArgs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.Two _;SynIndexerArg.One _],e3,_,_,_) -> Some (sliceOpPath,"SetArraySlice2DFixed2", (GetIndexArgs indexArgs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _],e3,_,_,_) -> Some (sliceOpPath,"SetArraySlice3D", (GetIndexArgs indexArgs @ [e3])) - | false,true,SynExpr.DotIndexedSet(_,[SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _],e3,_,_,_) -> Some (sliceOpPath,"SetArraySlice4D", (GetIndexArgs indexArgs @ [e3])) - | _ -> None // error(Error(FSComp.SR.tcInvalidIndexerExpression(),mWholeExpr)) + match isString, isArray, wholeExpr with + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One(SynExpr.Tuple ([_;_] as idxs, _, _))], _, _) -> Some (indexOpPath, "GetArray2D", idxs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One(SynExpr.Tuple ([_;_;_] as idxs, _, _))], _, _) -> Some (indexOpPath, "GetArray3D", idxs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One(SynExpr.Tuple ([_;_;_;_] as idxs, _, _))], _, _) -> Some (indexOpPath, "GetArray4D", idxs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One idx], _, _) -> Some (indexOpPath, "GetArray", [idx]) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One(SynExpr.Tuple ([_;_] as idxs, _, _))] , e3, _, _, _) -> Some (indexOpPath, "SetArray2D", (idxs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One(SynExpr.Tuple ([_;_;_] as idxs, _, _))] , e3, _, _, _) -> Some (indexOpPath, "SetArray3D", (idxs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One(SynExpr.Tuple ([_;_;_;_] as idxs, _, _))] , e3, _, _, _) -> Some (indexOpPath, "SetArray4D", (idxs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One _], e3, _, _, _) -> Some (indexOpPath, "SetArray", (GetIndexArgs indexArgs @ [e3])) + | true, false, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetStringSlice", GetIndexArgs indexArgs) + | true, false, SynExpr.DotIndexedGet(_, [SynIndexerArg.One _], _, _) -> Some (indexOpPath, "GetString", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.One _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice2DFixed1", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.One _], _, _) -> Some (sliceOpPath, "GetArraySlice2DFixed2", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice2D", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice3D", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedGet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], _, _) -> Some (sliceOpPath, "GetArraySlice4D", GetIndexArgs indexArgs) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2D", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.One _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2DFixed1", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.One _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice2DFixed2", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice3D", (GetIndexArgs indexArgs @ [e3])) + | false, true, SynExpr.DotIndexedSet(_, [SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _;SynIndexerArg.Two _], e3, _, _, _) -> Some (sliceOpPath, "SetArraySlice4D", (GetIndexArgs indexArgs @ [e3])) + | _ -> None // error(Error(FSComp.SR.tcInvalidIndexerExpression(), mWholeExpr)) match info with | None -> None - | Some (path,functionName,indexArgs) -> + | Some (path, functionName, indexArgs) -> let operPath = mkSynLidGet mDot path (CompileOpName functionName) - let f,fty,tpenv = TcExprOfUnknownType cenv env tpenv operPath - let domainTy,resultTy = UnifyFunctionType (Some mWholeExpr) cenv env.DisplayEnv mWholeExpr fty + let f, fty, tpenv = TcExprOfUnknownType cenv env tpenv operPath + let domainTy, resultTy = UnifyFunctionType (Some mWholeExpr) cenv env.DisplayEnv mWholeExpr fty UnifyTypes cenv env mWholeExpr domainTy e1ty let f' = buildApp cenv (MakeApplicableExprNoFlex cenv f) fty e1' mWholeExpr - let delayed = List.foldBack (fun idx acc -> DelayedApp(ExprAtomicFlag.Atomic,idx,mWholeExpr) :: acc) indexArgs delayed // atomic, otherwise no ar.[1] <- xyz + let delayed = List.foldBack (fun idx acc -> DelayedApp(ExprAtomicFlag.Atomic, idx, mWholeExpr) :: acc) indexArgs delayed // atomic, otherwise no ar.[1] <- xyz Some (PropagateThenTcDelayed cenv overallTy env tpenv mWholeExpr f' resultTy ExprAtomicFlag.Atomic delayed ) else None @@ -6161,19 +6161,19 @@ and TcIndexerThen cenv env overallTy mWholeExpr mDot tpenv wholeExpr e1 indexArg match wholeExpr with // e1.[e2] | SynExpr.DotIndexedGet _ -> - DelayedDotLookup([ident(nm,mWholeExpr)],mWholeExpr) :: DelayedApp(ExprAtomicFlag.Atomic,MakeIndexParam None,mWholeExpr) :: delayed + DelayedDotLookup([ident(nm, mWholeExpr)], mWholeExpr) :: DelayedApp(ExprAtomicFlag.Atomic, MakeIndexParam None, mWholeExpr) :: delayed // e1.[e2] <- e3 - | SynExpr.DotIndexedSet(_,_,e3,mOfLeftOfSet,_,_) -> + | SynExpr.DotIndexedSet(_, _, e3, mOfLeftOfSet, _, _) -> match indexArgs with - | [SynIndexerArg.One(_)] -> DelayedDotLookup([ident(nm,mOfLeftOfSet)],mOfLeftOfSet) :: DelayedApp(ExprAtomicFlag.Atomic,MakeIndexParam None,mOfLeftOfSet) :: MakeDelayedSet(e3,mWholeExpr) :: delayed - | _ -> DelayedDotLookup([ident("SetSlice",mOfLeftOfSet)],mOfLeftOfSet) :: DelayedApp(ExprAtomicFlag.Atomic,MakeIndexParam (Some e3),mWholeExpr) :: delayed + | [SynIndexerArg.One(_)] -> DelayedDotLookup([ident(nm, mOfLeftOfSet)], mOfLeftOfSet) :: DelayedApp(ExprAtomicFlag.Atomic, MakeIndexParam None, mOfLeftOfSet) :: MakeDelayedSet(e3, mWholeExpr) :: delayed + | _ -> DelayedDotLookup([ident("SetSlice", mOfLeftOfSet)], mOfLeftOfSet) :: DelayedApp(ExprAtomicFlag.Atomic, MakeIndexParam (Some e3), mWholeExpr) :: delayed - | _ -> error(InternalError("unreachable",mWholeExpr)) + | _ -> error(InternalError("unreachable", mWholeExpr)) PropagateThenTcDelayed cenv overallTy env tpenv mDot (MakeApplicableExprNoFlex cenv e1') e1ty ExprAtomicFlag.Atomic delayed else // deprecated constrained lookup - error(Error(FSComp.SR.tcObjectOfIndeterminateTypeUsedRequireTypeConstraint(),mWholeExpr)) + error(Error(FSComp.SR.tcObjectOfIndeterminateTypeUsedRequireTypeConstraint(), mWholeExpr)) /// Check a 'new Type(args)' expression, also an 'inheritedTys declaration in an implicit or explicit class @@ -6184,16 +6184,16 @@ and TcNewExpr cenv env tpenv objTy mObjTyOpt superInit arg mWholeExprOrObjTy = let ad = env.eAccessRights // Handle the case 'new 'a()' if (isTyparTy cenv.g objTy) then - if superInit then error(Error(FSComp.SR.tcCannotInheritFromVariableType(),mWholeExprOrObjTy)) + if superInit then error(Error(FSComp.SR.tcCannotInheritFromVariableType(), mWholeExprOrObjTy)) AddCxTypeMustSupportDefaultCtor env.DisplayEnv cenv.css mWholeExprOrObjTy NoTrace objTy match arg with - | SynExpr.Const (SynConst.Unit,_) -> () - | _ -> errorR(Error(FSComp.SR.tcObjectConstructorsOnTypeParametersCannotTakeArguments(),mWholeExprOrObjTy)) + | SynExpr.Const (SynConst.Unit, _) -> () + | _ -> errorR(Error(FSComp.SR.tcObjectConstructorsOnTypeParametersCannotTakeArguments(), mWholeExprOrObjTy)) - mkCallCreateInstance cenv.g mWholeExprOrObjTy objTy ,tpenv + mkCallCreateInstance cenv.g mWholeExprOrObjTy objTy , tpenv else - if not (isAppTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"),mWholeExprOrObjTy)) + if not (isAppTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"), mWholeExprOrObjTy)) let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mWholeExprOrObjTy ad objTy) TcCtorCall false cenv env tpenv objTy objTy mObjTyOpt item superInit [arg] mWholeExprOrObjTy [] None @@ -6205,13 +6205,13 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a let mItem = match mObjTyOpt with Some m -> m | None -> mWholeCall if isInterfaceTy cenv.g objTy then - error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()),mWholeCall)) + error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()), mWholeCall)) match item, args with - | Item.CtorGroup(methodName,minfos), _ -> - let meths = List.map (fun minfo -> minfo,None) minfos + | Item.CtorGroup(methodName, minfos), _ -> + let meths = List.map (fun minfo -> minfo, None) minfos if isNaked && TypeFeasiblySubsumesType 0 cenv.g cenv.amap mWholeCall cenv.g.system_IDisposable_typ NoCoerce objTy then - warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(),mWholeCall)) + warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(), mWholeCall)) // Check the type is not abstract // skip this check if this ctor call is either 'inherit(...)' or call is located within constructor shape @@ -6219,9 +6219,9 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a then CheckSuperInit cenv objTy mWholeCall let afterResolution = - match mObjTyOpt,afterTcOverloadResolutionOpt with - | _,Some action -> action - | Some mObjTy,None -> ForNewConstructors cenv.tcSink env mObjTy methodName minfos + match mObjTyOpt, afterTcOverloadResolutionOpt with + | _, Some action -> action + | Some mObjTy, None -> ForNewConstructors cenv.tcSink env mObjTy methodName minfos | None, _ -> AfterResolution.DoNothing TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed @@ -6229,12 +6229,12 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a | Item.DelegateCtor typ, [arg] -> // Re-record the name resolution since we now know it's a constructor call match mObjTyOpt with - | Some mObjTy -> CallNameResolutionSink cenv.tcSink (mObjTy,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + | Some mObjTy -> CallNameResolutionSink cenv.tcSink (mObjTy, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) | None -> () TcNewDelegateThen cenv objTy env tpenv mItem mWholeCall typ arg ExprAtomicFlag.NonAtomic delayed | _ -> - error(Error(FSComp.SR.tcSyntaxCanOnlyBeUsedToCreateObjectTypes(if superInit then "inherit" else "new"),mWholeCall)) + error(Error(FSComp.SR.tcSyntaxCanOnlyBeUsedToCreateObjectTypes(if superInit then "inherit" else "new"), mWholeCall)) //------------------------------------------------------------------------- @@ -6243,13 +6243,13 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a // Check a record construction expression and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = - let tcref,tinst = destAppTy cenv.g objTy + let tcref, tinst = destAppTy cenv.g objTy let tycon = tcref.Deref UnifyTypes cenv env m overallTy objTy // Types with implicit constructors can't use record or object syntax: all constructions must go through the implicit constructor if tycon.MembersOfFSharpTyconByName |> NameMultiMap.existsInRange (fun v -> v.IsIncrClassConstructor) then - errorR(Error(FSComp.SR.tcConstructorRequiresCall(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.tcConstructorRequiresCall(tycon.DisplayName), m)) let fspecs = tycon.TrueInstanceFieldsAsList // Freshen types and work out their subtype flexibility @@ -6259,30 +6259,30 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = try fspecs |> List.find (fun fspec -> fspec.Name = fname) with :? KeyNotFoundException -> - error (Error(FSComp.SR.tcUndefinedField(fname, NicePrint.minimalStringOfType env.DisplayEnv objTy),m)) + error (Error(FSComp.SR.tcUndefinedField(fname, NicePrint.minimalStringOfType env.DisplayEnv objTy), m)) let fty = actualTyOfRecdFieldForTycon tycon tinst fspec let flex = not (isTyparTy cenv.g fty) - yield (fname,fexpr,fty,flex) ] + yield (fname, fexpr, fty, flex) ] // Type check and generalize the supplied bindings - let fldsList,tpenv = + let fldsList, tpenv = let env = { env with eContextInfo = ContextInfo.RecordFields } - (tpenv,fldsList) ||> List.mapFold (fun tpenv (fname,fexpr,fty,flex) -> - let fieldExpr,tpenv = TcExprFlex cenv flex fty env tpenv fexpr - (fname,fieldExpr),tpenv) + (tpenv, fldsList) ||> List.mapFold (fun tpenv (fname, fexpr, fty, flex) -> + let fieldExpr, tpenv = TcExprFlex cenv flex fty env tpenv fexpr + (fname, fieldExpr), tpenv) // Add rebindings for unbound field when an "old value" is available // Effect order: mutable fields may get modified by other bindings... let oldFldsList, wrap = match optOrigExpr with | None -> [], id - | Some (_,_,oldve) -> - let wrap,oldveaddr = mkExprAddrOfExpr cenv.g tycon.IsStructOrEnumTycon false NeverMutates oldve None m - let fieldNameUnbound nom = List.forall (fun (name,_) -> name <> nom) fldsList + | Some (_, _, oldve) -> + let wrap, oldveaddr = mkExprAddrOfExpr cenv.g tycon.IsStructOrEnumTycon false NeverMutates oldve None m + let fieldNameUnbound nom = List.forall (fun (name, _) -> name <> nom) fldsList let flds = fspecs |> List.choose (fun rfld -> if fieldNameUnbound rfld.Name && not rfld.IsZeroInit - then Some(rfld.Name, mkRecdFieldGetViaExprAddr (oldveaddr,tcref.MakeNestedRecdFieldRef rfld,tinst,m)) + then Some(rfld.Name, mkRecdFieldGetViaExprAddr (oldveaddr, tcref.MakeNestedRecdFieldRef rfld, tinst, m)) else None) flds, wrap @@ -6293,18 +6293,18 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = // Check all fields are bound fspecs |> List.iter (fun fspec -> - if not (fldsList |> List.exists (fun (fname,_) -> fname = fspec.Name)) then - error(Error(FSComp.SR.tcFieldRequiresAssignment(fspec.rfield_id.idText, fullDisplayTextOfTyconRef tcref),m))) + if not (fldsList |> List.exists (fun (fname, _) -> fname = fspec.Name)) then + error(Error(FSComp.SR.tcFieldRequiresAssignment(fspec.rfield_id.idText, fullDisplayTextOfTyconRef tcref), m))) // Other checks (overlap with above check now clear) let ns1 = NameSet.ofList (List.map fst fldsList) let ns2 = NameSet.ofList (List.map (fun x -> x.rfield_id.idText) fspecs) if Option.isNone optOrigExpr && not (Zset.subset ns2 ns1) then - error (MissingFields(Zset.elements (Zset.diff ns2 ns1),m)) + error (MissingFields(Zset.elements (Zset.diff ns2 ns1), m)) if not (Zset.subset ns1 ns2) then - error (Error(FSComp.SR.tcExtraneousFieldsGivenValues(),m)) + error (Error(FSComp.SR.tcExtraneousFieldsGivenValues(), m)) // Build record let rfrefs = List.map (fst >> mkRecdFieldRef tcref) fldsList @@ -6325,7 +6325,7 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = // '{ recd fields }'. // expr - | Some (old,oldv,_) -> + | Some (old, oldv, _) -> // '{ recd with fields }'. // Assign the first object to a tmp and then construct mkCompGenLet m oldv old expr @@ -6337,48 +6337,48 @@ and TcRecordConstruction cenv overallTy env tpenv optOrigExpr objTy fldsList m = //------------------------------------------------------------------------- and GetNameAndArityOfObjExprBinding _cenv _env b = - let (NormalizedBinding (_,_,_,_,_,_,_,valSynData,pat,rhsExpr,mBinding,_)) = b - let (SynValData(memberFlagsOpt,valSynInfo,_)) = valSynData - match pat,memberFlagsOpt with + let (NormalizedBinding (_, _, _, _, _, _, _, valSynData, pat, rhsExpr, mBinding, _)) = b + let (SynValData(memberFlagsOpt, valSynInfo, _)) = valSynData + match pat, memberFlagsOpt with // This is the normal case for F# 'with member x.M(...) = ...' - | SynPat.InstanceMember(_thisId,memberId,_,None,_),Some memberFlags -> - let logicalMethId = ident (ComputeLogicalName memberId memberFlags,memberId.idRange) - logicalMethId.idText,valSynInfo + | SynPat.InstanceMember(_thisId, memberId, _, None, _), Some memberFlags -> + let logicalMethId = ident (ComputeLogicalName memberId memberFlags, memberId.idRange) + logicalMethId.idText, valSynInfo | _ -> // This is for the deprecated form 'with M(...) = ...' let rec lookPat pat = match pat with - | SynPat.Typed(pat,_,_) -> lookPat pat - | SynPat.FromParseError(pat,_) -> lookPat pat - | SynPat.Named (SynPat.Wild _, id,_,None,_) -> - let (NormalizedBindingRhs(pushedPats,_,_)) = rhsExpr + | SynPat.Typed(pat, _, _) -> lookPat pat + | SynPat.FromParseError(pat, _) -> lookPat pat + | SynPat.Named (SynPat.Wild _, id, _, None, _) -> + let (NormalizedBindingRhs(pushedPats, _, _)) = rhsExpr let infosForExplicitArgs = pushedPats |> List.map SynInfo.InferSynArgInfoFromSimplePats let infosForExplicitArgs = SynInfo.AdjustMemberArgs MemberKind.Member infosForExplicitArgs let infosForExplicitArgs = SynInfo.AdjustArgsForUnitElimination infosForExplicitArgs let argInfos = [SynInfo.selfMetadata] @ infosForExplicitArgs let retInfo = SynInfo.unnamedRetVal //SynInfo.InferSynReturnData pushedRetInfoOpt - let valSynData = SynValInfo(argInfos,retInfo) - (id.idText,valSynData) - | _ -> error(Error(FSComp.SR.tcObjectExpressionsCanOnlyOverrideAbstractOrVirtual(),mBinding)) + let valSynData = SynValInfo(argInfos, retInfo) + (id.idText, valSynData) + | _ -> error(Error(FSComp.SR.tcObjectExpressionsCanOnlyOverrideAbstractOrVirtual(), mBinding)) lookPat pat -and FreshenObjExprAbstractSlot cenv (env: TcEnv) (implty:TType) virtNameAndArityPairs (bind,bindAttribs,bindName,absSlots:(_ * MethInfo) list) = - let (NormalizedBinding (_,_,_,_,_,_,synTyparDecls,_,_,_,mBinding,_)) = bind +and FreshenObjExprAbstractSlot cenv (env: TcEnv) (implty:TType) virtNameAndArityPairs (bind, bindAttribs, bindName, absSlots:(_ * MethInfo) list) = + let (NormalizedBinding (_, _, _, _, _, _, synTyparDecls, _, _, _, mBinding, _)) = bind match absSlots with | [] when not (CompileAsEvent cenv.g bindAttribs) -> let absSlotsByName = List.filter (fst >> fst >> (=) bindName) virtNameAndArityPairs - let getSignature absSlot = (NicePrint.stringOfMethInfo cenv.amap mBinding env.DisplayEnv absSlot).Replace("abstract ","") + let getSignature absSlot = (NicePrint.stringOfMethInfo cenv.amap mBinding env.DisplayEnv absSlot).Replace("abstract ", "") let getDetails (absSlot:MethInfo) = - if absSlot.GetParamTypes(cenv.amap,mBinding,[]) |> List.existsSquared (isAnyTupleTy cenv.g) then + if absSlot.GetParamTypes(cenv.amap, mBinding, []) |> List.existsSquared (isAnyTupleTy cenv.g) then FSComp.SR.tupleRequiredInAbstractMethod() else "" // Compute the argument counts of the member arguments - let _,synValInfo = GetNameAndArityOfObjExprBinding cenv env bind + let _, synValInfo = GetNameAndArityOfObjExprBinding cenv env bind let arity = match SynInfo.AritiesOfArgs synValInfo with | _::x::_ -> x @@ -6397,111 +6397,111 @@ and FreshenObjExprAbstractSlot cenv (env: TcEnv) (implty:TType) virtNameAndArity |> Set.ofList if containsNonAbstractMemberWithSameName then - errorR(ErrorWithSuggestions(FSComp.SR.tcMemberFoundIsNotAbstractOrVirtual(tcref.DisplayName, bindName),mBinding,bindName,suggestVirtualMembers)) + errorR(ErrorWithSuggestions(FSComp.SR.tcMemberFoundIsNotAbstractOrVirtual(tcref.DisplayName, bindName), mBinding, bindName, suggestVirtualMembers)) else - errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound(bindName),mBinding,bindName,suggestVirtualMembers)) - | [(_,absSlot:MethInfo)] -> - errorR(Error(FSComp.SR.tcArgumentArityMismatch(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot),mBinding)) - | (_,absSlot:MethInfo) :: _ -> - errorR(Error(FSComp.SR.tcArgumentArityMismatchOneOverload(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot),mBinding)) + errorR(ErrorWithSuggestions(FSComp.SR.tcNoAbstractOrVirtualMemberFound(bindName), mBinding, bindName, suggestVirtualMembers)) + | [(_, absSlot:MethInfo)] -> + errorR(Error(FSComp.SR.tcArgumentArityMismatch(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding)) + | (_, absSlot:MethInfo) :: _ -> + errorR(Error(FSComp.SR.tcArgumentArityMismatchOneOverload(bindName, List.sum absSlot.NumArgs, arity, getSignature absSlot, getDetails absSlot), mBinding)) None - | [(_,absSlot)] -> + | [(_, absSlot)] -> - let typarsFromAbsSlotAreRigid,typarsFromAbsSlot,argTysFromAbsSlot, retTyFromAbsSlot + let typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot = FreshenAbstractSlot cenv.g cenv.amap mBinding synTyparDecls absSlot // Work out the required type of the member let bindingTy = implty --> (mkMethodTy cenv.g argTysFromAbsSlot retTyFromAbsSlot) - Some(typarsFromAbsSlotAreRigid,typarsFromAbsSlot,bindingTy) + Some(typarsFromAbsSlotAreRigid, typarsFromAbsSlot, bindingTy) | _ -> None -and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo,bind) = +and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo, bind) = // 4a1. normalize the binding (note: needlessly repeating what we've done above) - let (NormalizedBinding(vis,bkind,isInline,isMutable,attrs,doc,synTyparDecls,valSynData,p,bindingRhs,mBinding,spBind)) = bind - let (SynValData(memberFlagsOpt,_,_)) = valSynData + let (NormalizedBinding(vis, bkind, isInline, isMutable, attrs, doc, synTyparDecls, valSynData, p, bindingRhs, mBinding, spBind)) = bind + let (SynValData(memberFlagsOpt, _, _)) = valSynData // 4a2. adjust the binding, especially in the "member" case, a subset of the logic of AnalyzeAndMakeAndPublishRecursiveValue - let bindingRhs,logicalMethId,memberFlags = + let bindingRhs, logicalMethId, memberFlags = let rec lookPat p = - match p,memberFlagsOpt with - | SynPat.FromParseError(pat,_),_ -> lookPat pat - | SynPat.Named (SynPat.Wild _, id,_,_,_),None -> - let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar (ident (CompilerGeneratedName "this",id.idRange))) bindingRhs + match p, memberFlagsOpt with + | SynPat.FromParseError(pat, _), _ -> lookPat pat + | SynPat.Named (SynPat.Wild _, id, _, _, _), None -> + let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar (ident (CompilerGeneratedName "this", id.idRange))) bindingRhs let logicalMethId = id let memberFlags = OverrideMemberFlags MemberKind.Member - bindingRhs,logicalMethId,memberFlags + bindingRhs, logicalMethId, memberFlags - | SynPat.InstanceMember(thisId,memberId,_,_,_),Some memberFlags -> + | SynPat.InstanceMember(thisId, memberId, _, _, _), Some memberFlags -> CheckMemberFlags None NewSlotsOK OverridesOK memberFlags mBinding let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar thisId) bindingRhs - let logicalMethId = ident (ComputeLogicalName memberId memberFlags,memberId.idRange) - bindingRhs,logicalMethId,memberFlags + let logicalMethId = ident (ComputeLogicalName memberId memberFlags, memberId.idRange) + bindingRhs, logicalMethId, memberFlags | _ -> - error(InternalError("unexpected member binding",mBinding)) + error(InternalError("unexpected member binding", mBinding)) lookPat p - let bind = NormalizedBinding (vis,bkind,isInline,isMutable,attrs,doc,synTyparDecls,valSynData,mkSynPatVar vis logicalMethId,bindingRhs,mBinding,spBind) + let bind = NormalizedBinding (vis, bkind, isInline, isMutable, attrs, doc, synTyparDecls, valSynData, mkSynPatVar vis logicalMethId, bindingRhs, mBinding, spBind) // 4b. typecheck the binding let bindingTy = match absSlotInfo with - | Some(_,_,memberTyFromAbsSlot) -> + | Some(_, _, memberTyFromAbsSlot) -> memberTyFromAbsSlot | _ -> implty --> NewInferenceType () - let (CheckedBindingInfo(inlineFlag,bindingAttribs,_,_,ExplicitTyparInfo(_,declaredTypars,_),nameToPrelimValSchemeMap,rhsExpr,_,_,m,_,_,_,_),tpenv) = + let (CheckedBindingInfo(inlineFlag, bindingAttribs, _, _, ExplicitTyparInfo(_, declaredTypars, _), nameToPrelimValSchemeMap, rhsExpr, _, _, m, _, _, _, _), tpenv) = let flex, tpenv = TcNonrecBindingTyparDecls cenv env tpenv bind - TcNormalizedBinding ObjectExpressionOverrideBinding cenv env tpenv bindingTy None NoSafeInitInfo ([],flex) bind + TcNormalizedBinding ObjectExpressionOverrideBinding cenv env tpenv bindingTy None NoSafeInitInfo ([], flex) bind // 4c. generalize the binding - only relevant when implementing a generic virtual method match NameMap.range nameToPrelimValSchemeMap with - | [PrelimValScheme1(id,_,_,_,_,_,_,_,_,_,_)] -> + | [PrelimValScheme1(id, _, _, _, _, _, _, _, _, _, _)] -> let denv = env.DisplayEnv let declaredTypars = match absSlotInfo with - | Some(typarsFromAbsSlotAreRigid,typarsFromAbsSlot,_) -> + | Some(typarsFromAbsSlotAreRigid, typarsFromAbsSlot, _) -> if typarsFromAbsSlotAreRigid then typarsFromAbsSlot else declaredTypars | _ -> declaredTypars // Canonicalize constraints prior to generalization - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denv,m) declaredTypars + GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, m) declaredTypars let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv,m,freeInEnv,false,CanGeneralizeConstrainedTypars,inlineFlag,Some(rhsExpr),declaredTypars,[],bindingTy,false) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv, denv, m, freeInEnv, false, CanGeneralizeConstrainedTypars, inlineFlag, Some(rhsExpr), declaredTypars, [], bindingTy, false) let declaredTypars = ChooseCanonicalDeclaredTyparsAfterInference cenv.g env.DisplayEnv declaredTypars m let generalizedTypars = PlaceTyparsInDeclarationOrder declaredTypars generalizedTypars - (id,memberFlags,(generalizedTypars +-> bindingTy),bindingAttribs,rhsExpr),tpenv + (id, memberFlags, (generalizedTypars +-> bindingTy), bindingAttribs, rhsExpr), tpenv | _ -> - error(Error(FSComp.SR.tcSimpleMethodNameRequired(),m)) + error(Error(FSComp.SR.tcSimpleMethodNameRequired(), m)) and ComputeObjectExprOverrides cenv (env: TcEnv) tpenv impls = // Compute the method sets each implemented type needs to implement - let slotImplSets = DispatchSlotChecking.GetSlotImplSets cenv.infoReader env.DisplayEnv true (impls |> List.map (fun (m,ty,_) -> ty,m)) + let slotImplSets = DispatchSlotChecking.GetSlotImplSets cenv.infoReader env.DisplayEnv true (impls |> List.map (fun (m, ty, _) -> ty, m)) let allImpls = - (impls,slotImplSets) ||> List.map2 (fun (m,ty,binds) implTySet -> + (impls, slotImplSets) ||> List.map2 (fun (m, ty, binds) implTySet -> let binds = binds |> List.map (BindingNormalization.NormalizeBinding ObjExprBinding cenv env) - m, ty,binds,implTySet) + m, ty, binds, implTySet) - let overridesAndVirts,tpenv = - (tpenv,allImpls) ||> List.mapFold (fun tpenv (m,implty,binds, SlotImplSet(reqdSlots,dispatchSlotsKeyed,availPriorOverrides,_) ) -> + let overridesAndVirts, tpenv = + (tpenv, allImpls) ||> List.mapFold (fun tpenv (m, implty, binds, SlotImplSet(reqdSlots, dispatchSlotsKeyed, availPriorOverrides, _) ) -> // Generate extra bindings fo object expressions with bindings using the CLIEvent attribute let binds, bindsAttributes = [ for binding in binds do - let (NormalizedBinding(_,_,_,_,bindingSynAttribs,_,_,valSynData,_,_,_,_)) = binding - let (SynValData(memberFlagsOpt,_,_)) = valSynData + let (NormalizedBinding(_, _, _, _, bindingSynAttribs, _, _, valSynData, _, _, _, _)) = binding + let (SynValData(memberFlagsOpt, _, _)) = valSynData let attrTgt = DeclKind.AllowedAttribTargets memberFlagsOpt ObjectExpressionOverrideBinding let bindingAttribs = TcAttributes cenv env attrTgt bindingSynAttribs yield binding, bindingAttribs @@ -6510,19 +6510,19 @@ and ComputeObjectExprOverrides cenv (env: TcEnv) tpenv impls = |> List.unzip // 2. collect all name/arity of all overrides - let dispatchSlots = reqdSlots |> List.map (fun (RequiredSlot(dispatchSlot,_)) -> dispatchSlot) + let dispatchSlots = reqdSlots |> List.map (fun (RequiredSlot(dispatchSlot, _)) -> dispatchSlot) let virtNameAndArityPairs = dispatchSlots |> List.map (fun virt -> - let vkey = (virt.LogicalName,virt.NumArgs) + let vkey = (virt.LogicalName, virt.NumArgs) //dprintfn "vkey = %A" vkey - (vkey,virt)) + (vkey, virt)) let bindNameAndSynInfoPairs = binds |> List.map (GetNameAndArityOfObjExprBinding cenv env) let bindNames = bindNameAndSynInfoPairs |> List.map fst let bindKeys = - bindNameAndSynInfoPairs |> List.map (fun (name,valSynData) -> + bindNameAndSynInfoPairs |> List.map (fun (name, valSynData) -> // Compute the argument counts of the member arguments let argCounts = (SynInfo.AritiesOfArgs valSynData).Tail //dprintfn "name = %A, argCounts = %A" name argCounts - (name,argCounts)) + (name, argCounts)) // 3. infer must-have types by name/arity let preAssignedVirtsPerBinding = @@ -6533,19 +6533,19 @@ and ComputeObjectExprOverrides cenv (env: TcEnv) tpenv impls = |> List.map (FreshenObjExprAbstractSlot cenv env implty virtNameAndArityPairs) // 4. typecheck/typeinfer/generalizer overrides using this information - let overrides,tpenv = (tpenv,List.zip absSlotInfo binds) ||> List.mapFold (TcObjectExprBinding cenv env implty) + let overrides, tpenv = (tpenv, List.zip absSlotInfo binds) ||> List.mapFold (TcObjectExprBinding cenv env implty) // Convert the syntactic info to actual info let overrides = - (overrides,bindNameAndSynInfoPairs) ||> List.map2 (fun (id:Ident,memberFlags,ty,bindingAttribs,bindingBody) (_,valSynData) -> + (overrides, bindNameAndSynInfoPairs) ||> List.map2 (fun (id:Ident, memberFlags, ty, bindingAttribs, bindingBody) (_, valSynData) -> let partialValInfo = TranslateTopValSynInfo id.idRange (TcAttributes cenv env) valSynData - let tps,_ = tryDestForallTy cenv.g ty + let tps, _ = tryDestForallTy cenv.g ty let valInfo = TranslatePartialArity tps partialValInfo - DispatchSlotChecking.GetObjectExprOverrideInfo cenv.g cenv.amap (implty,id,memberFlags,ty,valInfo,bindingAttribs,bindingBody)) + DispatchSlotChecking.GetObjectExprOverrideInfo cenv.g cenv.amap (implty, id, memberFlags, ty, valInfo, bindingAttribs, bindingBody)) - (m,implty,reqdSlots,dispatchSlotsKeyed,availPriorOverrides,overrides),tpenv) + (m, implty, reqdSlots, dispatchSlotsKeyed, availPriorOverrides, overrides), tpenv) - overridesAndVirts,tpenv + overridesAndVirts, tpenv and CheckSuperType cenv typ m = if typeEquiv cenv.g typ cenv.g.system_Value_typ || @@ -6553,20 +6553,20 @@ and CheckSuperType cenv typ m = typeEquiv cenv.g typ cenv.g.system_Array_typ || typeEquiv cenv.g typ cenv.g.system_MulticastDelegate_typ || typeEquiv cenv.g typ cenv.g.system_Delegate_typ then - error(Error(FSComp.SR.tcPredefinedTypeCannotBeUsedAsSuperType(),m)) + error(Error(FSComp.SR.tcPredefinedTypeCannotBeUsedAsSuperType(), m)) if isErasedType cenv.g typ then - errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(),m)) + errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(), m)) -and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNewExpr,mWholeExpr) = +and TcObjectExpr cenv overallTy env tpenv (synObjTy, argopt, binds, extraImpls, mNewExpr, mWholeExpr) = let mObjTy = synObjTy.Range - let objTy,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy + let objTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synObjTy match tryDestAppTy cenv.g objTy with - | None -> error(Error(FSComp.SR.tcNewMustBeUsedWithNamedType(),mNewExpr)) + | None -> error(Error(FSComp.SR.tcNewMustBeUsedWithNamedType(), mNewExpr)) | Some tcref -> let isRecordTy = isRecdTy cenv.g objTy - if not isRecordTy && not (isInterfaceTy cenv.g objTy) && isSealedTy cenv.g objTy then errorR(Error(FSComp.SR.tcCannotCreateExtensionOfSealedType(),mNewExpr)) + if not isRecordTy && not (isInterfaceTy cenv.g objTy) && isSealedTy cenv.g objTy then errorR(Error(FSComp.SR.tcCannotCreateExtensionOfSealedType(), mNewExpr)) CheckSuperType cenv objTy synObjTy.Range @@ -6582,70 +6582,70 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew // object construction? (isFSharpObjModelTy cenv.g objTy && not (isInterfaceTy cenv.g objTy) && Option.isNone argopt) then - if Option.isSome argopt then error(Error(FSComp.SR.tcNoArgumentsForRecordValue(),mWholeExpr)) - if not (isNil extraImpls) then error(Error(FSComp.SR.tcNoInterfaceImplementationForConstructionExpression(),mNewExpr)) + if Option.isSome argopt then error(Error(FSComp.SR.tcNoArgumentsForRecordValue(), mWholeExpr)) + if not (isNil extraImpls) then error(Error(FSComp.SR.tcNoInterfaceImplementationForConstructionExpression(), mNewExpr)) if isFSharpObjModelTy cenv.g objTy && GetCtorShapeCounter env <> 1 then - error(Error(FSComp.SR.tcObjectConstructionCanOnlyBeUsedInClassTypes(),mNewExpr)) + error(Error(FSComp.SR.tcObjectConstructionCanOnlyBeUsedInClassTypes(), mNewExpr)) let fldsList = binds |> List.map (fun b -> match BindingNormalization.NormalizeBinding ObjExprBinding cenv env b with - | NormalizedBinding (_,_,_,_,[],_,_,_,SynPat.Named(SynPat.Wild _, id,_,_,_),NormalizedBindingRhs(_,_,rhsExpr),_,_) -> id.idText,rhsExpr - | _ -> error(Error(FSComp.SR.tcOnlySimpleBindingsCanBeUsedInConstructionExpressions(),b.RangeOfBindingSansRhs))) + | NormalizedBinding (_, _, _, _, [], _, _, _, SynPat.Named(SynPat.Wild _, id, _, _, _), NormalizedBindingRhs(_, _, rhsExpr), _, _) -> id.idText, rhsExpr + | _ -> error(Error(FSComp.SR.tcOnlySimpleBindingsCanBeUsedInConstructionExpressions(), b.RangeOfBindingSansRhs))) TcRecordConstruction cenv overallTy env tpenv None objTy fldsList mWholeExpr else let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mObjTy ad objTy) if isFSharpObjModelTy cenv.g objTy && GetCtorShapeCounter env = 1 then - error(Error(FSComp.SR.tcObjectsMustBeInitializedWithObjectExpression(),mNewExpr)) + error(Error(FSComp.SR.tcObjectsMustBeInitializedWithObjectExpression(), mNewExpr)) // Work out the type of any interfaces to implement - let extraImpls,tpenv = - (tpenv , extraImpls) ||> List.mapFold (fun tpenv (InterfaceImpl(synIntfTy,overrides,m)) -> - let intfTy,tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synIntfTy + let extraImpls, tpenv = + (tpenv , extraImpls) ||> List.mapFold (fun tpenv (InterfaceImpl(synIntfTy, overrides, m)) -> + let intfTy, tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv synIntfTy if not (isInterfaceTy cenv.g intfTy) then - error(Error(FSComp.SR.tcExpectedInterfaceType(),m)) + error(Error(FSComp.SR.tcExpectedInterfaceType(), m)) if isErasedType cenv.g intfTy then - errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(),m)) - (m,intfTy,overrides),tpenv) + errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(), m)) + (m, intfTy, overrides), tpenv) let realObjTy = if isObjTy cenv.g objTy && not (isNil extraImpls) then (p23 (List.head extraImpls)) else objTy UnifyTypes cenv env mWholeExpr overallTy realObjTy - let ctorCall,baseIdOpt,tpenv = - match item,argopt with - | Item.CtorGroup(methodName,minfos),Some (arg,baseIdOpt) -> - let meths = minfos |> List.map (fun minfo -> minfo,None) + let ctorCall, baseIdOpt, tpenv = + match item, argopt with + | Item.CtorGroup(methodName, minfos), Some (arg, baseIdOpt) -> + let meths = minfos |> List.map (fun minfo -> minfo, None) let afterResolution = ForNewConstructors cenv.tcSink env synObjTy.Range methodName minfos let ad = env.eAccessRights - let expr,tpenv = TcMethodApplicationThen cenv env objTy None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] + let expr, tpenv = TcMethodApplicationThen cenv env objTy None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] // The 'base' value is always bound - let baseIdOpt = (match baseIdOpt with None -> Some(ident("base",mObjTy)) | Some id -> Some(id)) - expr,baseIdOpt,tpenv - | Item.FakeInterfaceCtor intfTy,None -> + let baseIdOpt = (match baseIdOpt with None -> Some(ident("base", mObjTy)) | Some id -> Some(id)) + expr, baseIdOpt, tpenv + | Item.FakeInterfaceCtor intfTy, None -> UnifyTypes cenv env mWholeExpr objTy intfTy let expr = BuildObjCtorCall cenv.g mWholeExpr - expr,None,tpenv - | Item.FakeInterfaceCtor _,Some _ -> - error(Error(FSComp.SR.tcConstructorForInterfacesDoNotTakeArguments(),mNewExpr)) - | Item.CtorGroup _,None -> - error(Error(FSComp.SR.tcConstructorRequiresArguments(),mNewExpr)) - | _ -> error(Error(FSComp.SR.tcNewRequiresObjectConstructor(),mNewExpr)) + expr, None, tpenv + | Item.FakeInterfaceCtor _, Some _ -> + error(Error(FSComp.SR.tcConstructorForInterfacesDoNotTakeArguments(), mNewExpr)) + | Item.CtorGroup _, None -> + error(Error(FSComp.SR.tcConstructorRequiresArguments(), mNewExpr)) + | _ -> error(Error(FSComp.SR.tcNewRequiresObjectConstructor(), mNewExpr)) let baseValOpt = MakeAndPublishBaseVal cenv env baseIdOpt objTy let env = Option.foldBack (AddLocalVal cenv.tcSink mNewExpr) baseValOpt env - let impls = (mWholeExpr,objTy,binds) :: extraImpls + let impls = (mWholeExpr, objTy, binds) :: extraImpls // 1. collect all the relevant abstract slots for each type we have to implement - let overridesAndVirts,tpenv = ComputeObjectExprOverrides cenv env tpenv impls + let overridesAndVirts, tpenv = ComputeObjectExprOverrides cenv env tpenv impls - overridesAndVirts |> List.iter (fun (m,implty,dispatchSlots,dispatchSlotsKeyed,availPriorOverrides,overrides) -> + overridesAndVirts |> List.iter (fun (m, implty, dispatchSlots, dispatchSlotsKeyed, availPriorOverrides, overrides) -> let overrideSpecs = overrides |> List.map fst DispatchSlotChecking.CheckOverridesAreAllUsedOnce (env.DisplayEnv, cenv.g, cenv.amap, true, implty, dispatchSlotsKeyed, availPriorOverrides, overrideSpecs) @@ -6654,15 +6654,15 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew // 6c. create the specs of overrides let allTypeImpls = - overridesAndVirts |> List.map (fun (m,implty,_,dispatchSlotsKeyed,_,overrides) -> + overridesAndVirts |> List.map (fun (m, implty, _, dispatchSlotsKeyed, _, overrides) -> let overrides' = [ for overrideMeth in overrides do - let (Override(_,_, id,(mtps,_),_,_,isFakeEventProperty,_) as ovinfo),(_, thisVal, methodVars, bindingAttribs, bindingBody) = overrideMeth + let (Override(_, _, id, (mtps, _), _, _, isFakeEventProperty, _) as ovinfo), (_, thisVal, methodVars, bindingAttribs, bindingBody) = overrideMeth if not isFakeEventProperty then let searchForOverride = dispatchSlotsKeyed |> NameMultiMap.find id.idText - |> List.tryPick (fun (RequiredSlot(virt,_)) -> + |> List.tryPick (fun (RequiredSlot(virt, _)) -> if DispatchSlotChecking.IsExactMatch cenv.g cenv.amap m virt ovinfo then Some virt else @@ -6671,18 +6671,18 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew let overridden = match searchForOverride with | Some x -> x - | None -> error(Error(FSComp.SR.tcAtLeastOneOverrideIsInvalid(),synObjTy.Range)) + | None -> error(Error(FSComp.SR.tcAtLeastOneOverrideIsInvalid(), synObjTy.Range)) yield TObjExprMethod(overridden.GetSlotSig(cenv.amap, m), bindingAttribs, mtps, [thisVal]::methodVars, bindingBody, id.idRange) ] - (implty,overrides')) + (implty, overrides')) - let (objTy',overrides') = allTypeImpls.Head + let (objTy', overrides') = allTypeImpls.Head let extraImpls = allTypeImpls.Tail // 7. Build the implementation - let expr = mkObjExpr(objTy', baseValOpt, ctorCall, overrides',extraImpls,mWholeExpr) + let expr = mkObjExpr(objTy', baseValOpt, ctorCall, overrides', extraImpls, mWholeExpr) let expr = mkCoerceIfNeeded cenv.g realObjTy objTy' expr - expr,tpenv + expr, tpenv @@ -6694,7 +6694,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew and TcConstStringExpr cenv overallTy env m tpenv s = if (AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css m overallTy cenv.g.string_ty) then - mkString cenv.g m s,tpenv + mkString cenv.g m s, tpenv else let aty = NewInferenceType () let bty = NewInferenceType () @@ -6707,20 +6707,20 @@ and TcConstStringExpr cenv overallTy env m tpenv s = let source = match cenv.tcSink.CurrentSink with None -> None | Some sink -> sink.CurrentSource let normalizedString = (s.Replace("\r\n", "\n").Replace("\r", "\n")) - let (aty',ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s),m))) + let (aty', ety'), specifierLocations = (try CheckFormatStrings.ParseFormatString m cenv.g source normalizedString bty cty dty with Failure s -> error (Error(FSComp.SR.tcUnableToParseFormatString(s), m))) match cenv.tcSink.CurrentSink with | None -> () | Some sink -> - for specifierLocation,numArgs in specifierLocations do + for specifierLocation, numArgs in specifierLocations do sink.NotifyFormatSpecifierLocation(specifierLocation, numArgs) UnifyTypes cenv env m aty aty' UnifyTypes cenv env m ety ety' - mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s),tpenv + mkCallNewFormat cenv.g m aty bty cty dty ety (mkString cenv.g m s), tpenv else UnifyTypes cenv env m overallTy cenv.g.string_ty - mkString cenv.g m s,tpenv + mkString cenv.g m s, tpenv //------------------------------------------------------------------------- // TcConstExpr @@ -6731,40 +6731,40 @@ and TcConstExpr cenv overallTy env m tpenv c = match c with // NOTE: these aren't "really" constants - | SynConst.Bytes (bytes,m) -> + | SynConst.Bytes (bytes, m) -> UnifyTypes cenv env m overallTy (mkByteArrayTy cenv.g) - Expr.Op(TOp.Bytes bytes,[],[],m),tpenv + Expr.Op(TOp.Bytes bytes, [], [], m), tpenv | SynConst.UInt16s arr -> - UnifyTypes cenv env m overallTy (mkArrayType cenv.g cenv.g.uint16_ty); Expr.Op(TOp.UInt16s arr,[],[],m),tpenv + UnifyTypes cenv env m overallTy (mkArrayType cenv.g cenv.g.uint16_ty); Expr.Op(TOp.UInt16s arr, [], [], m), tpenv - | SynConst.UserNum (s,suffix) -> + | SynConst.UserNum (s, suffix) -> let expr = let modName = "NumericLiteral" + suffix let ad = env.eAccessRights - match ResolveLongIndentAsModuleOrNamespace ResultCollectionSettings.AtMostOneResult cenv.amap m OpenQualified env.eNameResEnv ad [ident (modName,m)] with + match ResolveLongIndentAsModuleOrNamespace ResultCollectionSettings.AtMostOneResult cenv.amap m OpenQualified env.eNameResEnv ad [ident (modName, m)] with | Result [] - | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule(modName),m)) - | Result ((_,mref,_) :: _) -> + | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule(modName), m)) + | Result ((_, mref, _) :: _) -> let expr = try match int32 s with - | 0 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromZero",SynExpr.Const(SynConst.Unit,m),m) - | 1 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromOne",SynExpr.Const(SynConst.Unit,m),m) - | i32 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt32",SynExpr.Const(SynConst.Int32 i32,m),m) + | 0 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromZero", SynExpr.Const(SynConst.Unit, m), m) + | 1 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromOne", SynExpr.Const(SynConst.Unit, m), m) + | i32 -> SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt32", SynExpr.Const(SynConst.Int32 i32, m), m) with _ -> try let i64 = int64 s - SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt64",SynExpr.Const(SynConst.Int64 i64,m),m) + SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromInt64", SynExpr.Const(SynConst.Int64 i64, m), m) with _ -> - SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromString",SynExpr.Const(SynConst.String (s,m),m),m) + SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet m [modName] "FromString", SynExpr.Const(SynConst.String (s, m), m), m) if suffix <> "I" then expr else match ccuOfTyconRef mref with | Some ccu when ccuEq ccu cenv.g.fslibCcu -> - SynExpr.Typed(expr,SynType.LongIdent(LongIdentWithDots(pathToSynLid m ["System";"Numerics";"BigInteger"],[])),m) + SynExpr.Typed(expr, SynType.LongIdent(LongIdentWithDots(pathToSynLid m ["System";"Numerics";"BigInteger"], [])), m) | _ -> expr @@ -6772,7 +6772,7 @@ and TcConstExpr cenv overallTy env m tpenv c = | _ -> let c' = TcConst cenv overallTy m env c - Expr.Const (c',m,overallTy),tpenv + Expr.Const (c', m, overallTy), tpenv //------------------------------------------------------------------------- @@ -6784,7 +6784,7 @@ and TcAssertExpr cenv overallTy env (m:range) tpenv x = let synm = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. let callDiagnosticsExpr = SynExpr.App(ExprAtomicFlag.Atomic, false, mkSynLidGet synm ["System";"Diagnostics";"Debug"] "Assert", // wrap an extra parentheses so 'assert(x=1) isn't considered a named argument to a method call - SynExpr.Paren(x,range0,None,synm), synm) + SynExpr.Paren(x, range0, None, synm), synm) TcExpr cenv overallTy env tpenv callDiagnosticsExpr @@ -6799,16 +6799,16 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr let requiresCtor = (GetCtorShapeCounter env = 1) // Get special expression forms for constructors let haveCtor = Option.isSome inherits - let optOrigExpr,tpenv = + let optOrigExpr, tpenv = match optOrigExpr with | None -> None, tpenv | Some (origExpr, _) -> match inherits with - | Some (_,_,mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(),mInherits)) + | Some (_, _, mInherits, _, _) -> error(Error(FSComp.SR.tcInvalidRecordConstruction(), mInherits)) | None -> - let olde,tpenv = TcExpr cenv overallTy env tpenv origExpr - let oldv,oldve = mkCompGenLocal mWholeExpr "inputRecord" overallTy - Some (olde,oldv,oldve), tpenv + let olde, tpenv = TcExpr cenv overallTy env tpenv origExpr + let oldv, oldve = mkCompGenLocal mWholeExpr "inputRecord" overallTy + Some (olde, oldv, oldve), tpenv let hasOrigExpr = Option.isSome optOrigExpr @@ -6828,8 +6828,8 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr match flds with | [] -> [] | _ -> - let tcref,_,fldsList = BuildFieldMap cenv env hasOrigExpr overallTy flds mWholeExpr - let _,_,_,gtyp = infoOfTyconRef mWholeExpr tcref + let tcref, _, fldsList = BuildFieldMap cenv env hasOrigExpr overallTy flds mWholeExpr + let _, _, _, gtyp = infoOfTyconRef mWholeExpr tcref UnifyTypes cenv env mWholeExpr overallTy gtyp [ for n, v in fldsList do @@ -6838,53 +6838,53 @@ and TcRecdExpr cenv overallTy env tpenv (inherits, optOrigExpr, flds, mWholeExpr | None -> () ] if hasOrigExpr && not (isRecdTy cenv.g overallTy) then - errorR(Error(FSComp.SR.tcExpressionFormRequiresRecordTypes(),mWholeExpr)) + errorR(Error(FSComp.SR.tcExpressionFormRequiresRecordTypes(), mWholeExpr)) if requiresCtor || haveCtor then if not (isFSharpObjModelTy cenv.g overallTy) then // Deliberate no-recovery failure here to prevent cascading internal errors - error(Error(FSComp.SR.tcInheritedTypeIsNotObjectModelType(),mWholeExpr)) + error(Error(FSComp.SR.tcInheritedTypeIsNotObjectModelType(), mWholeExpr)) if not requiresCtor then - errorR(Error(FSComp.SR.tcObjectConstructionExpressionCanOnlyImplementConstructorsInObjectModelTypes(),mWholeExpr)) + errorR(Error(FSComp.SR.tcObjectConstructionExpressionCanOnlyImplementConstructorsInObjectModelTypes(), mWholeExpr)) else if isNil flds then let errorInfo = if hasOrigExpr then FSComp.SR.tcEmptyCopyAndUpdateRecordInvalid() else FSComp.SR.tcEmptyRecordInvalid() - error(Error(errorInfo,mWholeExpr)) + error(Error(errorInfo, mWholeExpr)) - if isFSharpObjModelTy cenv.g overallTy then errorR(Error(FSComp.SR.tcTypeIsNotARecordTypeNeedConstructor(),mWholeExpr)) - elif not (isRecdTy cenv.g overallTy) then errorR(Error(FSComp.SR.tcTypeIsNotARecordType(),mWholeExpr)) + if isFSharpObjModelTy cenv.g overallTy then errorR(Error(FSComp.SR.tcTypeIsNotARecordTypeNeedConstructor(), mWholeExpr)) + elif not (isRecdTy cenv.g overallTy) then errorR(Error(FSComp.SR.tcTypeIsNotARecordType(), mWholeExpr)) - let superTy,tpenv = + let superTy, tpenv = match inherits, GetSuperTypeOfType cenv.g cenv.amap mWholeExpr overallTy with - | Some (superTyp,arg,m, _, _), Some realSuperTyp -> + | Some (superTyp, arg, m, _, _), Some realSuperTyp -> // Constructor expression, with an explicit 'inheritedTys clause. Check the inherits clause. - let e,tpenv = TcExpr cenv realSuperTyp env tpenv (SynExpr.New(true,superTyp,arg,m)) + let e, tpenv = TcExpr cenv realSuperTyp env tpenv (SynExpr.New(true, superTyp, arg, m)) Some e, tpenv | None, Some realSuperTyp when requiresCtor -> // Constructor expression, No 'inherited' clause, hence look for a default constructor - let e,tpenv = TcNewExpr cenv env tpenv realSuperTyp None true (SynExpr.Const (SynConst.Unit,mWholeExpr)) mWholeExpr + let e, tpenv = TcNewExpr cenv env tpenv realSuperTyp None true (SynExpr.Const (SynConst.Unit, mWholeExpr)) mWholeExpr Some e, tpenv - | None,_ -> - None,tpenv + | None, _ -> + None, tpenv | _, None -> - errorR(InternalError("Unexpected failure in getting super type",mWholeExpr)) - None,tpenv + errorR(InternalError("Unexpected failure in getting super type", mWholeExpr)) + None, tpenv - let expr,tpenv = TcRecordConstruction cenv overallTy env tpenv optOrigExpr overallTy fldsList mWholeExpr + let expr, tpenv = TcRecordConstruction cenv overallTy env tpenv optOrigExpr overallTy fldsList mWholeExpr let expr = match superTy with | _ when isStructTy cenv.g overallTy -> expr | Some e -> mkCompGenSequential mWholeExpr e expr | None -> expr - expr,tpenv + expr, tpenv //------------------------------------------------------------------------- // TcForEachExpr //------------------------------------------------------------------------- -and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,mWholeExpr,spForLoop) = +and TcForEachExpr cenv overallTy env tpenv (pat, enumSynExpr, bodySynExpr, mWholeExpr, spForLoop) = UnifyTypes cenv env mWholeExpr overallTy cenv.g.unit_ty let mPat = pat.Range @@ -6893,21 +6893,21 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,mWholeEx let mForLoopStart = match spForLoop with SequencePointAtForLoop(mStart) -> mStart | NoSequencePointAtForLoop -> mEnumExpr // Check the expression being enumerated - let enumExpr,enumExprTy,tpenv = TcExprOfUnknownType cenv env tpenv enumSynExpr + let enumExpr, enumExprTy, tpenv = TcExprOfUnknownType cenv env tpenv enumSynExpr // Depending on its type we compile it in different ways let enumElemTy, bodyExprFixup, overallExprFixup, iterationTechnique = match enumExpr with // optimize 'for i in n .. m do' - | Expr.App(Expr.Val(vf,_,_),_,[tyarg],[startExpr;finishExpr],_) + | Expr.App(Expr.Val(vf, _, _), _, [tyarg], [startExpr;finishExpr], _) when valRefEq cenv.g vf cenv.g.range_op_vref && typeEquiv cenv.g tyarg cenv.g.int_ty -> - (cenv.g.int32_ty, (fun _ x -> x), id, Choice1Of3 (startExpr,finishExpr)) + (cenv.g.int32_ty, (fun _ x -> x), id, Choice1Of3 (startExpr, finishExpr)) // optimize 'for i in arr do' | _ when isArray1DTy cenv.g enumExprTy -> - let arrVar,arrExpr = mkCompGenLocal mEnumExpr "arr" enumExprTy - let idxVar,idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty + let arrVar, arrExpr = mkCompGenLocal mEnumExpr "arr" enumExprTy + let idxVar, idxExpr = mkCompGenLocal mPat "idx" cenv.g.int32_ty let elemTy = destArrayTy cenv.g enumExprTy // Evaluate the array index lookup @@ -6917,34 +6917,34 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,mWholeEx let overallExprFixup overallExpr = mkCompGenLet mForLoopStart arrVar enumExpr overallExpr // Ask for a loop over integers for the given range - (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar,mkZero cenv.g mForLoopStart,mkDecr cenv.g mForLoopStart (mkLdlen cenv.g mForLoopStart arrExpr))) + (elemTy, bodyExprFixup, overallExprFixup, Choice2Of3 (idxVar, mkZero cenv.g mForLoopStart, mkDecr cenv.g mForLoopStart (mkLdlen cenv.g mForLoopStart arrExpr))) | _ -> - let enumerableVar,enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy - let enumeratorVar, enumeratorExpr,_,enumElemTy,getEnumExpr,getEnumTy,guardExpr,_,currentExpr = + let enumerableVar, enumerableExprInVar = mkCompGenLocal mEnumExpr "inputSequence" enumExprTy + let enumeratorVar, enumeratorExpr, _, enumElemTy, getEnumExpr, getEnumTy, guardExpr, _, currentExpr = AnalyzeArbitraryExprAsEnumerable cenv env true mEnumExpr enumExprTy enumerableExprInVar - (enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar,enumeratorVar, enumeratorExpr,getEnumExpr,getEnumTy,guardExpr,currentExpr)) + (enumElemTy, (fun _ x -> x), id, Choice3Of3(enumerableVar, enumeratorVar, enumeratorExpr, getEnumExpr, getEnumTy, guardExpr, currentExpr)) - let pat,_,vspecs,envinner,tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat,None) - let elemVar,pat = + let pat, _, vspecs, envinner, tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat, None) + let elemVar, pat = // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to match pat with - | TPat_as (pat1,PBind(v,TypeScheme([],_)),_) -> - v,pat1 + | TPat_as (pat1, PBind(v, TypeScheme([], _)), _) -> + v, pat1 | _ -> - let tmp,_ = mkCompGenLocal pat.Range "forLoopVar" enumElemTy - tmp,pat + let tmp, _ = mkCompGenLocal pat.Range "forLoopVar" enumElemTy + tmp, pat // Check the body of the loop - let bodyExpr,tpenv = TcStmt cenv envinner tpenv bodySynExpr + let bodyExpr, tpenv = TcStmt cenv envinner tpenv bodySynExpr // Add the pattern match compilation let bodyExpr = let valsDefinedByMatching = ListSet.remove valEq elemVar vspecs CompilePatternForMatch - cenv env enumSynExpr.Range pat.Range false IgnoreWithWarning (elemVar,[]) - [TClause(pat,None,TTarget(valsDefinedByMatching,bodyExpr,SequencePointAtTarget),mForLoopStart)] + cenv env enumSynExpr.Range pat.Range false IgnoreWithWarning (elemVar, []) + [TClause(pat, None, TTarget(valsDefinedByMatching, bodyExpr, SequencePointAtTarget), mForLoopStart)] enumElemTy overallTy @@ -6957,15 +6957,15 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,mWholeEx match iterationTechnique with // Build iteration as a for loop - | Choice1Of3(startExpr,finishExpr) -> - mkFastForLoop cenv.g (spForLoop,mWholeExpr,elemVar,startExpr,true,finishExpr,bodyExpr) + | Choice1Of3(startExpr, finishExpr) -> + mkFastForLoop cenv.g (spForLoop, mWholeExpr, elemVar, startExpr, true, finishExpr, bodyExpr) // Build iteration as a for loop with a specific index variable that is not the same as the elemVar - | Choice2Of3(idxVar,startExpr,finishExpr) -> - mkFastForLoop cenv.g (spForLoop,mWholeExpr,idxVar,startExpr,true,finishExpr,bodyExpr) + | Choice2Of3(idxVar, startExpr, finishExpr) -> + mkFastForLoop cenv.g (spForLoop, mWholeExpr, idxVar, startExpr, true, finishExpr, bodyExpr) // Build iteration as a while loop with a try/finally disposal - | Choice3Of3(enumerableVar,enumeratorVar, _,getEnumExpr,_,guardExpr,currentExpr) -> + | Choice3Of3(enumerableVar, enumeratorVar, _, getEnumExpr, _, guardExpr, currentExpr) -> // This compiled for must be matched EXACTLY by CompiledForEachExpr in opt.fs and creflect.fs mkCompGenLet mForLoopStart enumerableVar enumExpr @@ -6975,10 +6975,10 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,mWholeEx (mkTryFinally cenv.g (mkWhile cenv.g (NoSequencePointAtWhileLoop, - WhileLoopForCompiledForEachExprMarker, guardExpr, - mkCompGenLet mForLoopStart elemVar currentExpr bodyExpr, - mForLoopStart), - cleanupE,mForLoopStart,cenv.g.unit_ty,NoSequencePointAtTry,NoSequencePointAtFinally)))) + WhileLoopForCompiledForEachExprMarker, guardExpr, + mkCompGenLet mForLoopStart elemVar currentExpr bodyExpr, + mForLoopStart), + cleanupE, mForLoopStart, cenv.g.unit_ty, NoSequencePointAtTry, NoSequencePointAtFinally)))) let overallExpr = overallExprFixup overallExpr overallExpr, tpenv @@ -6987,23 +6987,23 @@ and TcForEachExpr cenv overallTy env tpenv (pat,enumSynExpr,bodySynExpr,mWholeEx // TcQuotationExpr //------------------------------------------------------------------------- -and TcQuotationExpr cenv overallTy env tpenv (_oper,raw,ast,isFromQueryExpression,m) = +and TcQuotationExpr cenv overallTy env tpenv (_oper, raw, ast, isFromQueryExpression, m) = let astTy = NewInferenceType () // Assert the overall type for the domain of the quotation template UnifyTypes cenv env m overallTy (if raw then mkRawQuotedExprTy cenv.g else mkQuotedExprTy cenv.g astTy) // Check the expression - let expr,tpenv = TcExpr cenv astTy env tpenv ast + let expr, tpenv = TcExpr cenv astTy env tpenv ast // Wrap the expression let expr = Expr.Quote(expr, ref None, isFromQueryExpression, m, overallTy) // Coerce it if needed - let expr = if raw then mkCoerceExpr(expr,(mkRawQuotedExprTy cenv.g),m,(tyOfExpr cenv.g expr)) else expr + let expr = if raw then mkCoerceExpr(expr, (mkRawQuotedExprTy cenv.g), m, (tyOfExpr cenv.g expr)) else expr // We serialize the quoted expression to bytes in IlxGen after type inference etc. is complete. - expr,tpenv + expr, tpenv //------------------------------------------------------------------------- // TcComputationOrSequenceExpression @@ -7011,7 +7011,7 @@ and TcQuotationExpr cenv overallTy env tpenv (_oper,raw,ast,isFromQueryExpressio and TcComputationOrSequenceExpression cenv (env: TcEnv) overallTy m interpValOpt tpenv comp = match interpValOpt with - | Some (interpExpr:Expr,builderTy) -> + | Some (interpExpr:Expr, builderTy) -> TcComputationExpression cenv env overallTy m interpExpr builderTy tpenv comp | None -> TcSequenceExpression cenv env tpenv comp overallTy m @@ -7033,9 +7033,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Give bespoke error messages for the FSharp.Core "query" builder let isQuery = match interpExpr with - | Expr.Val(vf,_,m) -> + | Expr.Val(vf, _, m) -> let item = Item.CustomBuilder (vf.DisplayName, vf) - CallNameResolutionSink cenv.tcSink (m,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) valRefEq cenv.g vf cenv.g.query_value_vref | _ -> false @@ -7044,12 +7044,12 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let m = m.MakeSynthetic() // Mark as synthetic so the language service won't pick it up. let args = match args with - | [] -> SynExpr.Const(SynConst.Unit,m) - | [arg] -> SynExpr.Paren(SynExpr.Paren(arg,range0,None,m),range0,None,m) - | args -> SynExpr.Paren(SynExpr.Tuple(args,[],m),range0,None,m) + | [] -> SynExpr.Const(SynConst.Unit, m) + | [arg] -> SynExpr.Paren(SynExpr.Paren(arg, range0, None, m), range0, None, m) + | args -> SynExpr.Paren(SynExpr.Tuple(args, [], m), range0, None, m) let builderVal = mkSynIdGet m builderValName - mkSynApp1 (SynExpr.DotGet(builderVal,range0,LongIdentWithDots([mkSynId m nm],[]), m)) args m + mkSynApp1 (SynExpr.DotGet(builderVal, range0, LongIdentWithDots([mkSynId m nm], []), m)) args m let sourceMethInfo = TryFindIntrinsicOrExtensionMethInfo cenv env mBuilderVal ad "Source" builderTy // Optionally wrap sources of "let!", "yield!", "use!" in "query.Source" @@ -7066,13 +7066,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | _ -> true let customOperationMethods = - AllMethInfosOfTypeInScope cenv.infoReader env.NameEnv (None,ad) IgnoreOverrides mBuilderVal builderTy + AllMethInfosOfTypeInScope 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 nameSearch = 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 ], _, _, _, _)) -> Some msg | _ -> None) IgnoreAttribute // We do not respect this attribute for provided methods match nameSearch with @@ -7081,13 +7081,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let joinConditionWord = 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), _, _, _)) -> Some s | _ -> None) IgnoreAttribute // We do not respect this attribute for provided methods 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), _, _, _)) -> Some b | _ -> None) IgnoreAttribute // We do not respect this attribute for provided methods let maintainsVarSpaceUsingBind = defaultArg (flagSearch "MaintainsVariableSpaceUsingBind") false @@ -7102,14 +7102,14 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let customOperationMethodsIndexedByKeyword = customOperationMethods |> Seq.groupBy (fun (nm, _, _, _, _, _, _, _, _) -> nm) - |> Seq.map (fun (nm,g) -> (nm, Seq.toList g)) + |> Seq.map (fun (nm, g) -> (nm, Seq.toList g)) |> dict // Check for duplicates by method name (keywords and method names must be 1:1) let customOperationMethodsIndexedByMethodName = customOperationMethods |> Seq.groupBy (fun (_, _, _, _, _, _, _, _, methInfo) -> methInfo.LogicalName) - |> Seq.map (fun (nm,g) -> (nm, Seq.toList g)) + |> Seq.map (fun (nm, g) -> (nm, Seq.toList g)) |> dict @@ -7119,12 +7119,12 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | true, [opData] -> let (opName, maintainsVarSpaceUsingBind, maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, methInfo) = opData if (maintainsVarSpaceUsingBind && maintainsVarSpace) || (isLikeZip && isLikeJoin) || (isLikeZip && isLikeGroupJoin) || (isLikeJoin && isLikeGroupJoin) then - errorR(Error(FSComp.SR.tcCustomOperationInvalid opName,nm.idRange)) + errorR(Error(FSComp.SR.tcCustomOperationInvalid opName, nm.idRange)) match customOperationMethodsIndexedByMethodName.TryGetValue methInfo.LogicalName with | true, [_] -> () - | _ -> errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText,nm.idRange)) + | _ -> errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)) Some opData - | true, opData::_ -> errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText,nm.idRange)); Some opData + | true, opData::_ -> errorR(Error(FSComp.SR.tcCustomOperationMayNotBeOverloaded nm.idText, nm.idRange)); Some opData | _ -> None /// Decide if the identifier represents a use of a custom query operator @@ -7173,9 +7173,9 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | None -> None | Some (_nm, _maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, isLikeZip, isLikeJoin, isLikeGroupJoin, _joinConditionWord, _methInfo) -> if isLikeGroupJoin then - Some (FSComp.SR.customOperationTextLikeGroupJoin(nm.idText,customOperationJoinConditionWord nm,customOperationJoinConditionWord nm)) + Some (FSComp.SR.customOperationTextLikeGroupJoin(nm.idText, customOperationJoinConditionWord nm, customOperationJoinConditionWord nm)) elif isLikeJoin then - Some (FSComp.SR.customOperationTextLikeJoin(nm.idText,customOperationJoinConditionWord nm,customOperationJoinConditionWord nm)) + Some (FSComp.SR.customOperationTextLikeJoin(nm.idText, customOperationJoinConditionWord nm, customOperationJoinConditionWord nm)) elif isLikeZip then Some (FSComp.SR.customOperationTextLikeZip(nm.idText)) else @@ -7186,7 +7186,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv /// the query. let env = env |> ModifyNameResEnv (fun nenv -> (nenv, customOperationMethods) ||> Seq.fold (fun nenv (nm, _, _, _, _, _, _, _, methInfo) -> - AddFakeNameToNameEnv nm nenv (Item.CustomOperation (nm, (fun () -> customOpUsageText (ident (nm,mBuilderVal))), Some methInfo)))) + AddFakeNameToNameEnv nm nenv (Item.CustomOperation (nm, (fun () -> customOpUsageText (ident (nm, mBuilderVal))), Some methInfo)))) // Environment is needed for completions CallEnvSink cenv.tcSink (comp.Range, env.NameEnv, ad) @@ -7197,7 +7197,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | None -> None | Some (_nm, __maintainsVarSpaceUsingBind, _maintainsVarSpace, _allowInto, _isLikeZip, _isLikeJoin, _isLikeGroupJoin, _joinConditionWord, methInfo) -> match methInfo with - | FSMeth(_,_,vref,_) -> + | FSMeth(_, _, vref, _) -> match ArgInfosOfMember cenv.g vref with | [curriedArgInfo] -> Some curriedArgInfo // one for the actual argument group | _ -> None @@ -7214,13 +7214,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | None -> false | Some argInfos -> i < argInfos.Length && - let (_,argInfo) = List.item i argInfos + let (_, argInfo) = List.item i argInfos HasFSharpAttribute cenv.g cenv.g.attrib_ProjectionParameterAttribute argInfo.Attribs let (|ForEachThen|_|) e = match e with - | SynExpr.ForEach (_spBind, SeqExprOnly false, isFromSource, pat1, expr1, SynExpr.Sequential(_,true,clause,rest,_),_) -> Some (isFromSource,pat1,expr1,clause,rest) + | SynExpr.ForEach (_spBind, SeqExprOnly false, isFromSource, pat1, expr1, SynExpr.Sequential(_, true, clause, rest, _), _) -> Some (isFromSource, pat1, expr1, clause, rest) | _ -> None let (|CustomOpId|_|) predicate e = @@ -7231,7 +7231,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // e1 in e2 ('in' is parsed as 'JOIN_IN') let (|InExpr|_|) (e:SynExpr) = match e with - | SynExpr.JoinIn(e1,_,e2,mApp) -> Some (e1,e2,mApp) + | SynExpr.JoinIn(e1, _, e2, mApp) -> Some (e1, e2, mApp) | _ -> None // e1 on e2 (note: 'on' is the 'JoinConditionWord') @@ -7240,17 +7240,17 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | None -> None | Some _ -> match e with - | SynExpr.App(_,_,SynExpr.App(_,_,e1,SingleIdent opName,_), e2, _) when opName.idText = customOperationJoinConditionWord nm -> + | SynExpr.App(_, _, SynExpr.App(_, _, e1, SingleIdent opName, _), e2, _) when opName.idText = customOperationJoinConditionWord nm -> let item = Item.CustomOperation (opName.idText, (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (opName.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) - Some (e1,e2) + CallNameResolutionSink cenv.tcSink (opName.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) + Some (e1, e2) | _ -> None // e1 into e2 let (|IntoSuffix|_|) (e:SynExpr) = match e with - | SynExpr.App(_,_,SynExpr.App(_,_,x,SingleIdent nm2,_), ExprAsPat intoPat, _) when nm2.idText = CustomOperations.Into -> - Some (x,nm2.idRange,intoPat) + | SynExpr.App(_, _, SynExpr.App(_, _, x, SingleIdent nm2, _), ExprAsPat intoPat, _) when nm2.idText = CustomOperations.Into -> + Some (x, nm2.idRange, intoPat) | _ -> None @@ -7258,32 +7258,32 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let MatchIntoSuffixOrRecover alreadyGivenError (nm:Ident) (e:SynExpr) = match e with - | IntoSuffix (x,intoWordRange,intoPat) -> + | IntoSuffix (x, intoWordRange, intoPat) -> // record the "into" as a custom operation for colorization let item = Item.CustomOperation ("into", (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (intoWordRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) - (x,intoPat,alreadyGivenError) + CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) + (x, intoPat, alreadyGivenError) | _ -> if not alreadyGivenError then - errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)),nm.idRange)) - (e,arbPat e.Range,true) + errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + (e, arbPat e.Range, true) let MatchOnExprOrRecover alreadyGivenError nm (onExpr:SynExpr) = match onExpr with - | OnExpr nm (innerSource, SynExprParen(keySelectors,_,_,_)) -> + | OnExpr nm (innerSource, SynExprParen(keySelectors, _, _, _)) -> (innerSource, keySelectors) | _ -> if not alreadyGivenError then suppressErrorReporting (fun () -> TcExprOfUnknownType cenv env tpenv onExpr) |> ignore - errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)),nm.idRange)) - (arbExpr("_innerSource",onExpr.Range), mkSynBifix onExpr.Range "=" (arbExpr("_keySelectors",onExpr.Range)) (arbExpr("_keySelector2",onExpr.Range))) + errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + (arbExpr("_innerSource", onExpr.Range), mkSynBifix onExpr.Range "=" (arbExpr("_keySelectors", onExpr.Range)) (arbExpr("_keySelector2", onExpr.Range))) let JoinOrGroupJoinOp detector e = match e with - | SynExpr.App(_,_,CustomOpId detector nm,ExprAsPat innerSourcePat,mJoinCore) -> + | SynExpr.App(_, _, CustomOpId detector nm, ExprAsPat innerSourcePat, mJoinCore) -> Some(nm, innerSourcePat, mJoinCore, false) // join with bad pattern (gives error on "join" and continues) - | SynExpr.App(_,_,CustomOpId detector nm,_innerSourcePatExpr,mJoinCore) -> + | SynExpr.App(_, _, CustomOpId detector nm, _innerSourcePatExpr, mJoinCore) -> errorR(Error(FSComp.SR.tcBinaryOperatorRequiresVariable(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) Some(nm, arbPat mJoinCore, mJoinCore, true) // join (without anything after - gives error on "join" and continues) @@ -7297,7 +7297,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|JoinOp|_|) (e:SynExpr) = JoinOrGroupJoinOp customOperationIsLikeJoin e let (|GroupJoinOp|_|) (e:SynExpr) = JoinOrGroupJoinOp customOperationIsLikeGroupJoin e - let arbKeySelectors m = mkSynBifix m "=" (arbExpr("_keySelectors",m)) (arbExpr("_keySelector2",m)) + let arbKeySelectors m = mkSynBifix m "=" (arbExpr("_keySelectors", m)) (arbExpr("_keySelector2", m)) let (|JoinExpr|_|) (e:SynExpr) = match e with @@ -7307,19 +7307,19 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | JoinOp (nm, innerSourcePat, mJoinCore, alreadyGivenError) -> if alreadyGivenError then errorR(Error(FSComp.SR.tcOperatorRequiresIn(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) - Some (nm, innerSourcePat, arbExpr("_innerSource",e.Range), arbKeySelectors e.Range, mJoinCore) + Some (nm, innerSourcePat, arbExpr("_innerSource", e.Range), arbKeySelectors e.Range, mJoinCore) | _ -> None let (|GroupJoinExpr|_|) (e:SynExpr) = match e with | InExpr (GroupJoinOp (nm, innerSourcePat, _, alreadyGivenError), intoExpr, mGroupJoinCore) -> - let onExpr,intoPat,alreadyGivenError = MatchIntoSuffixOrRecover alreadyGivenError nm intoExpr + let onExpr, intoPat, alreadyGivenError = MatchIntoSuffixOrRecover alreadyGivenError nm intoExpr let innerSource, keySelectors = MatchOnExprOrRecover alreadyGivenError nm onExpr Some (nm, innerSourcePat, innerSource, keySelectors, intoPat, mGroupJoinCore) | GroupJoinOp (nm, innerSourcePat, mGroupJoinCore, alreadyGivenError) -> if alreadyGivenError then - errorR(Error(FSComp.SR.tcOperatorRequiresIn(nm.idText, Option.get (customOpUsageText nm)),nm.idRange)) - Some (nm, innerSourcePat, arbExpr("_innerSource",e.Range), arbKeySelectors e.Range, arbPat e.Range, mGroupJoinCore) + errorR(Error(FSComp.SR.tcOperatorRequiresIn(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + Some (nm, innerSourcePat, arbExpr("_innerSource", e.Range), arbKeySelectors e.Range, arbPat e.Range, mGroupJoinCore) | _ -> None @@ -7336,18 +7336,18 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some(nm, innerSourcePat, innerSource, Some keySelectors, Some intoPat, mGroupJoinCore) // zip intoPat in secondSource - | InExpr (SynExpr.App(_,_,CustomOpId customOperationIsLikeZip nm,ExprAsPat secondSourcePat,_),secondSource,mZipCore) -> + | InExpr (SynExpr.App(_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, _), secondSource, mZipCore) -> Some(nm, secondSourcePat, secondSource, None, None, mZipCore) // zip (without secondSource or in - gives error) | CustomOpId customOperationIsLikeZip nm -> - errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)),nm.idRange)) - Some(nm, arbPat e.Range, arbExpr("_secondSource",e.Range), None, None, e.Range) + errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + Some(nm, arbPat e.Range, arbExpr("_secondSource", e.Range), None, None, e.Range) // zip secondSource (without in - gives error) - | SynExpr.App(_,_,CustomOpId customOperationIsLikeZip nm,ExprAsPat secondSourcePat,mZipCore) -> - errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)),mZipCore)) - Some(nm, secondSourcePat, arbExpr("_innerSource",e.Range), None, None, mZipCore) + | SynExpr.App(_, _, CustomOpId customOperationIsLikeZip nm, ExprAsPat secondSourcePat, mZipCore) -> + errorR(Error(FSComp.SR.tcOperatorIncorrectSyntax(nm.idText, Option.get (customOpUsageText nm)), mZipCore)) + Some(nm, secondSourcePat, arbExpr("_innerSource", e.Range), None, None, mZipCore) | _ -> None @@ -7356,7 +7356,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match e with | ForEachThen (isFromSource, firstSourcePat, firstSource, JoinOrGroupJoinOrZipClause(nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore), innerComp) when - (let _firstSourceSimplePats,later1 = + (let _firstSourceSimplePats, later1 = use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat Option.isNone later1) @@ -7364,8 +7364,8 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv -> Some (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, pat3opt, mOpCore, innerComp) | JoinOrGroupJoinOrZipClause(nm, pat2, expr2, expr3, pat3opt, mOpCore) -> - errorR(Error(FSComp.SR.tcBinaryOperatorRequiresBody(nm.idText, Option.get (customOpUsageText nm)),nm.idRange)) - Some (true, arbPat e.Range, arbExpr("_outerSource",e.Range), nm, pat2, expr2, expr3, pat3opt, mOpCore, arbExpr("_innerComp",e.Range)) + errorR(Error(FSComp.SR.tcBinaryOperatorRequiresBody(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) + Some (true, arbPat e.Range, arbExpr("_outerSource", e.Range), nm, pat2, expr2, expr3, pat3opt, mOpCore, arbExpr("_innerComp", e.Range)) | _ -> None @@ -7374,39 +7374,39 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|StripApps|) e = let rec strip e = match e with - | SynExpr.FromParseError(SynExpr.App(_,_,f,arg,_),_) - | SynExpr.App(_,_,f,arg,_) -> - let g,acc = strip f - g,(arg::acc) - | _ -> e,[] - let g,acc = strip e - g,List.rev acc + | SynExpr.FromParseError(SynExpr.App(_, _, f, arg, _), _) + | SynExpr.App(_, _, f, arg, _) -> + let g, acc = strip f + g, (arg::acc) + | _ -> e, [] + let g, acc = strip e + g, List.rev acc let (|OptionalIntoSuffix|) e = match e with - | IntoSuffix (body,intoWordRange,optInfo) -> (body,Some (intoWordRange, optInfo)) - | body -> (body,None) + | IntoSuffix (body, intoWordRange, optInfo) -> (body, Some (intoWordRange, optInfo)) + | body -> (body, None) let (|CustomOperationClause|_|) e = match e with - | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core,optInto) when isCustomOperation nm -> + | OptionalIntoSuffix(StripApps(SingleIdent nm, _) as core, optInto) when isCustomOperation nm -> // Now we know we have a custom operation, commit the name resolution let optIntoInfo = match optInto with - | Some (intoWordRange,optInfo) -> + | Some (intoWordRange, optInfo) -> let item = Item.CustomOperation ("into", (fun () -> None), None) - CallNameResolutionSink cenv.tcSink (intoWordRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (intoWordRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) Some optInfo | None -> None Some (nm, Option.get (tryGetDataForCustomOperation nm), core, core.Range, optIntoInfo) | _ -> None - let mkSynLambda p e m = SynExpr.Lambda(false,false,p,e,m) + let mkSynLambda p e m = SynExpr.Lambda(false, false, p, e, m) let mkExprForVarSpace m (patvs: Val list) = match patvs with - | [] -> SynExpr.Const(SynConst.Unit,m) + | [] -> SynExpr.Const(SynConst.Unit, m) | [v] -> SynExpr.Ident v.Id | vs -> SynExpr.Tuple((vs |> List.map (fun v -> SynExpr.Ident v.Id)), [], m) @@ -7426,10 +7426,10 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let (|OptionalSequential|) e = match e with - | SynExpr.Sequential(_sp, true, dataComp1, dataComp2,_) -> (dataComp1, Some dataComp2) + | SynExpr.Sequential(_sp, true, dataComp1, dataComp2, _) -> (dataComp1, Some dataComp2) | _ -> (e, None) - // Check for 'where x > y', 'select x,y' and other mis-applications of infix operators, give a good error message, and return a flag + // Check for 'where x > y', 'select x, y' and other mis-applications of infix operators, give a good error message, and return a flag let checkForBinaryApp comp = match comp with | StripApps(SingleIdent nm, [StripApps(SingleIdent nm2, args); arg2]) when @@ -7437,13 +7437,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv expectedArgCountForCustomOperator nm2 > 0 && args.Length > 0 -> let estimatedRangeOfIntendedLeftAndRightArguments = unionRanges (List.last args).Range arg2.Range - errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(),estimatedRangeOfIntendedLeftAndRightArguments)) + errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(), estimatedRangeOfIntendedLeftAndRightArguments)) true | SynExpr.Tuple( (StripApps(SingleIdent nm2, args) :: _), _, m) when expectedArgCountForCustomOperator nm2 > 0 && args.Length > 0 -> let estimatedRangeOfIntendedLeftAndRightArguments = unionRanges (List.last args).Range m.EndRange - errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(),estimatedRangeOfIntendedLeftAndRightArguments)) + errorR(Error(FSComp.SR.tcUnrecognizedQueryBinaryOperator(), estimatedRangeOfIntendedLeftAndRightArguments)) true | _ -> false @@ -7488,7 +7488,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | ForEachThenJoinOrGroupJoinOrZipClause (isFromSource, firstSourcePat, firstSource, nm, secondSourcePat, secondSource, keySelectorsOpt, secondResultPatOpt, mOpCore, innerComp) -> - if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(),nm.idRange)) + if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(), nm.idRange)) let firstSource = if isFromSource then mkSourceExpr firstSource else firstSource let secondSource = mkSourceExpr secondSource @@ -7496,13 +7496,13 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let varSpaceWithFirstVars = addVarsToVarSpace varSpace (fun _mCustomOp env -> use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _,_,vspecs,envinner,_ = TcMatchPattern cenv (NewInferenceType()) env tpenv (firstSourcePat, None) + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (firstSourcePat, None) vspecs, envinner) let varSpaceWithSecondVars = addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _,_,vspecs,envinner,_ = TcMatchPattern cenv (NewInferenceType()) env tpenv (secondSourcePat, None) + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (secondSourcePat, None) vspecs, envinner) let varSpaceWithGroupJoinVars = @@ -7510,19 +7510,19 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | Some pat3 -> addVarsToVarSpace varSpaceWithFirstVars (fun _mCustomOp env -> use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _,_,vspecs,envinner,_ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat3, None) + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat3, None) vspecs, envinner) | None -> varSpace - let firstSourceSimplePats,later1 = SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat - let secondSourceSimplePats,later2 = SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat + let firstSourceSimplePats, later1 = SimplePatsOfPat cenv.synArgNameGenerator firstSourcePat + let secondSourceSimplePats, later2 = SimplePatsOfPat cenv.synArgNameGenerator secondSourcePat if Option.isSome later1 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), firstSourcePat.Range)) if Option.isSome later2 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), secondSourcePat.Range)) // 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)) + | None -> error(Error(FSComp.SR.tcMissingCustomOperation(nm.idText), nm.idRange)) | Some (opName, _, _, _, _, _, _, _, methInfo) -> // Record the resolution of the custom operation for posterity @@ -7530,7 +7530,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) let mkJoinExpr keySelector1 keySelector2 innerPat e = let mSynthetic = mOpCore.MakeSynthetic() @@ -7562,7 +7562,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // 2. incompatible types: int and string // with SynExpr.ArbitraryAfterError we have only first one let wrapInArbErrSequence l caption = - SynExpr.Sequential(SequencePointInfoForSeq.SequencePointsAtSeq, true, l, (arbExpr(caption,l.Range.EndRange)), l.Range) + SynExpr.Sequential(SequencePointInfoForSeq.SequencePointsAtSeq, true, l, (arbExpr(caption, l.Range.EndRange)), l.Range) let mkOverallExprGivenVarSpaceExpr, varSpaceInner = let isNullableOp opId = @@ -7570,7 +7570,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match secondResultPatOpt, keySelectorsOpt with // groupJoin | Some secondResultPat, Some relExpr when customOperationIsLikeGroupJoin nm -> - let secondResultSimplePats,later3 = SimplePatsOfPat cenv.synArgNameGenerator secondResultPat + let secondResultSimplePats, later3 = SimplePatsOfPat cenv.synArgNameGenerator secondResultPat if Option.isSome later3 then errorR (Error (FSComp.SR.tcJoinMustUseSimplePattern(nm.idText), secondResultPat.Range)) match relExpr with | JoinRelation cenv env (keySelector1, keySelector2) -> @@ -7578,20 +7578,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | BinOpExpr (opId, l, r) -> if isNullableOp opId.idText then // When we cannot resolve NullableOps, recommend the relevant namespace to be added - errorR(Error(FSComp.SR.cannotResolveNullableOperators(DecompileOpName opId.idText),relExpr.Range)) + errorR(Error(FSComp.SR.cannotResolveNullableOperators(DecompileOpName opId.idText), relExpr.Range)) else - errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText),relExpr.Range)) + errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText), relExpr.Range)) let l = wrapInArbErrSequence l "_keySelector1" let r = wrapInArbErrSequence r "_keySelector2" // this is not correct JoinRelation but it is still binary operation // we've already reported error now we can use operands of binary operation as join components mkJoinExpr l r secondResultSimplePats, varSpaceWithGroupJoinVars | _ -> - errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText),relExpr.Range)) + errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText), relExpr.Range)) // since the shape of relExpr doesn't match our expectations (JoinRelation) // then we assume that this is l.h.s. of the join relation // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in GroupJoin method - mkJoinExpr relExpr (arbExpr("_keySelector2",relExpr.Range)) secondResultSimplePats, varSpaceWithGroupJoinVars + mkJoinExpr relExpr (arbExpr("_keySelector2", relExpr.Range)) secondResultSimplePats, varSpaceWithGroupJoinVars | None, Some relExpr when customOperationIsLikeJoin nm -> match relExpr with @@ -7600,20 +7600,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | BinOpExpr (opId, l, r) -> if isNullableOp opId.idText then // When we cannot resolve NullableOps, recommend the relevant namespace to be added - errorR(Error(FSComp.SR.cannotResolveNullableOperators(DecompileOpName opId.idText),relExpr.Range)) + errorR(Error(FSComp.SR.cannotResolveNullableOperators(DecompileOpName opId.idText), relExpr.Range)) else - errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText),relExpr.Range)) + errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText), relExpr.Range)) // this is not correct JoinRelation but it is still binary operation // we've already reported error now we can use operands of binary operation as join components let l = wrapInArbErrSequence l "_keySelector1" let r = wrapInArbErrSequence r "_keySelector2" mkJoinExpr l r secondSourceSimplePats, varSpaceWithGroupJoinVars | _ -> - errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText),relExpr.Range)) + errorR(Error(FSComp.SR.tcInvalidRelationInJoin(nm.idText), relExpr.Range)) // since the shape of relExpr doesn't match our expectations (JoinRelation) // then we assume that this is l.h.s. of the join relation // so typechecker will treat relExpr as body of outerKeySelector lambda parameter in Join method - mkJoinExpr relExpr (arbExpr("_keySelector2",relExpr.Range)) secondSourceSimplePats, varSpaceWithGroupJoinVars + mkJoinExpr relExpr (arbExpr("_keySelector2", relExpr.Range)) secondSourceSimplePats, varSpaceWithGroupJoinVars | None, None when customOperationIsLikeZip nm -> mkZipExpr, varSpaceWithSecondVars @@ -7625,67 +7625,67 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Case from C# spec: A query expression with a join clause with an into followed by something other than a select clause // Case from C# spec: A query expression with a join clause without an into followed by something other than a select clause - let valsInner,_env = varSpaceInner.Force mOpCore + let valsInner, _env = varSpaceInner.Force mOpCore let varSpaceExpr = mkExprForVarSpace mOpCore valsInner let varSpacePat = mkPatForVarSpace mOpCore valsInner let joinExpr = mkOverallExprGivenVarSpaceExpr varSpaceExpr Some (trans true q varSpaceInner (SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, varSpacePat, joinExpr, innerComp, mOpCore)) translatedCtxt) - | SynExpr.ForEach (spForLoop, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp,_) -> + | SynExpr.ForEach (spForLoop, SeqExprOnly _seqExprOnly, isFromSource, pat, sourceExpr, innerComp, _) -> let wrappedSourceExpr = if isFromSource then mkSourceExpr sourceExpr else sourceExpr let mFor = match spForLoop with SequencePointAtForLoop(m) -> m | _ -> pat.Range let mPat = pat.Range let spBind = match spForLoop with SequencePointAtForLoop(m) -> SequencePointAtBinding(m) | NoSequencePointAtForLoop -> NoSequencePointAtStickyBinding - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"),mFor)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mFor ad "For" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("For"), mFor)) // Add the variables to the query variable space, on demand let varSpace = addVarsToVarSpace varSpace (fun _mCustomOp env -> use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _,_,vspecs,envinner,_ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat,None) + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat, None) vspecs, envinner) - Some (trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "For" mFor [wrappedSourceExpr; SynExpr.MatchLambda(false,sourceExpr.Range,[Clause(pat,None, holeFill,mPat,SequencePointAtTarget)],spBind,mFor) ])) ) + Some (trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "For" mFor [wrappedSourceExpr; SynExpr.MatchLambda(false, sourceExpr.Range, [Clause(pat, None, holeFill, mPat, SequencePointAtTarget)], spBind, mFor) ])) ) - | SynExpr.For (spBind,id,start,dir,finish,innerComp,m) -> + | SynExpr.For (spBind, id, start, dir, finish, innerComp, m) -> let mFor = match spBind with SequencePointAtForLoop m -> m | _ -> m - if isQuery then errorR(Error(FSComp.SR.tcNoIntegerForLoopInQuery(),mFor)) - Some (trans true q varSpace (elimFastIntegerForLoop (spBind,id,start,dir,finish,innerComp,m)) translatedCtxt ) + if isQuery then errorR(Error(FSComp.SR.tcNoIntegerForLoopInQuery(), mFor)) + Some (trans true q varSpace (elimFastIntegerForLoop (spBind, id, start, dir, finish, innerComp, m)) translatedCtxt ) - | SynExpr.While (spWhile,guardExpr,innerComp,_) -> + | SynExpr.While (spWhile, guardExpr, innerComp, _) -> let mGuard = guardExpr.Range let mWhile = match spWhile with SequencePointAtWhileLoop(m) -> m | _ -> mGuard - if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(),mWhile)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"),mWhile)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mWhile)) + if isQuery then error(Error(FSComp.SR.tcNoWhileInQuery(), mWhile)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "While" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("While"), mWhile)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mWhile ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mWhile)) Some(trans true q varSpace innerComp (fun holeFill -> translatedCtxt (mkSynCall "While" mWhile [mkSynDelay2 guardExpr; mkSynCall "Delay" mWhile [mkSynDelay innerComp.Range holeFill]])) ) - | SynExpr.TryFinally (innerComp,unwindExpr,mTryToLast,spTry,_spFinally) -> + | SynExpr.TryFinally (innerComp, unwindExpr, mTryToLast, spTry, _spFinally) -> let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast - if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(),mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"),mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) + if isQuery then error(Error(FSComp.SR.tcNoTryFinallyInQuery(), mTry)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryFinally" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryFinally"), mTry)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) Some (translatedCtxt (mkSynCall "TryFinally" mTry [mkSynCall "Delay" mTry [mkSynDelay innerComp.Range (transNoQueryOps innerComp)]; mkSynDelay2 unwindExpr])) - | SynExpr.Paren (_,_,_,m) -> - error(Error(FSComp.SR.tcConstructIsAmbiguousInComputationExpression(),m)) + | SynExpr.Paren (_, _, _, m) -> + error(Error(FSComp.SR.tcConstructIsAmbiguousInComputationExpression(), m)) | SynExpr.ImplicitZero m -> - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"),m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), m)) Some (translatedCtxt (mkSynCall "Zero" m [])) | OptionalSequential (JoinOrGroupJoinOrZipClause (_, _, _, _, _, mClause), _) when firstTry -> // 'join' clauses preceded by 'let' and other constructs get processed by repackaging with a 'for' loop. - let patvs,_env = varSpace.Force comp.Range + 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))) + translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((true, false), varSpaceExpr, mClause))) // Rebind using for ... let rebind = @@ -7697,20 +7697,20 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv | OptionalSequential (CustomOperationClause (nm, _, opExpr, mClause, _), _) -> - if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(),opExpr.Range)) + if not q then error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedHere(), opExpr.Range)) - let patvs,_env = varSpace.Force comp.Range + 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))) + translatedCtxt (transNoQueryOps (SynExpr.YieldOrReturn((isYield, false), varSpaceExpr, mClause))) - let rec consumeClauses (varSpace:LazyWithContext<_,_>) dataCompPrior compClausesExpr lastUsesBind = + let rec consumeClauses (varSpace:LazyWithContext<_, _>) dataCompPrior compClausesExpr lastUsesBind = // Substitute 'yield ' into the context - let patvs,_env = varSpace.Force comp.Range + let patvs, _env = varSpace.Force comp.Range let varSpaceSimplePat = mkSimplePatForVarSpace mClause patvs let varSpacePat = mkPatForVarSpace mClause patvs @@ -7724,10 +7724,10 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // FUTURE: consider whether we can do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE. - CallNameResolutionSink cenv.tcSink (nm.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (nm.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) if isLikeZip || isLikeJoin || isLikeGroupJoin then - errorR(Error(FSComp.SR.tcBinaryOperatorRequiresBody(nm.idText, Option.get (customOpUsageText nm)),nm.idRange)) + errorR(Error(FSComp.SR.tcBinaryOperatorRequiresBody(nm.idText, Option.get (customOpUsageText nm)), nm.idRange)) match optionalCont with | None -> // we are about to drop the 'opExpr' AST on the floor. we've already reported an error. attempt to get name resolutions before dropping it @@ -7749,14 +7749,14 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let args = args |> List.mapi (fun i arg -> if isCustomOperationProjectionParameter (i+1) nm then SynExpr.Lambda (false, false, varSpaceSimplePat, arg, arg.Range.MakeSynthetic()) else arg) mkSynCall methInfo.DisplayName mClause (dataCompPrior :: args) else - errorR(Error(FSComp.SR.tcCustomOperationHasIncorrectArgCount(nm.idText,expectedArgCount,args.Length),nm.idRange)) + 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" match optionalCont with | None -> match optionalIntoPat with - | Some intoPat -> errorR(Error(FSComp.SR.tcIntoNeedsRestOfQuery(),intoPat.Range)) + | Some intoPat -> errorR(Error(FSComp.SR.tcIntoNeedsRestOfQuery(), intoPat.Range)) | None -> () dataCompAfterOp @@ -7769,12 +7769,12 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv match optionalIntoPat with | Some intoPat -> if not (customOperationAllowsInto nm) then - error(Error(FSComp.SR.tcOperatorDoesntAcceptInto(nm.idText),intoPat.Range)) + error(Error(FSComp.SR.tcOperatorDoesntAcceptInto(nm.idText), intoPat.Range)) // Rebind using either for ... or let!.... let rebind = if maintainsVarSpaceUsingBind then - SynExpr.LetOrUseBang(NoSequencePointAtLetBinding,false,false,intoPat,dataCompAfterOp,contExpr,intoPat.Range) + SynExpr.LetOrUseBang(NoSequencePointAtLetBinding, false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) else SynExpr.ForEach (NoSequencePointAtForLoop, SeqExprOnly false, false, intoPat, dataCompAfterOp, contExpr, intoPat.Range) @@ -7805,7 +7805,7 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // Now run the consumeClauses Some (consumeClauses varSpace dataCompPriorToOp comp false) - | SynExpr.Sequential(sp,true,innerComp1,innerComp2,m) -> + | 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 @@ -7816,30 +7816,30 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv 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)) + | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), innerComp1.RangeOfFirstPortion)) match tryTrans true false varSpace innerComp1 id with | Some c -> - // "cexpr; cexpr" is treated as builder.Combine(cexpr1,cexpr1) + // "cexpr; cexpr" is treated as builder.Combine(cexpr1, cexpr1) // This is not pretty - we have to decide which range markers we use for the calls to Combine and Delay // NOTE: we should probably suppress these sequence points altogether let m1 = match innerComp1 with - | SynExpr.IfThenElse (_,_,_,_,_,mIfToThen,_m) -> mIfToThen - | SynExpr.Match (SequencePointAtBinding mMatch,_,_,_,_) -> mMatch - | SynExpr.TryWith (_,_,_,_,_,SequencePointAtTry mTry,_) -> mTry - | SynExpr.TryFinally (_,_,_,SequencePointAtTry mTry,_) -> mTry - | SynExpr.For (SequencePointAtForLoop mBind,_,_,_,_,_,_) -> mBind - | SynExpr.ForEach (SequencePointAtForLoop mBind,_,_,_,_,_,_) -> mBind - | SynExpr.While (SequencePointAtWhileLoop mWhile,_,_,_) -> mWhile + | SynExpr.IfThenElse (_, _, _, _, _, mIfToThen, _m) -> mIfToThen + | SynExpr.Match (SequencePointAtBinding mMatch, _, _, _, _) -> mMatch + | SynExpr.TryWith (_, _, _, _, _, SequencePointAtTry mTry, _) -> mTry + | SynExpr.TryFinally (_, _, _, SequencePointAtTry mTry, _) -> mTry + | SynExpr.For (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind + | SynExpr.ForEach (SequencePointAtForLoop mBind, _, _, _, _, _, _) -> mBind + | SynExpr.While (SequencePointAtWhileLoop mWhile, _, _, _) -> mWhile | _ -> innerComp1.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"),m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Combine" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Combine"), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), m)) Some (translatedCtxt (mkSynCall "Combine" m1 [c; mkSynCall "Delay" m1 [mkSynDelay innerComp2.Range (transNoQueryOps innerComp2)]])) | None -> // "do! expr; cexpr" is treated as { let! () = expr in cexpr } match innerComp1 with - | SynExpr.DoBang(rhsExpr,m) -> + | SynExpr.DoBang(rhsExpr, m) -> let sp = match sp with | SuppressSequencePointOnStmtOfSequential -> SequencePointAtBinding m @@ -7848,31 +7848,31 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv Some(trans true q varSpace (SynExpr.LetOrUseBang(sp, false, true, SynPat.Const(SynConst.Unit, rhsExpr.Range), rhsExpr, innerComp2, m)) translatedCtxt) // "expr; cexpr" is treated as sequential execution | _ -> - Some (trans true q varSpace innerComp2 (fun holeFill -> translatedCtxt (SynExpr.Sequential(sp,true, innerComp1, holeFill, m)))) + Some (trans true q varSpace innerComp2 (fun holeFill -> translatedCtxt (SynExpr.Sequential(sp, true, innerComp1, holeFill, m)))) - | SynExpr.IfThenElse (guardExpr,thenComp,elseCompOpt,spIfToThen,isRecovery,mIfToThen,mIfToEndOfElseBranch) -> + | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch) -> match elseCompOpt with | Some elseComp -> - if isQuery then error(Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries(),mIfToThen)) - Some (translatedCtxt (SynExpr.IfThenElse(guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen,isRecovery,mIfToThen,mIfToEndOfElseBranch))) + if isQuery then error(Error(FSComp.SR.tcIfThenElseMayNotBeUsedWithinQueries(), mIfToThen)) + Some (translatedCtxt (SynExpr.IfThenElse(guardExpr, transNoQueryOps thenComp, Some(transNoQueryOps elseComp), spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch))) | None -> let elseComp = - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"),mIfToThen)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mIfToThen ad "Zero" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Zero"), mIfToThen)) mkSynCall "Zero" mIfToThen [] - Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse(guardExpr, holeFill, Some elseComp, spIfToThen,isRecovery,mIfToThen,mIfToEndOfElseBranch)))) + Some (trans true q varSpace thenComp (fun holeFill -> translatedCtxt (SynExpr.IfThenElse(guardExpr, holeFill, Some elseComp, spIfToThen, isRecovery, mIfToThen, mIfToEndOfElseBranch)))) // 'let binds in expr' - | SynExpr.LetOrUse (isRec,false,binds,innerComp,m) -> + | SynExpr.LetOrUse (isRec, false, binds, innerComp, m) -> // For 'query' check immediately if isQuery then match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with - | [NormalizedBinding(_,NormalBinding,(*inline*)false,(*mutable*)false,_,_,_,_,_,_,_,_)] when not isRec -> + | [NormalizedBinding(_, NormalBinding, (*inline*)false, (*mutable*)false, _, _, _, _, _, _, _, _)] when not isRec -> () | normalizedBindings -> - let failAt m = error(Error(FSComp.SR.tcNonSimpleLetBindingInQuery(),m)) + let failAt m = error(Error(FSComp.SR.tcNonSimpleLetBindingInQuery(), m)) match normalizedBindings with - | NormalizedBinding(_,_,_,_,_,_,_,_,_,_,mBinding,_) :: _ -> failAt mBinding + | NormalizedBinding(_, _, _, _, _, _, _, _, _, _, mBinding, _) :: _ -> failAt mBinding | _ -> failAt m // Add the variables to the query variable space, on demand @@ -7880,100 +7880,100 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv addVarsToVarSpace varSpace (fun mQueryOp env -> // Normalize the bindings before detecting the bound variables match (List.map (BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env) binds) with - | [NormalizedBinding(_vis,NormalBinding,false,false,_,_,_,_,pat,_,_,_)] -> + | [NormalizedBinding(_vis, NormalBinding, false, false, _, _, _, _, pat, _, _, _)] -> // successful case use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _,_,vspecs,envinner,_ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat,None) + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat, None) vspecs, envinner | _ -> // error case - error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings(),mQueryOp))) + error(Error(FSComp.SR.tcCustomOperationMayNotBeUsedInConjunctionWithNonSimpleLetBindings(), mQueryOp))) - Some (trans true q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse (isRec,false,binds,holeFill,m)))) + Some (trans true q varSpace innerComp (fun holeFill -> translatedCtxt (SynExpr.LetOrUse (isRec, false, binds, holeFill, m)))) // 'use x = expr in expr' - | SynExpr.LetOrUse (_,true,[Binding (_,NormalBinding,_,_,_,_,_,pat,_,rhsExpr,_,spBind)],innerComp,_) -> + | SynExpr.LetOrUse (_, true, [Binding (_, NormalBinding, _, _, _, _, _, pat, _, rhsExpr, _, spBind)], innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding m -> m | _ -> rhsExpr.Range - if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(),bindRange)) + if isQuery then error(Error(FSComp.SR.tcUseMayNotBeUsedInQueries(), bindRange)) let innerCompRange = innerComp.Range - let consumeExpr = SynExpr.MatchLambda(false,innerCompRange,[Clause(pat,None, transNoQueryOps innerComp,innerCompRange,SequencePointAtTarget)],spBind,innerCompRange) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"),bindRange)) + let consumeExpr = SynExpr.MatchLambda(false, innerCompRange, [Clause(pat, None, transNoQueryOps innerComp, innerCompRange, SequencePointAtTarget)], spBind, innerCompRange) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) Some (translatedCtxt (mkSynCall "Using" bindRange [rhsExpr; consumeExpr ])) - // 'let! pat = expr in expr' --> build.Bind(e1,(function _argN -> match _argN with pat -> expr)) - | SynExpr.LetOrUseBang(spBind, false, isFromSource, pat, rhsExpr, innerComp,_) -> + // 'let! pat = expr in expr' --> build.Bind(e1, (function _argN -> match _argN with pat -> expr)) + | SynExpr.LetOrUseBang(spBind, false, isFromSource, pat, rhsExpr, innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range - if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(),bindRange)) + if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) let innerRange = innerComp.Range - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"),bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) // Add the variables to the query variable space, on demand let varSpace = addVarsToVarSpace varSpace (fun _mCustomOp env -> use _holder = TemporarilySuspendReportingTypecheckResultsToSink cenv.tcSink - let _,_,vspecs,envinner,_ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat,None) + let _, _, vspecs, envinner, _ = TcMatchPattern cenv (NewInferenceType()) env tpenv (pat, None) vspecs, envinner) let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr Some (trans true q varSpace innerComp (fun holeFill -> - let consumeExpr = SynExpr.MatchLambda(false,pat.Range,[Clause(pat,None, holeFill,innerRange,SequencePointAtTarget)],spBind,innerRange) + let consumeExpr = SynExpr.MatchLambda(false, pat.Range, [Clause(pat, None, holeFill, innerRange, SequencePointAtTarget)], spBind, innerRange) translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr]))) - // '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(spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat) ,rhsExpr,innerComp,_) - | SynExpr.LetOrUseBang(spBind, true, isFromSource, (SynPat.LongIdent (LongIdentWithDots([id],_),_,_,_,_,_) as pat), rhsExpr, innerComp,_) -> + // '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(spBind, true, isFromSource, (SynPat.Named (SynPat.Wild _, id, false, _, _) as pat) , rhsExpr, innerComp, _) + | SynExpr.LetOrUseBang(spBind, true, isFromSource, (SynPat.LongIdent (LongIdentWithDots([id], _), _, _, _, _, _) as pat), rhsExpr, innerComp, _) -> let bindRange = match spBind with SequencePointAtBinding(m) -> m | _ -> rhsExpr.Range - if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(),bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"),bindRange)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"),bindRange)) - let consumeExpr = SynExpr.MatchLambda(false,bindRange,[Clause(pat,None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)],spBind,bindRange) + if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Using" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Using"), bindRange)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env bindRange ad "Bind" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Bind"), bindRange)) + let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, transNoQueryOps innerComp, innerComp.Range, SequencePointAtTarget)], spBind, bindRange) let consumeExpr = mkSynCall "Using" bindRange [SynExpr.Ident(id); consumeExpr ] - let consumeExpr = SynExpr.MatchLambda(false,bindRange,[Clause(pat,None, consumeExpr,id.idRange,SequencePointAtTarget)],spBind,bindRange) + let consumeExpr = SynExpr.MatchLambda(false, bindRange, [Clause(pat, None, consumeExpr, id.idRange, SequencePointAtTarget)], spBind, bindRange) let rhsExpr = if isFromSource then mkSourceExpr rhsExpr else rhsExpr Some(translatedCtxt (mkSynCall "Bind" bindRange [rhsExpr; consumeExpr])) // 'use! pat = e1 in e2' where 'pat' is not a simple name --> error - | SynExpr.LetOrUseBang(_spBind, true, _isFromSource, pat, _rhsExpr, _innerComp,_) -> - error(Error(FSComp.SR.tcInvalidUseBangBinding(),pat.Range)) + | SynExpr.LetOrUseBang(_spBind, true, _isFromSource, pat, _rhsExpr, _innerComp, _) -> + error(Error(FSComp.SR.tcInvalidUseBangBinding(), pat.Range)) - | SynExpr.Match (spMatch,expr,clauses,false,m) -> + | SynExpr.Match (spMatch, expr, clauses, false, m) -> let mMatch = match spMatch with SequencePointAtBinding mMatch -> mMatch | _ -> m - if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(),mMatch)) - let clauses = clauses |> List.map (fun (Clause(pat,cond,innerComp,patm,sp)) -> Clause(pat,cond,transNoQueryOps innerComp,patm,sp)) - Some(translatedCtxt (SynExpr.Match(spMatch,expr, clauses, false,m))) + if isQuery then error(Error(FSComp.SR.tcMatchMayNotBeUsedWithQuery(), mMatch)) + let clauses = clauses |> List.map (fun (Clause(pat, cond, innerComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps innerComp, patm, sp)) + Some(translatedCtxt (SynExpr.Match(spMatch, expr, clauses, false, m))) - | SynExpr.TryWith (innerComp,_mTryToWith,clauses,_mWithToLast,mTryToLast,spTry,_spWith) -> + | SynExpr.TryWith (innerComp, _mTryToWith, clauses, _mWithToLast, mTryToLast, spTry, _spWith) -> let mTry = match spTry with SequencePointAtTry(m) -> m | _ -> mTryToLast - if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(),mTry)) - let clauses = clauses |> List.map (fun (Clause(pat,cond,clauseComp,patm,sp)) -> Clause(pat,cond,transNoQueryOps clauseComp,patm,sp)) - let consumeExpr = SynExpr.MatchLambda(true,mTryToLast,clauses,NoSequencePointAtStickyBinding,mTryToLast) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"),mTry)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"),mTry)) + if isQuery then error(Error(FSComp.SR.tcTryWithMayNotBeUsedInQueries(), mTry)) + let clauses = clauses |> List.map (fun (Clause(pat, cond, clauseComp, patm, sp)) -> Clause(pat, cond, transNoQueryOps clauseComp, patm, sp)) + let consumeExpr = SynExpr.MatchLambda(true, mTryToLast, clauses, NoSequencePointAtStickyBinding, mTryToLast) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "TryWith" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("TryWith"), mTry)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env mTry ad "Delay" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("Delay"), mTry)) Some(translatedCtxt (mkSynCall "TryWith" mTry [mkSynCall "Delay" mTry [mkSynDelay2 (transNoQueryOps innerComp)]; consumeExpr])) - | SynExpr.YieldOrReturnFrom((isYield,_),yieldExpr,m) -> + | SynExpr.YieldOrReturnFrom((isYield, _), yieldExpr, m) -> let yieldExpr = mkSourceExpr yieldExpr if isYield then - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"),m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "YieldFrom" builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod("YieldFrom"), m)) Some (translatedCtxt (mkSynCall "YieldFrom" m [yieldExpr])) else - if isQuery then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(),m)) + if isQuery then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(), m)) if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "ReturnFrom" builderTy) then - errorR(Error(FSComp.SR.tcRequireBuilderMethod("ReturnFrom"),m)) + errorR(Error(FSComp.SR.tcRequireBuilderMethod("ReturnFrom"), m)) Some (translatedCtxt yieldExpr) else Some (translatedCtxt (mkSynCall "ReturnFrom" m [yieldExpr])) - | SynExpr.YieldOrReturn((isYield,_),yieldExpr,m) -> + | SynExpr.YieldOrReturn((isYield, _), yieldExpr, m) -> let methName = (if isYield then "Yield" else "Return") - if isQuery && not isYield then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(),m)) - if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName),m)) + if isQuery && not isYield then error(Error(FSComp.SR.tcReturnMayNotBeUsedInQueries(), m)) + if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad methName builderTy) then error(Error(FSComp.SR.tcRequireBuilderMethod(methName), m)) Some(translatedCtxt (mkSynCall methName m [yieldExpr])) | _ -> None @@ -7986,15 +7986,15 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv // 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 or as { let! () = expr in zero } otherwise - | SynExpr.DoBang(rhsExpr,m) -> + | SynExpr.DoBang(rhsExpr, m) -> let mUnit = rhsExpr.Range let rhsExpr = mkSourceExpr rhsExpr - if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(),m)) + if isQuery then error(Error(FSComp.SR.tcBindMayNotBeUsedInQueries(), m)) let bodyExpr = if isNil (TryFindIntrinsicOrExtensionMethInfo cenv env m ad "Return" builderTy) then SynExpr.ImplicitZero m else - SynExpr.YieldOrReturn((false,true), SynExpr.Const(SynConst.Unit, m), m) + SynExpr.YieldOrReturn((false, true), SynExpr.Const(SynConst.Unit, m), m) trans true q varSpace (SynExpr.LetOrUseBang(NoSequencePointAtDoBinding, false, false, SynPat.Const(SynConst.Unit, mUnit), rhsExpr, bodyExpr, m)) translatedCtxt // "expr;" in final position is treated as { expr; zero } // Suppress the sequence point on the "zero" @@ -8006,10 +8006,10 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv if isQuery && not comp.IsArbExprAndThusAlreadyReportedError then match comp with | SynExpr.JoinIn _ -> () // an error will be reported later when we process innerComp1 as a sequential - | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(),comp.RangeOfFirstPortion)) - trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> translatedCtxt (SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential,true, comp, holeFill,comp.Range))) + | _ -> errorR(Error(FSComp.SR.tcUnrecognizedQueryOperator(), comp.RangeOfFirstPortion)) + trans true q varSpace (SynExpr.ImplicitZero comp.Range) (fun holeFill -> translatedCtxt (SynExpr.Sequential(SuppressSequencePointOnStmtOfSequential, true, comp, holeFill, comp.Range))) - let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([],env)) comp (fun holeFill -> holeFill) + let basicSynExpr = trans true (hasCustomOperations ()) (LazyWithContext.NotLazy ([], env)) comp (fun holeFill -> holeFill) let delayedExpr = match TryFindIntrinsicOrExtensionMethInfo cenv env mBuilderVal ad "Delay" builderTy with @@ -8030,19 +8030,19 @@ and TcComputationExpression cenv env overallTy mWhole interpExpr builderTy tpenv let lambdaExpr = let mBuilderVal = mBuilderVal.MakeSynthetic() - SynExpr.Lambda (false,false,SynSimplePats.SimplePats ([mkSynSimplePatVar false (mkSynId mBuilderVal builderValName)],mBuilderVal), runExpr, mBuilderVal) + SynExpr.Lambda (false, false, SynSimplePats.SimplePats ([mkSynSimplePatVar false (mkSynId mBuilderVal builderValName)], mBuilderVal), runExpr, mBuilderVal) let env = match comp with - | SynExpr.YieldOrReturn ((true,_),_,_) -> { env with eContextInfo = ContextInfo.YieldInComputationExpression } - | SynExpr.YieldOrReturn ((_,true),_,_) -> { env with eContextInfo = ContextInfo.ReturnInComputationExpression } + | SynExpr.YieldOrReturn ((true, _), _, _) -> { env with eContextInfo = ContextInfo.YieldInComputationExpression } + | SynExpr.YieldOrReturn ((_, true), _, _) -> { env with eContextInfo = ContextInfo.ReturnInComputationExpression } | _ -> env - let lambdaExpr ,tpenv= TcExpr cenv (builderTy --> overallTy) env tpenv lambdaExpr + let lambdaExpr , tpenv= TcExpr cenv (builderTy --> overallTy) env tpenv lambdaExpr // beta-var-reduce to bind the builder using a 'let' binding - let coreExpr = mkApps cenv.g ((lambdaExpr,tyOfExpr cenv.g lambdaExpr),[],[interpExpr],mBuilderVal) + let coreExpr = mkApps cenv.g ((lambdaExpr, tyOfExpr cenv.g lambdaExpr), [], [interpExpr], mBuilderVal) - coreExpr,tpenv + coreExpr, tpenv /// This case is used for computation expressions which are sequence expressions. Technically the code path is different because it @@ -8062,49 +8062,49 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = match comp with | SynExpr.ForEach (_spBind, SeqExprOnly _seqExprOnly, _isFromSource, pat, pseudoEnumExpr, innerComp, m) -> // 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,arb_ty,tpenv = TcExprOfUnknownType cenv env tpenv pseudoEnumExpr - let enumExpr,enumElemTy = ConvertArbitraryExprToEnumerable cenv arb_ty env pseudoEnumExpr - let pat',_,vspecs,envinner,tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat,None) - let innerExpr,tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp + let pseudoEnumExpr, arb_ty, tpenv = TcExprOfUnknownType cenv env tpenv pseudoEnumExpr + let enumExpr, enumElemTy = ConvertArbitraryExprToEnumerable cenv arb_ty env pseudoEnumExpr + let pat', _, vspecs, envinner, tpenv = TcMatchPattern cenv enumElemTy env tpenv (pat, None) + let innerExpr, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp match pat', vspecs, innerExpr with // peephole optimization: "for x in e1 -> e2" == "e1 |> List.map (fun x -> e2)" *) - | (TPat_as (TPat_wild _,PBind (v,_),_), - vs, - Expr.App(Expr.Val(vf,_,_),_,[genEnumElemTy],[yexpr],_)) + | (TPat_as (TPat_wild _, PBind (v, _), _), + vs, + Expr.App(Expr.Val(vf, _, _), _, [genEnumElemTy], [yexpr], _)) when vs.Length = 1 && valRefEq cenv.g vf cenv.g.seq_singleton_vref -> let enumExprMark = enumExpr.Range - let lam = mkLambda enumExprMark v (yexpr,genEnumElemTy) + let lam = mkLambda enumExprMark v (yexpr, genEnumElemTy) // SEQUENCE POINTS: need to build a let here consuming spBind let enumExpr = mkCoerceIfNeeded cenv.g (mkSeqTy cenv.g enumElemTy) (tyOfExpr cenv.g enumExpr) enumExpr - Some(mkCallSeqMap cenv.g m enumElemTy genEnumElemTy lam enumExpr,tpenv) + Some(mkCallSeqMap cenv.g m enumElemTy genEnumElemTy lam enumExpr, tpenv) | _ -> let enumExprMark = enumExpr.Range // SEQUENCE POINTS: need to build a let here consuming spBind - let matchv,matchExpr = compileSeqExprMatchClauses cenv env enumExprMark (pat',vspecs) innerExpr enumElemTy genOuterTy - let lam = mkLambda enumExprMark matchv (matchExpr,tyOfExpr cenv.g matchExpr) + let matchv, matchExpr = compileSeqExprMatchClauses cenv env enumExprMark (pat', vspecs) innerExpr enumElemTy genOuterTy + let lam = mkLambda enumExprMark matchv (matchExpr, tyOfExpr cenv.g matchExpr) Some(mkSeqCollect cenv env m enumElemTy genOuterTy lam enumExpr , tpenv) - | SynExpr.For (spBind,id,start,dir,finish,innerComp,m) -> - Some(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spBind,id,start,dir,finish,innerComp,m))) + | SynExpr.For (spBind, id, start, dir, finish, innerComp, m) -> + Some(tcSequenceExprBody env genOuterTy tpenv (elimFastIntegerForLoop (spBind, id, start, dir, finish, innerComp, m))) - | SynExpr.While (_spWhile,guardExpr,innerComp,_m) -> - let guardExpr,tpenv = TcExpr cenv cenv.g.bool_ty env tpenv guardExpr - let innerExpr,tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp + | SynExpr.While (_spWhile, guardExpr, innerComp, _m) -> + let guardExpr, tpenv = TcExpr cenv cenv.g.bool_ty env tpenv guardExpr + let innerExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp let guardExprMark = guardExpr.Range let guardExpr = mkUnitDelayLambda cenv.g guardExprMark guardExpr let innerExpr = mkDelayedExpr innerExpr Some(mkSeqFromFunctions cenv env guardExprMark genOuterTy guardExpr innerExpr, tpenv) - | SynExpr.TryFinally (innerComp,unwindExpr,_mTryToLast,_spTry,_spFinally) -> - let innerExpr,tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp - let unwindExpr,tpenv = TcExpr cenv cenv.g.unit_ty env tpenv unwindExpr + | SynExpr.TryFinally (innerComp, unwindExpr, _mTryToLast, _spTry, _spFinally) -> + let innerExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp + let unwindExpr, tpenv = TcExpr cenv cenv.g.unit_ty env tpenv unwindExpr let unwindExprMark = unwindExpr.Range let unwindExpr = mkUnitDelayLambda cenv.g unwindExprMark unwindExpr @@ -8112,39 +8112,39 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = let innerExprMark = innerExpr.Range Some(mkSeqFinally cenv env innerExprMark genOuterTy innerExpr unwindExpr, tpenv) - | SynExpr.Paren (_,_,_,m) -> - error(Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression(),m)) + | SynExpr.Paren (_, _, _, m) -> + error(Error(FSComp.SR.tcConstructIsAmbiguousInSequenceExpression(), m)) | SynExpr.ImplicitZero m -> - Some(mkSeqEmpty cenv env m genOuterTy,tpenv ) + Some(mkSeqEmpty cenv env m genOuterTy, tpenv ) - | SynExpr.DoBang(_rhsExpr,m) -> - error(Error(FSComp.SR.tcDoBangIllegalInSequenceExpression(),m)) + | SynExpr.DoBang(_rhsExpr, m) -> + error(Error(FSComp.SR.tcDoBangIllegalInSequenceExpression(), m)) - | SynExpr.Sequential(sp,true,innerComp1, innerComp2,m) -> + | SynExpr.Sequential(sp, true, innerComp1, innerComp2, m) -> // "expr; cexpr" is treated as sequential execution // "cexpr; cexpr" is treated as append match tryTcSequenceExprBody env genOuterTy tpenv innerComp1 with | None -> - let innerExpr1,tpenv = TcStmtThatCantBeCtorBody cenv env tpenv innerComp1 - let innerExpr2,tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 + let innerExpr1, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv innerComp1 + let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 - Some(Expr.Sequential(innerExpr1,innerExpr2,NormalSeq,sp,m),tpenv) + Some(Expr.Sequential(innerExpr1, innerExpr2, NormalSeq, sp, m), tpenv) - | Some (innerExpr1,tpenv) -> - let innerExpr2,tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 + | Some (innerExpr1, tpenv) -> + let innerExpr2, tpenv = tcSequenceExprBody env genOuterTy tpenv innerComp2 let innerExpr2 = mkDelayedExpr innerExpr2 Some(mkSeqAppend cenv env innerComp1.Range genOuterTy innerExpr1 innerExpr2, tpenv) - | SynExpr.IfThenElse (guardExpr,thenComp,elseCompOpt,spIfToThen,_isRecovery,mIfToThen,mIfToEndOfElseBranch) -> - let guardExpr',tpenv = TcExpr cenv cenv.g.bool_ty env tpenv guardExpr - let thenExpr,tpenv = tcSequenceExprBody env genOuterTy tpenv thenComp + | SynExpr.IfThenElse (guardExpr, thenComp, elseCompOpt, spIfToThen, _isRecovery, mIfToThen, mIfToEndOfElseBranch) -> + let guardExpr', tpenv = TcExpr cenv cenv.g.bool_ty env tpenv guardExpr + let thenExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv thenComp let elseComp = (match elseCompOpt with Some c -> c | None -> SynExpr.ImplicitZero mIfToThen) - let elseExpr,tpenv = tcSequenceExprBody env genOuterTy tpenv elseComp + let elseExpr, tpenv = tcSequenceExprBody env genOuterTy tpenv elseComp Some(mkCond spIfToThen SequencePointAtTarget mIfToEndOfElseBranch genOuterTy guardExpr' thenExpr elseExpr, tpenv) // 'let x = expr in expr' - | SynExpr.LetOrUse (_,false (* not a 'use' binding *),_,_,_) -> + | SynExpr.LetOrUse (_, false (* not a 'use' binding *), _, _, _) -> TcLinearExprs (fun ty envinner tpenv e -> tcSequenceExprBody envinner ty tpenv e) cenv env overallTy @@ -8154,55 +8154,55 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = (fun x -> x) |> Some // 'use x = expr in expr' - | SynExpr.LetOrUse (_isRec,true,[Binding (_vis,NormalBinding,_,_,_,_,_,pat,_,rhsExpr,_,_spBind)],innerComp,wholeExprMark) -> + | SynExpr.LetOrUse (_isRec, true, [Binding (_vis, NormalBinding, _, _, _, _, _, pat, _, rhsExpr, _, _spBind)], innerComp, wholeExprMark) -> let bindPatTy = NewInferenceType () let inputExprTy = NewInferenceType () - let pat',_,vspecs,envinner,tpenv = TcMatchPattern cenv bindPatTy env tpenv (pat,None) + let pat', _, vspecs, envinner, tpenv = TcMatchPattern cenv bindPatTy env tpenv (pat, None) UnifyTypes cenv env m inputExprTy bindPatTy - let inputExpr,tpenv = TcExpr cenv inputExprTy env tpenv rhsExpr - let innerExpr,tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp + let inputExpr, tpenv = TcExpr cenv inputExprTy env tpenv rhsExpr + let innerExpr, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp let inputExprMark = inputExpr.Range - let matchv,matchExpr = compileSeqExprMatchClauses cenv env inputExprMark (pat',vspecs) innerExpr bindPatTy genOuterTy - let consumeExpr = mkLambda wholeExprMark matchv (matchExpr,genOuterTy) + let matchv, matchExpr = compileSeqExprMatchClauses cenv env inputExprMark (pat', vspecs) innerExpr bindPatTy genOuterTy + let consumeExpr = mkLambda wholeExprMark matchv (matchExpr, genOuterTy) //SEQPOINT NEEDED - we must consume spBind on this path Some(mkSeqUsing cenv env wholeExprMark bindPatTy genOuterTy inputExpr consumeExpr, tpenv) - | SynExpr.LetOrUseBang(_,_,_,_,_,_,m) -> - error(Error(FSComp.SR.tcUseForInSequenceExpression(),m)) + | SynExpr.LetOrUseBang(_, _, _, _, _, _, m) -> + error(Error(FSComp.SR.tcUseForInSequenceExpression(), m)) - | SynExpr.Match (spMatch,expr,clauses,false,_) -> - let inputExpr,matchty,tpenv = TcExprOfUnknownType cenv env tpenv expr - let tclauses,tpenv = + | SynExpr.Match (spMatch, expr, clauses, false, _) -> + let inputExpr, matchty, tpenv = TcExprOfUnknownType cenv env tpenv expr + let tclauses, tpenv = List.mapFold - (fun tpenv (Clause(pat,cond,innerComp,_,sp)) -> - let pat',cond',vspecs,envinner,tpenv = TcMatchPattern cenv matchty env tpenv (pat,cond) - let innerExpr,tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp - TClause(pat',cond',TTarget(vspecs, innerExpr,sp),pat'.Range),tpenv) + (fun tpenv (Clause(pat, cond, innerComp, _, sp)) -> + let pat', cond', vspecs, envinner, tpenv = TcMatchPattern cenv matchty env tpenv (pat, cond) + let innerExpr, tpenv = tcSequenceExprBody envinner genOuterTy tpenv innerComp + TClause(pat', cond', TTarget(vspecs, innerExpr, sp), pat'.Range), tpenv) tpenv clauses let inputExprTy = tyOfExpr cenv.g inputExpr let inputExprMark = inputExpr.Range - let matchv,matchExpr = CompilePatternForMatchClauses cenv env inputExprMark inputExprMark true ThrowIncompleteMatchException inputExprTy genOuterTy tclauses + let matchv, matchExpr = CompilePatternForMatchClauses cenv env inputExprMark inputExprMark true ThrowIncompleteMatchException inputExprTy genOuterTy tclauses Some(mkLet spMatch inputExprMark matchv inputExpr matchExpr, tpenv) - | SynExpr.TryWith (_,mTryToWith,_,_,_,_,_) -> - error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(),mTryToWith)) + | SynExpr.TryWith (_, mTryToWith, _, _, _, _, _) -> + error(Error(FSComp.SR.tcTryIllegalInSequenceExpression(), mTryToWith)) - | SynExpr.YieldOrReturnFrom((isYield,_),yieldExpr,m) -> - let resultExpr,genExprTy,tpenv = TcExprOfUnknownType cenv env tpenv yieldExpr + | SynExpr.YieldOrReturnFrom((isYield, _), yieldExpr, m) -> + let resultExpr, genExprTy, tpenv = TcExprOfUnknownType cenv env tpenv yieldExpr - if not isYield then errorR(Error(FSComp.SR.tcUseYieldBangForMultipleResults(),m)) + if not isYield then errorR(Error(FSComp.SR.tcUseYieldBangForMultipleResults(), m)) AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace genOuterTy genExprTy - Some(mkCoerceExpr(resultExpr,genOuterTy,m,genExprTy), tpenv) + Some(mkCoerceExpr(resultExpr, genOuterTy, m, genExprTy), tpenv) - | SynExpr.YieldOrReturn((isYield,_),yieldExpr,m) -> + | SynExpr.YieldOrReturn((isYield, _), yieldExpr, m) -> let genResultTy = NewInferenceType () - if not isYield then errorR(Error(FSComp.SR.tcSeqResultsUseYield(),m)) + if not isYield then errorR(Error(FSComp.SR.tcSeqResultsUseYield(), m)) UnifyTypes cenv env m genOuterTy (mkSeqTy cenv.g genResultTy) - let resultExpr,tpenv = TcExpr cenv genResultTy env tpenv yieldExpr + let resultExpr, tpenv = TcExpr cenv genResultTy env tpenv yieldExpr Some(mkCallSeqSingleton cenv.g m genResultTy resultExpr, tpenv ) | _ -> None @@ -8214,18 +8214,18 @@ and TcSequenceExpression cenv env tpenv comp overallTy m = // seq { ...; expr } is treated as 'seq { ... ; expr; yield! Seq.empty }' // Note this means seq { ...; () } is treated as 'seq { ... ; (); yield! Seq.empty }' let m = comp.Range - let expr,tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp - Expr.Sequential(expr,mkSeqEmpty cenv env m genOuterTy,NormalSeq,SuppressSequencePointOnStmtOfSequential,m),tpenv + let expr, tpenv = TcStmtThatCantBeCtorBody cenv env tpenv comp + Expr.Sequential(expr, mkSeqEmpty cenv env m genOuterTy, NormalSeq, SuppressSequencePointOnStmtOfSequential, m), tpenv let genEnumElemTy = NewInferenceType () UnifyTypes cenv env m overallTy (mkSeqTy cenv.g genEnumElemTy) - let coreExpr,tpenv = tcSequenceExprBody env overallTy tpenv comp + let coreExpr, tpenv = tcSequenceExprBody env overallTy tpenv comp let delayedExpr = mkDelayedExpr coreExpr - delayedExpr,tpenv + delayedExpr, tpenv //------------------------------------------------------------------------- -// Typecheck "expr ... " constructs where "..." is a sequence of applications, +// Typecheck "expr ... " constructs where "..." is a sequence of applications, // type applications and dot-notation projections. First extract known // type information from the "..." part to use during type checking. // @@ -8255,27 +8255,27 @@ and Propagate cenv overallTy env tpenv (expr: ApplicableExpr) exprty delayed = | DelayedApp (_, arg, mExprAndArg) :: delayedList' -> let denv = env.DisplayEnv match UnifyFunctionTypeUndoIfFailed cenv denv mExpr exprty with - | Some (_,resultTy) -> + | Some (_, resultTy) -> propagate delayedList' mExprAndArg resultTy | None -> let mArg = arg.Range match arg with | SynExpr.CompExpr _ -> () - | SynExpr.ArrayOrListOfSeqExpr (false,_,_) -> + | SynExpr.ArrayOrListOfSeqExpr (false, _, _) -> // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects_Delayed cenv env tpenv delayed if IsIndexerType cenv.g cenv.amap expr.Type then match expr.Expr with - | Expr.Val (d,_,_) -> - error (NotAFunctionButIndexer(denv,overallTy,Some d.DisplayName,mExpr,mArg)) + | Expr.Val (d, _, _) -> + error (NotAFunctionButIndexer(denv, overallTy, Some d.DisplayName, mExpr, mArg)) | _ -> - error (NotAFunctionButIndexer(denv,overallTy,None,mExpr,mArg)) + error (NotAFunctionButIndexer(denv, overallTy, None, mExpr, mArg)) else - error (NotAFunction(denv,overallTy,mExpr,mArg)) + error (NotAFunction(denv, overallTy, mExpr, mArg)) | _ -> // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects_Delayed cenv env tpenv delayed - error (NotAFunction(denv,overallTy,mExpr,mArg)) + error (NotAFunction(denv, overallTy, mExpr, mArg)) propagate delayed expr.Range exprty @@ -8284,24 +8284,24 @@ and PropagateThenTcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFla TcDelayed cenv overallTy env tpenv mExpr expr exprty atomicFlag delayed -/// Typecheck "expr ... " constructs where "..." is a sequence of applications, +/// Typecheck "expr ... " constructs where "..." is a sequence of applications, /// type applications and dot-notation projections. and TcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag:ExprAtomicFlag) delayed = // OK, we've typechecked the thing on the left of the delayed lookup chain. // We can now record for posterity the type of this expression and the location of the expression. if (atomicFlag = ExprAtomicFlag.Atomic) then - CallExprHasTypeSink cenv.tcSink (mExpr,env.NameEnv,exprty, env.DisplayEnv,env.eAccessRights) + CallExprHasTypeSink cenv.tcSink (mExpr, env.NameEnv, exprty, env.DisplayEnv, env.eAccessRights) match delayed with | [] | DelayedDot :: _ -> UnifyTypesAndRecover cenv env mExpr overallTy exprty - expr.Expr,tpenv + expr.Expr, tpenv // expr.M(args) where x.M is a .NET method or index property // expr.M(args) where x.M is a .NET method or index property // expr.M where x.M is a .NET method or index property - | DelayedDotLookup (longId,mDotLookup) :: otherDelayed -> + | DelayedDotLookup (longId, mDotLookup) :: otherDelayed -> TcLookupThen cenv overallTy env tpenv mExpr expr.Expr exprty longId otherDelayed mDotLookup // f x | DelayedApp (hpa, arg, mExprAndArg) :: otherDelayed -> @@ -8310,7 +8310,7 @@ and TcDelayed cenv overallTy env tpenv mExpr expr exprty (atomicFlag:ExprAtomicF | DelayedTypeApp (_, mTypeArgs, _mExprAndTypeArgs) :: _ -> error(Error(FSComp.SR.tcUnexpectedTypeArguments(), mTypeArgs)) | DelayedSet _ :: _ -> - error(Error(FSComp.SR.tcInvalidAssignment(),mExpr)) + error(Error(FSComp.SR.tcInvalidAssignment(), mExpr)) /// Convert the delayed identifiers to a dot-lookup. @@ -8322,7 +8322,7 @@ and delayRest rest mPrior delayed = | [] -> delayed | longId -> let mPriorAndLongId = unionRanges mPrior (rangeOfLid longId) - DelayedDotLookup (rest,mPriorAndLongId) :: delayed + DelayedDotLookup (rest, mPriorAndLongId) :: delayed //------------------------------------------------------------------------- @@ -8337,37 +8337,37 @@ and TcFunctionApplicationThen cenv overallTy env tpenv mExprAndArg expr exprty ( // If the type of 'synArg' unifies as a function type, then this is a function application, otherwise // it is an error or a computation expression match UnifyFunctionTypeUndoIfFailed cenv denv mFunExpr exprty with - | Some (domainTy,resultTy) -> + | Some (domainTy, resultTy) -> // Notice the special case 'seq { ... }'. In this case 'seq' is actually a function in the F# library. // Set a flag in the syntax tree to say we noticed a leading 'seq' match synArg with - | SynExpr.CompExpr (false,isNotNakedRefCell,_comp,_m) -> + | SynExpr.CompExpr (false, isNotNakedRefCell, _comp, _m) -> isNotNakedRefCell := !isNotNakedRefCell || (match expr with - | ApplicableExpr(_,Expr.Op(TOp.Coerce,_,[Expr.App(Expr.Val(vf,_,_),_,_,_,_)],_),_) when valRefEq cenv.g vf cenv.g.seq_vref -> true + | ApplicableExpr(_, Expr.Op(TOp.Coerce, _, [Expr.App(Expr.Val(vf, _, _), _, _, _, _)], _), _) when valRefEq cenv.g vf cenv.g.seq_vref -> true | _ -> false) | _ -> () - let arg,tpenv = TcExpr cenv domainTy env tpenv synArg + let arg, tpenv = TcExpr cenv domainTy env tpenv synArg let exprAndArg = buildApp cenv expr exprty arg mExprAndArg TcDelayed cenv overallTy env tpenv mExprAndArg exprAndArg resultTy atomicFlag delayed | None -> // OK, 'expr' doesn't have function type, but perhaps 'expr' is a computation expression builder, and 'arg' is '{ ... }' match synArg with - | SynExpr.CompExpr (false,_isNotNakedRefCell,comp,_m) -> - let bodyOfCompExpr,tpenv = TcComputationOrSequenceExpression cenv env overallTy mFunExpr (Some(expr.Expr,exprty)) tpenv comp + | SynExpr.CompExpr (false, _isNotNakedRefCell, comp, _m) -> + let bodyOfCompExpr, tpenv = TcComputationOrSequenceExpression cenv env overallTy mFunExpr (Some(expr.Expr, exprty)) tpenv comp TcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv bodyOfCompExpr) (tyOfExpr cenv.g bodyOfCompExpr) ExprAtomicFlag.NonAtomic delayed | _ -> - error (NotAFunction(denv,overallTy,mFunExpr,mArg)) + error (NotAFunction(denv, overallTy, mFunExpr, mArg)) //------------------------------------------------------------------------- // TcLongIdentThen : Typecheck "A.B.C.E.F ... " constructs //------------------------------------------------------------------------- -and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId,_)) delayed = +and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId, _)) delayed = let ad = env.eAccessRights let typeNameResInfo = @@ -8393,7 +8393,7 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId,_)) delay // Typecheck "item+projections" //------------------------------------------------------------------------- *) // mItem is the textual range covered by the long identifiers that make up the item -and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delayed = +and TcItemThen cenv overallTy env tpenv (item, mItem, rest, afterResolution) delayed = let delayed = delayRest rest mItem delayed let ad = env.eAccessRights match item with @@ -8401,19 +8401,19 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye | (Item.UnionCase _ | Item.ExnCase _ | Item.ActivePatternResult _) as item -> // ucaseAppTy is the type of the union constructor applied to its (optional) argument let ucaseAppTy = NewInferenceType () - let mkConstrApp,argtys, argNames = + let mkConstrApp, argtys, argNames = match item with | Item.ActivePatternResult(apinfo, _, n, _) -> let aparity = apinfo.Names.Length match aparity with | 0 | 1 -> - let mkConstrApp _mArgs = function [arg] -> arg | _ -> error(InternalError("ApplyUnionCaseOrExn",mItem)) - mkConstrApp, [ucaseAppTy], [ for (s,m) in apinfo.ActiveTagsWithRanges -> mkSynId m s ] + let mkConstrApp _mArgs = function [arg] -> arg | _ -> error(InternalError("ApplyUnionCaseOrExn", mItem)) + mkConstrApp, [ucaseAppTy], [ for (s, m) in apinfo.ActiveTagsWithRanges -> mkSynId m s ] | _ -> let ucref = mkChoiceCaseRef cenv.g mItem aparity n - let _,_,tinst,_ = infoOfTyconRef mItem ucref.TyconRef - let ucinfo = UnionCaseInfo(tinst,ucref) - ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase(ucinfo,false)) + let _, _, tinst, _ = infoOfTyconRef mItem ucref.TyconRef + let ucinfo = UnionCaseInfo(tinst, ucref) + ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy (Item.UnionCase(ucinfo, false)) | _ -> ApplyUnionCaseOrExnTypes mItem cenv env ucaseAppTy item let nargtys = List.length argtys @@ -8422,9 +8422,9 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye let (|FittedArgs|_|) arg = match arg with - | SynExprParen(SynExpr.Tuple(args,_,_),_,_,_) - | SynExpr.Tuple(args,_,_) when nargtys > 1 -> Some args - | SynExprParen(arg,_,_,_) + | SynExprParen(SynExpr.Tuple(args, _, _), _, _, _) + | SynExpr.Tuple(args, _, _) when nargtys > 1 -> Some args + | SynExprParen(arg, _, _, _) | arg when nargtys = 1 -> Some [arg] | _ -> None @@ -8442,7 +8442,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye // apply named parameters let args = // GetMethodArgs checks that no named parameters are located before positional - let unnamedArgs,namedCallerArgs = GetMethodArgs origArg + let unnamedArgs, namedCallerArgs = GetMethodArgs origArg match namedCallerArgs with | [] -> args @@ -8467,11 +8467,11 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye if isNull(box fittedArgs.[i]) then fittedArgs.[i] <- arg let argContainerOpt = match item with - | Item.UnionCase(uci,_) -> Some(ArgumentContainer.UnionCase(uci)) + | Item.UnionCase(uci, _) -> Some(ArgumentContainer.UnionCase(uci)) | Item.ExnCase tref -> Some(ArgumentContainer.Type(tref)) | _ -> None let argItem = Item.ArgName (argNames.[i], argtys.[i], argContainerOpt) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,argItem,argItem,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,ad) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, argItem, argItem, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad) else error(Error(FSComp.SR.tcUnionCaseFieldCannotBeUsedMoreThanOnce(id.idText), id.idRange)) currentIndex <- SEEN_NAMED_ARGUMENT | None -> @@ -8496,40 +8496,40 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye else let caseName = match item with - | Item.UnionCase(uci,_) -> uci.Name + | Item.UnionCase(uci, _) -> uci.Name | Item.ExnCase tcref -> tcref.DisplayName | _ -> failwith "impossible" - error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(caseName, id.idText), id.idRange)) + error(Error(FSComp.SR.tcUnionCaseConstructorDoesNotHaveFieldWithGivenName(caseName, id.idText), id.idRange)) assert (Seq.forall (box >> ((<>) null) ) fittedArgs) List.ofArray fittedArgs - let args',tpenv = TcExprs cenv env mExprAndArg tpenv flexes argtys args + let args', tpenv = TcExprs cenv env mExprAndArg tpenv flexes argtys args PropagateThenTcDelayed cenv overallTy env tpenv mExprAndArg (MakeApplicableExprNoFlex cenv (mkConstrApp mExprAndArg args')) ucaseAppTy atomicFlag otherDelayed | DelayedTypeApp (_x, mTypeArgs, _mExprAndTypeArgs) :: _delayed' -> - error(Error(FSComp.SR.tcUnexpectedTypeArguments(),mTypeArgs)) + error(Error(FSComp.SR.tcUnexpectedTypeArguments(), mTypeArgs)) | _ -> // Work out how many syntactic arguments we really expect. Also return a function that builds the overall // expression, but don't apply this function until after we've checked that the number of arguments is OK // (or else we would be building an invalid expression) // Unit-taking active pattern result can be applied to no args - let nargs,mkExpr = + let nargs, mkExpr = // This is where the constructor is an active pattern result applied to no argument // Unit-taking active pattern result can be applied to no args if (nargtys = 1 && match item with Item.ActivePatternResult _ -> true | _ -> false) then UnifyTypes cenv env mItem (List.head argtys) cenv.g.unit_ty - 1,(fun () -> mkConstrApp mItem [mkUnit cenv.g mItem]) + 1, (fun () -> mkConstrApp mItem [mkUnit cenv.g mItem]) // This is where the constructor expects no arguments and is applied to no argument elif nargtys = 0 then - 0,(fun () -> mkConstrApp mItem []) + 0, (fun () -> mkConstrApp mItem []) else // This is where the constructor expects arguments but is not applied to arguments, hence build a lambda nargtys, (fun () -> - let vs,args = argtys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + let vs, args = argtys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip let constrApp = mkConstrApp mItem args let lam = mkMultiLambda mItem vs (constrApp, tyOfExpr cenv.g constrApp) lam) @@ -8538,39 +8538,39 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye let exprTy = tyOfExpr cenv.g expr PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprNoFlex cenv expr) exprTy ExprAtomicFlag.Atomic delayed - | Item.Types(nm,(typ::_)) -> + | Item.Types(nm, (typ::_)) -> match delayed with - | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::(DelayedDotLookup (longId,mLongId))::otherDelayed) -> + | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::(DelayedDotLookup (longId, mLongId))::otherDelayed) -> - // If Item.Types is returned then the typ will be of the form TType_app(tcref,genericTyargs) where tyargs + // If Item.Types is returned then the typ will be of the form TType_app(tcref, genericTyargs) where tyargs // is a fresh instantiation for tcref. TcNestedTypeApplication will chop off precisely #genericTyargs args // and replace them by 'tyargs' - let typ,tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs typ tyargs + let typ, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs typ tyargs // Report information about the whole expression including type arguments to VS let item = Item.Types(nm, [typ]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) TcItemThen cenv overallTy env tpenv (ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver (unionRanges mExprAndTypeArgs mLongId) ad env.eNameResEnv typ longId IgnoreOverrides true) otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::_delayed') -> // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! - let typ,_ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs typ tyargs + let typ, _ = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs typ tyargs let item = Item.Types(nm, [typ]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) // Same error as in the following case - error(Error(FSComp.SR.tcInvalidUseOfTypeName(),mItem)) + error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) | _ -> // In this case the type is not generic, and indeed we should never have returned Item.Types. // That's because ResolveTypeNamesToCtors should have been set at the original // call to ResolveLongIdentAsExprAndComputeRange - error(Error(FSComp.SR.tcInvalidUseOfTypeName(),mItem)) + error(Error(FSComp.SR.tcInvalidUseOfTypeName(), mItem)) - | Item.MethodGroup (methodName,minfos,_) -> - // Static method calls Type.Foo(arg1,...,argn) - let meths = List.map (fun minfo -> minfo,None) minfos + | Item.MethodGroup (methodName, minfos, _) -> + // Static method calls Type.Foo(arg1, ..., argn) + let meths = List.map (fun minfo -> minfo, None) minfos match delayed with | (DelayedApp (atomicFlag, arg, mExprAndArg)::otherDelayed) -> TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterResolution NormalValUse [arg] atomicFlag otherDelayed @@ -8594,12 +8594,12 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye | None -> #endif - let tyargs,tpenv = TcTypesOrMeasures None cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mTypeArgs + let tyargs, tpenv = TcTypesOrMeasures None cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv tys mTypeArgs // FUTURE: can we do better than emptyTyparInst here, in order to display instantiations // of type variables in the quick info provided in the IDE? But note we haven't yet even checked if the // number of type arguments is correct... - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) match otherDelayed with | DelayedApp(atomicFlag, arg, mExprAndArg) :: otherDelayed -> @@ -8610,34 +8610,34 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye | _ -> #if EXTENSIONTYPING if not minfos.IsEmpty && minfos.[0].ProvidedStaticParameterInfo.IsSome then - error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(),mItem)) + error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterResolution NormalValUse [] ExprAtomicFlag.Atomic delayed - | Item.CtorGroup(nm,minfos) -> + | Item.CtorGroup(nm, minfos) -> let objTy = match minfos with | (minfo :: _) -> minfo.EnclosingType - | [] -> error(Error(FSComp.SR.tcTypeHasNoAccessibleConstructor(),mItem)) + | [] -> error(Error(FSComp.SR.tcTypeHasNoAccessibleConstructor(), mItem)) match delayed with | ((DelayedApp (_, arg, mExprAndArg))::otherDelayed) -> - CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv,objTy, env.DisplayEnv, env.eAccessRights) + CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTy, env.DisplayEnv, env.eAccessRights) TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [arg] mExprAndArg otherDelayed (Some afterResolution) | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::(DelayedApp (_, arg, mExprAndArg))::otherDelayed) -> - let objTyAfterTyArgs,tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs + let objTyAfterTyArgs, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTyAfterTyArgs, env.DisplayEnv, env.eAccessRights) let itemAfterTyArgs, minfosAfterTyArgs = #if EXTENSIONTYPING // If the type is provided and took static arguments then the constructor will have changed // to a provided constructor on the statically instantiated type. Re-resolve that constructor. match objTyAfterTyArgs with - | AppTy cenv.g (tcref,_) when tcref.Deref.IsProvided -> + | AppTy cenv.g (tcref, _) when tcref.Deref.IsProvided -> let newItem = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mExprAndArg ad objTyAfterTyArgs) match newItem with - | Item.CtorGroup(_,newMinfos) -> newItem, newMinfos + | Item.CtorGroup(_, newMinfos) -> newItem, newMinfos | _ -> item, minfos | _ -> #endif @@ -8648,11 +8648,11 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye | ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::otherDelayed) -> - let objTy,tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs + let objTy, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs // A case where we have an incomplete name e.g. 'Foo.' - we still want to report it to VS! let resolvedItem = Item.Types(nm, [objTy]) - CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,resolvedItem,resolvedItem,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs, env.NameEnv, resolvedItem, resolvedItem, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) minfos |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.EnclosingType objTy) TcCtorCall true cenv env tpenv overallTy objTy (Some mExprAndTypeArgs) item false [] mExprAndTypeArgs otherDelayed (Some afterResolution) @@ -8662,7 +8662,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterResolution) | Item.FakeInterfaceCtor _ -> - error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(),mItem)) + error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(), mItem)) | Item.ImplicitOp(id, sln) -> let isPrefix = PrettyNaming.IsPrefixOperator id.idText @@ -8670,29 +8670,29 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye let argData = if isPrefix then - [ Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) ] + [ Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) ] elif isTernary then - [ Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) - Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) - Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) ] + [ Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) + Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) + Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) ] else - [ Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) - Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) ] + [ Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) + Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) ] - let retTyData = Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq,true) - let argTypars = argData |> List.map (fun d -> NewTypar (TyparKind.Type, TyparRigidity.Flexible,d,false,TyparDynamicReq.Yes,[],false,false)) - let retTypar = NewTypar (TyparKind.Type, TyparRigidity.Flexible,retTyData,false,TyparDynamicReq.Yes,[],false,false) + let retTyData = Typar(mkSynId mItem (cenv.synArgNameGenerator.New()), HeadTypeStaticReq, true) + let argTypars = argData |> List.map (fun d -> NewTypar (TyparKind.Type, TyparRigidity.Flexible, d, false, TyparDynamicReq.Yes, [], false, false)) + let retTypar = NewTypar (TyparKind.Type, TyparRigidity.Flexible, retTyData, false, TyparDynamicReq.Yes, [], false, false) let argTys = argTypars |> List.map mkTyparTy let retTy = mkTyparTy retTypar - let vs,ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip + let vs, ves = argTys |> List.mapi (fun i ty -> mkCompGenLocal mItem ("arg" + string i) ty) |> List.unzip let memberFlags = StaticMemberFlags MemberKind.Member let logicalCompiledName = ComputeLogicalName id memberFlags - let traitInfo = TTrait(argTys,logicalCompiledName,memberFlags,argTys,Some retTy, sln) + let traitInfo = TTrait(argTys, logicalCompiledName, memberFlags, argTys, Some retTy, sln) let expr = Expr.Op(TOp.TraitCall(traitInfo), [], ves, mItem) - let expr = mkLambdas mItem [] vs (expr,retTy) + let expr = mkLambdas mItem [] vs (expr, retTy) let rec isSimpleArgument e = match e with @@ -8717,7 +8717,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye | SynExpr.Tuple(synExprs, _, _) | SynExpr.StructTuple(synExprs, _, _) | SynExpr.ArrayOrList(_, synExprs, _) -> synExprs |> List.forall isSimpleArgument - | SynExpr.Record(_,copyOpt,fields, _) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall (p23 >> Option.forall isSimpleArgument) + | SynExpr.Record(_, copyOpt, fields, _) -> copyOpt |> Option.forall (fst >> isSimpleArgument) && fields |> List.forall (p23 >> Option.forall isSimpleArgument) | SynExpr.App (_, _, synExpr, synExpr2, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 | SynExpr.IfThenElse(synExpr, synExpr2, synExprOpt, _, _, _, _) -> isSimpleArgument synExpr && isSimpleArgument synExpr2 && Option.forall isSimpleArgument synExprOpt | SynExpr.DotIndexedGet(synExpr, _, _, _) -> isSimpleArgument synExpr @@ -8765,7 +8765,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye // Take all simple arguments and process them before applying the constraint. let delayed1, delayed2 = - let pred = (function (DelayedApp (_,arg,_)) -> isSimpleArgument arg | _ -> false) + let pred = (function (DelayedApp (_, arg, _)) -> isSimpleArgument arg | _ -> false) List.takeWhile pred delayed, List.skipWhile pred delayed let intermediateTy = if isNil delayed2 then overallTy else NewInferenceType () @@ -8784,21 +8784,21 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye | ((DelayedApp (atomicFlag, arg, mItemAndArg))::otherDelayed) -> TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg typ arg atomicFlag otherDelayed | ((DelayedTypeApp(tyargs, _mTypeArgs, mItemAndTypeArgs))::(DelayedApp (atomicFlag, arg, mItemAndArg))::otherDelayed) -> - let typ,tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs typ tyargs + let typ, tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mItemAndTypeArgs typ tyargs // Report information about the whole expression including type arguments to VS let item = Item.DelegateCtor typ - CallNameResolutionSink cenv.tcSink (mItemAndTypeArgs,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (mItemAndTypeArgs, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) TcNewDelegateThen cenv overallTy env tpenv mItem mItemAndArg typ arg atomicFlag otherDelayed | _ -> - error(Error(FSComp.SR.tcInvalidUseOfDelegate(),mItem)) + error(Error(FSComp.SR.tcInvalidUseOfDelegate(), mItem)) | Item.Value vref -> match delayed with // Mutable value set: 'v <- e' - | DelayedSet(e2,mStmt) :: otherDelayed -> - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + | DelayedSet(e2, mStmt) :: otherDelayed -> + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty vref.Deref.SetHasBeenReferenced() CheckValAccessible mItem env.eAccessRights vref @@ -8808,10 +8808,10 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye if isByrefTy cenv.g vty then destByrefTy cenv.g vty else - if not vref.IsMutable then error (ValNotMutable(env.DisplayEnv,vref,mStmt)) + if not vref.IsMutable then error (ValNotMutable(env.DisplayEnv, vref, mStmt)) vty // Always allow subsumption on assignment to fields - let e2',tpenv = TcExprFlex cenv true vty2 env tpenv e2 + let e2', tpenv = TcExprFlex cenv true vty2 env tpenv e2 let vexp = if isByrefTy cenv.g vty then mkAddrSet mStmt vref e2' @@ -8839,53 +8839,53 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye let vexpFlex = (if isSpecial then MakeApplicableExprNoFlex cenv vexp else MakeApplicableExprWithFlex cenv env vexp) PropagateThenTcDelayed cenv overallTy env tpenv mItem vexpFlex vexpFlex.Type ExprAtomicFlag.Atomic delayed - | Item.Property (nm,pinfos) -> - if isNil pinfos then error (InternalError ("Unexpected error: empty property list",mItem)) + | Item.Property (nm, pinfos) -> + if isNil pinfos then error (InternalError ("Unexpected error: empty property list", mItem)) // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first. // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed let pinfo = List.head pinfos - let _, tyargsOpt,args,delayed,tpenv = + let _, tyargsOpt, args, delayed, tpenv = if pinfo.IsIndexer then GetMemberApplicationArgs delayed cenv env tpenv - else ExprAtomicFlag.Atomic,None,[mkSynUnit mItem],delayed,tpenv - if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic(nm),mItem)) + else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv + if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic(nm), mItem)) match delayed with - | DelayedSet(e2,mStmt) :: otherDelayed -> + | DelayedSet(e2, mStmt) :: otherDelayed -> let args = if pinfo.IsIndexer then args else [] - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) // Static Property Set (possibly indexer) UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty let meths = pinfos |> SettersOfPropInfos - if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) // Note: static calls never mutate a struct object argument TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed | _ -> // Static Property Get (possibly indexer) let meths = pinfos |> GettersOfPropInfos - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) // Note: static calls never mutate a struct object argument TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed | Item.ILField finfo -> CheckILFieldInfoAccessible cenv.g cenv.amap mItem ad finfo - if not finfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(finfo.FieldName),mItem)) + if not finfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(finfo.FieldName), mItem)) CheckILFieldAttributes cenv.g finfo mItem let fref = finfo.ILFieldRef - let exprty = finfo.FieldType(cenv.amap,mItem) + let exprty = finfo.FieldType(cenv.amap, mItem) match delayed with - | DelayedSet(e2,mStmt) :: _delayed' -> + | DelayedSet(e2, mStmt) :: _delayed' -> UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields - let e2',tpenv = TcExprFlex cenv true exprty env tpenv e2 + let e2', tpenv = TcExprFlex cenv true exprty env tpenv e2 let expr = BuildILStaticFieldSet mStmt finfo e2' - expr,tpenv + expr, tpenv | _ -> // Get static IL field let expr = match finfo.LiteralValue with | Some lit -> - Expr.Const(TcFieldInit mItem lit,mItem,exprty) + Expr.Const(TcFieldInit mItem lit, mItem, exprty) | None -> let isValueType = finfo.IsValueType let valu = if isValueType then AsValue else AsObject @@ -8893,51 +8893,51 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterResolution) delaye // The empty instantiation on the fspec is OK, since we make the correct fspec in IlxGen.GenAsm // This ensures we always get the type instantiation right when doing this from // polymorphic code, after inlining etc. - let fspec = mkILFieldSpec(fref,mkILNamedTy valu fref.EnclosingTypeRef []) + let fspec = mkILFieldSpec(fref, mkILNamedTy valu fref.EnclosingTypeRef []) // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. - mkAsmExpr ([ mkNormalLdsfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else []), finfo.TypeInst,[],[exprty],mItem) + mkAsmExpr ([ mkNormalLdsfld fspec ] @ (if finfo.IsInitOnly then [ AI_nop ] else []), finfo.TypeInst, [], [exprty], mItem) PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed | Item.RecdField rfinfo -> // Get static F# field or literal CheckRecdFieldInfoAccessible cenv.amap mItem ad rfinfo - if not rfinfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.Name),mItem)) + if not rfinfo.IsStatic then error (Error (FSComp.SR.tcFieldIsNotStatic(rfinfo.Name), mItem)) CheckRecdFieldInfoAttributes cenv.g rfinfo mItem |> CommitOperationResult let fref = rfinfo.RecdFieldRef let fieldTy = rfinfo.FieldType match delayed with - | DelayedSet(e2,mStmt) :: otherDelayed -> - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + | DelayedSet(e2, mStmt) :: otherDelayed -> + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) // Set static F# field CheckRecdFieldMutation mItem env.DisplayEnv rfinfo UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty let fieldTy = rfinfo.FieldType // Always allow subsumption on assignment to fields - let e2',tpenv = TcExprFlex cenv true fieldTy env tpenv e2 - let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef,rfinfo.TypeInst,e2',mStmt) - expr,tpenv + let e2', tpenv = TcExprFlex cenv true fieldTy env tpenv e2 + let expr = mkStaticRecdFieldSet (rfinfo.RecdFieldRef, rfinfo.TypeInst, e2', mStmt) + expr, tpenv | _ -> let exprty = fieldTy let expr = match rfinfo.LiteralValue with // Get literal F# field - | Some lit -> Expr.Const(lit,mItem,exprty) + | Some lit -> Expr.Const(lit, mItem, exprty) // Get static F# field - | None -> mkStaticRecdFieldGet (fref,rfinfo.TypeInst,mItem) + | None -> mkStaticRecdFieldGet (fref, rfinfo.TypeInst, mItem) PropagateThenTcDelayed cenv overallTy env tpenv mItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed | Item.Event einfo -> // Instance IL event (fake up event-as-value) TcEventValueThen cenv overallTy env tpenv mItem mItem None einfo delayed - | Item.CustomOperation (nm,usageTextOpt,_) -> + | Item.CustomOperation (nm, usageTextOpt, _) -> // 'delayed' is about to be dropped on the floor, first do rudimentary checking to get name resolutions in its body RecordNameAndTypeResolutions_IdeallyWithoutHavingOtherEffects_Delayed cenv env tpenv delayed match usageTextOpt() with | None -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly(nm), mItem)) - | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm,usageText), mItem)) + | Some usageText -> error(Error(FSComp.SR.tcCustomOperationNotUsedCorrectly2(nm, usageText), mItem)) | _ -> error(Error(FSComp.SR.tcLookupMayNotBeUsedHere(), mItem)) @@ -8950,9 +8950,9 @@ and GetSynMemberApplicationArgs delayed tpenv = | DelayedApp (atomicFlag, arg, _) :: otherDelayed -> atomicFlag, None, [arg], otherDelayed, tpenv | DelayedTypeApp(tyargs, mTypeArgs, _) :: DelayedApp (atomicFlag, arg, _mExprAndArg) :: otherDelayed -> - (atomicFlag, Some (tyargs,mTypeArgs), [arg], otherDelayed, tpenv) + (atomicFlag, Some (tyargs, mTypeArgs), [arg], otherDelayed, tpenv) | DelayedTypeApp(tyargs, mTypeArgs, _) :: otherDelayed -> - (ExprAtomicFlag.Atomic, Some (tyargs,mTypeArgs), [], otherDelayed, tpenv) + (ExprAtomicFlag.Atomic, Some (tyargs, mTypeArgs), [], otherDelayed, tpenv) | otherDelayed -> (ExprAtomicFlag.NonAtomic, None, [], otherDelayed, tpenv) @@ -8965,9 +8965,9 @@ and TcMemberTyArgsOpt cenv env tpenv tyargsOpt = Some tyargsChecked, tpenv and GetMemberApplicationArgs delayed cenv env tpenv = - let atomicFlag,tyargsOpt,args,delayed,tpenv = GetSynMemberApplicationArgs delayed tpenv + let atomicFlag, tyargsOpt, args, delayed, tpenv = GetSynMemberApplicationArgs delayed tpenv let tyArgsOptChecked, tpenv = TcMemberTyArgsOpt cenv env tpenv tyargsOpt - atomicFlag,tyArgsOptChecked,args,delayed,tpenv + atomicFlag, tyArgsOptChecked, args, delayed, tpenv and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId delayed mExprAndLongId = let objArgs = [objExpr] @@ -8980,15 +8980,15 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela // Canonicalize inference problem prior to '.' lookup on variable types if isTyparTy cenv.g objExprTy then - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,env.DisplayEnv,mExprAndLongId) (freeInTypeLeftToRight cenv.g false objExprTy) + GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, env.DisplayEnv, mExprAndLongId) (freeInTypeLeftToRight cenv.g false objExprTy) - let item,mItem,rest,afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.eNameResEnv objExprTy longId findFlag false + let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.eNameResEnv objExprTy longId findFlag false let mExprAndItem = unionRanges mObjExpr mItem let delayed = delayRest rest mExprAndItem delayed match item with - | Item.MethodGroup (methodName,minfos,_) -> - let atomicFlag,tyargsOpt,args,delayed,tpenv = GetSynMemberApplicationArgs delayed tpenv + | Item.MethodGroup (methodName, minfos, _) -> + let atomicFlag, tyargsOpt, args, delayed, tpenv = GetSynMemberApplicationArgs delayed tpenv // We pass PossiblyMutates here because these may actually mutate a value type object // To get better warnings we special case some of the few known mutate-a-struct method names let mutates = (if methodName = "MoveNext" || methodName = "GetNextArg" then DefinitelyMutates else PossiblyMutates) @@ -8998,46 +8998,46 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela | Some minfoAfterStaticArguments -> // Replace the resolution including the static parameters, plus the extra information about the original method info let item = Item.MethodGroup(methodName, [minfoAfterStaticArguments], Some minfos.[0]) - CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem,env.NameEnv, item, item, [], ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) + CallNameResolutionSinkReplacing cenv.tcSink (mExprAndItem, env.NameEnv, item, item, [], ItemOccurence.Use, env.DisplayEnv, env.eAccessRights) TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfoAfterStaticArguments, None)] afterResolution NormalValUse args atomicFlag delayed | None -> if not minfos.IsEmpty && minfos.[0].ProvidedStaticParameterInfo.IsSome then - error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(),mItem)) + error(Error(FSComp.SR.etMissingStaticArgumentsToMethod(), mItem)) #endif - let tyargsOpt,tpenv = TcMemberTyArgsOpt cenv env tpenv tyargsOpt - let meths = minfos |> List.map (fun minfo -> minfo,None) + let tyargsOpt, tpenv = TcMemberTyArgsOpt cenv env tpenv tyargsOpt + let meths = minfos |> List.map (fun minfo -> minfo, None) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterResolution NormalValUse args atomicFlag delayed - | Item.Property (nm,pinfos) -> + | Item.Property (nm, pinfos) -> // Instance property - if isNil pinfos then error (InternalError ("Unexpected error: empty property list",mItem)) + if isNil pinfos then error (InternalError ("Unexpected error: empty property list", mItem)) // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first. // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed let pinfo = List.head pinfos - let atomicFlag,tyargsOpt,args,delayed,tpenv = + let atomicFlag, tyargsOpt, args, delayed, tpenv = if pinfo.IsIndexer then GetMemberApplicationArgs delayed cenv env tpenv - else ExprAtomicFlag.Atomic,None,[mkSynUnit mItem],delayed,tpenv - if pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsStatic(nm),mItem)) + else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv + if pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsStatic(nm), mItem)) match delayed with - | DelayedSet(e2,mStmt) :: otherDelayed -> + | DelayedSet(e2, mStmt) :: otherDelayed -> let args = if pinfo.IsIndexer then args else [] - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mStmt)) + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt)) // Instance property setter UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty let meths = SettersOfPropInfos pinfos - if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem)) let mut = (if isStructTy cenv.g (tyOfExpr cenv.g objExpr) then DefinitelyMutates else PossiblyMutates) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mStmt mItem nm ad mut true meths afterResolution NormalValUse (args @ [e2]) atomicFlag [] | _ -> // Instance property getter let meths = GettersOfPropInfos pinfos - if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem)) + if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm), mItem)) TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterResolution NormalValUse args atomicFlag delayed | Item.RecdField rfinfo -> @@ -9046,44 +9046,44 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela let tgty = rfinfo.EnclosingType let valu = isStructTy cenv.g tgty AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css mItem NoTrace tgty objExprTy - let objExpr = if valu then objExpr else mkCoerceExpr(objExpr,tgty,mExprAndItem,objExprTy) + let objExpr = if valu then objExpr else mkCoerceExpr(objExpr, tgty, mExprAndItem, objExprTy) let fieldTy = rfinfo.FieldType match delayed with - | DelayedSet(e2,mStmt) :: otherDelayed -> + | DelayedSet(e2, mStmt) :: otherDelayed -> // Mutable value set: 'v <- e' - if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(),mItem)) + if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mItem)) CheckRecdFieldMutation mItem env.DisplayEnv rfinfo UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields - let e2',tpenv = TcExprFlex cenv true fieldTy env tpenv e2 - BuildRecdFieldSet cenv.g mStmt objExpr rfinfo e2',tpenv + let e2', tpenv = TcExprFlex cenv true fieldTy env tpenv e2 + BuildRecdFieldSet cenv.g mStmt objExpr rfinfo e2', tpenv | _ -> // Instance F# Record or Class field - let objExpr' = mkRecdFieldGet cenv.g (objExpr,rfinfo.RecdFieldRef,rfinfo.TypeInst,mExprAndItem) + let objExpr' = mkRecdFieldGet cenv.g (objExpr, rfinfo.RecdFieldRef, rfinfo.TypeInst, mExprAndItem) PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprWithFlex cenv env objExpr') fieldTy ExprAtomicFlag.Atomic delayed | Item.ILField finfo -> // Get or set instance IL field ILFieldInstanceChecks cenv.g cenv.amap ad mItem finfo - let exprty = finfo.FieldType(cenv.amap,mItem) + let exprty = finfo.FieldType(cenv.amap, mItem) match delayed with // Set instance IL field - | DelayedSet(e2,mStmt) :: _delayed' -> + | DelayedSet(e2, mStmt) :: _delayed' -> UnifyTypes cenv env mStmt overallTy cenv.g.unit_ty // Always allow subsumption on assignment to fields - let e2',tpenv = TcExprFlex cenv true exprty env tpenv e2 + let e2', tpenv = TcExprFlex cenv true exprty env tpenv e2 let expr = BuildILFieldSet cenv.g mStmt objExpr finfo e2' - expr,tpenv + expr, tpenv | _ -> let expr = BuildILFieldGet cenv.g cenv.amap mExprAndItem objExpr finfo PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprWithFlex cenv env expr) exprty ExprAtomicFlag.Atomic delayed | Item.Event einfo -> // Instance IL event (fake up event-as-value) - TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem (Some(objExpr,objExprTy)) einfo delayed + TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem (Some(objExpr, objExprTy)) einfo delayed | (Item.FakeInterfaceCtor _ | Item.DelegateCtor _) -> error (Error (FSComp.SR.tcConstructorsCannotBeFirstClassValues(), mItem)) | _ -> error (Error (FSComp.SR.tcSyntaxFormUsedOnlyWithRecordLabelsPropertiesAndFields(), mItem)) @@ -9093,12 +9093,12 @@ and TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem objDetails (ein let nm = einfo.EventName let ad = env.eAccessRights match objDetails, einfo.IsStatic with - | Some _, true -> error (Error (FSComp.SR.tcEventIsStatic(nm),mItem)) - | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic(nm),mItem)) + | Some _, true -> error (Error (FSComp.SR.tcEventIsStatic(nm), mItem)) + | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic(nm), mItem)) | _ -> () - let delegateType = einfo.GetDelegateType(cenv.amap,mItem) - let (SigOfFunctionForDelegate(invokeMethInfo,compiledViewOfDelArgTys,_,_)) = GetSigOfFunctionForDelegate cenv.infoReader delegateType mItem ad + let delegateType = einfo.GetDelegateType(cenv.amap, mItem) + let (SigOfFunctionForDelegate(invokeMethInfo, compiledViewOfDelArgTys, _, _)) = GetSigOfFunctionForDelegate cenv.infoReader delegateType mItem ad let objArgs = Option.toList (Option.map fst objDetails) MethInfoChecks cenv.g cenv.amap true None objArgs env.eAccessRights mItem invokeMethInfo @@ -9110,7 +9110,7 @@ and TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem objDetails (ein let bindObjArgs f = match objDetails with | None -> f [] - | Some (objExpr,objExprTy) -> mkCompGenLetIn mItem "eventTarget" objExprTy objExpr (fun (_,ve) -> f [ve]) + | Some (objExpr, objExprTy) -> mkCompGenLetIn mItem "eventTarget" objExprTy objExpr (fun (_, ve) -> f [ve]) // Bind the object target expression to make sure we only run its sdie effects once, and to make // sure if it's a mutable reference then we dereference it - see FSharp 1.0 bug 942 @@ -9118,14 +9118,14 @@ and TcEventValueThen cenv overallTy env tpenv mItem mExprAndItem objDetails (ein bindObjArgs (fun objVars -> // EventHelper ((fun d -> e.add_X(d)), (fun d -> e.remove_X(d)), (fun f -> new 'Delegate(f))) mkCallCreateEvent cenv.g mItem delegateType argsTy - (let dv,de = mkCompGenLocal mItem "eventDelegate" delegateType - let callExpr,_ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false (einfo.GetAddMethod()) NormalValUse [] objVars [de] + (let dv, de = mkCompGenLocal mItem "eventDelegate" delegateType + let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false (einfo.GetAddMethod()) NormalValUse [] objVars [de] mkLambda mItem dv (callExpr, cenv.g.unit_ty)) - (let dv,de = mkCompGenLocal mItem "eventDelegate" delegateType - let callExpr,_ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false (einfo.GetRemoveMethod()) NormalValUse [] objVars [de] + (let dv, de = mkCompGenLocal mItem "eventDelegate" delegateType + let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false (einfo.GetRemoveMethod()) NormalValUse [] objVars [de] mkLambda mItem dv (callExpr, cenv.g.unit_ty)) (let fvty = (cenv.g.obj_ty --> (argsTy --> cenv.g.unit_ty)) - let fv,fe = mkCompGenLocal mItem "callback" fvty + let fv, fe = mkCompGenLocal mItem "callback" fvty let createExpr = BuildNewDelegateExpr (Some einfo, cenv.g, cenv.amap, delegateType, invokeMethInfo, compiledViewOfDelArgTys, fe, fvty, mItem) mkLambda mItem fv (createExpr, delegateType))) @@ -9162,20 +9162,20 @@ and TcMethodApplicationThen = // Nb. args is always of List.length <= 1 except for indexed setters, when it is 2 - let mWholeExpr = (m,args) ||> List.fold (fun m arg -> unionRanges m arg.Range) + let mWholeExpr = (m, args) ||> List.fold (fun m arg -> unionRanges m arg.Range) // Work out if we know anything about the return type of the overall expression. If there are any delayed // lookups then we don't know anything. let exprTy = if isNil delayed then overallTy else NewInferenceType () // Call the helper below to do the real checking - let (expr,attributeAssignedNamedItems,delayed),tpenv = + let (expr, attributeAssignedNamedItems, delayed), tpenv = TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterResolution isSuperInit args exprTy delayed // Give errors if some things couldn't be assigned if not (isNil attributeAssignedNamedItems) then - let (CallerNamedArg(id,_)) = List.head attributeAssignedNamedItems - errorR(Error(FSComp.SR.tcNamedArgumentDidNotMatch(id.idText),id.idRange)) + let (CallerNamedArg(id, _)) = List.head attributeAssignedNamedItems + errorR(Error(FSComp.SR.tcNamedArgumentDidNotMatch(id.idText), id.idRange)) // Resolve the "delayed" lookups @@ -9186,10 +9186,10 @@ and TcMethodApplicationThen /// Infer initial type information at the callsite from the syntax of an argument, prior to overload resolution. and GetNewInferenceTypeForMethodArg cenv env tpenv x = match x with - | SynExprParen(a,_,_,_) -> GetNewInferenceTypeForMethodArg cenv env tpenv a - | SynExpr.AddressOf(true,a,_,_) -> mkByrefTy cenv.g (GetNewInferenceTypeForMethodArg cenv env tpenv a) - | SynExpr.Lambda(_,_,_,a,_) -> mkFunTy (NewInferenceType ()) (GetNewInferenceTypeForMethodArg cenv env tpenv a) - | SynExpr.Quote(_,raw,a,_,_) -> + | SynExprParen(a, _, _, _) -> GetNewInferenceTypeForMethodArg cenv env tpenv a + | SynExpr.AddressOf(true, a, _, _) -> mkByrefTy cenv.g (GetNewInferenceTypeForMethodArg cenv env tpenv a) + | SynExpr.Lambda(_, _, _, a, _) -> mkFunTy (NewInferenceType ()) (GetNewInferenceTypeForMethodArg cenv env tpenv a) + | SynExpr.Quote(_, raw, a, _, _) -> if raw then mkRawQuotedExprTy cenv.g else mkQuotedExprTy cenv.g (GetNewInferenceTypeForMethodArg cenv env tpenv a) | _ -> NewInferenceType () @@ -9228,18 +9228,18 @@ and TcMethodApplication // Uses of curried members are ALWAYS treated as if they are first class uses of members. // Curried members may not be overloaded (checked at use-site for curried members brought into scope through extension members) - let curriedCallerArgs,exprTy,delayed = + let curriedCallerArgs, exprTy, delayed = match calledMeths with | [calledMeth] when not isProp && calledMeth.NumArgs.Length > 1 -> - [], NewInferenceType (),[ for x in curriedCallerArgs -> DelayedApp(ExprAtomicFlag.NonAtomic, x, x.Range) ] @ delayed + [], NewInferenceType (), [ for x in curriedCallerArgs -> DelayedApp(ExprAtomicFlag.NonAtomic, x, x.Range) ] @ delayed | _ when not isProp && calledMeths |> List.exists (fun calledMeth -> calledMeth.NumArgs.Length > 1) -> // This condition should only apply when multiple conflicting curried extension members are brought into scope - error(Error(FSComp.SR.tcOverloadsCannotHaveCurriedArguments(),mMethExpr)) + error(Error(FSComp.SR.tcOverloadsCannotHaveCurriedArguments(), mMethExpr)) | _ -> - curriedCallerArgs,exprTy,delayed + curriedCallerArgs, exprTy, delayed let candidateMethsAndProps = - match calledMethsAndProps |> List.filter (fun (meth,_prop) -> IsMethInfoAccessible cenv.amap mItem ad meth) with + match calledMethsAndProps |> List.filter (fun (meth, _prop) -> IsMethInfoAccessible cenv.amap mItem ad meth) with | [] -> calledMethsAndProps | accessibleMeths -> accessibleMeths @@ -9253,9 +9253,9 @@ and TcMethodApplication let curriedCallerArgsOpt, unnamedDelayedCallerArgExprOpt, exprTy = match curriedCallerArgs with | [] -> - None,None,exprTy + None, None, exprTy | _ -> - let unnamedCurriedCallerArgs,namedCurriedCallerArgs = curriedCallerArgs |> List.map GetMethodArgs |> List.unzip + let unnamedCurriedCallerArgs, namedCurriedCallerArgs = curriedCallerArgs |> List.map GetMethodArgs |> List.unzip // There is an mismatch when _uses_ of indexed property setters in the tc.fs code that calls this function. // The arguments are passed as if they are curried with arity [numberOfIndexParameters;1], however in the TAST, indexed property setters @@ -9263,20 +9263,20 @@ and TcMethodApplication // // Here we work around this mismatch by crunching all property argument lists to uncirred form. // Ideally the problem needs to be solved at its root cause at the callsites to this function - let unnamedCurriedCallerArgs,namedCurriedCallerArgs = + let unnamedCurriedCallerArgs, namedCurriedCallerArgs = if isProp then [List.concat unnamedCurriedCallerArgs], [List.concat namedCurriedCallerArgs] else - unnamedCurriedCallerArgs,namedCurriedCallerArgs + unnamedCurriedCallerArgs, namedCurriedCallerArgs let MakeUnnamedCallerArgInfo x = (x, GetNewInferenceTypeForMethodArg cenv env tpenv x, x.Range) // "single named item" rule. This is where we have a single accessible method // member x.M(arg1) // being used with - // x.M (x,y) + // x.M (x, y) // Without this rule this requires - // x.M ((x,y)) + // x.M ((x, y)) match candidates with | [calledMeth] when (namedCurriedCallerArgs |> List.forall isNil && @@ -9286,15 +9286,15 @@ and TcMethodApplication curriedCalledArgs.Head.Head |> isSimpleFormalArg) -> let unnamedCurriedCallerArgs = curriedCallerArgs |> List.map (MakeUnnamedCallerArgInfo >> List.singleton) let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.map (fun _ -> []) - (Some (unnamedCurriedCallerArgs,namedCurriedCallerArgs), None, exprTy) + (Some (unnamedCurriedCallerArgs, namedCurriedCallerArgs), None, exprTy) // "single named item" rule. This is where we have a single accessible method - // member x.M(arg1,arg2) + // member x.M(arg1, arg2) // being used with // x.M p - // We typecheck this as if it has been written "(fun (v1,v2) -> x.M(v1,v2)) p" + // We typecheck this as if it has been written "(fun (v1, v2) -> x.M(v1, v2)) p" // Without this rule this requires - // x.M (fst p,snd p) + // x.M (fst p, snd p) | [calledMeth] when (namedCurriedCallerArgs |> List.forall isNil && unnamedCurriedCallerArgs.Length = 1 && @@ -9311,12 +9311,12 @@ and TcMethodApplication | _ -> let unnamedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.mapSquared MakeUnnamedCallerArgInfo - let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (isOpt,nm,x) -> + let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (isOpt, nm, x) -> let ty = GetNewInferenceTypeForMethodArg cenv env tpenv x // #435263 : compiler crash with .net optional parameters and F# optional syntax // named optional arguments should always have option type let ty = if isOpt then mkOptionTy denv.g ty else ty - nm,isOpt,x,ty, x.Range + nm, isOpt, x, ty, x.Range ) (Some (unnamedCurriedCallerArgs, namedCurriedCallerArgs), None, exprTy) @@ -9335,47 +9335,47 @@ and TcMethodApplication let UnifyMatchingSimpleArgumentTypes exprTy (calledMeth:MethInfo) = let curriedArgTys = GenerateMatchingSimpleArgumentTypes calledMeth let returnTy = - (exprTy,curriedArgTys) ||> List.fold (fun exprTy argTys -> - let domainTy,resultTy = UnifyFunctionType None cenv denv mMethExpr exprTy + (exprTy, curriedArgTys) ||> List.fold (fun exprTy argTys -> + let domainTy, resultTy = UnifyFunctionType None cenv denv mMethExpr exprTy UnifyTypes cenv env mMethExpr domainTy (mkRefTupledTy cenv.g argTys) resultTy) - curriedArgTys,returnTy + curriedArgTys, returnTy if isProp && Option.isNone curriedCallerArgsOpt then - error(Error(FSComp.SR.parsIndexerPropertyRequiresAtLeastOneArgument(),mItem)) + error(Error(FSComp.SR.parsIndexerPropertyRequiresAtLeastOneArgument(), mItem)) // STEP 1. UnifyUniqueOverloading. This happens BEFORE we type check the arguments. // Extract what we know about the caller arguments, either type-directed if // no arguments are given or else based on the syntax of the arguments. - let uniquelyResolved,preArgumentTypeCheckingCalledMethGroup = + let uniquelyResolved, preArgumentTypeCheckingCalledMethGroup = let dummyExpr = mkSynUnit mItem // Build the CallerArg values for the caller's arguments. // Fake up some arguments if this is the use of a method as a first class function - let unnamedCurriedCallerArgs,namedCurriedCallerArgs,returnTy = + let unnamedCurriedCallerArgs, namedCurriedCallerArgs, returnTy = - match curriedCallerArgsOpt,candidates with + match curriedCallerArgsOpt, candidates with // "single named item" rule. This is where we have a single accessible method - // member x.M(arg1,...,argN) + // member x.M(arg1, ..., argN) // being used in a first-class way, i.e. // x.M // Because there is only one accessible method info available based on the name of the item // being accessed we know the number of arguments the first class use of this // method will take. Optional and out args are _not_ included, which means they will be resolved // to their default values (for optionals) and be part of the return tuple (for out args). - | None,[calledMeth] -> - let curriedArgTys,returnTy = UnifyMatchingSimpleArgumentTypes exprTy calledMeth - let unnamedCurriedCallerArgs = curriedArgTys |> List.mapSquared (fun ty -> CallerArg(ty,mMethExpr,false,dummyExpr)) + | None, [calledMeth] -> + let curriedArgTys, returnTy = UnifyMatchingSimpleArgumentTypes exprTy calledMeth + let unnamedCurriedCallerArgs = curriedArgTys |> List.mapSquared (fun ty -> CallerArg(ty, mMethExpr, false, dummyExpr)) let namedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.map (fun _ -> []) - unnamedCurriedCallerArgs, namedCurriedCallerArgs,returnTy + unnamedCurriedCallerArgs, namedCurriedCallerArgs, returnTy // "type directed" rule for first-class uses of ambiguous methods. // By context we know a type for the input argument. If it's a tuple // this gives us the a potential number of arguments expected. Indeed even if it's a variable // type we assume the number of arguments is just "1". - | None,_ -> + | None, _ -> - let domainTy,returnTy = UnifyFunctionType None cenv denv mMethExpr exprTy + let domainTy, returnTy = UnifyFunctionType None cenv denv mMethExpr exprTy let argTys = if isUnitTy cenv.g domainTy then [] else tryDestRefTupleTy cenv.g domainTy // Only apply this rule if a candidate method exists with this number of arguments let argTys = @@ -9383,33 +9383,33 @@ and TcMethodApplication argTys else [domainTy] - let unnamedCurriedCallerArgs = [argTys |> List.map (fun ty -> CallerArg(ty,mMethExpr,false,dummyExpr)) ] + let unnamedCurriedCallerArgs = [argTys |> List.map (fun ty -> CallerArg(ty, mMethExpr, false, dummyExpr)) ] let namedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.map (fun _ -> []) unnamedCurriedCallerArgs, namedCurriedCallerArgs, returnTy - | Some (unnamedCurriedCallerArgs,namedCurriedCallerArgs),_ -> - let unnamedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.mapSquared (fun (argExpr,argTy,mArg) -> CallerArg(argTy,mArg,false,argExpr)) - let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (id,isOpt,argExpr,argTy,mArg) -> CallerNamedArg(id,CallerArg(argTy,mArg,isOpt,argExpr))) + | Some (unnamedCurriedCallerArgs, namedCurriedCallerArgs), _ -> + let unnamedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.mapSquared (fun (argExpr, argTy, mArg) -> CallerArg(argTy, mArg, false, argExpr)) + let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (id, isOpt, argExpr, argTy, mArg) -> CallerNamedArg(id, CallerArg(argTy, mArg, isOpt, argExpr))) unnamedCurriedCallerArgs, namedCurriedCallerArgs, exprTy let callerArgCounts = (List.sumBy List.length unnamedCurriedCallerArgs, List.sumBy List.length namedCurriedCallerArgs) let callerArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs - let makeOneCalledMeth (minfo,pinfoOpt,usesParamArrayConversion) = + let makeOneCalledMeth (minfo, pinfoOpt, usesParamArrayConversion) = let minst = FreshenMethInfo mItem minfo let callerTyArgs = match tyargsOpt with | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) | None -> minst - CalledMeth(cenv.infoReader,Some(env.NameEnv),isCheckingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt) let preArgumentTypeCheckingCalledMethGroup = - [ for (minfo,pinfoOpt) in candidateMethsAndProps do - let meth = makeOneCalledMeth (minfo,pinfoOpt,true) + [ for (minfo, pinfoOpt) in candidateMethsAndProps do + let meth = makeOneCalledMeth (minfo, pinfoOpt, true) yield meth if meth.UsesParamArrayConversion then - yield makeOneCalledMeth (minfo,pinfoOpt,false) ] + yield makeOneCalledMeth (minfo, pinfoOpt, false) ] let uniquelyResolved = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv @@ -9424,19 +9424,19 @@ and TcMethodApplication res |> CommitOperationResult - uniquelyResolved,preArgumentTypeCheckingCalledMethGroup + uniquelyResolved, preArgumentTypeCheckingCalledMethGroup // STEP 2. Type check arguments - let unnamedCurriedCallerArgs,namedCurriedCallerArgs,lambdaVars,returnTy,tpenv = + let unnamedCurriedCallerArgs, namedCurriedCallerArgs, lambdaVars, returnTy, tpenv = // STEP 2a. First extract what we know about the caller arguments, either type-directed if // no arguments are given or else based on the syntax of the arguments. match curriedCallerArgsOpt with | None -> - let curriedArgTys,returnTy = + let curriedArgTys, returnTy = match candidates with // "single named item" rule. This is where we have a single accessible method - // member x.M(arg1,...,argN) + // member x.M(arg1, ..., argN) // being used in a first-class way, i.e. // x.M // Because there is only one accessible method info available based on the name of the item @@ -9446,7 +9446,7 @@ and TcMethodApplication | [calledMeth] -> UnifyMatchingSimpleArgumentTypes exprTy calledMeth | _ -> - let domainTy,returnTy = UnifyFunctionType None cenv denv mMethExpr exprTy + let domainTy, returnTy = UnifyFunctionType None cenv denv mMethExpr exprTy let argTys = if isUnitTy cenv.g domainTy then [] else tryDestRefTupleTy cenv.g domainTy // Only apply this rule if a candidate method exists with this number of arguments let argTys = @@ -9454,19 +9454,19 @@ and TcMethodApplication argTys else [domainTy] - [argTys],returnTy + [argTys], returnTy let lambdaVarsAndExprs = curriedArgTys |> List.mapiSquared (fun i j ty -> mkCompGenLocal mMethExpr ("arg"+string i+string j) ty) - let unnamedCurriedCallerArgs = lambdaVarsAndExprs |> List.mapSquared (fun (_,e) -> CallerArg(tyOfExpr cenv.g e,e.Range,false,e)) + let unnamedCurriedCallerArgs = lambdaVarsAndExprs |> List.mapSquared (fun (_, e) -> CallerArg(tyOfExpr cenv.g e, e.Range, false, e)) let namedCurriedCallerArgs = lambdaVarsAndExprs |> List.map (fun _ -> []) let lambdaVars = List.mapSquared fst lambdaVarsAndExprs unnamedCurriedCallerArgs, namedCurriedCallerArgs, Some lambdaVars, returnTy, tpenv - | Some (unnamedCurriedCallerArgs,namedCurriedCallerArgs) -> + | Some (unnamedCurriedCallerArgs, namedCurriedCallerArgs) -> // This is the case where some explicit arguments have been given. - let unnamedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.mapSquared (fun (argExpr,argTy,mArg) -> CallerArg(argTy,mArg,false,argExpr)) - let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (id,isOpt,argExpr,argTy,mArg) -> CallerNamedArg(id,CallerArg(argTy,mArg,isOpt,argExpr))) + let unnamedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.mapSquared (fun (argExpr, argTy, mArg) -> CallerArg(argTy, mArg, false, argExpr)) + let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (id, isOpt, argExpr, argTy, mArg) -> CallerNamedArg(id, CallerArg(argTy, mArg, isOpt, argExpr))) // Collect the information for F# 3.1 lambda propagation rule, and apply the caller's object type to the method's object type if the rule is relevant. let lambdaPropagationInfo = @@ -9482,8 +9482,8 @@ and TcMethodApplication [| |] // Now typecheck the argument expressions - let unnamedCurriedCallerArgs,(lambdaPropagationInfo,tpenv) = TcUnnamedMethodArgs cenv env lambdaPropagationInfo tpenv unnamedCurriedCallerArgs - let namedCurriedCallerArgs,(_,tpenv) = TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv namedCurriedCallerArgs + let unnamedCurriedCallerArgs, (lambdaPropagationInfo, tpenv) = TcUnnamedMethodArgs cenv env lambdaPropagationInfo tpenv unnamedCurriedCallerArgs + let namedCurriedCallerArgs, (_, tpenv) = TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv namedCurriedCallerArgs unnamedCurriedCallerArgs, namedCurriedCallerArgs, None, exprTy, tpenv let preArgumentTypeCheckingCalledMethGroup = @@ -9496,12 +9496,12 @@ and TcMethodApplication let callerArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs let postArgumentTypeCheckingCalledMethGroup = - preArgumentTypeCheckingCalledMethGroup |> List.map (fun (minfo:MethInfo,minst,pinfoOpt,usesParamArrayConversion) -> + preArgumentTypeCheckingCalledMethGroup |> List.map (fun (minfo:MethInfo, minst, pinfoOpt, usesParamArrayConversion) -> let callerTyArgs = match tyargsOpt with | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs) | None -> minst - CalledMeth(cenv.infoReader,Some(env.NameEnv),isCheckingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt)) + CalledMeth(cenv.infoReader, Some(env.NameEnv), isCheckingAttributeCall, FreshenMethInfo, mMethExpr, ad, minfo, minst, callerTyArgs, pinfoOpt, callerObjArgTys, callerArgs, usesParamArrayConversion, true, objTyOpt)) let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length) let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css mMethExpr denv @@ -9509,7 +9509,7 @@ and TcMethodApplication // Commit unassociated constraints prior to member overload resolution where there is ambiguity // about the possible target of the call. if not uniquelyResolved then - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denv,mItem) + GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, mItem) (//freeInTypeLeftToRight cenv.g false returnTy @ (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type))) @@ -9525,8 +9525,8 @@ and TcMethodApplication let overriding = match unrefinedItem with - | Item.MethodGroup(_,overridenMeths,_) -> overridenMeths |> List.map (fun minfo -> minfo,None) - | Item.Property(_,pinfos) -> + | Item.MethodGroup(_, overridenMeths, _) -> overridenMeths |> List.map (fun minfo -> minfo, None) + | Item.Property(_, pinfos) -> if result.Method.LogicalName.StartsWith ("set_") then SettersOfPropInfos pinfos else @@ -9535,10 +9535,10 @@ and TcMethodApplication let overridingInfo = overriding - |> List.tryFind (fun (minfo,_) -> minfo.IsVirtual && MethInfosEquivByNameAndSig EraseNone true cenv.g cenv.amap range0 result.Method minfo) + |> List.tryFind (fun (minfo, _) -> minfo.IsVirtual && MethInfosEquivByNameAndSig EraseNone true cenv.g cenv.amap range0 result.Method minfo) match overridingInfo with - | Some (minfo,pinfoOpt) -> + | Some (minfo, pinfoOpt) -> let tps = minfo.FormalMethodTypars let tyargs = result.CalledTyArgs let tpinst = if tps.Length = tyargs.Length then mkTyparInst tps tyargs else [] @@ -9557,7 +9557,7 @@ and TcMethodApplication // Raise the errors from the constraint solving RaiseOperationResult errors match result with - | None -> error(InternalError("at least one error should be returned by failed method overloading",mItem)) + | None -> error(InternalError("at least one error should be returned by failed method overloading", mItem)) | Some res -> res let finalCalledMethInfo = finalCalledMeth.Method @@ -9597,7 +9597,7 @@ and TcMethodApplication if HasHeadType cenv.g cenv.g.tcref_System_Collections_Generic_Dictionary finalCalledMethInfo.EnclosingType && finalCalledMethInfo.IsConstructor && not (finalCalledMethInfo.GetParamDatas(cenv.amap, mItem, finalCalledMeth.CalledTyArgs) - |> List.existsSquared (fun (ParamData(_,_,_,_,_,_,ty)) -> + |> List.existsSquared (fun (ParamData(_, _, _, _, _, _, ty)) -> HasHeadType cenv.g cenv.g.tcref_System_Collections_Generic_IEqualityComparer ty)) then match argsOfAppTy cenv.g finalCalledMethInfo.EnclosingType with @@ -9605,8 +9605,8 @@ and TcMethodApplication | _ -> () end - if (finalArgSets |> List.existsi (fun i argSet -> argSet.UnnamedCalledArgs |> List.existsi (fun j ca -> ca.Position <> (i,j)))) then - errorR(Deprecated(FSComp.SR.tcUnnamedArgumentsDoNotFormPrefix(),mMethExpr)) + if (finalArgSets |> List.existsi (fun i argSet -> argSet.UnnamedCalledArgs |> List.existsi (fun j ca -> ca.Position <> (i, j)))) then + errorR(Deprecated(FSComp.SR.tcUnnamedArgumentsDoNotFormPrefix(), mMethExpr)) // STEP 5. Build the argument list. Adjust for optional arguments, byref arguments and coercions. @@ -9620,21 +9620,21 @@ and TcMethodApplication let emptyPreBinder (e: Expr) = e // For unapplied 'e.M' we first evaluate 'e' outside the lambda, i.e. 'let v = e in (fun arg -> v.M(arg))' - let objArgPreBinder,objArgs = - match objArgs,lambdaVars with - | [objArg],Some _ -> + let objArgPreBinder, objArgs = + match objArgs, lambdaVars with + | [objArg], Some _ -> let objArgTy = tyOfExpr cenv.g objArg - let v,ve = mkCompGenLocal mMethExpr "objectArg" objArgTy + let v, ve = mkCompGenLocal mMethExpr "objectArg" objArgTy (fun body -> mkCompGenLet mMethExpr v objArg body), [ve] | _ -> - emptyPreBinder,objArgs + emptyPreBinder, objArgs // Handle adhoc argument conversions let coerceExpr isOutArg calledArgTy (reflArgInfo: ReflectedArgInfo) callerArgTy m callerArgExpr = if isByrefTy cenv.g calledArgTy && isRefCellTy cenv.g callerArgTy then - Expr.Op(TOp.RefAddrGet,[destRefCellTy cenv.g callerArgTy],[callerArgExpr],m) + Expr.Op(TOp.RefAddrGet, [destRefCellTy cenv.g callerArgTy], [callerArgExpr], m) elif isDelegateTy cenv.g calledArgTy && isFunTy cenv.g callerArgTy then CoerceFromFSharpFuncToDelegate cenv.g cenv.amap cenv.infoReader ad callerArgTy m callerArgExpr calledArgTy @@ -9662,10 +9662,10 @@ and TcMethodApplication mkCoerceIfNeeded cenv.g calledArgTy callerArgTy callerArgExpr // Handle optional arguments - let optArgPreBinder,allArgs,outArgExprs,outArgTmpBinds = + let optArgPreBinder, allArgs, outArgExprs, outArgTmpBinds = let normalUnnamedArgs = - (finalUnnamedCalledArgs,finalUnnamedCallerArgs) ||> List.map2 (fun called caller -> { NamedArgIdOpt = None; CalledArg=called; CallerArg=caller }) + (finalUnnamedCalledArgs, finalUnnamedCallerArgs) ||> List.map2 (fun called caller -> { NamedArgIdOpt = None; CalledArg=called; CallerArg=caller }) let paramArrayArgs = match finalCalledMeth.ParamArrayCalledArgOpt with @@ -9675,10 +9675,10 @@ and TcMethodApplication let es = finalParamArrayCallerArgs |> List.map (fun callerArg -> - let (CallerArg(callerArgTy,m,isOutArg,callerArgExpr)) = callerArg + let (CallerArg(callerArgTy, m, isOutArg, callerArgExpr)) = callerArg coerceExpr isOutArg paramArrayCalledArgElementType paramArrayCalledArg.ReflArgInfo callerArgTy m callerArgExpr) - [ { NamedArgIdOpt = None; CalledArg=paramArrayCalledArg; CallerArg=CallerArg(paramArrayCalledArg.CalledArgumentType,mMethExpr,false,Expr.Op(TOp.Array,[paramArrayCalledArgElementType], es ,mMethExpr)) } ] + [ { NamedArgIdOpt = None; CalledArg=paramArrayCalledArg; CallerArg=CallerArg(paramArrayCalledArg.CalledArgumentType, mMethExpr, false, Expr.Op(TOp.Array, [paramArrayCalledArgElementType], es , mMethExpr)) } ] // CLEANUP: Move all this code into some isolated file, e.g. "optional.fs" // @@ -9701,60 +9701,60 @@ and TcMethodApplication // - VB also allows you to pass intrinsic values as optional values to parameters // typed as Object. What we do in this case is we box the intrinsic value." // - let optArgs,optArgPreBinder = - (emptyPreBinder,finalUnnamedCalledOptArgs) ||> List.mapFold (fun wrapper calledArg -> + let optArgs, optArgPreBinder = + (emptyPreBinder, finalUnnamedCalledOptArgs) ||> List.mapFold (fun wrapper calledArg -> let calledArgTy = calledArg.CalledArgumentType - let wrapper2,expr = + let wrapper2, expr = match calledArg.OptArgInfo with | NotOptional -> - error(InternalError("Unexpected NotOptional",mItem)) + error(InternalError("Unexpected NotOptional", mItem)) | CallerSide dfltVal -> let rec build currCalledArgTy currDfltVal = match currDfltVal with | MissingValue -> // Add an I_nop if this is an initonly field to make sure we never recognize it as an lvalue. See mkExprAddrOfExpr. - emptyPreBinder,mkAsmExpr ([ mkNormalLdsfld (fspec_Missing_Value cenv.g); AI_nop ],[],[],[currCalledArgTy],mMethExpr) + emptyPreBinder, mkAsmExpr ([ mkNormalLdsfld (fspec_Missing_Value cenv.g); AI_nop ], [], [], [currCalledArgTy], mMethExpr) | DefaultValue -> - emptyPreBinder,mkDefault(mMethExpr,currCalledArgTy) + emptyPreBinder, mkDefault(mMethExpr, currCalledArgTy) | Constant fieldInit -> match currCalledArgTy with | NullableTy cenv.g inst when fieldInit <> ILFieldInit.Null -> let nullableTy = mkILNonGenericBoxedTy(cenv.g.FindSysILTypeRef "System.Nullable`1") let ctor = mkILCtorMethSpecForTy(nullableTy, [ILType.TypeVar 0us]).MethodRef - let ctorArgs = [Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr, inst)] - emptyPreBinder,Expr.Op(TOp.ILCall(false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) + let ctorArgs = [Expr.Const(TcFieldInit mMethExpr fieldInit, mMethExpr, inst)] + emptyPreBinder, Expr.Op(TOp.ILCall(false, false, true, true, NormalValUse, false, false, ctor, [inst], [], [currCalledArgTy]), [], ctorArgs, mMethExpr) | ByrefTy cenv.g inst -> build inst (PassByRef(inst, currDfltVal)) | _ -> match calledArg.CallerInfoInfo, env.eCallerMemberName with | CallerLineNumber, _ when typeEquiv cenv.g currCalledArgTy cenv.g.int_ty -> - emptyPreBinder,Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, currCalledArgTy) + emptyPreBinder, Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, currCalledArgTy) | CallerFilePath, _ when typeEquiv cenv.g currCalledArgTy cenv.g.string_ty -> - emptyPreBinder,Expr.Const(Const.String(System.IO.Path.GetFullPath(mMethExpr.FileName)), mMethExpr, currCalledArgTy) + emptyPreBinder, Expr.Const(Const.String(System.IO.Path.GetFullPath(mMethExpr.FileName)), mMethExpr, currCalledArgTy) | CallerMemberName, Some(callerName) when (typeEquiv cenv.g currCalledArgTy cenv.g.string_ty) -> - emptyPreBinder,Expr.Const(Const.String(callerName), mMethExpr, currCalledArgTy) + emptyPreBinder, Expr.Const(Const.String(callerName), mMethExpr, currCalledArgTy) | _ -> - emptyPreBinder,Expr.Const(TcFieldInit mMethExpr fieldInit,mMethExpr,currCalledArgTy) + emptyPreBinder, Expr.Const(TcFieldInit mMethExpr fieldInit, mMethExpr, currCalledArgTy) | WrapperForIDispatch -> match cenv.g.TryFindSysILTypeRef "System.Runtime.InteropServices.DispatchWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) | Some tref -> let ty = mkILNonGenericBoxedTy tref - let mref = mkILCtorMethSpecForTy(ty,[cenv.g.ilg.typ_Object]).MethodRef - let expr = Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[cenv.g.obj_ty]),[],[mkDefault(mMethExpr,currCalledArgTy)],mMethExpr) - emptyPreBinder,expr + let mref = mkILCtorMethSpecForTy(ty, [cenv.g.ilg.typ_Object]).MethodRef + let expr = Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [cenv.g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) + emptyPreBinder, expr | WrapperForIUnknown -> match cenv.g.TryFindSysILTypeRef "System.Runtime.InteropServices.UnknownWrapper" with | None -> error(Error(FSComp.SR.fscSystemRuntimeInteropServicesIsRequired(), mMethExpr)) | Some tref -> let ty = mkILNonGenericBoxedTy tref - let mref = mkILCtorMethSpecForTy(ty,[cenv.g.ilg.typ_Object]).MethodRef - let expr = Expr.Op(TOp.ILCall(false,false,false,true,NormalValUse,false,false,mref,[],[],[cenv.g.obj_ty]),[],[mkDefault(mMethExpr,currCalledArgTy)],mMethExpr) - emptyPreBinder,expr + let mref = mkILCtorMethSpecForTy(ty, [cenv.g.ilg.typ_Object]).MethodRef + let expr = Expr.Op(TOp.ILCall(false, false, false, true, NormalValUse, false, false, mref, [], [], [cenv.g.obj_ty]), [], [mkDefault(mMethExpr, currCalledArgTy)], mMethExpr) + emptyPreBinder, expr | PassByRef (ty, dfltVal2) -> - let v,_ = mkCompGenLocal mMethExpr "defaultByrefArg" ty - let wrapper2,rhs = build currCalledArgTy dfltVal2 + let v, _ = mkCompGenLocal mMethExpr "defaultByrefArg" ty + let wrapper2, rhs = build currCalledArgTy dfltVal2 (wrapper2 >> mkCompGenLet mMethExpr v rhs), mkValAddr mMethExpr (mkLocalValRef v) build calledArgTy dfltVal | CalleeSide -> @@ -9767,28 +9767,28 @@ and TcMethodApplication match calledArg.CallerInfoInfo, env.eCallerMemberName with | CallerLineNumber, _ when typeEquiv cenv.g calledNonOptTy cenv.g.int_ty -> let lineExpr = Expr.Const(Const.Int32(mMethExpr.StartLine), mMethExpr, calledNonOptTy) - emptyPreBinder,mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[lineExpr],mMethExpr) + emptyPreBinder, mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [lineExpr], mMethExpr) | CallerFilePath, _ when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> let filePathExpr = Expr.Const(Const.String(System.IO.Path.GetFullPath(mMethExpr.FileName)), mMethExpr, calledNonOptTy) - emptyPreBinder,mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[filePathExpr],mMethExpr) + emptyPreBinder, mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [filePathExpr], mMethExpr) | CallerMemberName, Some(callerName) when typeEquiv cenv.g calledNonOptTy cenv.g.string_ty -> let memberNameExpr = Expr.Const(Const.String(callerName), mMethExpr, calledNonOptTy) - emptyPreBinder,mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[memberNameExpr],mMethExpr) + emptyPreBinder, mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [memberNameExpr], mMethExpr) | _ -> - emptyPreBinder,mkUnionCaseExpr(mkNoneCase cenv.g,[calledNonOptTy],[],mMethExpr) + emptyPreBinder, mkUnionCaseExpr(mkNoneCase cenv.g, [calledNonOptTy], [], mMethExpr) // Combine the variable allocators (if any) let wrapper = (wrapper >> wrapper2) - let callerArg = CallerArg(calledArgTy,mMethExpr,false,expr) - { NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg },wrapper) + let callerArg = CallerArg(calledArgTy, mMethExpr, false, expr) + { NamedArgIdOpt = None; CalledArg = calledArg; CallerArg = callerArg }, wrapper) // Handle optional arguments let wrapOptionalArg (assignedArg: AssignedCalledArg<_>) = - let (CallerArg(callerArgTy,m,isOptCallerArg,expr)) = assignedArg.CallerArg + let (CallerArg(callerArgTy, m, isOptCallerArg, expr)) = assignedArg.CallerArg match assignedArg.CalledArg.OptArgInfo with | NotOptional -> - if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(),m)) + if isOptCallerArg then errorR(Error(FSComp.SR.tcFormalArgumentIsNotOptional(), m)) assignedArg | _ -> let expr = @@ -9797,7 +9797,7 @@ and TcMethodApplication if isOptCallerArg then // STRUCT OPTIONS: if we allow struct options as optional arguments then we should take // the address correctly. - mkUnionCaseFieldGetUnprovenViaExprAddr (expr,mkSomeCase cenv.g,[destOptionTy cenv.g callerArgTy],0,m) + mkUnionCaseFieldGetUnprovenViaExprAddr (expr, mkSomeCase cenv.g, [destOptionTy cenv.g callerArgTy], 0, m) else expr | CalleeSide -> @@ -9809,20 +9809,20 @@ and TcMethodApplication let calledArgTy = assignedArg.CalledArg.CalledArgumentType if isOptionTy cenv.g calledArgTy then let calledNonOptTy = destOptionTy cenv.g calledArgTy - mkUnionCaseExpr(mkSomeCase cenv.g,[calledNonOptTy],[mkCoerceIfNeeded cenv.g calledNonOptTy callerArgTy expr],m) + mkUnionCaseExpr(mkSomeCase cenv.g, [calledNonOptTy], [mkCoerceIfNeeded cenv.g calledNonOptTy callerArgTy expr], m) else expr // should be unreachable | _ -> failwith "Unreachable" - { assignedArg with CallerArg=CallerArg((tyOfExpr cenv.g expr),m,isOptCallerArg,expr) } + { assignedArg with CallerArg=CallerArg((tyOfExpr cenv.g expr), m, isOptCallerArg, expr) } - let outArgsAndExprs,outArgTmpBinds = + let outArgsAndExprs, outArgTmpBinds = finalUnnamedCalledOutArgs |> List.map (fun calledArg -> let calledArgTy = calledArg.CalledArgumentType let outArgTy = destByrefTy cenv.g calledArgTy - let outv,outArgExpr = mkMutableCompGenLocal mMethExpr "outArg" outArgTy // mutable! - let expr = mkDefault(mMethExpr,outArgTy) - let callerArg = CallerArg(calledArgTy,mMethExpr,false,mkValAddr mMethExpr (mkLocalValRef outv)) + let outv, outArgExpr = mkMutableCompGenLocal mMethExpr "outArg" outArgTy // mutable! + let expr = mkDefault(mMethExpr, outArgTy) + let callerArg = CallerArg(calledArgTy, mMethExpr, false, mkValAddr mMethExpr (mkLocalValRef outv)) let outArg = { NamedArgIdOpt=None;CalledArg=calledArg;CallerArg=callerArg } (outArg, outArgExpr), mkCompGenBind outv expr) |> List.unzip @@ -9839,13 +9839,13 @@ and TcMethodApplication let allArgs = allArgs |> List.sortBy (fun x -> x.Position) - optArgPreBinder,allArgs,outArgExprs,outArgTmpBinds + optArgPreBinder, allArgs, outArgExprs, outArgTmpBinds let coerce (assignedArg: AssignedCalledArg<_>) = let isOutArg = assignedArg.CalledArg.IsOutArg let reflArgInfo = assignedArg.CalledArg.ReflArgInfo let calledArgTy = assignedArg.CalledArg.CalledArgumentType - let (CallerArg(callerArgTy,m,_,e)) = assignedArg.CallerArg + let (CallerArg(callerArgTy, m, _, e)) = assignedArg.CallerArg coerceExpr isOutArg calledArgTy reflArgInfo callerArgTy m e @@ -9855,19 +9855,19 @@ and TcMethodApplication | None -> () | Some id -> let item = Item.ArgName (defaultArg assignedArg.CalledArg.NameOpt id, assignedArg.CalledArg.CalledArgumentType, Some(ArgumentContainer.Method(finalCalledMethInfo))) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,ad)) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad)) let allArgsCoerced = List.map coerce allArgs // Make the call expression - let expr,exprty = + let expr, exprty = BuildPossiblyConditionalMethodCall cenv env mut mMethExpr isProp finalCalledMethInfo isSuperInit finalCalledMethInst objArgs allArgsCoerced // Bind "out" parameters as part of the result tuple - let expr,exprty = - if isNil outArgTmpBinds then expr,exprty + let expr, exprty = + if isNil outArgTmpBinds then expr, exprty else let outArgTys = outArgExprs |> List.map (tyOfExpr cenv.g) let expr = if isUnitTy cenv.g exprty then mkCompGenSequential mMethExpr expr (mkRefTupled cenv.g mMethExpr outArgExprs outArgTys) @@ -9880,15 +9880,15 @@ and TcMethodApplication if isCheckingAttributeCall then expr else if isNil finalAssignedItemSetters then expr else // This holds the result of the call - let objv,objExpr = mkMutableCompGenLocal mMethExpr "returnVal" exprty // mutable in case it's a struct + let objv, objExpr = mkMutableCompGenLocal mMethExpr "returnVal" exprty // mutable in case it's a struct // This expression mutates the properties on the result of the call let propSetExpr = - (mkUnit cenv.g mMethExpr, finalAssignedItemSetters) ||> List.fold (fun acc (AssignedItemSetter(id,setter,CallerArg(callerArgTy,m,isOptCallerArg,argExpr))) -> - if isOptCallerArg then error(Error(FSComp.SR.tcInvalidOptionalAssignmentToPropertyOrField(),m)) + (mkUnit cenv.g mMethExpr, finalAssignedItemSetters) ||> List.fold (fun acc (AssignedItemSetter(id, setter, CallerArg(callerArgTy, m, isOptCallerArg, argExpr))) -> + if isOptCallerArg then error(Error(FSComp.SR.tcInvalidOptionalAssignmentToPropertyOrField(), m)) let action, defnItem = match setter with - | AssignedPropSetter (pinfo,pminfo,pminst) -> + | AssignedPropSetter (pinfo, pminfo, pminst) -> MethInfoChecks cenv.g cenv.amap true None [objExpr] ad m pminfo let calledArgTy = List.head (List.head (pminfo.GetParamTypes(cenv.amap, m, pminst))) let argExpr = coerceExpr false calledArgTy ReflectedArgInfo.None callerArgTy m argExpr @@ -9914,7 +9914,7 @@ and TcMethodApplication // Record the resolution for the Language Service let item = Item.SetterArg (id, defnItem) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,ad) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad) mkCompGenSequential m acc action) @@ -9938,10 +9938,10 @@ and TcMethodApplication | Some synArgExpr -> match lambdaVars with | Some [lambdaVars] -> - let argExpr,tpenv = TcExpr cenv (mkRefTupledVarsTy cenv.g lambdaVars) env tpenv synArgExpr - mkApps cenv.g ((expr,tyOfExpr cenv.g expr),[],[argExpr],mMethExpr), tpenv + let argExpr, tpenv = TcExpr cenv (mkRefTupledVarsTy cenv.g lambdaVars) env tpenv synArgExpr + mkApps cenv.g ((expr, tyOfExpr cenv.g expr), [], [argExpr], mMethExpr), tpenv | _ -> - error(InternalError("unreachable - expected some lambda vars for a tuple mismatch",mItem)) + error(InternalError("unreachable - expected some lambda vars for a tuple mismatch", mItem)) | None -> expr, tpenv @@ -9949,34 +9949,34 @@ and TcMethodApplication let expr = optArgPreBinder expr let expr = objArgPreBinder expr - (expr,finalAttributeAssignedNamedItems,delayed),tpenv + (expr, finalAttributeAssignedNamedItems, delayed), tpenv and TcUnnamedMethodArgs cenv env lambdaPropagationInfo tpenv args = - List.mapiFoldSquared (TcUnnamedMethodArg cenv env) (lambdaPropagationInfo,tpenv) args + List.mapiFoldSquared (TcUnnamedMethodArg cenv env) (lambdaPropagationInfo, tpenv) args -and TcUnnamedMethodArg cenv env (lambdaPropagationInfo,tpenv) (i,j,CallerArg(argTy,mArg,isOpt,argExpr)) = +and TcUnnamedMethodArg cenv env (lambdaPropagationInfo, tpenv) (i, j, CallerArg(argTy, mArg, isOpt, argExpr)) = // Try to find the lambda propagation info for the corresponding unnamed argument at this position let lambdaPropagationInfoForArg = - [| for (unnamedInfo,_) in lambdaPropagationInfo -> + [| for (unnamedInfo, _) in lambdaPropagationInfo -> if i < unnamedInfo.Length && j < unnamedInfo.[i].Length then unnamedInfo.[i].[j] else NoInfo |] - TcMethodArg cenv env (lambdaPropagationInfo,tpenv) (lambdaPropagationInfoForArg,CallerArg(argTy,mArg,isOpt,argExpr)) + TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, CallerArg(argTy, mArg, isOpt, argExpr)) and TcMethodNamedArgs cenv env lambdaPropagationInfo tpenv args = - List.mapFoldSquared (TcMethodNamedArg cenv env) (lambdaPropagationInfo,tpenv) args + List.mapFoldSquared (TcMethodNamedArg cenv env) (lambdaPropagationInfo, tpenv) args -and TcMethodNamedArg cenv env (lambdaPropagationInfo,tpenv) (CallerNamedArg(id,arg)) = +and TcMethodNamedArg cenv env (lambdaPropagationInfo, tpenv) (CallerNamedArg(id, arg)) = // Try to find the lambda propagation info for the corresponding named argument let lambdaPropagationInfoForArg = - [| for (_,namedInfo) in lambdaPropagationInfo -> + [| for (_, namedInfo) in lambdaPropagationInfo -> namedInfo |> Array.tryPick (fun namedInfoForArgSet -> - namedInfoForArgSet |> Array.tryPick (fun (nm,info) -> + namedInfoForArgSet |> Array.tryPick (fun (nm, info) -> if nm.idText = id.idText then Some info else None)) |] |> Array.map (fun x -> defaultArg x NoInfo) - let arg',(lambdaPropagationInfo,tpenv) = TcMethodArg cenv env (lambdaPropagationInfo,tpenv) (lambdaPropagationInfoForArg,arg) - CallerNamedArg(id,arg'),(lambdaPropagationInfo,tpenv) + let arg', (lambdaPropagationInfo, tpenv) = TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, arg) + CallerNamedArg(id, arg'), (lambdaPropagationInfo, tpenv) -and TcMethodArg cenv env (lambdaPropagationInfo,tpenv) (lambdaPropagationInfoForArg,CallerArg(argTy,mArg,isOpt,argExpr)) = +and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoForArg, CallerArg(argTy, mArg, isOpt, argExpr)) = // Apply the F# 3.1 rule for extracting information for lambdas // @@ -10005,13 +10005,13 @@ and TcMethodArg cenv env (lambdaPropagationInfo,tpenv) (lambdaPropagationInfoF let calledLambdaArgTy = col.[0] // Force the caller to be a function type. match UnifyFunctionTypeUndoIfFailed cenv env.DisplayEnv mArg callerLambdaTy with - | Some (callerLambdaDomainTy,callerLambdaRangeTy) -> + | Some (callerLambdaDomainTy, callerLambdaRangeTy) -> if AddCxTypeEqualsTypeUndoIfFailed env.DisplayEnv cenv.css mArg calledLambdaArgTy callerLambdaDomainTy then loop callerLambdaRangeTy (lambdaVarNum + 1) | None -> () loop argTy 0 - let e',tpenv = TcExpr cenv argTy env tpenv argExpr + let e', tpenv = TcExpr cenv argTy env tpenv argExpr // After we have checked, propagate the info from argument into the overloads that receive it. // @@ -10027,120 +10027,120 @@ and TcMethodArg cenv env (lambdaPropagationInfo,tpenv) (lambdaPropagationInfoF if AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed env.DisplayEnv cenv.css mArg adjustedCalledTy argTy then yield info |] - CallerArg(argTy,mArg,isOpt,e'),(lambdaPropagationInfo,tpenv) + CallerArg(argTy, mArg, isOpt, e'), (lambdaPropagationInfo, tpenv) /// Typecheck "new Delegate(fun x y z -> ...)" constructs and TcNewDelegateThen cenv overallTy env tpenv mDelTy mExprAndArg delegateTy arg atomicFlag delayed = let ad = env.eAccessRights UnifyTypes cenv env mExprAndArg overallTy delegateTy - let (SigOfFunctionForDelegate(invokeMethInfo,delArgTys,_,fty)) = GetSigOfFunctionForDelegate cenv.infoReader delegateTy mDelTy ad + let (SigOfFunctionForDelegate(invokeMethInfo, delArgTys, _, fty)) = GetSigOfFunctionForDelegate cenv.infoReader delegateTy mDelTy ad // We pass isInstance = true here because we're checking the rights to access the "Invoke" method MethInfoChecks cenv.g cenv.amap true None [] env.eAccessRights mExprAndArg invokeMethInfo let args = GetMethodArgs arg match args with - | [farg],[] -> + | [farg], [] -> let m = arg.Range - let callerArg,(_,tpenv) = TcMethodArg cenv env (Array.empty,tpenv) (Array.empty,CallerArg(fty,m,false,farg)) + let callerArg, (_, tpenv) = TcMethodArg cenv env (Array.empty, tpenv) (Array.empty, CallerArg(fty, m, false, farg)) let expr = BuildNewDelegateExpr (None, cenv.g, cenv.amap, delegateTy, invokeMethInfo, delArgTys, callerArg.Expr, fty, m) PropagateThenTcDelayed cenv overallTy env tpenv m (MakeApplicableExprNoFlex cenv expr) delegateTy atomicFlag delayed | _ -> - error(Error(FSComp.SR.tcDelegateConstructorMustBePassed(),mExprAndArg)) + error(Error(FSComp.SR.tcDelegateConstructorMustBePassed(), mExprAndArg)) and bindLetRec (binds:Bindings) m e = if isNil binds then e else - Expr.LetRec (binds,e,m,NewFreeVarsCache()) + Expr.LetRec (binds, e, m, NewFreeVarsCache()) /// Check for duplicate bindings in simple recursive patterns and CheckRecursiveBindingIds binds = let hashOfBinds = new HashSet() - for (SynBinding.Binding(_,_,_,_,_,_,_,b,_,_,m,_)) in binds do + for (SynBinding.Binding(_, _, _, _, _, _, _, b, _, _, m, _)) in binds do let nm = match b with - | SynPat.Named(_,id,_,_,_) -> id.idText - | SynPat.LongIdent(LongIdentWithDots([id],_),_,_,_,_,_) -> id.idText + | SynPat.Named(_, id, _, _, _) -> id.idText + | SynPat.LongIdent(LongIdentWithDots([id], _), _, _, _, _, _) -> id.idText | _ -> "" if nm <> "" && not (hashOfBinds.Add nm) then - error(Duplicate("value",nm,m)) + error(Duplicate("value", nm, m)) /// Process a sequence of sequentials mixed with iterated lets "let ... in let ... in ..." in a tail recursive way /// This avoids stack overflow on really large "let" and "letrec" lists and TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr expr cont = match expr with - | SynExpr.Sequential (sp,true,e1,e2,m) when not isCompExpr -> - let e1',_ = TcStmtThatCantBeCtorBody cenv env tpenv e1 + | SynExpr.Sequential (sp, true, e1, e2, m) when not isCompExpr -> + let e1', _ = TcStmtThatCantBeCtorBody cenv env tpenv e1 // tailcall - TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr e2 (fun (e2',tpenv) -> - cont (Expr.Sequential(e1',e2',NormalSeq,sp,m),tpenv)) + TcLinearExprs bodyChecker cenv env overallTy tpenv isCompExpr e2 (fun (e2', tpenv) -> + cont (Expr.Sequential(e1', e2', NormalSeq, sp, m), tpenv)) - | SynExpr.LetOrUse (isRec,isUse,binds,body,m) when not (isUse && isCompExpr) -> + | SynExpr.LetOrUse (isRec, isUse, binds, body, m) when not (isUse && isCompExpr) -> if isRec then // TcLinearExprs processes at most one recursive binding, this is not tailcalling CheckRecursiveBindingIds binds - let binds = List.map (fun x -> RecDefnBindingInfo(ExprContainerInfo,NoNewSlots,ExpressionBinding,x)) binds - if isUse then errorR(Error(FSComp.SR.tcBindingCannotBeUseAndRec(),m)) - let binds,envinner,tpenv = TcLetrec ErrorOnOverrides cenv env tpenv (binds,m,m) - let bodyExpr,tpenv = bodyChecker overallTy envinner tpenv body + let binds = List.map (fun x -> RecDefnBindingInfo(ExprContainerInfo, NoNewSlots, ExpressionBinding, x)) binds + if isUse then errorR(Error(FSComp.SR.tcBindingCannotBeUseAndRec(), m)) + let binds, envinner, tpenv = TcLetrec ErrorOnOverrides cenv env tpenv (binds, m, m) + let bodyExpr, tpenv = bodyChecker overallTy envinner tpenv body let bodyExpr = bindLetRec binds m bodyExpr - cont (bodyExpr,tpenv) + cont (bodyExpr, tpenv) else // TcLinearExprs processes multiple 'let' bindings in a tail recursive way - let mkf,envinner,tpenv = TcLetBinding cenv isUse env ExprContainerInfo ExpressionBinding tpenv (binds,m,body.Range) - TcLinearExprs bodyChecker cenv envinner overallTy tpenv isCompExpr body (fun (x,tpenv) -> - cont (fst (mkf (x,overallTy)), tpenv)) + let mkf, envinner, tpenv = TcLetBinding cenv isUse env ExprContainerInfo ExpressionBinding tpenv (binds, m, body.Range) + TcLinearExprs bodyChecker cenv envinner overallTy tpenv isCompExpr body (fun (x, tpenv) -> + cont (fst (mkf (x, overallTy)), tpenv)) | _ -> cont (bodyChecker overallTy env tpenv expr) /// Typecheck and compile pattern-matching constructs and TcAndPatternCompileMatchClauses mExpr matchm actionOnFailure cenv inputTy resultTy env tpenv clauses = let tclauses, tpenv = TcMatchClauses cenv inputTy resultTy env tpenv clauses - let v,expr = CompilePatternForMatchClauses cenv env mExpr matchm true actionOnFailure inputTy resultTy tclauses - v,expr,tpenv + let v, expr = CompilePatternForMatchClauses cenv env mExpr matchm true actionOnFailure inputTy resultTy tclauses + v, expr, tpenv -and TcMatchPattern cenv inputTy env tpenv (pat:SynPat,optWhenExpr) = +and TcMatchPattern cenv inputTy env tpenv (pat:SynPat, optWhenExpr) = let m = pat.Range - let patf',(tpenv,names,_) = TcPat WarnOnUpperCase cenv env None (ValInline.Optional,permitInferTypars,noArgOrRetAttribs,false,None,false) (tpenv,Map.empty,Set.empty) inputTy pat - let envinner,values,vspecMap = MakeAndPublishSimpleVals cenv env m names false - let optWhenExpr',tpenv = + let patf', (tpenv, names, _) = TcPat WarnOnUpperCase cenv env None (ValInline.Optional, permitInferTypars, noArgOrRetAttribs, false, None, false) (tpenv, Map.empty, Set.empty) inputTy pat + let envinner, values, vspecMap = MakeAndPublishSimpleVals cenv env m names false + let optWhenExpr', tpenv = match optWhenExpr with | Some whenExpr -> let guardEnv = { envinner with eContextInfo = ContextInfo.PatternMatchGuard whenExpr.Range } - let whenExpr',tpenv = TcExpr cenv cenv.g.bool_ty guardEnv tpenv whenExpr - Some whenExpr',tpenv - | None -> None,tpenv - patf' (TcPatPhase2Input (values, true)),optWhenExpr', NameMap.range vspecMap,envinner,tpenv + let whenExpr', tpenv = TcExpr cenv cenv.g.bool_ty guardEnv tpenv whenExpr + Some whenExpr', tpenv + | None -> None, tpenv + patf' (TcPatPhase2Input (values, true)), optWhenExpr', NameMap.range vspecMap, envinner, tpenv and TcMatchClauses cenv inputTy resultTy env tpenv clauses = let first = ref true let isFirst() = if !first then first := false; true else false List.mapFold (fun clause -> TcMatchClause cenv inputTy resultTy env (isFirst()) clause) tpenv clauses -and TcMatchClause cenv inputTy resultTy env isFirst tpenv (Clause(pat,optWhenExpr,e,patm,spTgt)) = - let pat',optWhenExpr',vspecs,envinner,tpenv = TcMatchPattern cenv inputTy env tpenv (pat,optWhenExpr) +and TcMatchClause cenv inputTy resultTy env isFirst tpenv (Clause(pat, optWhenExpr, e, patm, spTgt)) = + let pat', optWhenExpr', vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv (pat, optWhenExpr) let resultEnv = if isFirst then envinner else { envinner with eContextInfo = ContextInfo.FollowingPatternMatchClause e.Range } - let e',tpenv = TcExprThatCanBeCtorBody cenv resultTy resultEnv tpenv e - TClause(pat',optWhenExpr',TTarget(vspecs, e',spTgt),patm),tpenv + let e', tpenv = TcExprThatCanBeCtorBody cenv resultTy resultEnv tpenv e + TClause(pat', optWhenExpr', TTarget(vspecs, e', spTgt), patm), tpenv and TcStaticOptimizationConstraint cenv env tpenv c = match c with - | WhenTyparTyconEqualsTycon(tp,ty,m) -> + | WhenTyparTyconEqualsTycon(tp, ty, m) -> if not cenv.g.compilingFslib then - errorR(Error(FSComp.SR.tcStaticOptimizationConditionalsOnlyForFSharpLibrary(),m)) - let ty',tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv ty - let tp',tpenv = TcTypar cenv env NewTyparsOK tpenv tp - TTyconEqualsTycon(mkTyparTy tp', ty'),tpenv - | WhenTyparIsStruct(tp,m) -> + errorR(Error(FSComp.SR.tcStaticOptimizationConditionalsOnlyForFSharpLibrary(), m)) + let ty', tpenv = TcType cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv ty + let tp', tpenv = TcTypar cenv env NewTyparsOK tpenv tp + TTyconEqualsTycon(mkTyparTy tp', ty'), tpenv + | WhenTyparIsStruct(tp, m) -> if not cenv.g.compilingFslib then - errorR(Error(FSComp.SR.tcStaticOptimizationConditionalsOnlyForFSharpLibrary(),m)) - let tp',tpenv = TcTypar cenv env NewTyparsOK tpenv tp - TTyconIsStruct(mkTyparTy tp'),tpenv + errorR(Error(FSComp.SR.tcStaticOptimizationConditionalsOnlyForFSharpLibrary(), m)) + let tp', tpenv = TcTypar cenv env NewTyparsOK tpenv tp + TTyconIsStruct(mkTyparTy tp'), tpenv /// Emit a conv.i instruction -and mkConvToNativeInt (g:TcGlobals) e m = Expr.Op (TOp.ILAsm ([ AI_conv ILBasicType.DT_I], [ g.nativeint_ty ]),[],[e],m) +and mkConvToNativeInt (g:TcGlobals) e m = Expr.Op (TOp.ILAsm ([ AI_conv ILBasicType.DT_I], [ g.nativeint_ty ]), [], [e], m) /// Fix up the r.h.s. of a 'use x = fixed expr' and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBinding) = @@ -10149,20 +10149,20 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi | ty when isByrefTy cenv.g ty -> let okByRef = match stripExpr fixedExpr with - | Expr.Op (op,tyargs,args,_) -> - match op,tyargs,args with - | TOp.ValFieldGetAddr rfref,_,[_] -> not rfref.Tycon.IsStructOrEnumTycon - | TOp.ILAsm ([ I_ldflda (fspec)],_),_,_ -> fspec.EnclosingType.Boxity = ILBoxity.AsObject - | TOp.ILAsm ([ I_ldelema _],_),_,_ -> true - | TOp.RefAddrGet _,_,_ -> true + | Expr.Op (op, tyargs, args, _) -> + match op, tyargs, args with + | TOp.ValFieldGetAddr rfref, _, [_] -> not rfref.Tycon.IsStructOrEnumTycon + | TOp.ILAsm ([ I_ldflda (fspec)], _), _, _ -> fspec.EnclosingType.Boxity = ILBoxity.AsObject + | TOp.ILAsm ([ I_ldelema _], _), _, _ -> true + | TOp.RefAddrGet _, _, _ -> true | _ -> false | _ -> false if not okByRef then - error(Error(FSComp.SR.tcFixedNotAllowed(),mBinding)) + error(Error(FSComp.SR.tcFixedNotAllowed(), mBinding)) let elemTy = destByrefTy cenv.g overallExprTy UnifyTypes cenv env mBinding (mkNativePtrTy cenv.g elemTy) overallPatTy - mkCompGenLetIn mBinding "pinnedByref" ty fixedExpr (fun (v,ve) -> + mkCompGenLetIn mBinding "pinnedByref" ty fixedExpr (fun (v, ve) -> v.SetIsFixed() mkConvToNativeInt cenv.g ve mBinding) @@ -10174,11 +10174,11 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi // let pinned s = str // (nativeptr)s + get_OffsettoStringData() - mkCompGenLetIn mBinding "pinnedString" cenv.g.string_ty fixedExpr (fun (v,ve) -> + mkCompGenLetIn mBinding "pinnedString" cenv.g.string_ty fixedExpr (fun (v, ve) -> v.SetIsFixed() let addrOffset = BuildOffsetToStringData cenv env mBinding let stringAsNativeInt = mkConvToNativeInt cenv.g ve mBinding - let plusOffset = Expr.Op (TOp.ILAsm ([ AI_add ], [ cenv.g.nativeint_ty ]),[],[stringAsNativeInt; addrOffset],mBinding) + let plusOffset = Expr.Op (TOp.ILAsm ([ AI_add ], [ cenv.g.nativeint_ty ]), [], [stringAsNativeInt; addrOffset], mBinding) // check for non-null mkNullTest cenv.g mBinding ve plusOffset ve) @@ -10198,37 +10198,37 @@ and TcAndBuildFixedExpr cenv env (overallPatTy, fixedExpr, overallExprTy, mBindi // else // (nativeint) 0 // - mkCompGenLetIn mBinding "tmpArray" overallExprTy fixedExpr (fun (_,ve) -> + mkCompGenLetIn mBinding "tmpArray" overallExprTy fixedExpr (fun (_, ve) -> // This is &arr.[0] - let elemZeroAddress = mkArrayElemAddress cenv.g (ILReadonly.NormalAddress,false,ILArrayShape.SingleDimensional,elemTy,ve,mkInt32 cenv.g mBinding 0,mBinding) + let elemZeroAddress = mkArrayElemAddress cenv.g (ILReadonly.NormalAddress, false, ILArrayShape.SingleDimensional, elemTy, ve, mkInt32 cenv.g mBinding 0, mBinding) // check for non-null and non-empty let zero = mkConvToNativeInt cenv.g (mkInt32 cenv.g mBinding 0) mBinding // This is arr.Length let arrayLengthExpr = mkCallArrayLength cenv.g mBinding elemTy ve mkNullTest cenv.g mBinding ve (mkNullTest cenv.g mBinding arrayLengthExpr - (mkCompGenLetIn mBinding "pinnedByref" (mkByrefTy cenv.g elemTy) elemZeroAddress (fun (v,ve) -> + (mkCompGenLetIn mBinding "pinnedByref" (mkByrefTy cenv.g elemTy) elemZeroAddress (fun (v, ve) -> v.SetIsFixed() (mkConvToNativeInt cenv.g ve mBinding))) zero) zero) - | _ -> error(Error(FSComp.SR.tcFixedNotAllowed(),mBinding)) + | _ -> error(Error(FSComp.SR.tcFixedNotAllowed(), mBinding)) /// Binding checking code, for all bindings including let bindings, let-rec bindings, member bindings and object-expression bindings and -and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt safeInitInfo (enclosingDeclaredTypars,(ExplicitTyparInfo(_,declaredTypars,_) as flex)) bind = +and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt safeInitInfo (enclosingDeclaredTypars, (ExplicitTyparInfo(_, declaredTypars, _) as flex)) bind = let envinner = AddDeclaredTypars NoCheckForDuplicateTypars (enclosingDeclaredTypars@declaredTypars) env match bind with - | NormalizedBinding(vis,bkind,isInline,isMutable,attrs,doc,_,valSynData,pat,NormalizedBindingRhs(spatsL,rtyOpt,rhsExpr),mBinding,spBind) -> - let (SynValData(memberFlagsOpt,valSynInfo,_)) = valSynData + | NormalizedBinding(vis, bkind, isInline, isMutable, attrs, doc, _, valSynData, pat, NormalizedBindingRhs(spatsL, rtyOpt, rhsExpr), mBinding, spBind) -> + let (SynValData(memberFlagsOpt, valSynInfo, _)) = valSynData let callerName = match declKind, bkind, pat with | ExpressionBinding, _, _ -> envinner.eCallerMemberName - | _, _, SynPat.Named(_,name,_,_,_) -> + | _, _, SynPat.Named(_, name, _, _, _) -> match memberFlagsOpt with | Some(memberFlags) -> match memberFlags.MemberKind with @@ -10246,16 +10246,16 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt let attrTgt = DeclKind.AllowedAttribTargets memberFlagsOpt declKind - let isFixed,rhsExpr,overallPatTy,overallExprTy = + let isFixed, rhsExpr, overallPatTy, overallExprTy = match rhsExpr with - | SynExpr.Fixed (e,_) -> true, e, NewInferenceType(), overallTy + | SynExpr.Fixed (e, _) -> true, e, NewInferenceType(), overallTy | e -> false, e, overallTy, overallTy // Check the attributes of the binding, parameters or return value let TcAttrs tgt attrs = let attrs = TcAttributes cenv envinner tgt attrs if attrTgt = enum 0 && not (isNil attrs) then - errorR(Error(FSComp.SR.tcAttributesAreNotPermittedOnLetBindings(),mBinding)) + errorR(Error(FSComp.SR.tcAttributesAreNotPermittedOnLetBindings(), mBinding)) attrs let valAttribs = TcAttrs attrTgt attrs @@ -10267,13 +10267,13 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt spatsL |> List.map (SynInfo.InferSynArgInfoFromSimplePats >> List.map (SynInfo.AttribsOfArgData >> TcAttrs AttributeTargets.Parameter)) let retAttribs = match rtyOpt with - | Some (SynBindingReturnInfo(_,_,retAttrs)) -> TcAttrs AttributeTargets.ReturnValue retAttrs + | Some (SynBindingReturnInfo(_, _, retAttrs)) -> TcAttrs AttributeTargets.ReturnValue retAttrs | None -> [] let argAndRetAttribs = ArgAndRetAttribs(argAttribs, retAttribs) if HasFSharpAttribute cenv.g cenv.g.attrib_DefaultValueAttribute valAttribs then - errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(),mBinding)) + errorR(Error(FSComp.SR.tcDefaultValueAttributeRequiresVal(), mBinding)) let isThreadStatic = isThreadOrContextStatic cenv.g valAttribs if isThreadStatic then errorR(DeprecatedThreadStaticBindingWarning(mBinding)) @@ -10281,39 +10281,39 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt if isVolatile then match declKind with | ClassLetBinding(_) -> () - | _ -> errorR(Error(FSComp.SR.tcVolatileOnlyOnClassLetBindings(),mBinding)) + | _ -> errorR(Error(FSComp.SR.tcVolatileOnlyOnClassLetBindings(), mBinding)) if (not isMutable || isThreadStatic) then - errorR(Error(FSComp.SR.tcVolatileFieldsMustBeMutable(),mBinding)) + errorR(Error(FSComp.SR.tcVolatileFieldsMustBeMutable(), mBinding)) if isFixed && (declKind <> ExpressionBinding || isInline || isMutable) then - errorR(Error(FSComp.SR.tcFixedNotAllowed(),mBinding)) + errorR(Error(FSComp.SR.tcFixedNotAllowed(), mBinding)) if (not declKind.CanBeDllImport || (match memberFlagsOpt with Some memberFlags -> memberFlags.IsInstance | _ -> false)) && HasFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute valAttribs then - errorR(Error(FSComp.SR.tcDllImportNotAllowed(),mBinding)) + errorR(Error(FSComp.SR.tcDllImportNotAllowed(), mBinding)) if Option.isNone memberFlagsOpt && HasFSharpAttribute cenv.g cenv.g.attrib_ConditionalAttribute valAttribs then - errorR(Error(FSComp.SR.tcConditionalAttributeRequiresMembers(),mBinding)) + errorR(Error(FSComp.SR.tcConditionalAttributeRequiresMembers(), mBinding)) if HasFSharpAttribute cenv.g cenv.g.attrib_EntryPointAttribute valAttribs then if Option.isSome memberFlagsOpt then - errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(),mBinding)) + errorR(Error(FSComp.SR.tcEntryPointAttributeRequiresFunctionInModule(), mBinding)) else UnifyTypes cenv env mBinding overallPatTy (mkArrayType cenv.g cenv.g.string_ty --> cenv.g.int_ty) - if isMutable && isInline then errorR(Error(FSComp.SR.tcMutableValuesCannotBeInline(),mBinding)) + if isMutable && isInline then errorR(Error(FSComp.SR.tcMutableValuesCannotBeInline(), mBinding)) - if isMutable && not (isNil declaredTypars) then errorR(Error(FSComp.SR.tcMutableValuesMayNotHaveGenericParameters(),mBinding)) + if isMutable && not (isNil declaredTypars) then errorR(Error(FSComp.SR.tcMutableValuesMayNotHaveGenericParameters(), mBinding)) let flex = if isMutable then dontInferTypars else flex - if isMutable && not (isNil spatsL) then errorR(Error(FSComp.SR.tcMutableValuesSyntax(),mBinding)) + if isMutable && not (isNil spatsL) then errorR(Error(FSComp.SR.tcMutableValuesSyntax(), mBinding)) let isInline = if isInline && isNil spatsL && isNil declaredTypars then - errorR(Error(FSComp.SR.tcOnlyFunctionsCanBeInline(),mBinding)) + errorR(Error(FSComp.SR.tcOnlyFunctionsCanBeInline(), mBinding)) false else isInline @@ -10324,29 +10324,29 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt let partialValReprInfo = TranslateTopValSynInfo mBinding (TcAttributes cenv env) valSynInfo // Check the pattern of the l.h.s. of the binding - let tcPatPhase2,(tpenv,nameToPrelimValSchemeMap,_) = - TcPat AllIdsOK cenv envinner (Some(partialValReprInfo)) (inlineFlag,flex,argAndRetAttribs,isMutable,vis,compgen) (tpenv,NameMap.empty,Set.empty) overallPatTy pat + let tcPatPhase2, (tpenv, nameToPrelimValSchemeMap, _) = + TcPat AllIdsOK cenv envinner (Some(partialValReprInfo)) (inlineFlag, flex, argAndRetAttribs, isMutable, vis, compgen) (tpenv, NameMap.empty, Set.empty) overallPatTy pat // Add active pattern result names to the environment let apinfoOpt = match NameMap.range nameToPrelimValSchemeMap with - | [PrelimValScheme1(id,_,ty,_,_,_,_,_,_,_,_) ] -> + | [PrelimValScheme1(id, _, ty, _, _, _, _, _, _, _, _) ] -> match ActivePatternInfoOfValName id.idText id.idRange with - | Some apinfo -> Some (apinfo,ty, id.idRange) + | Some apinfo -> Some (apinfo, ty, id.idRange) | None -> None | _ -> None // Add active pattern result names to the environment let envinner = match apinfoOpt with - | Some (apinfo,ty,m) -> + | Some (apinfo, ty, m) -> if Option.isSome memberFlagsOpt || (not apinfo.IsTotal && apinfo.ActiveTags.Length > 1) then - error(Error(FSComp.SR.tcInvalidActivePatternName(),mBinding)) + error(Error(FSComp.SR.tcInvalidActivePatternName(), mBinding)) - apinfo.ActiveTagsWithRanges |> List.iteri (fun i (_tag,tagRange) -> + apinfo.ActiveTagsWithRanges |> List.iteri (fun i (_tag, tagRange) -> let item = Item.ActivePatternResult(apinfo, cenv.g.unit_ty, i, tagRange) - CallNameResolutionSink cenv.tcSink (tagRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights)) + CallNameResolutionSink cenv.tcSink (tagRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights)) ModifyNameResEnv (fun nenv -> AddActivePatternResultTagsToNameEnv apinfo nenv ty m) envinner | None -> @@ -10358,7 +10358,7 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt // At each module binding, dive into the expression to check for syntax errors and suppress them if they show. // Don't do this for lambdas, because we always check for suppression for all lambda bodies in TcIteratedLambdas - let rhsExprChecked,tpenv = + let rhsExprChecked, tpenv = let atTopNonLambdaDefn = DeclKind.IsModuleOrMemberOrExtensionBinding declKind && (match rhsExpr with SynExpr.Lambda _ -> false | _ -> true) && @@ -10379,46 +10379,46 @@ and TcNormalizedBinding declKind (cenv:cenv) env tpenv overallTy safeThisValOpt // Assert the return type of an active pattern match apinfoOpt with - | Some (apinfo,ty,_) -> + | Some (apinfo, ty, _) -> let activePatResTys = NewInferenceTypes apinfo.ActiveTags - let _,rty = stripFunTy cenv.g ty + let _, rty = stripFunTy cenv.g ty UnifyTypes cenv env mBinding (apinfo.ResultType cenv.g rhsExpr.Range activePatResTys) rty | None -> () // Check other attributes - let hasLiteralAttr,konst = TcLiteral cenv overallExprTy env tpenv (valAttribs,rhsExpr) + let hasLiteralAttr, konst = TcLiteral cenv overallExprTy env tpenv (valAttribs, rhsExpr) if hasLiteralAttr then if isThreadStatic then - errorR(Error(FSComp.SR.tcIllegalAttributesForLiteral(),mBinding)) + errorR(Error(FSComp.SR.tcIllegalAttributesForLiteral(), mBinding)) if isMutable then - errorR(Error(FSComp.SR.tcLiteralCannotBeMutable(),mBinding)) + errorR(Error(FSComp.SR.tcLiteralCannotBeMutable(), mBinding)) if isInline then - errorR(Error(FSComp.SR.tcLiteralCannotBeInline(),mBinding)) + errorR(Error(FSComp.SR.tcLiteralCannotBeInline(), mBinding)) if not (isNil declaredTypars) then - errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(),mBinding)) + errorR(Error(FSComp.SR.tcLiteralCannotHaveGenericParameters(), mBinding)) - CheckedBindingInfo(inlineFlag,valAttribs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExprChecked,argAndRetAttribs,overallPatTy,mBinding,spBind,compgen,konst,isFixed),tpenv + CheckedBindingInfo(inlineFlag, valAttribs, doc, tcPatPhase2, flex, nameToPrelimValSchemeMap, rhsExprChecked, argAndRetAttribs, overallPatTy, mBinding, spBind, compgen, konst, isFixed), tpenv -and TcLiteral cenv overallTy env tpenv (attrs,synLiteralValExpr) = +and TcLiteral cenv overallTy env tpenv (attrs, synLiteralValExpr) = let hasLiteralAttr = HasFSharpAttribute cenv.g cenv.g.attrib_LiteralAttribute attrs if hasLiteralAttr then - let literalValExpr,_ = TcExpr cenv overallTy env tpenv synLiteralValExpr + let literalValExpr, _ = TcExpr cenv overallTy env tpenv synLiteralValExpr match EvalLiteralExprOrAttribArg cenv.g literalValExpr with - | Expr.Const(c,_, ty) -> + | Expr.Const(c, _, ty) -> if c = Const.Zero && isStructTy cenv.g ty then warning(Error(FSComp.SR.tcIllegalStructTypeForConstantExpression(), synLiteralValExpr.Range)) false, None else true, Some c | _ -> - errorR(Error(FSComp.SR.tcInvalidConstantExpression(),synLiteralValExpr.Range)) + errorR(Error(FSComp.SR.tcInvalidConstantExpression(), synLiteralValExpr.Range)) true, Some Const.Unit else hasLiteralAttr, None -and TcBindingTyparDecls alwaysRigid cenv env tpenv (SynValTyparDecls(synTypars,infer,synTyparConstraints)) = +and TcBindingTyparDecls alwaysRigid cenv env tpenv (SynValTyparDecls(synTypars, infer, synTyparConstraints)) = let declaredTypars = TcTyparDecls cenv env synTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars declaredTypars env let tpenv = TcTyparConstraints cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv synTyparConstraints @@ -10435,46 +10435,46 @@ and TcBindingTyparDecls alwaysRigid cenv env tpenv (SynValTyparDecls(synTypars,i declaredTypars |> List.iter (fun tp -> tp.SetRigidity TyparRigidity.WillBeRigid) rigidCopyOfDeclaredTypars - ExplicitTyparInfo(rigidCopyOfDeclaredTypars,declaredTypars,infer) , tpenv + ExplicitTyparInfo(rigidCopyOfDeclaredTypars, declaredTypars, infer) , tpenv and TcNonrecBindingTyparDecls cenv env tpenv bind = - let (NormalizedBinding(_,_,_,_,_,_,synTyparDecls,_,_,_,_,_)) = bind + let (NormalizedBinding(_, _, _, _, _, _, synTyparDecls, _, _, _, _, _)) = bind TcBindingTyparDecls true cenv env tpenv synTyparDecls and TcNonRecursiveBinding declKind cenv env tpenv ty b = let b = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env b let flex, tpenv = TcNonrecBindingTyparDecls cenv env tpenv b - TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([],flex) b + TcNormalizedBinding declKind cenv env tpenv ty None NoSafeInitInfo ([], flex) b //------------------------------------------------------------------------- // TcAttribute* //------------------------------------------------------------------------ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = - let (LongIdentWithDots(tycon,_)) = synAttr.TypeName + let (LongIdentWithDots(tycon, _)) = synAttr.TypeName let arg = synAttr.ArgExpr let targetIndicator = synAttr.Target let isAppliedToGetterOrSetter = synAttr.AppliesToGetterAndSetter let mAttr = synAttr.Range - let (typath,tyid) = List.frontAndBack tycon + let (typath, tyid) = List.frontAndBack tycon let tpenv = emptyUnscopedTyparEnv // if we're checking an attribute that was applied directly to a getter or a setter, then // what we're really checking against is a method, not a property let attrTgt = if isAppliedToGetterOrSetter then ((attrTgt ^^^ AttributeTargets.Property) ||| AttributeTargets.Method) else attrTgt - let ty,tpenv = + let ty, tpenv = let try1 n = let tyid = mkSynId tyid.idRange n let tycon = (typath @ [tyid]) let ad = env.eAccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInAttribute OpenQualified env.eNameResEnv ad tycon TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.No with | Exception err -> raze(err) - | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(LongIdentWithDots(tycon,[])),None,[],[],None,false,mAttr)) ) + | _ -> success(TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInAttribute env tpenv (SynType.App(SynType.LongIdent(LongIdentWithDots(tycon, [])), None, [], [], None, false, mAttr)) ) ForceRaise ((try1 (tyid.idText + "Attribute")) |> ResultOrException.otherwise (fun () -> (try1 tyid.idText))) let ad = env.eAccessRights - if not (IsTypeAccessible cenv.g cenv.amap mAttr ad ty) then errorR(Error(FSComp.SR.tcTypeIsInaccessible(),mAttr)) + if not (IsTypeAccessible cenv.g cenv.amap mAttr ad ty) then errorR(Error(FSComp.SR.tcTypeIsInaccessible(), mAttr)) let tcref = tcrefOfAppTy cenv.g ty @@ -10486,7 +10486,7 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = | _ -> // REVIEW: take notice of inherited? - let validOn,_inherited = + let validOn, _inherited = let validOnDefault = 0x7fff let inheritedDefault = true if tcref.IsILTycon then @@ -10494,26 +10494,26 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let tref = cenv.g.attrib_AttributeUsageAttribute.TypeRef match TryDecodeILAttribute cenv.g tref tdef.CustomAttrs with - | Some ([ILAttribElem.Int32 validOn ],named) -> + | Some ([ILAttribElem.Int32 validOn ], named) -> let inherited = - match List.tryPick (function ("Inherited",_,_,ILAttribElem.Bool res) -> Some res | _ -> None) named with + 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 ],_) -> + | Some ([ILAttribElem.Int32 validOn; ILAttribElem.Bool _allowMultiple; ILAttribElem.Bool inherited ], _) -> (validOn, inherited) | _ -> (validOnDefault, inheritedDefault) else match (TryFindFSharpAttribute cenv.g cenv.g.attrib_AttributeUsageAttribute tcref.Attribs) with - | Some(Attrib(_,_,[ AttribInt32Arg(validOn) ],_,_,_,_)) -> + | Some(Attrib(_, _, [ AttribInt32Arg(validOn) ], _, _, _, _)) -> (validOn, inheritedDefault) - | Some(Attrib(_,_,[ AttribInt32Arg(validOn) - AttribBoolArg(_allowMultiple) - AttribBoolArg(inherited)],_,_,_,_)) -> + | Some(Attrib(_, _, [ AttribInt32Arg(validOn) + AttribBoolArg(_allowMultiple) + AttribBoolArg(inherited)], _, _, _, _)) -> (validOn, inherited) | Some _ -> - warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(),mAttr)) + warning(Error(FSComp.SR.tcUnexpectedConditionInImportedAssembly(), mAttr)) (validOnDefault, inheritedDefault) | _ -> (validOnDefault, inheritedDefault) @@ -10531,15 +10531,15 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = | Some id when id.idText = "constructor" -> AttributeTargets.Constructor | Some id when id.idText = "event" -> AttributeTargets.Event | Some id -> - errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(),id.idRange)) + errorR(Error(FSComp.SR.tcUnrecognizedAttributeTarget(), id.idRange)) possibleTgts | _ -> possibleTgts let constrainedTgts = possibleTgts &&& directedTgts if constrainedTgts = enum 0 then if (directedTgts = AttributeTargets.Assembly || directedTgts = AttributeTargets.Module) then - error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElementUseDo(),mAttr)) + error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElementUseDo(), mAttr)) else - error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElement(),mAttr)) + error(Error(FSComp.SR.tcAttributeIsNotValidForLanguageElement(), mAttr)) match ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mAttr ad ty with | Exception _ when canFail -> [ ], true @@ -10547,70 +10547,70 @@ and TcAttribute canFail cenv (env: TcEnv) attrTgt (synAttr: SynAttribute) = let item = ForceRaise res let attrib = match item with - | Item.CtorGroup(methodName,minfos) -> - let meths = minfos |> List.map (fun minfo -> minfo,None) + | Item.CtorGroup(methodName, minfos) -> + let meths = minfos |> List.map (fun minfo -> minfo, None) let afterResolution = ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos - let (expr,attributeAssignedNamedItems,_),_ = + let (expr, attributeAssignedNamedItems, _), _ = TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterResolution NormalValUse [arg] (NewInferenceType ()) [] UnifyTypes cenv env mAttr ty (tyOfExpr cenv.g expr) let mkAttribExpr e = - AttribExpr(e,EvalLiteralExprOrAttribArg cenv.g e) + AttribExpr(e, EvalLiteralExprOrAttribArg cenv.g e) let namedAttribArgMap = - attributeAssignedNamedItems |> List.map (fun (CallerNamedArg(id,CallerArg(argtyv,m,isOpt,callerArgExpr))) -> - if isOpt then error(Error(FSComp.SR.tcOptionalArgumentsCannotBeUsedInCustomAttribute(),m)) + attributeAssignedNamedItems |> List.map (fun (CallerNamedArg(id, CallerArg(argtyv, m, isOpt, callerArgExpr))) -> + if isOpt then error(Error(FSComp.SR.tcOptionalArgumentsCannotBeUsedInCustomAttribute(), m)) let m = callerArgExpr.Range let setterItem, _ = ResolveLongIdentInType cenv.tcSink cenv.nameResolver env.NameEnv LookupKind.Expr m ad [id] IgnoreOverrides TypeNameResolutionInfo.Default ty let nm, isProp, argty = match setterItem with - | Item.Property (_,[pinfo]) -> + | Item.Property (_, [pinfo]) -> if not pinfo.HasSetter then - errorR(Error(FSComp.SR.tcPropertyCannotBeSet0(),m)) - id.idText, true, pinfo.GetPropertyType(cenv.amap,m) + errorR(Error(FSComp.SR.tcPropertyCannotBeSet0(), m)) + id.idText, true, pinfo.GetPropertyType(cenv.amap, m) | Item.ILField finfo -> CheckILFieldInfoAccessible cenv.g cenv.amap m ad finfo CheckILFieldAttributes cenv.g finfo m - id.idText,false, finfo.FieldType(cenv.amap, m) + id.idText, false, finfo.FieldType(cenv.amap, m) | Item.RecdField rfinfo when not rfinfo.IsStatic -> CheckRecdFieldInfoAttributes cenv.g rfinfo m |> CommitOperationResult CheckRecdFieldInfoAccessible cenv.amap m ad rfinfo // This uses the F# backend name mangling of fields.... let nm = ComputeFieldName rfinfo.Tycon rfinfo.RecdField - nm,false,rfinfo.FieldType + nm, false, rfinfo.FieldType | _ -> - errorR(Error(FSComp.SR.tcPropertyOrFieldNotFoundInAttribute(),m)) - id.idText,false,cenv.g.unit_ty + errorR(Error(FSComp.SR.tcPropertyOrFieldNotFoundInAttribute(), m)) + id.idText, false, cenv.g.unit_ty let propNameItem = Item.SetterArg(id, setterItem) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,propNameItem,propNameItem,emptyTyparInst,ItemOccurence.Use,env.DisplayEnv,ad) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, propNameItem, propNameItem, emptyTyparInst, ItemOccurence.Use, env.DisplayEnv, ad) AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace argty argtyv - AttribNamedArg(nm,argty,isProp,mkAttribExpr callerArgExpr)) + AttribNamedArg(nm, argty, isProp, mkAttribExpr callerArgExpr)) match expr with - | Expr.Op(TOp.ILCall(_,_,valu,_,_,_,_,ilMethRef,[],[],_rtys),[],args,m) -> - if valu then error (Error(FSComp.SR.tcCustomAttributeMustBeReferenceType(),m)) - if args.Length <> ilMethRef.ArgTypes.Length then error (Error(FSComp.SR.tcCustomAttributeArgumentMismatch(),m)) + | Expr.Op(TOp.ILCall(_, _, valu, _, _, _, _, ilMethRef, [], [], _rtys), [], args, m) -> + if valu then error (Error(FSComp.SR.tcCustomAttributeMustBeReferenceType(), m)) + if args.Length <> ilMethRef.ArgTypes.Length then error (Error(FSComp.SR.tcCustomAttributeArgumentMismatch(), m)) let args = args |> List.map mkAttribExpr - Attrib(tcref,ILAttrib(ilMethRef),args,namedAttribArgMap,isAppliedToGetterOrSetter,Some constrainedTgts,m) + Attrib(tcref, ILAttrib(ilMethRef), args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, m) - | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(vref,_,_,_))),_,_,args,_) -> - let args = args |> List.collect (function Expr.Const(Const.Unit,_,_) -> [] | expr -> tryDestRefTupleExpr expr) |> List.map mkAttribExpr - Attrib(tcref,FSAttrib(vref),args,namedAttribArgMap,isAppliedToGetterOrSetter,Some constrainedTgts,mAttr) + | Expr.App((InnerExprPat(ExprValWithPossibleTypeInst(vref, _, _, _))), _, _, args, _) -> + let args = args |> List.collect (function Expr.Const(Const.Unit, _, _) -> [] | expr -> tryDestRefTupleExpr expr) |> List.map mkAttribExpr + Attrib(tcref, FSAttrib(vref), args, namedAttribArgMap, isAppliedToGetterOrSetter, Some constrainedTgts, mAttr) | _ -> - error (Error(FSComp.SR.tcCustomAttributeMustInvokeConstructor(),mAttr)) + error (Error(FSComp.SR.tcCustomAttributeMustInvokeConstructor(), mAttr)) | _ -> - error(Error(FSComp.SR.tcAttributeExpressionsMustBeConstructorCalls(),mAttr)) + error(Error(FSComp.SR.tcAttributeExpressionsMustBeConstructorCalls(), mAttr)) [ (constrainedTgts, attrib) ], false and TcAttributesWithPossibleTargets canFail cenv env attrTgt synAttribs = - (false,synAttribs) ||> List.collectFold (fun didFail synAttrib -> + (false, synAttribs) ||> List.collectFold (fun didFail synAttrib -> try let attribsAndTargets, didFail2 = TcAttribute canFail cenv env attrTgt synAttrib @@ -10620,7 +10620,7 @@ and TcAttributesWithPossibleTargets canFail cenv env attrTgt synAttribs = if HasFSharpAttribute cenv.g cenv.g.attrib_TypeForwardedToAttribute attribs || HasFSharpAttribute cenv.g cenv.g.attrib_CompilationArgumentCountsAttribute attribs || HasFSharpAttribute cenv.g cenv.g.attrib_CompilationMappingAttribute attribs then - errorR(Error(FSComp.SR.tcUnsupportedAttribute(),synAttrib.Range)) + errorR(Error(FSComp.SR.tcUnsupportedAttribute(), synAttrib.Range)) attribsAndTargets, didFail || didFail2 @@ -10643,30 +10643,30 @@ and TcAttributes cenv env attrTgt synAttribs = // TcLetBinding //------------------------------------------------------------------------ -and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scopem) = +and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds, bindsm, scopem) = // Typecheck all the bindings... - let binds',tpenv = List.mapFold (fun tpenv b -> TcNonRecursiveBinding declKind cenv env tpenv (NewInferenceType ()) b) tpenv binds - let (ContainerInfo(altActualParent,_)) = containerInfo + let binds', tpenv = List.mapFold (fun tpenv b -> TcNonRecursiveBinding declKind cenv env tpenv (NewInferenceType ()) b) tpenv binds + let (ContainerInfo(altActualParent, _)) = containerInfo // Canonicalize constraints prior to generalization let denv = env.DisplayEnv - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denv,bindsm) + GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, bindsm) (binds' |> List.collect (fun tbinfo -> - let (CheckedBindingInfo(_,_,_,_,flex,_,_,_,tauTy,_,_,_,_,_)) = tbinfo - let (ExplicitTyparInfo(_,declaredTypars,_)) = flex + let (CheckedBindingInfo(_, _, _, _, flex, _, _, _, tauTy, _, _, _, _, _)) = tbinfo + let (ExplicitTyparInfo(_, declaredTypars, _)) = flex let maxInferredTypars = (freeInTypeLeftToRight cenv.g false tauTy) declaredTypars @ maxInferredTypars)) let lazyFreeInEnv = lazy (GeneralizationHelpers.ComputeUngeneralizableTypars env) // Generalize the bindings... - (((fun x -> x), env, tpenv), binds') ||> List.fold (fun (mkf_sofar,env,tpenv) tbinfo -> - let (CheckedBindingInfo(inlineFlag,attrs,doc,tcPatPhase2,flex,nameToPrelimValSchemeMap,rhsExpr,_,tauTy,m,spBind,_,konst,isFixed)) = tbinfo + (((fun x -> x), env, tpenv), binds') ||> List.fold (fun (mkf_sofar, env, tpenv) tbinfo -> + let (CheckedBindingInfo(inlineFlag, attrs, doc, tcPatPhase2, flex, nameToPrelimValSchemeMap, rhsExpr, _, tauTy, m, spBind, _, konst, isFixed)) = tbinfo let enclosingDeclaredTypars = [] - let (ExplicitTyparInfo(_,declaredTypars,canInferTypars)) = flex + let (ExplicitTyparInfo(_, declaredTypars, canInferTypars)) = flex let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars - let generalizedTypars,prelimValSchemes2 = + let generalizedTypars, prelimValSchemes2 = let canInferTypars = GeneralizationHelpers. ComputeCanInferExtraGeneralizableTypars (containerInfo.ParentRef, canInferTypars, None) let maxInferredTypars = freeInTypeLeftToRight cenv.g false tauTy @@ -10676,76 +10676,76 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope [] else let freeInEnv = lazyFreeInEnv.Force() - GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv, m, freeInEnv, canInferTypars, GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind), inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars,tauTy,false) + GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv, denv, m, freeInEnv, canInferTypars, GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl(declKind), inlineFlag, Some rhsExpr, allDeclaredTypars, maxInferredTypars, tauTy, false) let prelimValSchemes2 = GeneralizeVals cenv denv enclosingDeclaredTypars generalizedTypars nameToPrelimValSchemeMap - generalizedTypars,prelimValSchemes2 + generalizedTypars, prelimValSchemes2 // REVIEW: this scopes generalized type variables. Ensure this is handled properly // on all other paths. let tpenv = HideUnscopedTypars generalizedTypars tpenv let valSchemes = NameMap.map (UseCombinedArity cenv.g declKind rhsExpr) prelimValSchemes2 - let values = MakeAndPublishVals cenv env (altActualParent,false,declKind,ValNotInRecScope,valSchemes,attrs,doc,konst) + let values = MakeAndPublishVals cenv env (altActualParent, false, declKind, ValNotInRecScope, valSchemes, attrs, doc, konst) let pat' = tcPatPhase2 (TcPatPhase2Input (values, true)) let prelimRecValues = NameMap.map fst values // Now bind the r.h.s. to the l.h.s. - let rhsExpr = mkTypeLambda m generalizedTypars (rhsExpr,tauTy) + let rhsExpr = mkTypeLambda m generalizedTypars (rhsExpr, tauTy) match pat' with // Don't introduce temporary or 'let' for 'match against wild' or 'match against unit' - | (TPat_wild _ | TPat_const (Const.Unit,_)) when not isUse && not isFixed && isNil generalizedTypars -> - let mk_seq_bind (tm,tmty) = (mkSequential SequencePointsAtSeq m rhsExpr tm, tmty) - (mk_seq_bind << mkf_sofar,env,tpenv) + | (TPat_wild _ | TPat_const (Const.Unit, _)) when not isUse && not isFixed && isNil generalizedTypars -> + let mk_seq_bind (tm, tmty) = (mkSequential SequencePointsAtSeq m rhsExpr tm, tmty) + (mk_seq_bind << mkf_sofar, env, tpenv) | _ -> // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to - let tmp,pat'' = + let tmp, pat'' = match pat' with // nice: don't introduce awful temporary for r.h.s. in the 99% case where we know what we're binding it to - | TPat_as (pat1,PBind(v,TypeScheme(generalizedTypars',_)),_) + | TPat_as (pat1, PBind(v, TypeScheme(generalizedTypars', _)), _) when List.lengthsEqAndForall2 typarRefEq generalizedTypars generalizedTypars' -> v, pat1 - | _ when inlineFlag.MustInline -> error(Error(FSComp.SR.tcInvalidInlineSpecification(),m)) + | _ when inlineFlag.MustInline -> error(Error(FSComp.SR.tcInvalidInlineSpecification(), m)) | _ -> - let tmp,_ = mkCompGenLocal m "patternInput" (generalizedTypars +-> tauTy) + let tmp, _ = mkCompGenLocal m "patternInput" (generalizedTypars +-> tauTy) if isUse || isFixed then - errorR(Error(FSComp.SR.tcInvalidUseBinding(),m)) + errorR(Error(FSComp.SR.tcInvalidUseBinding(), m)) // This assignment forces representation as module value, to maintain the invariant from the // type checker that anything related to binding module-level values is marked with an // val_repr_info, val_actual_parent and is_topbind if (DeclKind.MustHaveArity declKind) then AdjustValToTopVal tmp altActualParent (InferArityOfExprBinding cenv.g AllowTypeDirectedDetupling.Yes tmp rhsExpr) - tmp,pat' + tmp, pat' - let mkRhsBind (bodyExpr,bodyExprTy) = + let mkRhsBind (bodyExpr, bodyExprTy) = let letExpr = mkLet spBind m tmp rhsExpr bodyExpr - letExpr,bodyExprTy + letExpr, bodyExprTy let allValsDefinedByPattern = NameMap.range prelimRecValues - let mkPatBind (bodyExpr,bodyExprTy) = + let mkPatBind (bodyExpr, bodyExprTy) = let valsDefinedByMatching = ListSet.remove valEq tmp allValsDefinedByPattern - let matchx = CompilePatternForMatch cenv env m m true ThrowIncompleteMatchException (tmp,generalizedTypars) [TClause(pat'',None,TTarget(valsDefinedByMatching,bodyExpr,SuppressSequencePointAtTarget),m)] tauTy bodyExprTy + let matchx = CompilePatternForMatch cenv env m m true ThrowIncompleteMatchException (tmp, generalizedTypars) [TClause(pat'', None, TTarget(valsDefinedByMatching, bodyExpr, SuppressSequencePointAtTarget), m)] tauTy bodyExprTy let matchx = if (DeclKind.ConvertToLinearBindings declKind) then LinearizeTopMatch cenv.g altActualParent matchx else matchx - matchx,bodyExprTy + matchx, bodyExprTy - let mkCleanup (bodyExpr,bodyExprTy) = + let mkCleanup (bodyExpr, bodyExprTy) = if isUse && not isFixed then - (allValsDefinedByPattern,(bodyExpr,bodyExprTy)) ||> List.foldBack (fun v (bodyExpr,bodyExprTy) -> + (allValsDefinedByPattern, (bodyExpr, bodyExprTy)) ||> List.foldBack (fun v (bodyExpr, bodyExprTy) -> AddCxTypeMustSubsumeType ContextInfo.NoContext denv cenv.css v.Range NoTrace cenv.g.system_IDisposable_typ v.Type let cleanupE = BuildDisposableCleanup cenv env m v - mkTryFinally cenv.g (bodyExpr,cleanupE,m,bodyExprTy,SequencePointInBodyOfTry,NoSequencePointAtFinally),bodyExprTy) + mkTryFinally cenv.g (bodyExpr, cleanupE, m, bodyExprTy, SequencePointInBodyOfTry, NoSequencePointAtFinally), bodyExprTy) else - (bodyExpr,bodyExprTy) + (bodyExpr, bodyExprTy) - ((mkf_sofar >> mkCleanup >> mkPatBind >> mkRhsBind), - AddLocalValMap cenv.tcSink scopem prelimRecValues env, + ((mkf_sofar >> mkCleanup >> mkPatBind >> mkRhsBind), + AddLocalValMap cenv.tcSink scopem prelimRecValues env, tpenv)) /// Return binds corresponding to the linearised let-bindings. @@ -10756,28 +10756,28 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (binds,bindsm,scope /// So letbindings could contain a fork at a match construct, with one branch being the match failure. /// If bindings are linearised, then this fork is pushed to the RHS. /// In this case, the let bindings type check to a sequence of bindings. -and TcLetBindings cenv env containerInfo declKind tpenv (binds,bindsm,scopem) = +and TcLetBindings cenv env containerInfo declKind tpenv (binds, bindsm, scopem) = assert(DeclKind.ConvertToLinearBindings declKind) - let mkf,env,tpenv = TcLetBinding cenv false env containerInfo declKind tpenv (binds,bindsm,scopem) + let mkf, env, tpenv = TcLetBinding cenv false env containerInfo declKind tpenv (binds, bindsm, scopem) let unite = mkUnit cenv.g bindsm - let expr,_ = mkf (unite,cenv.g.unit_ty) + let expr, _ = mkf (unite, cenv.g.unit_ty) let rec stripLets acc = function - | Expr.Let (bind,body,m,_) -> stripLets (TMDefLet(bind,m) :: acc) body - | Expr.Sequential (e1,e2,NormalSeq,_,m) -> stripLets (TMDefDo(e1,m) :: acc) e2 - | Expr.Const (Const.Unit,_,_) -> List.rev acc + | Expr.Let (bind, body, m, _) -> stripLets (TMDefLet(bind, m) :: acc) body + | Expr.Sequential (e1, e2, NormalSeq, _, m) -> stripLets (TMDefDo(e1, m) :: acc) e2 + | Expr.Const (Const.Unit, _, _) -> List.rev acc | _ -> failwith "TcLetBindings: let sequence is non linear. Maybe a LHS pattern was not linearised?" let binds = stripLets [] expr - binds,env,tpenv + binds, env, tpenv and CheckMemberFlags optIntfSlotTy newslotsOK overridesOK memberFlags m = if newslotsOK = NoNewSlots && memberFlags.IsDispatchSlot then - errorR(Error(FSComp.SR.tcAbstractMembersIllegalInAugmentation(),m)) + errorR(Error(FSComp.SR.tcAbstractMembersIllegalInAugmentation(), m)) if overridesOK = ErrorOnOverrides && memberFlags.MemberKind = MemberKind.Constructor then - errorR(Error(FSComp.SR.tcConstructorsIllegalInAugmentation(),m)) + errorR(Error(FSComp.SR.tcConstructorsIllegalInAugmentation(), m)) if overridesOK = WarnOnOverrides && memberFlags.IsOverrideOrExplicitImpl && Option.isNone optIntfSlotTy then warning(OverrideInIntrinsicAugmentation(m)) if overridesOK = ErrorOnOverrides && memberFlags.IsOverrideOrExplicitImpl then - error(Error(FSComp.SR.tcMethodOverridesIllegalHere(),m)) + error(Error(FSComp.SR.tcMethodOverridesIllegalHere(), m)) /// Apply the pre-assumed knowledge available to type inference prior to looking at /// the _body_ of the binding. For example, in a letrec we may assume this knowledge @@ -10789,7 +10789,7 @@ and ApplyTypesFromArgumentPatterns (cenv, env, optArgsOK, ty, m, tpenv, Normaliz match retInfoOpt with | None -> () | Some (SynBindingReturnInfo (retInfoTy, m, _)) -> - let retInfoTy,_ = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv retInfoTy + let retInfoTy, _ = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv retInfoTy UnifyTypes cenv env m ty retInfoTy // Property setters always have "unit" return type match memberFlagsOpt with @@ -10798,10 +10798,10 @@ and ApplyTypesFromArgumentPatterns (cenv, env, optArgsOK, ty, m, tpenv, Normaliz | _ -> () | pushedPat :: morePushedPats -> - let domainTy,resultTy = UnifyFunctionType None cenv env.DisplayEnv m ty + let domainTy, resultTy = UnifyFunctionType None cenv env.DisplayEnv m ty // We apply the type information from the patterns by type checking the // "simple" patterns against 'domainTy'. They get re-typechecked later. - ignore (TcSimplePats cenv optArgsOK CheckCxs domainTy env (tpenv,Map.empty,Set.empty) pushedPat) + ignore (TcSimplePats cenv optArgsOK CheckCxs domainTy env (tpenv, Map.empty, Set.empty) pushedPat) ApplyTypesFromArgumentPatterns (cenv, env, optArgsOK, resultTy, m, tpenv, NormalizedBindingRhs (morePushedPats, retInfoOpt, e), memberFlagsOpt) @@ -10815,7 +10815,7 @@ and ComputeIsComplete enclosingDeclaredTypars declaredTypars ty = /// Determine if a uniquely-identified-abstract-slot exists for an override member (or interface member implementation) based on the information available /// at the syntactic definition of the member (i.e. prior to type inference). If so, we know the expected signature of the override, and the full slotsig /// it implements. Apply the inferred slotsig. -and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTyparDecls,declaredTypars,memberId,tcrefObjTy,renaming,_objTy,optIntfSlotTy,valSynData,memberFlags,attribs) = +and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy, m, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, _objTy, optIntfSlotTy, valSynData, memberFlags, attribs) = let ad = envinner.eAccessRights let typToSearchForAbstractMembers = @@ -10823,9 +10823,9 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa | Some (ty, abstractSlots) -> // The interface type is in terms of the type's type parameters. // We need a signature in terms of the values' type parameters. - ty,Some(abstractSlots) + ty, Some(abstractSlots) | None -> - tcrefObjTy,None + tcrefObjTy, None // Determine if a uniquely-identified-override exists based on the information // at the member signature. If so, we know the type of this member, and the full slotsig @@ -10836,13 +10836,13 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa let makeUniqueBySig meths = meths |> ListSet.setify (MethInfosEquivByNameAndSig EraseNone false cenv.g cenv.amap m) match memberFlags.MemberKind with | MemberKind.Member -> - let dispatchSlots,dispatchSlotsArityMatch = - GetAbstractMethInfosForSynMethodDecl(cenv.infoReader,ad,memberId,m,typToSearchForAbstractMembers,valSynData) + let dispatchSlots, dispatchSlotsArityMatch = + GetAbstractMethInfosForSynMethodDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, valSynData) let uniqueAbstractMethSigs = match dispatchSlots with | [] -> - errorR(Error(FSComp.SR.tcNoMemberFoundForOverride(),memberId.idRange)) + errorR(Error(FSComp.SR.tcNoMemberFoundForOverride(), memberId.idRange)) [] | slots -> @@ -10855,7 +10855,7 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa |> Seq.map (sprintf "%s %s" System.Environment.NewLine) |> String.concat "" - errorR(Error(FSComp.SR.tcOverrideArityMismatch(details),memberId.idRange)) + errorR(Error(FSComp.SR.tcOverrideArityMismatch(details), memberId.idRange)) [] | _ -> [] // check that method to override is sealed is located at CheckOverridesAreAllUsedOnce (typrelns.fs) // We hit this case when it is ambiguous which abstract method is being implemented. @@ -10869,7 +10869,7 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa let uniqueAbstractMeth = uniqueAbstractMeth.Instantiate(cenv.amap, m, renaming) - let typarsFromAbsSlotAreRigid,typarsFromAbsSlot,argTysFromAbsSlot, retTyFromAbsSlot = + let typarsFromAbsSlotAreRigid, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot = FreshenAbstractSlot cenv.g cenv.amap m synTyparDecls uniqueAbstractMeth let declaredTypars = (if typarsFromAbsSlotAreRigid then typarsFromAbsSlot else declaredTypars) @@ -10880,21 +10880,21 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa declaredTypars | _ -> declaredTypars - // Retained to ensure use of an FSComp.txt entry, can be removed at a later date: errorR(Error(FSComp.SR.tcDefaultAmbiguous(),memberId.idRange)) + // Retained to ensure use of an FSComp.txt entry, can be removed at a later date: errorR(Error(FSComp.SR.tcDefaultAmbiguous(), memberId.idRange)) // What's the type containing the abstract slot we're implementing? Used later on in MakeMemberDataAndMangledNameForMemberVal. // This type must be in terms of the enclosing type's formal type parameters, hence the application of revRenaming let optInferredImplSlotTys = match optIntfSlotTy with - | Some (x,_) -> [x] + | Some (x, _) -> [x] | None -> uniqueAbstractMethSigs |> List.map (fun x -> x.EnclosingType) - optInferredImplSlotTys,declaredTypars + optInferredImplSlotTys, declaredTypars | MemberKind.PropertyGet | MemberKind.PropertySet as k -> - let dispatchSlots = GetAbstractPropInfosForSynPropertyDecl(cenv.infoReader,ad,memberId,m,typToSearchForAbstractMembers,k,valSynData) + let dispatchSlots = GetAbstractPropInfosForSynPropertyDecl(cenv.infoReader, ad, memberId, m, typToSearchForAbstractMembers, k, valSynData) // Only consider those abstract slots where the get/set flags match the value we're defining let dispatchSlots = @@ -10907,7 +10907,7 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa let uniqueAbstractPropSigs = match dispatchSlots with | [] when not (CompileAsEvent cenv.g attribs) -> - errorR(Error(FSComp.SR.tcNoPropertyFoundForOverride(),memberId.idRange)) + errorR(Error(FSComp.SR.tcNoPropertyFoundForOverride(), memberId.idRange)) [] | [uniqueAbstractProp] -> [uniqueAbstractProp] | _ -> @@ -10920,17 +10920,17 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa let kIsGet = (k = MemberKind.PropertyGet) if not (if kIsGet then uniqueAbstractProp.HasGetter else uniqueAbstractProp.HasSetter) then - error(Error(FSComp.SR.tcAbstractPropertyMissingGetOrSet(if kIsGet then "getter" else "setter"),memberId.idRange)) + error(Error(FSComp.SR.tcAbstractPropertyMissingGetOrSet(if kIsGet then "getter" else "setter"), memberId.idRange)) let uniqueAbstractMeth = if kIsGet then uniqueAbstractProp.GetterMethod else uniqueAbstractProp.SetterMethod let uniqueAbstractMeth = uniqueAbstractMeth.Instantiate(cenv.amap, m, renaming) - let _,typarsFromAbsSlot,argTysFromAbsSlot, retTyFromAbsSlot = + let _, typarsFromAbsSlot, argTysFromAbsSlot, retTyFromAbsSlot = FreshenAbstractSlot cenv.g cenv.amap m synTyparDecls uniqueAbstractMeth if not (isNil typarsFromAbsSlot) then - errorR(InternalError("Unexpected generic property",memberId.idRange)) + errorR(InternalError("Unexpected generic property", memberId.idRange)) let absSlotTy = if (memberFlags.MemberKind = MemberKind.PropertyGet) @@ -10939,7 +10939,7 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa match argTysFromAbsSlot with | [argTysFromAbsSlot] -> mkRefTupledTy cenv.g argTysFromAbsSlot --> cenv.g.unit_ty | _ -> - error(Error(FSComp.SR.tcInvalidSignatureForSet(),memberId.idRange)) + error(Error(FSComp.SR.tcInvalidSignatureForSet(), memberId.idRange)) retTyFromAbsSlot --> cenv.g.unit_ty UnifyTypes cenv envinner m bindingTy absSlotTy) @@ -10949,14 +10949,14 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa let optInferredImplSlotTys = match optIntfSlotTy with - | Some (x,_) -> [ x ] + | Some (x, _) -> [ x ] | None -> uniqueAbstractPropSigs |> List.map (fun pinfo -> pinfo.EnclosingType) - optInferredImplSlotTys,declaredTypars + optInferredImplSlotTys, declaredTypars | _ -> match optIntfSlotTy with - | Some (x,_) -> [x], declaredTypars + | Some (x, _) -> [x], declaredTypars | None -> [], declaredTypars else @@ -10966,13 +10966,13 @@ and ApplyAbstractSlotInference (cenv:cenv) (envinner:TcEnv) (bindingTy,m,synTypa and CheckForNonAbstractInterface declKind tcref memberFlags m = if isInterfaceTyconRef tcref then if memberFlags.MemberKind = MemberKind.ClassConstructor then - error(Error(FSComp.SR.tcStaticInitializersIllegalInInterface(),m)) + error(Error(FSComp.SR.tcStaticInitializersIllegalInInterface(), m)) elif memberFlags.MemberKind = MemberKind.Constructor then - error(Error(FSComp.SR.tcObjectConstructorsIllegalInInterface(),m)) + error(Error(FSComp.SR.tcObjectConstructorsIllegalInInterface(), m)) elif memberFlags.IsOverrideOrExplicitImpl then - error(Error(FSComp.SR.tcMemberOverridesIllegalInInterface(),m)) + error(Error(FSComp.SR.tcMemberOverridesIllegalInInterface(), m)) elif not (declKind=ExtrinsicExtensionBinding || memberFlags.IsDispatchSlot ) then - error(Error(FSComp.SR.tcConcreteMembersIllegalInInterface(),m)) + error(Error(FSComp.SR.tcConcreteMembersIllegalInInterface(), m)) //------------------------------------------------------------------------- // TcLetrec - AnalyzeAndMakeAndPublishRecursiveValue(s) @@ -10985,17 +10985,17 @@ and AnalyzeRecursiveStaticMemberOrValDecl (cenv, envinner: TcEnv, tpenv, declKin // name for the member and the information about which type it is agumenting match tcrefContainerInfo, memberFlagsOpt with - | (Some(MemberOrValContainerInfo(tcref, optIntfSlotTy, baseValOpt, _safeInitInfo, declaredTyconTypars)),Some memberFlags) -> + | (Some(MemberOrValContainerInfo(tcref, optIntfSlotTy, baseValOpt, _safeInitInfo, declaredTyconTypars)), Some memberFlags) -> assert (Option.isNone optIntfSlotTy) CheckMemberFlags None newslotsOK overridesOK memberFlags id.idRange CheckForNonAbstractInterface declKind tcref memberFlags id.idRange if memberFlags.MemberKind = MemberKind.Constructor && tcref.Deref.IsExceptionDecl then - error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(),id.idRange)) + error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange)) let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let _,enclosingDeclaredTypars,_,objTy,thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let _, enclosingDeclaredTypars, _, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner let envinner = MakeInnerEnvForTyconRef cenv envinner tcref isExtrinsic @@ -11005,11 +11005,11 @@ and AnalyzeRecursiveStaticMemberOrValDecl (cenv, envinner: TcEnv, tpenv, declKin // Explicit struct or class constructor | MemberKind.Constructor -> // A fairly adhoc place to put this check - if tcref.IsStructOrEnumTycon && (match valSynInfo with SynValInfo([[]],_) -> true | _ -> false) then - errorR(Error(FSComp.SR.tcStructsCannotHaveConstructorWithNoArguments(),mBinding)) + if tcref.IsStructOrEnumTycon && (match valSynInfo with SynValInfo([[]], _) -> true | _ -> false) then + errorR(Error(FSComp.SR.tcStructsCannotHaveConstructorWithNoArguments(), mBinding)) if not tcref.IsFSharpObjectModelTycon then - errorR(Error(FSComp.SR.tcConstructorsIllegalForThisType(),id.idRange)) + errorR(Error(FSComp.SR.tcConstructorsIllegalForThisType(), id.idRange)) let safeThisValOpt = MakeAndPublishSafeThisVal cenv envinner thisIdOpt thisTy @@ -11030,37 +11030,37 @@ and AnalyzeRecursiveStaticMemberOrValDecl (cenv, envinner: TcEnv, tpenv, declKin safeThisValOpt, baseValOpt | _ -> - None,None + None, None let memberInfo = let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - MakeMemberDataAndMangledNameForMemberVal(cenv.g,tcref,isExtrinsic,bindingAttribs,[],memberFlags,valSynInfo,id,false) + MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, isExtrinsic, bindingAttribs, [], memberFlags, valSynInfo, id, false) - envinner,tpenv,id,None,Some(memberInfo),vis,vis2,safeThisValOpt,enclosingDeclaredTypars,baseValOpt,flex,bindingRhs,declaredTypars + envinner, tpenv, id, None, Some(memberInfo), vis, vis2, safeThisValOpt, enclosingDeclaredTypars, baseValOpt, flex, bindingRhs, declaredTypars // non-member bindings. How easy. | _ -> - envinner,tpenv,id,None,None,vis,vis2,None,[],None,flex,bindingRhs,declaredTypars + envinner, tpenv, id, None, None, vis, vis2, None, [], None, flex, bindingRhs, declaredTypars -and AnalyzeRecursiveInstanceMemberDecl (cenv,envinner: TcEnv, tpenv, declKind, synTyparDecls, valSynInfo, flex:ExplicitTyparInfo, newslotsOK, overridesOK, vis1, thisId, memberId:Ident, toolId:Ident option, bindingAttribs, vis2, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) = +and AnalyzeRecursiveInstanceMemberDecl (cenv, envinner: TcEnv, tpenv, declKind, synTyparDecls, valSynInfo, flex:ExplicitTyparInfo, newslotsOK, overridesOK, vis1, thisId, memberId:Ident, toolId:Ident option, bindingAttribs, vis2, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) = let vis = CombineVisibilityAttribs vis1 vis2 mBinding - let (ExplicitTyparInfo(_,declaredTypars,infer)) = flex - match tcrefContainerInfo,memberFlagsOpt with + let (ExplicitTyparInfo(_, declaredTypars, infer)) = flex + match tcrefContainerInfo, memberFlagsOpt with // Normal instance members. | Some(MemberOrValContainerInfo(tcref, optIntfSlotTy, baseValOpt, _safeInitInfo, declaredTyconTypars)), Some memberFlags -> CheckMemberFlags optIntfSlotTy newslotsOK overridesOK memberFlags mBinding if Option.isSome vis && memberFlags.IsOverrideOrExplicitImpl then - errorR(Error(FSComp.SR.tcOverridesCannotHaveVisibilityDeclarations(),memberId.idRange)) + errorR(Error(FSComp.SR.tcOverridesCannotHaveVisibilityDeclarations(), memberId.idRange)) // Syntactically push the "this" variable across to be a lambda on the right let bindingRhs = PushOnePatternToRhs cenv true (mkSynThisPatVar thisId) bindingRhs // The type being augmented tells us the type of 'this' let isExtrinsic = (declKind = ExtrinsicExtensionBinding) - let tcrefObjTy,enclosingDeclaredTypars,renaming,objTy,thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let tcrefObjTy, enclosingDeclaredTypars, renaming, objTy, thisTy = FreshenObjectArgType cenv mBinding TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars let envinner = AddDeclaredTypars CheckForDuplicateTypars enclosingDeclaredTypars envinner @@ -11079,10 +11079,10 @@ and AnalyzeRecursiveInstanceMemberDecl (cenv,envinner: TcEnv, tpenv, declKind, s // at the member signature. If so, we know the type of this member, and the full slotsig // it implements. Apply the inferred slotsig. let optInferredImplSlotTys, declaredTypars = - ApplyAbstractSlotInference cenv envinner (bindingTy,mBinding,synTyparDecls,declaredTypars,memberId,tcrefObjTy,renaming,objTy,optIntfSlotTy,valSynInfo,memberFlags,bindingAttribs) + ApplyAbstractSlotInference cenv envinner (bindingTy, mBinding, synTyparDecls, declaredTypars, memberId, tcrefObjTy, renaming, objTy, optIntfSlotTy, valSynInfo, memberFlags, bindingAttribs) // Update the ExplicitTyparInfo to reflect the declaredTypars inferred from the abstract slot - let flex = ExplicitTyparInfo(declaredTypars,declaredTypars,infer) + let flex = ExplicitTyparInfo(declaredTypars, declaredTypars, infer) // baseValOpt is the 'base' variable associated with the inherited portion of a class // It is declared once on the 'inheritedTys clause, but a fresh binding is made for @@ -11092,7 +11092,7 @@ and AnalyzeRecursiveInstanceMemberDecl (cenv,envinner: TcEnv, tpenv, declKind, s | Some(superTy) -> MakeAndPublishBaseVal cenv envinner (match baseValOpt with None -> None | Some v -> Some v.Id) superTy | None -> None - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g,tcref,isExtrinsic,bindingAttribs,optInferredImplSlotTys,memberFlags,valSynInfo,memberId,false) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, isExtrinsic, bindingAttribs, optInferredImplSlotTys, memberFlags, valSynInfo, memberId, false) // This line factored in the 'get' or 'set' as the identifier for a property declaration using "with get () = ... and set v = ..." // It has been removed from FSharp.Compiler.Service because we want the property name to be the location of // the definition of these symbols. @@ -11103,18 +11103,18 @@ and AnalyzeRecursiveInstanceMemberDecl (cenv,envinner: TcEnv, tpenv, declKind, s envinner, tpenv, memberId, toolId, Some memberInfo, vis, vis2, None, enclosingDeclaredTypars, baseValOpt, flex, bindingRhs, declaredTypars | _ -> - error(Error(FSComp.SR.tcRecursiveBindingsWithMembersMustBeDirectAugmentation(),mBinding)) + error(Error(FSComp.SR.tcRecursiveBindingsWithMembersMustBeDirectAugmentation(), mBinding)) -and AnalyzeRecursiveDecl (cenv,envinner,tpenv,declKind,synTyparDecls,declaredTypars,thisIdOpt,valSynInfo,flex,newslotsOK,overridesOK,vis1,declPattern,bindingAttribs,tcrefContainerInfo,memberFlagsOpt,ty,bindingRhs,mBinding) = +and AnalyzeRecursiveDecl (cenv, envinner, tpenv, declKind, synTyparDecls, declaredTypars, thisIdOpt, valSynInfo, flex, newslotsOK, overridesOK, vis1, declPattern, bindingAttribs, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) = let rec analyzeRecursiveDeclPat tpenv p = match p with - | SynPat.FromParseError(pat',_) -> analyzeRecursiveDeclPat tpenv pat' - | SynPat.Typed(pat',cty,_) -> - let cty',tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType envinner tpenv cty + | SynPat.FromParseError(pat', _) -> analyzeRecursiveDeclPat tpenv pat' + | SynPat.Typed(pat', cty, _) -> + let cty', tpenv = TcTypeAndRecover cenv NewTyparsOK CheckCxs ItemOccurence.UseInType envinner tpenv cty UnifyTypes cenv envinner mBinding ty cty' analyzeRecursiveDeclPat tpenv pat' - | SynPat.Attrib(_pat',_attribs,m) -> - error(Error(FSComp.SR.tcAttributesInvalidInPatterns(),m)) + | SynPat.Attrib(_pat', _attribs, m) -> + error(Error(FSComp.SR.tcAttributesInvalidInPatterns(), m)) //analyzeRecursiveDeclPat pat' // This is for the construct 'let rec x = ... and do ... and y = ...' (DEPRECATED IN pars.mly ) @@ -11124,16 +11124,16 @@ and AnalyzeRecursiveDecl (cenv,envinner,tpenv,declKind,synTyparDecls,declaredTyp // printfn "hello" // side effects in recursive modules // let x = 1 | SynPat.Const (SynConst.Unit, m) | SynPat.Wild m -> - let id = ident (cenv.niceNameGen.FreshCompilerGeneratedName("doval",m),m) + let id = ident (cenv.niceNameGen.FreshCompilerGeneratedName("doval", m), m) analyzeRecursiveDeclPat tpenv (SynPat.Named (SynPat.Wild m, id, false, None, m)) - | SynPat.Named (SynPat.Wild _, id,_,vis2,_) -> - AnalyzeRecursiveStaticMemberOrValDecl (cenv,envinner,tpenv,declKind,newslotsOK,overridesOK,tcrefContainerInfo,vis1,id,vis2,declaredTypars,memberFlagsOpt,thisIdOpt,bindingAttribs,valSynInfo,ty,bindingRhs,mBinding,flex) + | SynPat.Named (SynPat.Wild _, id, _, vis2, _) -> + AnalyzeRecursiveStaticMemberOrValDecl (cenv, envinner, tpenv, declKind, newslotsOK, overridesOK, tcrefContainerInfo, vis1, id, vis2, declaredTypars, memberFlagsOpt, thisIdOpt, bindingAttribs, valSynInfo, ty, bindingRhs, mBinding, flex) - | SynPat.InstanceMember(thisId,memberId,toolId,vis2,_) -> - AnalyzeRecursiveInstanceMemberDecl (cenv,envinner,tpenv,declKind,synTyparDecls,valSynInfo,flex,newslotsOK,overridesOK,vis1,thisId,memberId,toolId,bindingAttribs,vis2,tcrefContainerInfo,memberFlagsOpt,ty,bindingRhs,mBinding) + | SynPat.InstanceMember(thisId, memberId, toolId, vis2, _) -> + AnalyzeRecursiveInstanceMemberDecl (cenv, envinner, tpenv, declKind, synTyparDecls, valSynInfo, flex, newslotsOK, overridesOK, vis1, thisId, memberId, toolId, bindingAttribs, vis2, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) - | _ -> error(Error(FSComp.SR.tcOnlySimplePatternsInLetRec(),mBinding)) + | _ -> error(Error(FSComp.SR.tcOnlySimplePatternsInLetRec(), mBinding)) analyzeRecursiveDeclPat tpenv declPattern @@ -11144,13 +11144,13 @@ and AnalyzeRecursiveDecl (cenv,envinner,tpenv,declKind,synTyparDecls,declaredTyp /// and overrides). At this point we perform override inference, to infer /// which method we are overriding, in order to add constraints to the /// implementation of the method. -and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv (env:TcEnv) (tpenv,recBindIdx) (NormalizedRecBindingDefn(containerInfo,newslotsOK,declKind,binding)) = +and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv (env:TcEnv) (tpenv, recBindIdx) (NormalizedRecBindingDefn(containerInfo, newslotsOK, declKind, binding)) = // Pull apart the inputs - let (NormalizedBinding(vis1,bindingKind,isInline,isMutable,bindingSynAttribs,bindingXmlDoc,synTyparDecls,valSynData,declPattern,bindingRhs,mBinding,spBind)) = binding - let (NormalizedBindingRhs(_,_,bindingExpr)) = bindingRhs - let (SynValData(memberFlagsOpt,valSynInfo,thisIdOpt)) = valSynData - let (ContainerInfo(altActualParent,tcrefContainerInfo)) = containerInfo + let (NormalizedBinding(vis1, bindingKind, isInline, isMutable, bindingSynAttribs, bindingXmlDoc, synTyparDecls, valSynData, declPattern, bindingRhs, mBinding, spBind)) = binding + let (NormalizedBindingRhs(_, _, bindingExpr)) = bindingRhs + let (SynValData(memberFlagsOpt, valSynInfo, thisIdOpt)) = valSynData + let (ContainerInfo(altActualParent, tcrefContainerInfo)) = containerInfo let attrTgt = DeclKind.AllowedAttribTargets memberFlagsOpt declKind @@ -11162,25 +11162,25 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv let inlineFlag = ComputeInlineFlag memberFlagsOpt isInline isMutable mBinding - if isMutable then errorR(Error(FSComp.SR.tcOnlyRecordFieldsAndSimpleLetCanBeMutable(),mBinding)) + if isMutable then errorR(Error(FSComp.SR.tcOnlyRecordFieldsAndSimpleLetCanBeMutable(), mBinding)) // Typecheck the typar decls, if any let flex, tpenv = TcBindingTyparDecls false cenv env tpenv synTyparDecls - let (ExplicitTyparInfo(_,declaredTypars,_)) = flex + let (ExplicitTyparInfo(_, declaredTypars, _)) = flex let envinner = AddDeclaredTypars CheckForDuplicateTypars declaredTypars env // OK, analyze the declaration and return lots of information about it - let envinner,tpenv,bindingId,toolIdOpt,memberInfoOpt,vis,vis2,safeThisValOpt,enclosingDeclaredTypars,baseValOpt,flex,bindingRhs,declaredTypars = + let envinner, tpenv, bindingId, toolIdOpt, memberInfoOpt, vis, vis2, safeThisValOpt, enclosingDeclaredTypars, baseValOpt, flex, bindingRhs, declaredTypars = - AnalyzeRecursiveDecl (cenv, envinner, tpenv, declKind, synTyparDecls, declaredTypars, thisIdOpt, valSynInfo, flex, - newslotsOK, overridesOK, vis1, declPattern, bindingAttribs, tcrefContainerInfo, + AnalyzeRecursiveDecl (cenv, envinner, tpenv, declKind, synTyparDecls, declaredTypars, thisIdOpt, valSynInfo, flex, + newslotsOK, overridesOK, vis1, declPattern, bindingAttribs, tcrefContainerInfo, memberFlagsOpt, ty, bindingRhs, mBinding) let optArgsOK = Option.isSome memberFlagsOpt // Assert the types given in the argument patterns - ApplyTypesFromArgumentPatterns(cenv,envinner,optArgsOK,ty,mBinding,tpenv,bindingRhs,memberFlagsOpt) + ApplyTypesFromArgumentPatterns(cenv, envinner, optArgsOK, ty, mBinding, tpenv, bindingRhs, memberFlagsOpt) // Do the type annotations give the full and complete generic type? // If so, generic recursion can be used when using this type. @@ -11188,37 +11188,37 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv // NOTE: The type scheme here is normally not 'complete'!!!! The type is more or less just a type variable at this point. // NOTE: toparity, type and typars get fixed-up after inference - let prelimTyscheme = TypeScheme(enclosingDeclaredTypars@declaredTypars,ty) + let prelimTyscheme = TypeScheme(enclosingDeclaredTypars@declaredTypars, ty) let partialValReprInfo = TranslateTopValSynInfo mBinding (TcAttributes cenv envinner) valSynInfo let topValInfo = UseSyntacticArity declKind prelimTyscheme partialValReprInfo let hasDeclaredTypars = declaredTypars.Length > 0 - let prelimValScheme = ValScheme(bindingId,prelimTyscheme,topValInfo,memberInfoOpt,false,inlineFlag,NormalVal,vis,false,false,false,hasDeclaredTypars) + let prelimValScheme = ValScheme(bindingId, prelimTyscheme, topValInfo, memberInfoOpt, false, inlineFlag, NormalVal, vis, false, false, false, hasDeclaredTypars) // Check the literal r.h.s., if any - let _, konst = TcLiteral cenv ty env tpenv (bindingAttribs,bindingExpr) + let _, konst = TcLiteral cenv ty env tpenv (bindingAttribs, bindingExpr) - let extraBindings,extraValues,tpenv,recBindIdx = + let extraBindings, extraValues, tpenv, recBindIdx = let extraBindings = - [ for extraBinding in EventDeclarationNormalization.GenerateExtraBindings cenv (bindingAttribs,binding) do - yield (NormalizedRecBindingDefn(containerInfo,newslotsOK,declKind,extraBinding)) ] - let res,(tpenv,recBindIdx) = List.mapFold (AnalyzeAndMakeAndPublishRecursiveValue overridesOK true cenv env) (tpenv,recBindIdx) extraBindings + [ for extraBinding in EventDeclarationNormalization.GenerateExtraBindings cenv (bindingAttribs, binding) do + yield (NormalizedRecBindingDefn(containerInfo, newslotsOK, declKind, extraBinding)) ] + let res, (tpenv, recBindIdx) = List.mapFold (AnalyzeAndMakeAndPublishRecursiveValue overridesOK true cenv env) (tpenv, recBindIdx) extraBindings let extraBindings, extraValues = List.unzip res - List.concat extraBindings, List.concat extraValues, tpenv,recBindIdx + List.concat extraBindings, List.concat extraValues, tpenv, recBindIdx // Create the value - let vspec = MakeAndPublishVal cenv envinner (altActualParent,false,declKind,ValInRecScope(isComplete),prelimValScheme,bindingAttribs,bindingXmlDoc,konst,isGeneratedEventVal) + let vspec = MakeAndPublishVal cenv envinner (altActualParent, false, declKind, ValInRecScope(isComplete), prelimValScheme, bindingAttribs, bindingXmlDoc, konst, isGeneratedEventVal) // Suppress hover tip for "get" and "set" at property definitions, where toolId <> bindingId match toolIdOpt with | Some tid when not tid.idRange.IsSynthetic && tid.idRange <> bindingId.idRange -> let item = Item.Value (mkLocalValRef vspec) - CallNameResolutionSink cenv.tcSink (tid.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.RelatedText,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (tid.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.RelatedText, env.DisplayEnv, env.eAccessRights) | _ -> () - let mangledId = ident(vspec.LogicalName,vspec.Range) + let mangledId = ident(vspec.LogicalName, vspec.Range) // Reconstitute the binding with the unique name - let revisedBinding = NormalizedBinding (vis1,bindingKind,isInline,isMutable,bindingSynAttribs,bindingXmlDoc,synTyparDecls,valSynData,mkSynPatVar vis2 mangledId,bindingRhs,mBinding,spBind) + let revisedBinding = NormalizedBinding (vis1, bindingKind, isInline, isMutable, bindingSynAttribs, bindingXmlDoc, synTyparDecls, valSynData, mkSynPatVar vis2 mangledId, bindingRhs, mBinding, spBind) // Create the RBInfo to use in later phases let rbinfo = @@ -11227,7 +11227,7 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv | Some(MemberOrValContainerInfo(_, _, _, safeInitInfo, _)) -> safeInitInfo | _ -> NoSafeInitInfo - RBInfo(recBindIdx,containerInfo,enclosingDeclaredTypars,inlineFlag,vspec,flex,partialValReprInfo,memberInfoOpt,baseValOpt,safeThisValOpt,safeInitInfo,vis,ty,declKind) + RBInfo(recBindIdx, containerInfo, enclosingDeclaredTypars, inlineFlag, vspec, flex, partialValReprInfo, memberInfoOpt, baseValOpt, safeThisValOpt, safeInitInfo, vis, ty, declKind) let recBindIdx = recBindIdx + 1 @@ -11236,12 +11236,12 @@ and AnalyzeAndMakeAndPublishRecursiveValue overridesOK isGeneratedEventVal cenv { SyntacticBinding = revisedBinding RecBindingInfo = rbinfo } - ((primaryBinding::extraBindings),(vspec::extraValues)),(tpenv,recBindIdx) + ((primaryBinding::extraBindings), (vspec::extraValues)), (tpenv, recBindIdx) and AnalyzeAndMakeAndPublishRecursiveValues overridesOK cenv env tpenv binds = let recBindIdx = 0 - let res,tpenv = List.mapFold (AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv env) (tpenv,recBindIdx) binds + let res, tpenv = List.mapFold (AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv env) (tpenv, recBindIdx) binds let bindings, values = List.unzip res List.concat bindings, List.concat values, tpenv @@ -11255,15 +11255,15 @@ and TcLetrecBinding // The state of the left-to-right iteration through the bindings (envNonRec: TcEnv, - generalizedRecBinds : PostGeneralizationRecursiveBinding list, - preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, - tpenv, - uncheckedRecBindsTable : Map) + generalizedRecBinds : PostGeneralizationRecursiveBinding list, + preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, + tpenv, + uncheckedRecBindsTable : Map) // This is the actual binding to check (rbind : PreCheckingRecursiveBinding) = - let (RBInfo(_,_,enclosingDeclaredTypars,_,vspec,flex,_,_,baseValOpt,safeThisValOpt,safeInitInfo,_,tau,declKind)) = rbind.RecBindingInfo + let (RBInfo(_, _, enclosingDeclaredTypars, _, vspec, flex, _, _, baseValOpt, safeThisValOpt, safeInitInfo, _, tau, declKind)) = rbind.RecBindingInfo let allDeclaredTypars = enclosingDeclaredTypars @ rbind.RecBindingInfo.DeclaredTypars @@ -11296,11 +11296,11 @@ and TcLetrecBinding // Members can access protected members of parents of the type, and private members in the type let envRec = MakeInnerEnvForMember cenv envRec vspec - let checkedBind,tpenv = - TcNormalizedBinding declKind cenv envRec tpenv tau safeThisValOpt safeInitInfo (enclosingDeclaredTypars,flex) rbind.SyntacticBinding + let checkedBind, tpenv = + TcNormalizedBinding declKind cenv envRec tpenv tau safeThisValOpt safeInitInfo (enclosingDeclaredTypars, flex) rbind.SyntacticBinding (try UnifyTypes cenv envRec vspec.Range (allDeclaredTypars +-> tau) vspec.Type - with e -> error (Recursion(envRec.DisplayEnv,vspec.Id,tau,vspec.Type,vspec.Range))) + with e -> error (Recursion(envRec.DisplayEnv, vspec.Id, tau, vspec.Type, vspec.Range))) // Inside the incremental class syntax we assert the type of the 'this' variable to be precisely the same type as the // this variable for the implicit class constructor. For static members, we assert the type variables associated @@ -11317,7 +11317,7 @@ and TcLetrecBinding | Some thisVal -> reqdThisValTy, thisVal.Type, thisVal.Range if not (AddCxTypeEqualsTypeUndoIfFailed envRec.DisplayEnv cenv.css rangeForCheck actualThisValTy reqdThisValTy) then - errorR (Error(FSComp.SR.tcNonUniformMemberUse vspec.DisplayName,vspec.Range)) + errorR (Error(FSComp.SR.tcNonUniformMemberUse vspec.DisplayName, vspec.Range)) let preGeneralizationRecBind = { RecBindingInfo = rbind.RecBindingInfo @@ -11338,10 +11338,10 @@ and TcLetrecBinding and TcIncrementalLetRecGeneralization cenv scopem // The state of the left-to-right iteration through the bindings (envNonRec: TcEnv, - generalizedRecBinds : PostGeneralizationRecursiveBinding list, - preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, - tpenv, - uncheckedRecBindsTable : Map) = + generalizedRecBinds : PostGeneralizationRecursiveBinding list, + preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, + tpenv, + uncheckedRecBindsTable : Map) = let denv = envNonRec.DisplayEnv // recompute the free-in-environment in case any type variables have been instantiated @@ -11351,7 +11351,7 @@ and TcIncrementalLetRecGeneralization cenv scopem // Compute which bindings are now eligible for early generalization. // Do this by computing a greatest fixed point by iteratively knocking out bindings that refer // to type variables free in later bindings. Look for ones whose type doesn't involve any of the other types - let newGeneralizedRecBinds,preGeneralizationRecBinds, tpenv = + let newGeneralizedRecBinds, preGeneralizationRecBinds, tpenv = //printfn "\n---------------------\nConsidering early generalization after type checking binding %s" vspec.DisplayName @@ -11383,7 +11383,7 @@ and TcIncrementalLetRecGeneralization cenv scopem else acc)) - let rec loop (preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, + let rec loop (preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, frozenBindings: PreGeneralizationRecursiveBinding list) = let frozenBindingTypes = frozenBindings |> List.map (fun pgrbind -> pgrbind.RecBindingInfo.Val.Type) @@ -11394,7 +11394,7 @@ and TcIncrementalLetRecGeneralization cenv scopem else lazy (accFreeInTypes CollectAllNoCaching frozenBindingTypes (freeInUncheckedRecBinds.Force())) - let preGeneralizationRecBinds,newFrozenBindings = + let preGeneralizationRecBinds, newFrozenBindings = preGeneralizationRecBinds |> List.partition (fun pgrbind -> @@ -11426,7 +11426,7 @@ and TcIncrementalLetRecGeneralization cenv scopem //printfn "(failed generalization test 3 for binding for %s)" pgrbind.RecBindingInfo.Val.DisplayName - // Type variables free in the non-recursive environment do not stop us generalizing the binding, + // Type variables free in the non-recursive environment do not stop us generalizing the binding, // since they can't be generalized anyway let freeInBinding = Zset.diff freeInBinding freeInEnv @@ -11449,13 +11449,13 @@ and TcIncrementalLetRecGeneralization cenv scopem // Have we reached a fixed point? if newFrozenBindings.IsEmpty then - preGeneralizationRecBinds,frozenBindings + preGeneralizationRecBinds, frozenBindings else // if not, then repeat - loop(preGeneralizationRecBinds,newFrozenBindings@frozenBindings) + loop(preGeneralizationRecBinds, newFrozenBindings@frozenBindings) // start with no frozen bindings - let newGeneralizableBindings,preGeneralizationRecBinds = loop(preGeneralizationRecBinds,[]) + let newGeneralizableBindings, preGeneralizationRecBinds = loop(preGeneralizationRecBinds, []) // Some of the bindings may now have been marked as 'generalizable' (which means they now transition // from PreGeneralization --> PostGeneralization, since we won't get any more information on @@ -11471,7 +11471,7 @@ and TcIncrementalLetRecGeneralization cenv scopem // constructors do not pass CanInferExtraGeneralizedTyparsForRecBinding. let freeInEnv = - (freeInEnv,newGeneralizableBindings) ||> List.fold (fun freeInEnv pgrbind -> + (freeInEnv, newGeneralizableBindings) ||> List.fold (fun freeInEnv pgrbind -> if GeneralizationHelpers.IsGeneralizableValue cenv.g pgrbind.CheckedBinding.Expr then freeInEnv else @@ -11481,20 +11481,20 @@ and TcIncrementalLetRecGeneralization cenv scopem Zset.union freeInBinding freeInEnv) // Process the bindings marked for transition from PreGeneralization --> PostGeneralization - let newGeneralizedRecBinds,tpenv = + let newGeneralizedRecBinds, tpenv = if newGeneralizableBindings.IsEmpty then [], tpenv else let supportForBindings = newGeneralizableBindings |> List.collect (TcLetrecComputeSupportForBinding cenv) - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denv,scopem) supportForBindings + GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denv, scopem) supportForBindings let generalizedTyparsL = newGeneralizableBindings |> List.map (TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv) // Generalize the bindings. - let newGeneralizedRecBinds = (generalizedTyparsL,newGeneralizableBindings) ||> List.map2 (TcLetrecGeneralizeBinding cenv denv ) + let newGeneralizedRecBinds = (generalizedTyparsL, newGeneralizableBindings) ||> List.map2 (TcLetrecGeneralizeBinding cenv denv ) let tpenv = HideUnscopedTypars (List.concat generalizedTyparsL) tpenv - newGeneralizedRecBinds,tpenv + newGeneralizedRecBinds, tpenv newGeneralizedRecBinds, preGeneralizationRecBinds, tpenv @@ -11502,7 +11502,7 @@ and TcIncrementalLetRecGeneralization cenv scopem let envNonRec = envNonRec |> AddLocalVals cenv.tcSink scopem (newGeneralizedRecBinds |> List.map (fun b -> b.RecBindingInfo.Val)) let generalizedRecBinds = newGeneralizedRecBinds @ generalizedRecBinds - (envNonRec,generalizedRecBinds,preGeneralizationRecBinds,tpenv,uncheckedRecBindsTable) + (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, tpenv, uncheckedRecBindsTable) //------------------------------------------------------------------------- // TcLetrecComputeAndGeneralizeGenericTyparsForBinding @@ -11515,8 +11515,8 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr let rbinfo = pgrbind.RecBindingInfo let vspec = rbinfo.Val - let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,expr,_,_,m,_,_,_,_)) = pgrbind.CheckedBinding - let (ExplicitTyparInfo(rigidCopyOfDeclaredTypars,declaredTypars,_)) = rbinfo.ExplicitTyparInfo + let (CheckedBindingInfo(inlineFlag, _, _, _, _, _, expr, _, _, m, _, _, _, _)) = pgrbind.CheckedBinding + let (ExplicitTyparInfo(rigidCopyOfDeclaredTypars, declaredTypars, _)) = rbinfo.ExplicitTyparInfo let allDeclaredTypars = rbinfo.EnclosingDeclaredTypars @ declaredTypars @@ -11529,14 +11529,14 @@ and TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv (pgr let memFlagsOpt = vspec.MemberInfo |> Option.map (fun memInfo -> memInfo.MemberFlags) let isCtor = (match memFlagsOpt with None -> false | Some memberFlags -> memberFlags.MemberKind = MemberKind.Constructor) - GeneralizationHelpers.CheckDeclaredTyparsPermitted(memFlagsOpt,declaredTypars,m) + GeneralizationHelpers.CheckDeclaredTyparsPermitted(memFlagsOpt, declaredTypars, m) let canInferTypars = CanInferExtraGeneralizedTyparsForRecBinding pgrbind let tau = vspec.TauType let maxInferredTypars = freeInTypeLeftToRight cenv.g false tau let canGeneralizeConstrained = GeneralizationHelpers.CanGeneralizeConstrainedTyparsForDecl rbinfo.DeclKind - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv,denv,m,freeInEnv,canInferTypars,canGeneralizeConstrained,inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars,tau,isCtor) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars (cenv, denv, m, freeInEnv, canInferTypars, canGeneralizeConstrained, inlineFlag, Some(expr), allDeclaredTypars, maxInferredTypars, tau, isCtor) generalizedTypars /// Compute the type variables which may have member constraints that need to be canonicalized prior to generalization @@ -11553,15 +11553,15 @@ and TcLetrecComputeSupportForBinding cenv (pgrbind : PreGeneralizationRecursiveB // Generalise generalizedTypars from checkedBind. and TcLetrecGeneralizeBinding cenv denv generalizedTypars (pgrbind : PreGeneralizationRecursiveBinding) : PostGeneralizationRecursiveBinding = - let (RBInfo(_,_,enclosingDeclaredTypars,_,vspec,flex,partialValReprInfo,memberInfoOpt,_,_,_,vis,_,declKind)) = pgrbind.RecBindingInfo - let (CheckedBindingInfo(inlineFlag,_,_,_,_,_,expr,argAttribs,_,_,_,compgen,_,isFixed)) = pgrbind.CheckedBinding + let (RBInfo(_, _, enclosingDeclaredTypars, _, vspec, flex, partialValReprInfo, memberInfoOpt, _, _, _, vis, _, declKind)) = pgrbind.RecBindingInfo + let (CheckedBindingInfo(inlineFlag, _, _, _, _, _, expr, argAttribs, _, _, _, compgen, _, isFixed)) = pgrbind.CheckedBinding if isFixed then - errorR(Error(FSComp.SR.tcFixedNotAllowed(),expr.Range)) + errorR(Error(FSComp.SR.tcFixedNotAllowed(), expr.Range)) - let _,tau = vspec.TypeScheme + let _, tau = vspec.TypeScheme - let pvalscheme1 = PrelimValScheme1(vspec.Id,flex,tau,Some(partialValReprInfo),memberInfoOpt,false,inlineFlag,NormalVal,argAttribs,vis,compgen) + let pvalscheme1 = PrelimValScheme1(vspec.Id, flex, tau, Some(partialValReprInfo), memberInfoOpt, false, inlineFlag, NormalVal, argAttribs, vis, compgen) let pvalscheme2 = GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTypars pvalscheme1 let valscheme = UseCombinedArity cenv.g declKind expr pvalscheme2 @@ -11615,7 +11615,7 @@ and MakeCheckSafeInit g tinst safeInitInfo reqExpr expr = and TcLetrecAdjustMemberForSpecialVals cenv (pgrbind: PostGeneralizationRecursiveBinding) : PostBindCtorThisVarRefCellRecursiveBinding = - let (RBInfo(_,_,_,_,vspec,_,_,_,baseValOpt,safeThisValOpt,safeInitInfo,_,_,_)) = pgrbind.RecBindingInfo + let (RBInfo(_, _, _, _, vspec, _, _, _, baseValOpt, safeThisValOpt, safeInitInfo, _, _, _)) = pgrbind.RecBindingInfo let expr = pgrbind.CheckedBinding.Expr let spBind = pgrbind.CheckedBinding.SeqPoint @@ -11624,7 +11624,7 @@ and TcLetrecAdjustMemberForSpecialVals cenv (pgrbind: PostGeneralizationRecursiv | None -> expr | Some bind -> let m = expr.Range - let tps,vsl,body,returnTy = stripTopLambda (expr,vspec.Type) + let tps, vsl, body, returnTy = stripTopLambda (expr, vspec.Type) mkMultiLambdas m tps vsl (mkLetBind m bind body, returnTy) // Add a call to CheckInit if necessary for instance members @@ -11633,7 +11633,7 @@ and TcLetrecAdjustMemberForSpecialVals cenv (pgrbind: PostGeneralizationRecursiv match safeInitInfo with | SafeInitField (rfref, _) -> let m = expr.Range - let tps,vsl,body,returnTy = stripTopLambda (expr,vspec.Type) + let tps, vsl, body, returnTy = stripTopLambda (expr, vspec.Type) // This is an instance member, it must have a 'this' let thisVar = vsl.Head.Head let thisTypeInst = argsOfAppTy cenv.g thisVar.Type @@ -11650,14 +11650,14 @@ and TcLetrecAdjustMemberForSpecialVals cenv (pgrbind: PostGeneralizationRecursiv | None -> expr | _ -> let m = expr.Range - let tps,vsl,body,returnTy = stripTopLambda (expr,vspec.Type) + let tps, vsl, body, returnTy = stripTopLambda (expr, vspec.Type) mkMemberLambdas m tps None baseValOpt vsl (body, returnTy) { ValScheme = pgrbind.ValScheme - Binding = TBind(vspec,expr,spBind) } + Binding = TBind(vspec, expr, spBind) } and FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock (bind : PostBindCtorThisVarRefCellRecursiveBinding) = - let (TBind(vspec,expr,spBind)) = bind.Binding + let (TBind(vspec, expr, spBind)) = bind.Binding // Check coherence of generalization of variables for memberInfo members in generic classes match vspec.MemberInfo with @@ -11667,10 +11667,10 @@ and FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock (bind : PostBin | Some _ -> #endif match PartitionValTyparsForApparentEnclosingType cenv.g vspec with - | Some(parentTypars,memberParentTypars,_,_,_) -> + | Some(parentTypars, memberParentTypars, _, _, _) -> ignore(SignatureConformance.Checker(cenv.g, cenv.amap, denv, SignatureRepackageInfo.Empty, false).CheckTypars vspec.Range TypeEquivEnv.Empty memberParentTypars parentTypars) | None -> - errorR(Error(FSComp.SR.tcMemberIsNotSufficientlyGeneric(),vspec.Range)) + errorR(Error(FSComp.SR.tcMemberIsNotSufficientlyGeneric(), vspec.Range)) | _ -> () // Fixup recursive references... @@ -11681,7 +11681,7 @@ and FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock (bind : PostBin let expr = mkGenericBindRhs cenv.g vspec.Range generalizedTyparsForRecursiveBlock bind.ValScheme.TypeScheme expr { FixupPoints = fixupPoints - Binding = TBind(vspec,expr,spBind) } + Binding = TBind(vspec, expr, spBind) } //------------------------------------------------------------------------- // TcLetrec @@ -11690,19 +11690,19 @@ and FixupLetrecBind cenv denv generalizedTyparsForRecursiveBlock (bind : PostBin and unionGeneralizedTypars typarSets = List.foldBack (ListSet.unionFavourRight typarEq) typarSets [] -and TcLetrec overridesOK cenv env tpenv (binds,bindsm,scopem) = +and TcLetrec overridesOK cenv env tpenv (binds, bindsm, scopem) = // Create prelimRecValues for the recursive items (includes type info from LHS of bindings) *) - let binds = binds |> List.map (fun (RecDefnBindingInfo(a,b,c,bind)) -> NormalizedRecBindingDefn(a,b,c,BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env bind)) - let uncheckedRecBinds,prelimRecValues,(tpenv,_) = AnalyzeAndMakeAndPublishRecursiveValues overridesOK cenv env tpenv binds + let binds = binds |> List.map (fun (RecDefnBindingInfo(a, b, c, bind)) -> NormalizedRecBindingDefn(a, b, c, BindingNormalization.NormalizeBinding ValOrMemberBinding cenv env bind)) + let uncheckedRecBinds, prelimRecValues, (tpenv, _) = AnalyzeAndMakeAndPublishRecursiveValues overridesOK cenv env tpenv binds let envRec = AddLocalVals cenv.tcSink scopem prelimRecValues env // Typecheck bindings let uncheckedRecBindsTable = uncheckedRecBinds |> List.map (fun rbind -> rbind.RecBindingInfo.Val.Stamp, rbind) |> Map.ofList - let (_,generalizedRecBinds,preGeneralizationRecBinds,tpenv,_) = - ((env,[],[],tpenv,uncheckedRecBindsTable),uncheckedRecBinds) ||> List.fold (TcLetrecBinding (cenv,envRec,scopem,[],None)) + let (_, generalizedRecBinds, preGeneralizationRecBinds, tpenv, _) = + ((env, [], [], tpenv, uncheckedRecBindsTable), uncheckedRecBinds) ||> List.fold (TcLetrecBinding (cenv, envRec, scopem, [], None)) // There should be no bindings that have not been generalized since checking the vary last binding always // results in the generalization of all remaining ungeneralized bindings, since there are no remaining unchecked bindings @@ -11743,7 +11743,7 @@ and TcLetrec overridesOK cenv env tpenv (binds,bindsm,scopem) = // Post letrec env let envbody = AddLocalVals cenv.tcSink scopem prelimRecValues env - binds,envbody,tpenv + binds, envbody, tpenv @@ -11755,7 +11755,7 @@ let TcAndPublishValSpec (cenv, env, containerInfo: ContainerInfo, declKind, memF let (ValSpfn (synAttrs, _, SynValTyparDecls (synTypars, synCanInferTypars, _), _, _, isInline, mutableFlag, doc, vis, literalExprOpt, m)) = valSpfn - GeneralizationHelpers.CheckDeclaredTyparsPermitted(memFlagsOpt,synTypars,m) + GeneralizationHelpers.CheckDeclaredTyparsPermitted(memFlagsOpt, synTypars, m) let canInferTypars = GeneralizationHelpers.ComputeCanInferExtraGeneralizableTypars (containerInfo.ParentRef, synCanInferTypars, memFlagsOpt) let attrTgt = DeclKind.AllowedAttribTargets memFlagsOpt declKind @@ -11770,17 +11770,17 @@ let TcAndPublishValSpec (cenv, env, containerInfo: ContainerInfo, declKind, memF let (ValSpecResult (altActualParent, memberInfoOpt, id, enclosingDeclaredTypars, declaredTypars, ty, partialValReprInfo, declKind)) = valSpecResult - let inlineFlag = ComputeInlineFlag (memberInfoOpt |> Option.map (fun (ValMemberInfoTransient(memberInfo,_,_)) -> memberInfo.MemberFlags)) isInline mutableFlag m + let inlineFlag = ComputeInlineFlag (memberInfoOpt |> Option.map (fun (ValMemberInfoTransient(memberInfo, _, _)) -> memberInfo.MemberFlags)) isInline mutableFlag m let freeInType = freeInTypeLeftToRight cenv.g false ty let allDeclaredTypars = enclosingDeclaredTypars @ declaredTypars - let flex = ExplicitTyparInfo(declaredTypars,declaredTypars,synCanInferTypars) + let flex = ExplicitTyparInfo(declaredTypars, declaredTypars, synCanInferTypars) - let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv,denv,id.idRange,emptyFreeTypars,canInferTypars,CanGeneralizeConstrainedTypars,inlineFlag,None,allDeclaredTypars,freeInType,ty,false) + let generalizedTypars = GeneralizationHelpers.ComputeAndGeneralizeGenericTypars(cenv, denv, id.idRange, emptyFreeTypars, canInferTypars, CanGeneralizeConstrainedTypars, inlineFlag, None, allDeclaredTypars, freeInType, ty, false) - let valscheme1 = PrelimValScheme1(id,flex,ty,Some(partialValReprInfo),memberInfoOpt,mutableFlag,inlineFlag,NormalVal,noArgOrRetAttribs,vis,false) + let valscheme1 = PrelimValScheme1(id, flex, ty, Some(partialValReprInfo), memberInfoOpt, mutableFlag, inlineFlag, NormalVal, noArgOrRetAttribs, vis, false) let valscheme2 = GeneralizeVal cenv denv enclosingDeclaredTypars generalizedTypars valscheme1 @@ -11793,19 +11793,19 @@ let TcAndPublishValSpec (cenv, env, containerInfo: ContainerInfo, declKind, memF | None -> let hasLiteralAttr = HasFSharpAttribute cenv.g cenv.g.attrib_LiteralAttribute attrs if hasLiteralAttr then - errorR(Error(FSComp.SR.tcLiteralAttributeRequiresConstantValue(),m)) + errorR(Error(FSComp.SR.tcLiteralAttributeRequiresConstantValue(), m)) None | Some e -> - let hasLiteralAttr,konst = TcLiteral cenv ty env tpenv (attrs,e) + let hasLiteralAttr, konst = TcLiteral cenv ty env tpenv (attrs, e) if not hasLiteralAttr then errorR(Error(FSComp.SR.tcValueInSignatureRequiresLiteralAttribute(), e.Range)) konst - let vspec = MakeAndPublishVal cenv env (altActualParent,true,declKind,ValNotInRecScope,valscheme,attrs,doc.ToXmlDoc(),konst,false) + let vspec = MakeAndPublishVal cenv env (altActualParent, true, declKind, ValNotInRecScope, valscheme, attrs, doc.ToXmlDoc(), konst, false) assert(vspec.InlineInfo = inlineFlag) - vspec,tpenv) + vspec, tpenv) //------------------------------------------------------------------------- @@ -11817,7 +11817,7 @@ exception NotUpperCaseConstructor of range let CheckNamespaceModuleOrTypeName (g:TcGlobals) (id:Ident) = // type names '[]' etc. are used in fslib if not g.compilingFslib && id.idText.IndexOfAny(IllegalCharactersInTypeAndNamespaceNames) <> -1 then - errorR(Error(FSComp.SR.tcInvalidNamespaceModuleTypeUnionName(),id.idRange)) + errorR(Error(FSComp.SR.tcInvalidNamespaceModuleTypeUnionName(), id.idRange)) let CheckDuplicates (idf : _ -> Ident) k elems = elems |> List.iteri (fun i uc1 -> @@ -11825,7 +11825,7 @@ let CheckDuplicates (idf : _ -> Ident) k elems = let id1 = (idf uc1) let id2 = (idf uc2) if j > i && id1.idText = id2.idText then - errorR (Duplicate(k,id1.idText,id1.idRange)))) + errorR (Duplicate(k, id1.idText, id1.idRange)))) elems @@ -11836,31 +11836,31 @@ module TcRecdUnionAndEnumDeclarations = begin | ParentNone -> vis | Parent tcref -> combineAccess vis tcref.TypeReprAccessibility - let MakeRecdFieldSpec _cenv env parent (isStatic,konst,ty',attrsForProperty,attrsForField,id,isMutable,vol,xmldoc,vis,m) = - let vis,_ = ComputeAccessAndCompPath env None m vis None parent + let MakeRecdFieldSpec _cenv env parent (isStatic, konst, ty', attrsForProperty, attrsForField, id, isMutable, vol, xmldoc, vis, m) = + let vis, _ = ComputeAccessAndCompPath env None m vis None parent let vis = CombineReprAccess parent vis NewRecdField isStatic konst id ty' isMutable vol attrsForProperty attrsForField xmldoc vis false - let TcFieldDecl cenv env parent isIncrClass tpenv (isStatic,synAttrs,id,ty,isMutable,xmldoc,vis,m) = + let TcFieldDecl cenv env parent isIncrClass tpenv (isStatic, synAttrs, id, ty, isMutable, xmldoc, vis, m) = let attrs, _ = TcAttributesWithPossibleTargets false cenv env AttributeTargets.FieldDecl synAttrs - let attrsForProperty,attrsForField = attrs |> List.partition (fun (attrTargets,_) -> (attrTargets &&& AttributeTargets.Property) <> enum 0) + let attrsForProperty, attrsForField = attrs |> List.partition (fun (attrTargets, _) -> (attrTargets &&& AttributeTargets.Property) <> enum 0) let attrsForProperty = (List.map snd attrsForProperty) let attrsForField = (List.map snd attrsForField) - let ty',_ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty + let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty let zeroInit = HasFSharpAttribute cenv.g cenv.g.attrib_DefaultValueAttribute attrsForField let isVolatile = HasFSharpAttribute cenv.g cenv.g.attrib_VolatileFieldAttribute attrsForField let isThreadStatic = isThreadOrContextStatic cenv.g attrsForField if isThreadStatic && (not zeroInit || not isStatic) then - error(Error(FSComp.SR.tcThreadStaticAndContextStaticMustBeStatic(),m)) + error(Error(FSComp.SR.tcThreadStaticAndContextStaticMustBeStatic(), m)) if isVolatile then - error(Error(FSComp.SR.tcVolatileOnlyOnClassLetBindings(),m)) + error(Error(FSComp.SR.tcVolatileOnlyOnClassLetBindings(), m)) - if isIncrClass && (not zeroInit || not isMutable) then errorR(Error(FSComp.SR.tcUninitializedValFieldsMustBeMutable(),m)) - if isStatic && (not zeroInit || not isMutable || vis <> Some SynAccess.Private ) then errorR(Error(FSComp.SR.tcStaticValFieldsMustBeMutableAndPrivate(),m)) + if isIncrClass && (not zeroInit || not isMutable) then errorR(Error(FSComp.SR.tcUninitializedValFieldsMustBeMutable(), m)) + if isStatic && (not zeroInit || not isMutable || vis <> Some SynAccess.Private ) then errorR(Error(FSComp.SR.tcStaticValFieldsMustBeMutableAndPrivate(), m)) let konst = if zeroInit then Some Const.Zero else None - let rfspec = MakeRecdFieldSpec cenv env parent (isStatic,konst,ty',attrsForProperty,attrsForField,id,isMutable,isVolatile,xmldoc,vis,m) + let rfspec = MakeRecdFieldSpec cenv env parent (isStatic, konst, ty', attrsForProperty, attrsForField, id, isMutable, isVolatile, xmldoc, vis, m) match parent with | Parent tcref when useGenuineField tcref.Deref rfspec -> // Recheck the attributes for errors if the definition only generates a field @@ -11869,21 +11869,21 @@ module TcRecdUnionAndEnumDeclarations = begin rfspec - let TcAnonFieldDecl cenv env parent tpenv nm (Field(attribs,isStatic,idOpt,ty,isMutable,xmldoc,vis,m)) = + let TcAnonFieldDecl cenv env parent tpenv nm (Field(attribs, isStatic, idOpt, ty, isMutable, xmldoc, vis, m)) = let id = (match idOpt with None -> mkSynId m nm | Some id -> id) - let f = TcFieldDecl cenv env parent false tpenv (isStatic,attribs,id,ty,isMutable,xmldoc.ToXmlDoc(),vis,m) + let f = TcFieldDecl cenv env parent false tpenv (isStatic, attribs, id, ty, isMutable, xmldoc.ToXmlDoc(), vis, m) match idOpt with | None -> () | Some id -> let item = Item.ArgName(id, f.FormalType, None) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Binding,env.DisplayEnv,env.AccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.AccessRights) f - let TcNamedFieldDecl cenv env parent isIncrClass tpenv (Field(attribs,isStatic,id,ty,isMutable,xmldoc,vis,m)) = + let TcNamedFieldDecl cenv env parent isIncrClass tpenv (Field(attribs, isStatic, id, ty, isMutable, xmldoc, vis, m)) = match id with - | None -> error (Error(FSComp.SR.tcFieldRequiresName(),m)) - | Some(id) -> TcFieldDecl cenv env parent isIncrClass tpenv (isStatic,attribs,id,ty,isMutable,xmldoc.ToXmlDoc(),vis,m) + | None -> error (Error(FSComp.SR.tcFieldRequiresName(), m)) + | Some(id) -> TcFieldDecl cenv env parent isIncrClass tpenv (isStatic, attribs, id, ty, isMutable, xmldoc.ToXmlDoc(), vis, m) let TcNamedFieldDecls cenv env parent isIncrClass tpenv fields = fields |> List.map (TcNamedFieldDecl cenv env parent isIncrClass tpenv) @@ -11913,9 +11913,9 @@ module TcRecdUnionAndEnumDeclarations = begin else seen.Add(f.Name, sf) - let TcUnionCaseDecl cenv env parent thisTy tpenv (UnionCase (synAttrs,id,args,xmldoc,vis,m)) = + let TcUnionCaseDecl cenv env parent thisTy tpenv (UnionCase (synAttrs, id, args, xmldoc, vis, m)) = let attrs = TcAttributes cenv env AttributeTargets.UnionCaseDecl synAttrs // the attributes of a union case decl get attached to the generated "static factory" method - let vis,_ = ComputeAccessAndCompPath env None m vis None parent + let vis, _ = ComputeAccessAndCompPath env None m vis None parent let vis = CombineReprAccess parent vis let realUnionCaseName = if id.idText = opNameCons then "Cons" @@ -11923,33 +11923,33 @@ module TcRecdUnionAndEnumDeclarations = begin else id.idText if realUnionCaseName = "Tags" then - errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(realUnionCaseName,"Tags"),m)) + errorR(Error(FSComp.SR.tcUnionCaseNameConflictsWithGeneratedType(realUnionCaseName, "Tags"), m)) CheckUnionCaseName cenv realUnionCaseName id.idRange let mkName nFields i = if nFields <= 1 then "Item" else "Item"+string (i+1) - let rfields,recordTy = + let rfields, recordTy = match args with | UnionCaseFields flds -> let nFields = flds.Length let rfields = flds |> List.mapi (fun i fld -> TcAnonFieldDecl cenv env parent tpenv (mkName nFields i) fld) ValidateFieldNames(flds, rfields) - rfields,thisTy - | UnionCaseFullType (ty,arity) -> - let ty',_ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty - let argtysl,recordTy = GetTopTauTypeInFSharpForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv env) |> TranslatePartialArity []).ArgInfos ty' m + rfields, thisTy + | UnionCaseFullType (ty, arity) -> + let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType env tpenv ty + let argtysl, recordTy = GetTopTauTypeInFSharpForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv env) |> TranslatePartialArity []).ArgInfos ty' m if argtysl.Length > 1 then - errorR(Error(FSComp.SR.tcIllegalFormForExplicitTypeDeclaration(),m)) + errorR(Error(FSComp.SR.tcIllegalFormForExplicitTypeDeclaration(), m)) let argtys = argtysl |> List.concat let nFields = argtys.Length let rfields = - argtys |> List.mapi (fun i (argty,argInfo) -> + argtys |> List.mapi (fun i (argty, argInfo) -> let id = (match argInfo.Name with Some id -> id | None -> mkSynId m (mkName nFields i)) - MakeRecdFieldSpec cenv env parent (false,None,argty,[],[],id,false,false,XmlDoc.Empty,None,m)) + MakeRecdFieldSpec cenv env parent (false, None, argty, [], [], id, false, false, XmlDoc.Empty, None, m)) if not (typeEquiv cenv.g recordTy thisTy) then - error(Error(FSComp.SR.tcReturnTypesForUnionMustBeSameAsType(),m)) - rfields,recordTy + error(Error(FSComp.SR.tcReturnTypesForUnionMustBeSameAsType(), m)) + rfields, recordTy NewUnionCase id realUnionCaseName rfields recordTy attrs (xmldoc.ToXmlDoc()) vis @@ -11957,23 +11957,23 @@ module TcRecdUnionAndEnumDeclarations = begin let unionCases' = unionCases |> List.map (TcUnionCaseDecl cenv env parent thisTy tpenv) unionCases' |> CheckDuplicates (fun uc -> uc.Id) "union case" - let TcEnumDecl cenv env parent thisTy fieldTy (EnumCase (synAttrs,id,v,xmldoc,m)) = + let TcEnumDecl cenv env parent thisTy fieldTy (EnumCase (synAttrs, id, v, xmldoc, m)) = let attrs = TcAttributes cenv env AttributeTargets.Field synAttrs match v with | SynConst.Bytes _ | SynConst.UInt16s _ - | SynConst.UserNum _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(),m)) + | SynConst.UserNum _ -> error(Error(FSComp.SR.tcInvalidEnumerationLiteral(), m)) | _ -> let v = TcConst cenv fieldTy m env v - let vis,_ = ComputeAccessAndCompPath env None m None None parent + let vis, _ = ComputeAccessAndCompPath env None m None None parent let vis = CombineReprAccess parent vis - if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(),id.idRange)) + if id.idText = "value__" then errorR(Error(FSComp.SR.tcNotValidEnumCaseName(), id.idRange)) NewRecdField true (Some v) id thisTy false false [] attrs (xmldoc.ToXmlDoc()) vis false let TcEnumDecls cenv env parent thisTy enumCases = let fieldTy = NewInferenceType () let enumCases' = enumCases |> List.map (TcEnumDecl cenv env parent thisTy fieldTy) |> CheckDuplicates (fun f -> f.Id) "enum element" - fieldTy,enumCases' + fieldTy, enumCases' end @@ -11982,27 +11982,27 @@ end //------------------------------------------------------------------------- let PublishInterface cenv denv (tcref:TyconRef) m compgen ty' = - if not (isInterfaceTy cenv.g ty') then errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType1(NicePrint.minimalStringOfType denv ty'),m)) + if not (isInterfaceTy cenv.g ty') then errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType1(NicePrint.minimalStringOfType denv ty'), m)) let tcaug = tcref.TypeContents if tcref.HasInterface cenv.g ty' then - errorR(Error(FSComp.SR.tcDuplicateSpecOfInterface(),m)) - tcaug.tcaug_interfaces <- (ty',compgen,m) :: tcaug.tcaug_interfaces + errorR(Error(FSComp.SR.tcDuplicateSpecOfInterface(), m)) + tcaug.tcaug_interfaces <- (ty', compgen, m) :: tcaug.tcaug_interfaces let TcAndPublishMemberSpec cenv env containerInfo declKind tpenv memb = match memb with - | SynMemberSig.ValField(_,m) -> error(Error(FSComp.SR.tcFieldValIllegalHere(),m)) - | SynMemberSig.Inherit(_,m) -> error(Error(FSComp.SR.tcInheritIllegalHere(),m)) - | SynMemberSig.NestedType(_,m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(),m)) - | SynMemberSig.Member(valSpfn,memberFlags,_) -> - TcAndPublishValSpec (cenv,env,containerInfo,declKind,Some memberFlags,tpenv,valSpfn) + | SynMemberSig.ValField(_, m) -> error(Error(FSComp.SR.tcFieldValIllegalHere(), m)) + | SynMemberSig.Inherit(_, m) -> error(Error(FSComp.SR.tcInheritIllegalHere(), m)) + | SynMemberSig.NestedType(_, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)) + | SynMemberSig.Member(valSpfn, memberFlags, _) -> + TcAndPublishValSpec (cenv, env, containerInfo, declKind, Some memberFlags, tpenv, valSpfn) | SynMemberSig.Interface _ -> // These are done in TcMutRecDefns_Phase1 - [],tpenv + [], tpenv let TcTyconMemberSpecs cenv env containerInfo declKind tpenv (augSpfn: SynMemberSigs) = - let members,tpenv = List.mapFold (TcAndPublishMemberSpec cenv env containerInfo declKind) tpenv augSpfn - List.concat members,tpenv + let members, tpenv = List.mapFold (TcAndPublishMemberSpec cenv env containerInfo declKind) tpenv augSpfn + List.concat members, tpenv //------------------------------------------------------------------------- @@ -12025,12 +12025,12 @@ let TcOpenDecl tcSink (g:TcGlobals) amap m scopem env (longId : Ident list) = CheckNamespaceModuleOrTypeName g id let IsPartiallyQualifiedNamespace (modref: ModuleOrNamespaceRef) = - let (CompPath(_,p)) = modref.CompilationPath + let (CompPath(_, p)) = modref.CompilationPath // Bug FSharp 1.0 3274: FSI paths don't count when determining this warning let p = match p with | [] -> [] - | (h,_):: t -> if h.StartsWith(FsiDynamicModulePrefix,System.StringComparison.Ordinal) then t else p + | (h, _):: t -> if h.StartsWith(FsiDynamicModulePrefix, System.StringComparison.Ordinal) then t else p // See https://fslang.uservoice.com/forums/245727-f-language/suggestions/6107641-make-microsoft-prefix-optional-when-using-core-f let isFSharpCoreSpecialCase = @@ -12053,17 +12053,17 @@ let TcOpenDecl tcSink (g:TcGlobals) amap m scopem env (longId : Ident list) = not isFSharpCoreSpecialCase // Allow "open Foo" for "Microsoft.Foo" from FSharp.Core - modrefs |> List.iter (fun (_,modref,_) -> + modrefs |> List.iter (fun (_, modref, _) -> if modref.IsModule && HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs then - errorR(Error(FSComp.SR.tcModuleRequiresQualifiedAccess(fullDisplayTextOfModRef modref),m))) + errorR(Error(FSComp.SR.tcModuleRequiresQualifiedAccess(fullDisplayTextOfModRef modref), m))) // Bug FSharp 1.0 3133: 'open Lexing'. Skip this warning if we successfully resolved to at least a module name - if not (modrefs |> List.exists (fun (_,modref,_) -> modref.IsModule && not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs))) then - modrefs |> List.iter (fun (_,modref,_) -> + if not (modrefs |> List.exists (fun (_, modref, _) -> modref.IsModule && not (HasFSharpAttribute g g.attrib_RequireQualifiedAccessAttribute modref.Attribs))) then + modrefs |> List.iter (fun (_, modref, _) -> if IsPartiallyQualifiedNamespace modref then - errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref),m))) + errorR(Error(FSComp.SR.tcOpenUsedWithPartiallyQualifiedPath(fullDisplayTextOfModRef modref), m))) - modrefs |> List.iter (fun (_,modref,_) -> CheckEntityAttributes g modref m |> CommitOperationResult) + modrefs |> List.iter (fun (_, modref, _) -> CheckEntityAttributes g modref m |> CommitOperationResult) let env = OpenModulesOrNamespaces tcSink g amap scopem false env (List.map p23 modrefs) env @@ -12128,10 +12128,10 @@ module IncrClassChecking = // Type check arguments by processing them as 'simple' patterns // NOTE: if we allow richer patterns here this is where we'd process those patterns - let ctorArgNames,(_,names,_) = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv (SynSimplePats.SimplePats (spats,m)) + let ctorArgNames, (_, names, _) = TcSimplePatsOfUnknownType cenv true CheckCxs env tpenv (SynSimplePats.SimplePats (spats, m)) // Create the values with the given names - let _,vspecs = MakeSimpleVals cenv env names + let _, vspecs = MakeSimpleVals cenv env names if tcref.IsStructOrEnumTycon && isNil spats then errorR (ParameterlessStructCtor(tcref.Range)) @@ -12142,7 +12142,7 @@ module IncrClassChecking = // NOTE: the type scheme here is not complete!!! The ctorTy is more or less // just a type variable. The type and typars get fixed-up after inference - let ctorValScheme,ctorVal = + let ctorValScheme, ctorVal = let argty = mkRefTupledTy cenv.g (typesOfVals ctorArgs) // Initial type has known information let ctorTy = mkFunTy argty objTy @@ -12151,18 +12151,18 @@ module IncrClassChecking = let memberFlags = CtorMemberFlags let synArgInfos = List.map (SynInfo.InferSynArgInfoFromSimplePat []) spats - let valSynData = SynValInfo([synArgInfos],SynInfo.unnamedRetVal) - let id = ident ("new",m) + let valSynData = SynValInfo([synArgInfos], SynInfo.unnamedRetVal) + let id = ident ("new", m) CheckForNonAbstractInterface ModuleOrMemberBinding tcref memberFlags id.idRange - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g,tcref,false,attribs,[],memberFlags,valSynData,id,false) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, false, attribs, [], memberFlags, valSynData, id, false) let partialValReprInfo = TranslateTopValSynInfo m (TcAttributes cenv env) valSynData - let prelimTyschemeG = TypeScheme(copyOfTyconTypars,ctorTy) + let prelimTyschemeG = TypeScheme(copyOfTyconTypars, ctorTy) let isComplete = ComputeIsComplete copyOfTyconTypars [] ctorTy let topValInfo = InferGenericArityFromTyScheme prelimTyschemeG partialValReprInfo - let ctorValScheme = ValScheme(id,prelimTyschemeG,Some(topValInfo),Some(memberInfo),false,ValInline.Never,NormalVal,vis,false,true,false,false) - let ctorVal = MakeAndPublishVal cenv env (Parent(tcref),false,ModuleOrMemberBinding,ValInRecScope(isComplete),ctorValScheme,attribs,XmlDoc.Empty,None,false) - ctorValScheme,ctorVal + let ctorValScheme = ValScheme(id, prelimTyschemeG, Some(topValInfo), Some(memberInfo), false, ValInline.Never, NormalVal, vis, false, true, false, false) + let ctorVal = MakeAndPublishVal cenv env (Parent(tcref), false, ModuleOrMemberBinding, ValInRecScope(isComplete), ctorValScheme, attribs, XmlDoc.Empty, None, false) + ctorValScheme, ctorVal // We only generate the cctor on demand, because we don't need it if there are no cctor actions. // The code below has a side-effect (MakeAndPublishVal), so we only want to run it once if at all. @@ -12172,23 +12172,23 @@ module IncrClassChecking = (let cctorArgs = [ fst(mkCompGenLocal m "unitVar" cenv.g.unit_ty) ] let cctorTy = mkFunTy cenv.g.unit_ty cenv.g.unit_ty - let valSynData = SynValInfo([[]],SynInfo.unnamedRetVal) - let id = ident ("cctor",m) + let valSynData = SynValInfo([[]], SynInfo.unnamedRetVal) + let id = ident ("cctor", m) CheckForNonAbstractInterface ModuleOrMemberBinding tcref ClassCtorMemberFlags id.idRange - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g,tcref,false,[(*no attributes*)],[],ClassCtorMemberFlags,valSynData,id,false) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(cenv.g, tcref, false, [(*no attributes*)], [], ClassCtorMemberFlags, valSynData, id, false) let partialValReprInfo = TranslateTopValSynInfo m (TcAttributes cenv env) valSynData - let prelimTyschemeG = TypeScheme(copyOfTyconTypars,cctorTy) + let prelimTyschemeG = TypeScheme(copyOfTyconTypars, cctorTy) let topValInfo = InferGenericArityFromTyScheme prelimTyschemeG partialValReprInfo - let cctorValScheme = ValScheme(id,prelimTyschemeG,Some(topValInfo),Some(memberInfo),false,ValInline.Never,NormalVal,Some SynAccess.Private,false,true,false,false) + let cctorValScheme = ValScheme(id, prelimTyschemeG, Some(topValInfo), Some(memberInfo), false, ValInline.Never, NormalVal, Some SynAccess.Private, false, true, false, false) - let cctorVal = MakeAndPublishVal cenv env (Parent(tcref),false,ModuleOrMemberBinding,ValNotInRecScope,cctorValScheme,[(* no attributes*)],XmlDoc.Empty,None,false) - cctorArgs,cctorVal,cctorValScheme) + let cctorVal = MakeAndPublishVal cenv env (Parent(tcref), false, ModuleOrMemberBinding, ValNotInRecScope, cctorValScheme, [(* no attributes*)], XmlDoc.Empty, None, false) + cctorArgs, cctorVal, cctorValScheme) let thisVal = // --- Create this for use inside constructor - let thisId = ident ("this",m) - let thisValScheme = ValScheme(thisId,NonGenericTypeScheme(thisTy),None,None,false,ValInline.Never,CtorThisVal,None,true,false,false,false) - let thisVal = MakeAndPublishVal cenv env (ParentNone,false,ClassLetBinding(false),ValNotInRecScope,thisValScheme,[],XmlDoc.Empty,None,false) + let thisId = ident ("this", m) + let thisValScheme = ValScheme(thisId, NonGenericTypeScheme(thisTy), None, None, false, ValInline.Never, CtorThisVal, None, true, false, false, false) + let thisVal = MakeAndPublishVal cenv env (ParentNone, false, ClassLetBinding(false), ValNotInRecScope, thisValScheme, [], XmlDoc.Empty, None, false) thisVal {TyconRef = tcref @@ -12216,7 +12216,7 @@ module IncrClassChecking = /// Field specifications added to a tcref must be in terms of the tcrefs formal typars. let private MakeIncrClassField(g, cpath, formalTyparInst:TyparInst, v:Val, isStatic, rfref:RecdFieldRef) = let name = rfref.FieldName - let id = ident (name,v.Range) + let id = ident (name, v.Range) let ty = v.Type |> instType formalTyparInst let taccess = TAccess [cpath] let isVolatile = HasFSharpAttribute g g.attrib_VolatileFieldAttribute v.Attribs @@ -12240,11 +12240,11 @@ module IncrClassChecking = TakenFieldNames:Set RepInfoTcGlobals:TcGlobals /// vals mapped to representations - ValReprs : Zmap + ValReprs : Zmap /// vals represented as fields or members from this point on ValsWithRepresentation : Zset } - static member Empty(g,names) = + static member Empty(g, names) = { TakenFieldNames=Set.ofList names RepInfoTcGlobals=g ValReprs = Zmap.empty valOrder @@ -12253,7 +12253,7 @@ module IncrClassChecking = /// Find the representation of a value member localRep.LookupRepr (v:Val) = match Zmap.tryFind v localRep.ValReprs with - | None -> error(InternalError("LookupRepr: failed to find representation for value",v.Range)) + | None -> error(InternalError("LookupRepr: failed to find representation for value", v.Range)) | Some res -> res static member IsMethodRepr cenv (bind:Binding) = @@ -12267,20 +12267,20 @@ module IncrClassChecking = /// Choose how a binding is represented - member localRep.ChooseRepresentation (cenv,env: TcEnv,isStatic,isCtorArg, - ctorInfo:IncrClassCtorLhs, + member localRep.ChooseRepresentation (cenv, env: TcEnv, isStatic, isCtorArg, + ctorInfo:IncrClassCtorLhs, /// The vars forced to be fields due to static member bindings, instance initialization expressions or instance member bindings - staticForcedFieldVars:FreeLocals, + staticForcedFieldVars:FreeLocals, /// The vars forced to be fields due to instance member bindings - instanceForcedFieldVars:FreeLocals, - takenFieldNames: Set, + instanceForcedFieldVars:FreeLocals, + takenFieldNames: Set, bind:Binding) = let g = cenv.g let v = bind.Var let relevantForcedFieldVars = (if isStatic then staticForcedFieldVars else instanceForcedFieldVars) let tcref = ctorInfo.TyconRef - let name,takenFieldNames = + let name, takenFieldNames = let isNameTaken = // Check if a implicit field already exists with this name @@ -12290,7 +12290,7 @@ module IncrClassChecking = let nm = if isNameTaken then - ctorInfo.NameGenerator.FreshCompilerGeneratedName (v.LogicalName,v.Range) + ctorInfo.NameGenerator.FreshCompilerGeneratedName (v.LogicalName, v.Range) else v.LogicalName nm, takenFieldNames.Add(nm) @@ -12329,39 +12329,39 @@ module IncrClassChecking = //dprintfn "Representing %s as a method %s" v.LogicalName name let tps, argInfos, _, _ = GetTopValTypeInCompiledForm g topValInfo v.Type v.Range - let valSynInfo = SynValInfo(argInfos |> List.mapSquared (fun (_,argInfo) -> SynArgInfo([],false,argInfo.Name)),SynInfo.unnamedRetVal) + let valSynInfo = SynValInfo(argInfos |> List.mapSquared (fun (_, argInfo) -> SynArgInfo([], false, argInfo.Name)), SynInfo.unnamedRetVal) let memberFlags = (if isStatic then StaticMemberFlags else NonVirtualMemberFlags) MemberKind.Member let id = mkSynId v.Range name - let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g,tcref,false,[],[],memberFlags,valSynInfo,mkSynId v.Range name,true) + let memberInfo = MakeMemberDataAndMangledNameForMemberVal(g, tcref, false, [], [], memberFlags, valSynInfo, mkSynId v.Range name, true) let copyOfTyconTypars = ctorInfo.GetNormalizedInstanceCtorDeclaredTypars cenv env.DisplayEnv ctorInfo.TyconRef.Range // Add the 'this' pointer on to the function - let memberTauTy,topValInfo = + let memberTauTy, topValInfo = let tauTy = v.TauType if isStatic then - tauTy,topValInfo + tauTy, topValInfo else let tauTy = ctorInfo.InstanceCtorThisVal.Type --> v.TauType - let (ValReprInfo(tpNames,args,ret)) = topValInfo + let (ValReprInfo(tpNames, args, ret)) = topValInfo let topValInfo = ValReprInfo(tpNames, ValReprInfo.selfMetadata::args, ret) tauTy, topValInfo // Add the enclosing type parameters on to the function let topValInfo = - let (ValReprInfo(tpNames,args,ret)) = topValInfo + let (ValReprInfo(tpNames, args, ret)) = topValInfo ValReprInfo(tpNames@ValReprInfo.InferTyparInfo(copyOfTyconTypars), args, ret) - let prelimTyschemeG = TypeScheme(copyOfTyconTypars@tps,memberTauTy) - let memberValScheme = ValScheme(id,prelimTyschemeG,Some(topValInfo),Some(memberInfo),false,ValInline.Never,NormalVal,None,true (* isCompilerGenerated *) ,true (* isIncrClass *) ,false, false) - let methodVal = MakeAndPublishVal cenv env (Parent(tcref),false,ModuleOrMemberBinding,ValNotInRecScope,memberValScheme,v.Attribs,XmlDoc.Empty,None,false) + let prelimTyschemeG = TypeScheme(copyOfTyconTypars@tps, memberTauTy) + let memberValScheme = ValScheme(id, prelimTyschemeG, Some(topValInfo), Some(memberInfo), false, ValInline.Never, NormalVal, None, true (* isCompilerGenerated *) , true (* isIncrClass *) , false, false) + let methodVal = MakeAndPublishVal cenv env (Parent(tcref), false, ModuleOrMemberBinding, ValNotInRecScope, memberValScheme, v.Attribs, XmlDoc.Empty, None, false) reportIfUnused() - InMethod(isStatic,methodVal,topValInfo) + InMethod(isStatic, methodVal, topValInfo) repr, takenFieldNames /// Extend the known local representations by choosing a representation for a binding - member localRep.ChooseAndAddRepresentation(cenv,env: TcEnv,isStatic,isCtorArg,ctorInfo:IncrClassCtorLhs,staticForcedFieldVars:FreeLocals,instanceForcedFieldVars: FreeLocals,bind:Binding) = + member localRep.ChooseAndAddRepresentation(cenv, env: TcEnv, isStatic, isCtorArg, ctorInfo:IncrClassCtorLhs, staticForcedFieldVars:FreeLocals, instanceForcedFieldVars: FreeLocals, bind:Binding) = let v = bind.Var - let repr,takenFieldNames = localRep.ChooseRepresentation (cenv,env,isStatic,isCtorArg,ctorInfo,staticForcedFieldVars,instanceForcedFieldVars,localRep.TakenFieldNames,bind ) + let repr, takenFieldNames = localRep.ChooseRepresentation (cenv, env, isStatic, isCtorArg, ctorInfo, staticForcedFieldVars, instanceForcedFieldVars, localRep.TakenFieldNames, bind ) // OK, representation chosen, now add it {localRep with TakenFieldNames=takenFieldNames @@ -12383,68 +12383,68 @@ module IncrClassChecking = member localRep.MakeValueLookup thisValOpt tinst safeStaticInitInfo v tyargs m = let g = localRep.RepInfoTcGlobals match localRep.LookupRepr v, thisValOpt with - | InVar _,_ -> + | InVar _, _ -> exprForVal m v - | InField(false, _idx, rfref),Some(thisVal) -> + | InField(false, _idx, rfref), Some(thisVal) -> let thise = exprForVal m thisVal - mkRecdFieldGetViaExprAddr(thise,rfref,tinst,m) - | InField(false, _idx, _rfref),None -> - error(InternalError("Unexpected missing 'this' variable in MakeValueLookup",m)) - | InField(true, idx, rfref),_ -> - let expr = mkStaticRecdFieldGet(rfref,tinst,m) + mkRecdFieldGetViaExprAddr(thise, rfref, tinst, m) + | InField(false, _idx, _rfref), None -> + error(InternalError("Unexpected missing 'this' variable in MakeValueLookup", m)) + | InField(true, idx, rfref), _ -> + let expr = mkStaticRecdFieldGet(rfref, tinst, m) MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr - | InMethod(isStatic,methodVal,topValInfo),_ -> + | InMethod(isStatic, methodVal, topValInfo), _ -> //dprintfn "Rewriting application of %s to be call to method %s" v.LogicalName methodVal.LogicalName - let expr,exprty = AdjustValForExpectedArity g m (mkLocalValRef methodVal) NormalValUse topValInfo + let expr, exprty = AdjustValForExpectedArity g m (mkLocalValRef methodVal) NormalValUse topValInfo // Prepend the the type arguments for the class let tyargs = tinst @ tyargs let thisArgs = if isStatic then [] else Option.toList (Option.map (exprForVal m) thisValOpt) - MakeApplicationAndBetaReduce g (expr,exprty,[tyargs],thisArgs,m) + MakeApplicationAndBetaReduce g (expr, exprty, [tyargs], thisArgs, m) /// Make the elaborated expression that represents an assignment /// to a "let mutable v = ..." class binding member localRep.MakeValueAssign thisValOpt tinst safeStaticInitInfo v expr m = let g = localRep.RepInfoTcGlobals match localRep.LookupRepr v, thisValOpt with - | InField(false,_,rfref),Some(thisVal) -> + | InField(false, _, rfref), Some(thisVal) -> let thise = exprForVal m thisVal - mkRecdFieldSetViaExprAddr(thise,rfref,tinst,expr,m) - | InField(false,_,_rfref),None -> - error(InternalError("Unexpected missing 'this' variable in MakeValueAssign",m)) - | InVar _,_ -> + mkRecdFieldSetViaExprAddr(thise, rfref, tinst, expr, m) + | InField(false, _, _rfref), None -> + error(InternalError("Unexpected missing 'this' variable in MakeValueAssign", m)) + | InVar _, _ -> mkValSet m (mkLocalValRef v) expr - | InField (true, idx, rfref),_ -> - let expr = mkStaticRecdFieldSet(rfref,tinst,expr,m) + | InField (true, idx, rfref), _ -> + let expr = mkStaticRecdFieldSet(rfref, tinst, expr, m) MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr - | InMethod _,_ -> - error(InternalError("Local was given method storage, yet later it's been assigned to",m)) + | InMethod _, _ -> + error(InternalError("Local was given method storage, yet later it's been assigned to", m)) member localRep.MakeValueGetAddress thisValOpt tinst safeStaticInitInfo v m = let g = localRep.RepInfoTcGlobals - match localRep.LookupRepr v,thisValOpt with - | InField(false, _, rfref),Some(thisVal) -> + match localRep.LookupRepr v, thisValOpt with + | InField(false, _, rfref), Some(thisVal) -> let thise = exprForVal m thisVal - mkRecdFieldGetAddrViaExprAddr(thise,rfref,tinst,m) - | InField(false, _, _rfref),None -> - error(InternalError("Unexpected missing 'this' variable in MakeValueGetAddress",m)) - | InField(true, idx, rfref),_ -> - let expr = mkStaticRecdFieldGetAddr(rfref,tinst,m) + mkRecdFieldGetAddrViaExprAddr(thise, rfref, tinst, m) + | InField(false, _, _rfref), None -> + error(InternalError("Unexpected missing 'this' variable in MakeValueGetAddress", m)) + | InField(true, idx, rfref), _ -> + let expr = mkStaticRecdFieldGetAddr(rfref, tinst, m) MakeCheckSafeInit g tinst safeStaticInitInfo (mkInt g m idx) expr - | InVar _,_ -> + | InVar _, _ -> mkValAddr m (mkLocalValRef v) - | InMethod _,_ -> - error(InternalError("Local was given method storage, yet later it's address was required",m)) + | InMethod _, _ -> + error(InternalError("Local was given method storage, yet later it's address was required", m)) /// Mutate a type definition by adding fields /// Used as part of processing "let" bindings in a type definition. member localRep.PublishIncrClassFields (cenv, denv, cpath, ctorInfo:IncrClassCtorLhs, safeStaticInitInfo) = let tcref = ctorInfo.TyconRef let rfspecs = - [ for KeyValue(v,repr) in localRep.ValReprs do + [ for KeyValue(v, repr) in localRep.ValReprs do match repr with | InField(isStatic, _, rfref) -> // Instance fields for structs are published earlier because the full set of fields is determined syntactically from the implicit @@ -12481,7 +12481,7 @@ module IncrClassChecking = //dprintfn "Fixup %s" (showL (exprL e)) match e with // Rewrite references to applied let-bound-functions-compiled-as-methods - | Expr.App(Expr.Val (ValDeref(v),_,_),_,tyargs,args,m) + | Expr.App(Expr.Val (ValDeref(v), _, _), _, tyargs, args, m) when (localRep.IsValWithRepresentation(v) && (match localRep.LookupRepr(v) with | InMethod _ -> true //(methodVal.Typars.Length > thisTyInst.Length) @@ -12491,24 +12491,24 @@ module IncrClassChecking = let g = localRep.RepInfoTcGlobals let expr = localRep.MakeValueLookup thisValOpt thisTyInst safeStaticInitInfo v tyargs m let args = args |> List.map rw - Some (MakeApplicationAndBetaReduce g (expr,(tyOfExpr g expr),[],args,m)) + Some (MakeApplicationAndBetaReduce g (expr, (tyOfExpr g expr), [], args, m)) // Rewrite references to values stored as fields and first class uses of method values - | Expr.Val (ValDeref(v),_,m) + | Expr.Val (ValDeref(v), _, m) when localRep.IsValWithRepresentation(v) -> //dprintfn "Found use of %s" v.LogicalName Some (localRep.MakeValueLookup thisValOpt thisTyInst safeStaticInitInfo v [] m) // Rewrite assignments to mutable values stored as fields - | Expr.Op(TOp.LValueOp (LSet, ValDeref(v)) ,[],[arg],m) + | Expr.Op(TOp.LValueOp (LSet, ValDeref(v)) , [], [arg], m) when localRep.IsValWithRepresentation(v) -> let arg = rw arg Some (localRep.MakeValueAssign thisValOpt thisTyInst safeStaticInitInfo v arg m) // Rewrite taking the address of mutable values stored as fields - | Expr.Op(TOp.LValueOp (LGetAddr,ValDeref(v)),[],[] ,m) + | Expr.Op(TOp.LValueOp (LGetAddr, ValDeref(v)), [], [] , m) when localRep.IsValWithRepresentation(v) -> Some (localRep.MakeValueGetAddress thisValOpt thisTyInst safeStaticInitInfo v m) @@ -12527,19 +12527,19 @@ module IncrClassChecking = /// Given a set of 'let' bindings (static or not, recursive or not) that make up a class, /// generate their initialization expression(s). let MakeCtorForIncrClassConstructionPhase2C - (cenv, - env: TcEnv, + (cenv, + env: TcEnv, /// The lhs information about the implicit constructor - ctorInfo:IncrClassCtorLhs, + ctorInfo:IncrClassCtorLhs, /// The call to the super class constructor - inheritsExpr, + inheritsExpr, /// Should we place a sequence point at the 'inheritedTys call? - inheritsIsVisible, + inheritsIsVisible, /// The declarations - decs : IncrClassConstructionBindingsPhase2C list, - memberBinds : Binding list, + decs : IncrClassConstructionBindingsPhase2C list, + memberBinds : Binding list, /// Record any unconstrained type parameters generalized for the outer members as "free choices" in the let bindings - generalizedTyparsForRecursiveBlock, + generalizedTyparsForRecursiveBlock, safeStaticInitInfo : SafeInitData) = @@ -12565,58 +12565,58 @@ module IncrClassChecking = accFreeInExpr acc bind.Expr let accFreeInBindings acc (binds:Binding list) = - (acc,binds) ||> List.fold accFreeInBinding + (acc, binds) ||> List.fold accFreeInBinding // Find all the variables used in any method. These become fields. // staticForcedFieldVars:FreeLocals: the vars forced to be fields due to static member bindings, instance initialization expressions or instance member bindings // instanceForcedFieldVars: FreeLocals: the vars forced to be fields due to instance member bindings - let staticForcedFieldVars,instanceForcedFieldVars = - let (staticForcedFieldVars,instanceForcedFieldVars) = - ((emptyFreeVars,emptyFreeVars),decs) ||> List.fold (fun (staticForcedFieldVars,instanceForcedFieldVars) dec -> + let staticForcedFieldVars, instanceForcedFieldVars = + let (staticForcedFieldVars, instanceForcedFieldVars) = + ((emptyFreeVars, emptyFreeVars), decs) ||> List.fold (fun (staticForcedFieldVars, instanceForcedFieldVars) dec -> match dec with | Phase2CCtorJustAfterLastLet | Phase2CCtorJustAfterSuperInit -> - (staticForcedFieldVars,instanceForcedFieldVars) + (staticForcedFieldVars, instanceForcedFieldVars) | Phase2CBindings decs -> - ((staticForcedFieldVars,instanceForcedFieldVars),decs) ||> List.fold (fun (staticForcedFieldVars,instanceForcedFieldVars) dec -> + ((staticForcedFieldVars, instanceForcedFieldVars), decs) ||> List.fold (fun (staticForcedFieldVars, instanceForcedFieldVars) dec -> match dec with - | IncrClassBindingGroup(binds,isStatic,_) -> + | IncrClassBindingGroup(binds, isStatic, _) -> let methodBinds = binds |> List.filter (IncrClassReprInfo.IsMethodRepr cenv) let staticForcedFieldVars = if isStatic then // Any references to static variables in any static method force the variable to be represented as a field - (staticForcedFieldVars,methodBinds) ||> accFreeInBindings + (staticForcedFieldVars, methodBinds) ||> accFreeInBindings else // Any references to static variables in any instance bindings force the variable to be represented as a field - (staticForcedFieldVars,binds) ||> accFreeInBindings + (staticForcedFieldVars, binds) ||> accFreeInBindings let instanceForcedFieldVars = // Any references to instance variables in any methods force the variable to be represented as a field - (instanceForcedFieldVars,methodBinds) ||> accFreeInBindings + (instanceForcedFieldVars, methodBinds) ||> accFreeInBindings - (staticForcedFieldVars,instanceForcedFieldVars) - | IncrClassDo (e,isStatic) -> + (staticForcedFieldVars, instanceForcedFieldVars) + | IncrClassDo (e, isStatic) -> let staticForcedFieldVars = if isStatic then staticForcedFieldVars else unionFreeVars staticForcedFieldVars (freeInExpr CollectLocalsNoCaching e) - (staticForcedFieldVars,instanceForcedFieldVars))) - let staticForcedFieldVars = (staticForcedFieldVars,memberBinds) ||> accFreeInBindings - let instanceForcedFieldVars = (instanceForcedFieldVars,memberBinds) ||> accFreeInBindings + (staticForcedFieldVars, instanceForcedFieldVars))) + let staticForcedFieldVars = (staticForcedFieldVars, memberBinds) ||> accFreeInBindings + let instanceForcedFieldVars = (instanceForcedFieldVars, memberBinds) ||> accFreeInBindings // Any references to static variables in the 'inherits' expression force those static variables to be represented as fields - let staticForcedFieldVars = (staticForcedFieldVars,inheritsExpr) ||> accFreeInExpr + let staticForcedFieldVars = (staticForcedFieldVars, inheritsExpr) ||> accFreeInExpr - (staticForcedFieldVars.FreeLocals,instanceForcedFieldVars.FreeLocals) + (staticForcedFieldVars.FreeLocals, instanceForcedFieldVars.FreeLocals) // Compute the implicit construction side effects of single // 'let' or 'let rec' binding in the implicit class construction sequence - let TransBind (reps:IncrClassReprInfo) (TBind(v,rhsExpr,spBind)) = + let TransBind (reps:IncrClassReprInfo) (TBind(v, rhsExpr, spBind)) = if v.MustInline then - error(Error(FSComp.SR.tcLocalClassBindingsCannotBeInline(),v.Range)) + error(Error(FSComp.SR.tcLocalClassBindingsCannotBeInline(), v.Range)) let rhsExpr = reps.FixupIncrClassExprPhase2C (Some thisVal) safeStaticInitInfo thisTyInst rhsExpr // The initialization of the 'ref cell' variable for 'this' is the only binding which comes prior to the super init @@ -12626,40 +12626,40 @@ module IncrClassChecking = | Some v2 -> valEq v v2 match reps.LookupRepr v with - | InMethod(isStatic,methodVal,_) -> - let _,chooseTps,tauExpr,tauTy,m = + | InMethod(isStatic, methodVal, _) -> + let _, chooseTps, tauExpr, tauTy, m = match rhsExpr with - | Expr.TyChoose(chooseTps,b,_) -> [],chooseTps,b,(tyOfExpr cenv.g b),m - | Expr.TyLambda (_,tps,Expr.TyChoose(chooseTps,b,_),m,returnTy) -> tps,chooseTps,b,returnTy,m - | Expr.TyLambda (_,tps,b,m,returnTy) -> tps,[],b,returnTy,m - | e -> [],[],e,(tyOfExpr cenv.g e),e.Range + | Expr.TyChoose(chooseTps, b, _) -> [], chooseTps, b, (tyOfExpr cenv.g b), m + | Expr.TyLambda (_, tps, Expr.TyChoose(chooseTps, b, _), m, returnTy) -> tps, chooseTps, b, returnTy, m + | Expr.TyLambda (_, tps, b, m, returnTy) -> tps, [], b, returnTy, m + | e -> [], [], e, (tyOfExpr cenv.g e), e.Range let chooseTps = chooseTps @ freeChoiceTypars // Add the 'this' variable as an argument - let tauExpr,tauTy = + let tauExpr, tauTy = if isStatic then - tauExpr,tauTy + tauExpr, tauTy else - let e = mkLambda m thisVal (tauExpr,tauTy) + let e = mkLambda m thisVal (tauExpr, tauTy) e, tyOfExpr cenv.g e // Replace the type parameters that used to be on the rhs with // the full set of type parameters including the type parameters of the enclosing class - let rhsExpr = mkTypeLambda m methodVal.Typars (mkTypeChoose m chooseTps tauExpr,tauTy) - (isPriorToSuperInit, (fun e -> e)), [TBind (methodVal,rhsExpr,spBind)] + let rhsExpr = mkTypeLambda m methodVal.Typars (mkTypeChoose m chooseTps tauExpr, tauTy) + (isPriorToSuperInit, (fun e -> e)), [TBind (methodVal, rhsExpr, spBind)] // If it's represented as a non-escaping local variable then just bind it to its value // If it's represented as a non-escaping local arg then no binding necessary (ctor args are already bound) | InVar isArg -> - (isPriorToSuperInit, (fun e -> if isArg then e else mkLetBind m (TBind(v,rhsExpr,spBind)) e)), [] + (isPriorToSuperInit, (fun e -> if isArg then e else mkLetBind m (TBind(v, rhsExpr, spBind)) e)), [] | InField (isStatic, idx, _) -> // Use spBind if it available as the span for the assignment into the field let m = - match spBind,rhsExpr with + match spBind, rhsExpr with // Don't generate big sequence points for functions in classes | _, (Expr.Lambda _ | Expr.TyLambda _) -> v.Range - | SequencePointAtBinding m,_ -> m + | SequencePointAtBinding m, _ -> m | _ -> v.Range let assignExpr = reps.MakeValueAssign (Some thisVal) thisTyInst NoSafeInitInfo v rhsExpr m let adjustSafeInitFieldExprOpt = @@ -12682,34 +12682,34 @@ module IncrClassChecking = /// binding in the implicit class construction sequence let TransTrueDec isCtorArg (reps:IncrClassReprInfo) dec = match dec with - | (IncrClassBindingGroup(binds,isStatic,isRec)) -> - let actions,reps,methodBinds = - let reps = (reps,binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv,env,isStatic,isCtorArg,ctorInfo,staticForcedFieldVars,instanceForcedFieldVars,bind)) // extend + | (IncrClassBindingGroup(binds, isStatic, isRec)) -> + let actions, reps, methodBinds = + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ChooseAndAddRepresentation(cenv, env, isStatic, isCtorArg, ctorInfo, staticForcedFieldVars, instanceForcedFieldVars, bind)) // extend if isRec then // Note: the recursive calls are made via members on the object // or via access to fields. This means the recursive loop is "broken", // and we can collapse to sequential bindings - let reps = (reps,binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope before - let actions,methodBinds = binds |> List.map (TransBind reps) |> List.unzip // since can occur in RHS of own defns - actions,reps,methodBinds + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope before + let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip // since can occur in RHS of own defns + actions, reps, methodBinds else - let actions,methodBinds = binds |> List.map (TransBind reps) |> List.unzip - let reps = (reps,binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope after - actions,reps,methodBinds + let actions, methodBinds = binds |> List.map (TransBind reps) |> List.unzip + let reps = (reps, binds) ||> List.fold (fun rep bind -> rep.ValNowWithRepresentation bind.Var) // inscope after + actions, reps, methodBinds let methodBinds = List.concat methodBinds if isStatic then - (actions,[],methodBinds),reps + (actions, [], methodBinds), reps else - ([],actions,methodBinds),reps + ([], actions, methodBinds), reps - | IncrClassDo (doExpr,isStatic) -> + | IncrClassDo (doExpr, isStatic) -> let doExpr = reps.FixupIncrClassExprPhase2C (Some(thisVal)) safeStaticInitInfo thisTyInst doExpr let binder = (fun e -> mkSequential SequencePointsAtSeq doExpr.Range doExpr e) let isPriorToSuperInit = false if isStatic then - ([(isPriorToSuperInit,binder)],[],[]),reps + ([(isPriorToSuperInit, binder)], [], []), reps else - ([],[(isPriorToSuperInit,binder)],[]),reps + ([], [(isPriorToSuperInit, binder)], []), reps /// Work out the implicit construction side effects of each declaration @@ -12726,9 +12726,9 @@ module IncrClassChecking = let setExpr = reps.FixupIncrClassExprPhase2C (Some(thisVal)) safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential SequencePointsAtSeq setExpr.Range setExpr e) let isPriorToSuperInit = false - yield (isPriorToSuperInit,binder) ] + yield (isPriorToSuperInit, binder) ] - ([],binders,[]),reps + ([], binders, []), reps // The last 'let' binding is done so we can set the initialization condition for the collection of object fields // which now allows members to be called. @@ -12740,11 +12740,11 @@ module IncrClassChecking = let setExpr = reps.FixupIncrClassExprPhase2C (Some(thisVal)) safeStaticInitInfo thisTyInst setExpr let binder = (fun e -> mkSequential SequencePointsAtSeq setExpr.Range setExpr e) let isPriorToSuperInit = false - yield (isPriorToSuperInit,binder) + yield (isPriorToSuperInit, binder) | NoSafeInitInfo -> () ] - ([],binders,[]),reps + ([], binders, []), reps | Phase2CBindings decs -> let initActions, reps = List.mapFold (TransTrueDec false) reps decs @@ -12766,17 +12766,17 @@ module IncrClassChecking = // for each constructor argument 'x', but with the special flag 'isCtorArg', which helps TransBind know that // the value is already available as an argument, and that nothing special needs to be done unless the // value is being stored into a field. - let (cctorInitActions1, ctorInitActions1,methodBinds1),reps = + let (cctorInitActions1, ctorInitActions1, methodBinds1), reps = let binds = ctorInfo.InstanceCtorArgs |> List.map (fun v -> mkInvisibleBind v (exprForVal v.Range v)) - TransTrueDec true reps (IncrClassBindingGroup(binds,false,false)) + TransTrueDec true reps (IncrClassBindingGroup(binds, false, false)) // We expect that only ctorInitActions1 will be non-empty here, and even then only if some elements are stored in the field assert (isNil cctorInitActions1) assert (isNil methodBinds1) // Now deal with all the 'let' and 'member' declarations - let initActions,reps = List.mapFold TransDec reps decs - let cctorInitActions2, ctorInitActions2,methodBinds2 = List.unzip3 initActions + let initActions, reps = List.mapFold TransDec reps decs + let cctorInitActions2, ctorInitActions2, methodBinds2 = List.unzip3 initActions let cctorInitActions = cctorInitActions1 @ List.concat cctorInitActions2 let ctorInitActions = ctorInitActions1 @ List.concat ctorInitActions2 let methodBinds = methodBinds1 @ List.concat methodBinds2 @@ -12787,15 +12787,15 @@ module IncrClassChecking = // // // return () - let ctorInitActionsPre,ctorInitActionsPost = ctorInitActions |> List.partition (fun (isPriorToSuperInit,_) -> isPriorToSuperInit) + let ctorInitActionsPre, ctorInitActionsPost = ctorInitActions |> List.partition (fun (isPriorToSuperInit, _) -> isPriorToSuperInit) // This is the return result let ctorBody = mkUnit cenv.g m // Add . - // That is, add any that come prior to the super init constructor call, + // That is, add any that come prior to the super init constructor call, // This is only ever at most the init of the InstanceCtorSafeThisValOpt and InstanceCtorSafeInitInfo var/field - let ctorBody = List.foldBack (fun (_,binder) acc -> binder acc) ctorInitActionsPost ctorBody + let ctorBody = List.foldBack (fun (_, binder) acc -> binder acc) ctorInitActionsPost ctorBody // Add the let ctorBody = @@ -12829,10 +12829,10 @@ module IncrClassChecking = mkSequential spAtSuperInit m inheritsExpr ctorBody // Add the normal - let ctorBody = List.foldBack (fun (_,binder) acc -> binder acc) ctorInitActionsPre ctorBody + let ctorBody = List.foldBack (fun (_, binder) acc -> binder acc) ctorInitActionsPre ctorBody // Add the final wrapping to make this into a method - let ctorBody = mkMemberLambdas m [] (Some(thisVal)) ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody,cenv.g.unit_ty) + let ctorBody = mkMemberLambdas m [] (Some(thisVal)) ctorInfo.InstanceCtorBaseValOpt [ctorInfo.InstanceCtorArgs] (ctorBody, cenv.g.unit_ty) ctorBody @@ -12841,15 +12841,15 @@ module IncrClassChecking = match cctorInitActions with | [] -> None | _ -> - let cctorInitAction = List.foldBack (fun (_,binder) acc -> binder acc) cctorInitActions (mkUnit cenv.g m) + let cctorInitAction = List.foldBack (fun (_, binder) acc -> binder acc) cctorInitActions (mkUnit cenv.g m) let m = thisVal.Range - let cctorArgs,cctorVal,_ = ctorInfo.StaticCtorValInfo.Force() + let cctorArgs, cctorVal, _ = ctorInfo.StaticCtorValInfo.Force() // Reconstitute the type of the implicit class constructor with the correct quantified type variables. cctorVal.SetType (tryMkForallTy ctorDeclaredTypars cctorVal.TauType) - let cctorBody = mkMemberLambdas m [] None None [cctorArgs] (cctorInitAction,cenv.g.unit_ty) + let cctorBody = mkMemberLambdas m [] None None [cctorArgs] (cctorInitAction, cenv.g.unit_ty) Some(cctorBody) - ctorBody,cctorBodyOpt,methodBinds,reps + ctorBody, cctorBodyOpt, methodBinds, reps @@ -12871,11 +12871,11 @@ module MutRecBindingChecking = | Phase2AIncrClassCtor of IncrClassCtorLhs /// An 'inherit' declaration in an incremental class /// - /// Phase2AInherit (typ,arg,baseValOpt,m) + /// Phase2AInherit (typ, arg, baseValOpt, m) | Phase2AInherit of SynType * SynExpr * Val option * range /// A set of value or function definitions in an incremental class /// - /// Phase2AIncrClassBindings (tcref,letBinds,isStatic,isRec,m) + /// Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m) | Phase2AIncrClassBindings of TyconRef * Ast.SynBinding list * bool * bool * range /// A 'member' definition in a class | Phase2AMember of PreCheckingRecursiveBinding @@ -12940,23 +12940,23 @@ module MutRecBindingChecking = // recBindIdx: index of the recursive binding // prelimRecValuesRev: accumulation of prelim value entries // uncheckedBindsRev: accumulation of unchecked bindings - let (defnsAs: MutRecDefnsPhase2AData), (tpenv,_,uncheckedBindsRev) = + let (defnsAs: MutRecDefnsPhase2AData), (tpenv, _, uncheckedBindsRev) = let initialOuterState = (tpenv, 0, ([]: PreCheckingRecursiveBinding list)) (initialOuterState, envMutRec, mutRecDefns) |||> MutRecShapes.mapFoldWithEnv (fun outerState envForDecls defn -> - let (tpenv,recBindIdx,uncheckedBindsRev) = outerState + let (tpenv, recBindIdx, uncheckedBindsRev) = outerState match defn with | MutRecShape.Module _ -> failwith "unreachable" | MutRecShape.Open x -> MutRecShape.Open x, outerState | MutRecShape.ModuleAbbrev x -> MutRecShape.ModuleAbbrev x, outerState | MutRecShape.Lets recBinds -> let normRecDefns = - [ for (RecDefnBindingInfo(a,b,c,bind)) in recBinds do - yield NormalizedRecBindingDefn(a,b,c,BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForDecls bind) ] - let bindsAndValues,(tpenv,recBindIdx) = ((tpenv,recBindIdx), normRecDefns) ||> List.mapFold (AnalyzeAndMakeAndPublishRecursiveValue ErrorOnOverrides false cenv envForDecls) + [ for (RecDefnBindingInfo(a, b, c, bind)) in recBinds do + yield NormalizedRecBindingDefn(a, b, c, BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForDecls bind) ] + let bindsAndValues, (tpenv, recBindIdx) = ((tpenv, recBindIdx), normRecDefns) ||> List.mapFold (AnalyzeAndMakeAndPublishRecursiveValue ErrorOnOverrides false cenv envForDecls) let binds = bindsAndValues |> List.collect fst let defnAs = MutRecShape.Lets binds - defnAs,(tpenv,recBindIdx,List.rev binds @ uncheckedBindsRev) + defnAs, (tpenv, recBindIdx, List.rev binds @ uncheckedBindsRev) | MutRecShape.Tycon (MutRecDefnsPhase2InfoForTycon(tyconOpt, tcref, declaredTyconTypars, declKind, binds, _)) -> @@ -12975,72 +12975,72 @@ module MutRecBindingChecking = AddLocalTyconRefs true cenv.g cenv.amap tcref.Range [tcref] innitalEnvForTycon // Make fresh version of the class type for type checking the members and lets * - let _,copyOfTyconTypars,_,objTy,thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars + let _, copyOfTyconTypars, _, objTy, thisTy = FreshenObjectArgType cenv tcref.Range TyparRigidity.WillBeRigid tcref isExtrinsic declaredTyconTypars // The basic iteration over the declarations in a single type definition - let initialInnerState = (None,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) - let defnAs,(_,_envForTycon,tpenv,recBindIdx,uncheckedBindsRev) = + let initialInnerState = (None, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + let defnAs, (_, _envForTycon, tpenv, recBindIdx, uncheckedBindsRev) = - (initialInnerState,binds) ||> List.collectFold (fun innerState defn -> + (initialInnerState, binds) ||> List.collectFold (fun innerState defn -> - let (TyconBindingDefn(containerInfo,newslotsOK,declKind,classMemberDef,m)) = defn - let (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) = innerState + let (TyconBindingDefn(containerInfo, newslotsOK, declKind, classMemberDef, m)) = defn + let (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) = innerState if tcref.IsTypeAbbrev then // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx - error(Error(FSComp.SR.tcTypeAbbreviationsMayNotHaveMembers(),(trimRangeToLine m))) + error(Error(FSComp.SR.tcTypeAbbreviationsMayNotHaveMembers(), (trimRangeToLine m))) - if tcref.IsEnumTycon && (declKind <> ExtrinsicExtensionBinding) then error(Error(FSComp.SR.tcEnumerationsMayNotHaveMembers(),(trimRangeToLine m))) // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx + if tcref.IsEnumTycon && (declKind <> ExtrinsicExtensionBinding) then error(Error(FSComp.SR.tcEnumerationsMayNotHaveMembers(), (trimRangeToLine m))) // ideally we'd have the 'm' of the type declaration stored here, to avoid needing to trim to line to approx match classMemberDef, containerInfo with - | SynMemberDefn.ImplicitCtor (vis,attrs,spats,thisIdOpt, m), ContainerInfo(_,Some(MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _))) -> + | SynMemberDefn.ImplicitCtor (vis, attrs, spats, thisIdOpt, m), ContainerInfo(_, Some(MemberOrValContainerInfo(tcref, _, baseValOpt, safeInitInfo, _))) -> if tcref.TypeOrMeasureKind = TyparKind.Measure then error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) // Phase2A: make incrClassCtorLhs - ctorv, thisVal etc, type depends on argty(s) - let incrClassCtorLhs = TcImplictCtorLhs_Phase2A(cenv,envForTycon,tpenv,tcref,vis,attrs,spats,thisIdOpt,baseValOpt,safeInitInfo,m,copyOfTyconTypars,objTy,thisTy) + let incrClassCtorLhs = TcImplictCtorLhs_Phase2A(cenv, envForTycon, tpenv, tcref, vis, attrs, spats, thisIdOpt, baseValOpt, safeInitInfo, m, copyOfTyconTypars, objTy, thisTy) // Phase2A: Add copyOfTyconTypars from incrClassCtorLhs - or from tcref let envForTycon = AddDeclaredTypars CheckForDuplicateTypars incrClassCtorLhs.InstanceCtorDeclaredTypars envForTycon let innerState = (Some incrClassCtorLhs, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) - [Phase2AIncrClassCtor incrClassCtorLhs],innerState + [Phase2AIncrClassCtor incrClassCtorLhs], innerState - | SynMemberDefn.ImplicitInherit (typ,arg,_baseIdOpt,m),_ -> + | SynMemberDefn.ImplicitInherit (typ, arg, _baseIdOpt, m), _ -> if tcref.TypeOrMeasureKind = TyparKind.Measure then error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) // Phase2A: inherit typ(arg) as base - pass through // Phase2A: pick up baseValOpt! let baseValOpt = incrClassCtorLhsOpt |> Option.bind (fun x -> x.InstanceCtorBaseValOpt) - let innerState = (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) - [Phase2AInherit (typ,arg,baseValOpt,m); Phase2AIncrClassCtorJustAfterSuperInit], innerState + let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + [Phase2AInherit (typ, arg, baseValOpt, m); Phase2AIncrClassCtorJustAfterSuperInit], innerState - | SynMemberDefn.LetBindings (letBinds,isStatic,isRec,m),_ -> - match tcref.TypeOrMeasureKind,isStatic with - | TyparKind.Measure,false -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) + | SynMemberDefn.LetBindings (letBinds, isStatic, isRec, m), _ -> + match tcref.TypeOrMeasureKind, isStatic with + | TyparKind.Measure, false -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembers(), m)) | _ -> () if not isStatic && tcref.IsStructOrEnumTycon then - let allDo = letBinds |> List.forall (function (Binding(_,DoBinding,_,_,_,_,_,_,_,_,_,_)) -> true | _ -> false) + let allDo = letBinds |> List.forall (function (Binding(_, DoBinding, _, _, _, _, _, _, _, _, _, _)) -> true | _ -> false) // Code for potential future design change to allow functions-compiled-as-members in structs if allDo then - errorR(Deprecated(FSComp.SR.tcStructsMayNotContainDoBindings(),(trimRangeToLine m))) + errorR(Deprecated(FSComp.SR.tcStructsMayNotContainDoBindings(), (trimRangeToLine m))) else // Code for potential future design change to allow functions-compiled-as-members in structs - errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(),(trimRangeToLine m))) + errorR(Error(FSComp.SR.tcStructsMayNotContainLetBindings(), (trimRangeToLine m))) if isStatic && Option.isNone incrClassCtorLhsOpt then - errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(),m)) + errorR(Error(FSComp.SR.tcStaticLetBindingsRequireClassesWithImplicitConstructors(), m)) // Phase2A: let-bindings - pass through - let innerState = (incrClassCtorLhsOpt,envForTycon,tpenv,recBindIdx,uncheckedBindsRev) - [Phase2AIncrClassBindings (tcref,letBinds,isStatic,isRec,m)], innerState + let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, uncheckedBindsRev) + [Phase2AIncrClassBindings (tcref, letBinds, isStatic, isRec, m)], innerState - | SynMemberDefn.Member (bind,m),_ -> + | SynMemberDefn.Member (bind, m), _ -> // Phase2A: member binding - create prelim valspec (for recursive reference) and RecursiveBindingInfo - let (NormalizedBinding(_,_,_,_,_,_,_,valSynData,_,_,_,_)) as bind = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForTycon bind - let (SynValData(memberFlagsOpt,_,_)) = valSynData + let (NormalizedBinding(_, _, _, _, _, _, _, valSynData, _, _, _, _)) as bind = BindingNormalization.NormalizeBinding ValOrMemberBinding cenv envForTycon bind + let (SynValData(memberFlagsOpt, _, _)) = valSynData match tcref.TypeOrMeasureKind with | TyparKind.Type -> () | TyparKind.Measure -> @@ -13051,22 +13051,22 @@ module MutRecBindingChecking = match memberFlags.MemberKind with | MemberKind.Constructor -> error(Error(FSComp.SR.tcMeasureDeclarationsRequireStaticMembersNotConstructors(), m)) | _ -> () - let rbind = NormalizedRecBindingDefn(containerInfo,newslotsOK,declKind,bind) + let rbind = NormalizedRecBindingDefn(containerInfo, newslotsOK, declKind, bind) let overridesOK = DeclKind.CanOverrideOrImplement(declKind) - let (binds,_values),(tpenv,recBindIdx) = AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv envForTycon (tpenv,recBindIdx) rbind + let (binds, _values), (tpenv, recBindIdx) = AnalyzeAndMakeAndPublishRecursiveValue overridesOK false cenv envForTycon (tpenv, recBindIdx) rbind let cbinds = [ for rbind in binds -> Phase2AMember rbind ] let innerState = (incrClassCtorLhsOpt, envForTycon, tpenv, recBindIdx, List.rev binds @ uncheckedBindsRev) - cbinds,innerState + cbinds, innerState #if OPEN_IN_TYPE_DECLARATIONS - | SynMemberDefn.Open (mp,m),_ -> - let innerState = (incrClassCtorLhsOpt,env,tpenv,recBindIdx,prelimRecValuesRev,uncheckedBindsRev) - [ Phase2AOpen (mp,m) ], innerState + | SynMemberDefn.Open (mp, m), _ -> + let innerState = (incrClassCtorLhsOpt, env, tpenv, recBindIdx, prelimRecValuesRev, uncheckedBindsRev) + [ Phase2AOpen (mp, m) ], innerState #endif | definition -> - error(InternalError(sprintf "Unexpected definition %A" definition,m))) + error(InternalError(sprintf "Unexpected definition %A" definition, m))) // If no constructor call, insert Phase2AIncrClassCtorJustAfterSuperInit at start let defnAs = @@ -13085,7 +13085,7 @@ module MutRecBindingChecking = | Phase2AOpen _ #endif | Phase2AIncrClassCtor _ | Phase2AInherit _ | Phase2AIncrClassCtorJustAfterSuperInit -> false - | Phase2AIncrClassBindings (_,binds,_,_,_) -> binds |> List.exists (function (Binding (_,DoBinding,_,_,_,_,_,_,_,_,_,_)) -> true | _ -> false) + | Phase2AIncrClassBindings (_, binds, _, _, _) -> binds |> List.exists (function (Binding (_, DoBinding, _, _, _, _, _, _, _, _, _, _)) -> true | _ -> false) | Phase2AIncrClassCtorJustAfterLastLet | Phase2AMember _ -> true let restRev = List.rev rest @@ -13101,8 +13101,8 @@ module MutRecBindingChecking = | rest -> rest let prelimRecValues = [ for x in defnAs do match x with Phase2AMember bind -> yield bind.RecBindingInfo.Val | _ -> () ] - let defnAs = MutRecShape.Tycon(TyconBindingsPhase2A(tyconOpt,declKind,prelimRecValues,tcref,copyOfTyconTypars,thisTy,defnAs)) - defnAs,(tpenv,recBindIdx,uncheckedBindsRev)) + let defnAs = MutRecShape.Tycon(TyconBindingsPhase2A(tyconOpt, declKind, prelimRecValues, tcref, copyOfTyconTypars, thisTy, defnAs)) + defnAs, (tpenv, recBindIdx, uncheckedBindsRev)) let uncheckedRecBinds = List.rev uncheckedBindsRev @@ -13133,11 +13133,11 @@ module MutRecBindingChecking = // The envForTycon is the environment used for name resolution within the let and member bindings // of the type definition. This becomes 'envStatic' and 'envInstance' for the two - let initialOuterState = (tpenv,([]: PostGeneralizationRecursiveBinding list),([]: PreGeneralizationRecursiveBinding list),uncheckedRecBindsTable,envInitial) + let initialOuterState = (tpenv, ([]: PostGeneralizationRecursiveBinding list), ([]: PreGeneralizationRecursiveBinding list), uncheckedRecBindsTable, envInitial) - (initialOuterState,envMutRec,defnsAs) |||> MutRecShapes.mapFoldWithEnv (fun outerState envForDecls defnsA -> + (initialOuterState, envMutRec, defnsAs) |||> MutRecShapes.mapFoldWithEnv (fun outerState envForDecls defnsA -> - let (tpenv,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable,envNonRec) = outerState + let (tpenv, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable, envNonRec) = outerState match defnsA with | MutRecShape.Module _ -> failwith "unreachable" @@ -13145,14 +13145,14 @@ module MutRecBindingChecking = | MutRecShape.ModuleAbbrev x -> MutRecShape.ModuleAbbrev x, outerState | MutRecShape.Lets binds -> - let defnBs,(tpenv,_,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) = + let defnBs, (tpenv, _, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = - let initialInnerState = (tpenv,envForDecls,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) - (initialInnerState,binds) ||> List.mapFold (fun innerState rbind -> + let initialInnerState = (tpenv, envForDecls, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) + (initialInnerState, binds) ||> List.mapFold (fun innerState rbind -> - let (tpenv,envStatic,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) = innerState + let (tpenv, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = innerState - let (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, _, uncheckedRecBindsTable) = TcLetrecBinding (cenv,envStatic,scopem,[],None) (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, tpenv, uncheckedRecBindsTable) rbind + let (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, _, uncheckedRecBindsTable) = TcLetrecBinding (cenv, envStatic, scopem, [], None) (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, tpenv, uncheckedRecBindsTable) rbind let innerState = (tpenv, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) rbind.RecBindingInfo.Index, innerState) @@ -13179,12 +13179,12 @@ module MutRecBindingChecking = // generalizedRecBinds: part of the incremental generalization state // preGeneralizationRecBinds: part of the incremental generalization state // uncheckedRecBindsTable: part of the incremental generalization state - let defnBs,(tpenv,_,_,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) = + let defnBs, (tpenv, _, _, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = - let initialInnerState = (tpenv,envForTycon,envForTycon,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) - (initialInnerState,defnAs) ||> List.mapFold (fun innerState defnA -> + let initialInnerState = (tpenv, envForTycon, envForTycon, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) + (initialInnerState, defnAs) ||> List.mapFold (fun innerState defnA -> - let (tpenv,envInstance,envStatic,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) = innerState + let (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) = innerState match defnA with // Phase2B for the definition of an implicit constructor. Enrich the instance environments @@ -13199,62 +13199,62 @@ module MutRecBindingChecking = let envNonRec = List.foldBack AddLocalValPrimitive incrClassCtorLhs.InstanceCtorArgs envNonRec let safeThisValBindOpt = TcLetrecComputeCtorSafeThisValBind cenv incrClassCtorLhs.InstanceCtorSafeThisValOpt - let innerState = (tpenv,envInstance,envStatic,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) + let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt), innerState // Phase2B: typecheck the argument to an 'inherits' call and build the new object expr for the inherit-call - | Phase2AInherit (synBaseTy,arg,baseValOpt,m) -> - let baseTy,tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use envInstance tpenv synBaseTy - let inheritsExpr,tpenv = TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg m + | Phase2AInherit (synBaseTy, arg, baseValOpt, m) -> + let baseTy, tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Use envInstance tpenv synBaseTy + let inheritsExpr, tpenv = TcNewExpr cenv envInstance tpenv baseTy (Some synBaseTy.Range) true arg m let envInstance = match baseValOpt with Some baseVal -> AddLocalVal cenv.tcSink scopem baseVal envInstance | None -> envInstance let envNonRec = match baseValOpt with Some baseVal -> AddLocalVal cenv.tcSink scopem baseVal envNonRec | None -> envNonRec - let innerState = (tpenv,envInstance,envStatic,envNonRec,generalizedRecBinds,preGeneralizationRecBinds,uncheckedRecBindsTable) - Phase2BInherit (inheritsExpr,baseValOpt), innerState + let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) + Phase2BInherit (inheritsExpr, baseValOpt), innerState // Phase2B: let and let rec value and function definitions - | Phase2AIncrClassBindings (tcref,binds,isStatic,isRec,bindsm) -> + | Phase2AIncrClassBindings (tcref, binds, isStatic, isRec, bindsm) -> let envForBinding = if isStatic then envStatic else envInstance - let binds,bindRs,env,tpenv = + let binds, bindRs, env, tpenv = if isRec then // Type check local recursive binding - let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(ExprContainerInfo,NoNewSlots,ClassLetBinding(isStatic),bind)) - let binds,env,tpenv = TcLetrec ErrorOnOverrides cenv envForBinding tpenv (binds,scopem(*bindsm*),scopem) - let bindRs = [IncrClassBindingGroup(binds,isStatic,true)] - binds,bindRs,env,tpenv + let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(ExprContainerInfo, NoNewSlots, ClassLetBinding(isStatic), bind)) + let binds, env, tpenv = TcLetrec ErrorOnOverrides cenv envForBinding tpenv (binds, scopem(*bindsm*), scopem) + let bindRs = [IncrClassBindingGroup(binds, isStatic, true)] + binds, bindRs, env, tpenv else // Type check local binding - let binds,env,tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding(isStatic)) tpenv (binds,bindsm,scopem) - let binds,bindRs = + let binds, env, tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding(isStatic)) tpenv (binds, bindsm, scopem) + let binds, bindRs = binds |> List.map (function - | TMDefLet(bind,_) -> [bind],IncrClassBindingGroup([bind],isStatic,false) - | TMDefDo(e,_) -> [],IncrClassDo(e,isStatic) - | _ -> error(InternalError("unexpected definition kind",tcref.Range))) + | TMDefLet(bind, _) -> [bind], IncrClassBindingGroup([bind], isStatic, false) + | TMDefDo(e, _) -> [], IncrClassDo(e, isStatic) + | _ -> error(InternalError("unexpected definition kind", tcref.Range))) |> List.unzip - List.concat binds,bindRs,env,tpenv + List.concat binds, bindRs, env, tpenv - let envNonRec = (envNonRec,binds) ||> List.fold (fun acc bind -> AddLocalValPrimitive bind.Var acc) + let envNonRec = (envNonRec, binds) ||> List.fold (fun acc bind -> AddLocalValPrimitive bind.Var acc) // Check to see that local bindings and members don't have the same name and check some other adhoc conditions for bind in binds do if not isStatic && HasFSharpAttributeOpt cenv.g cenv.g.attrib_DllImportAttribute bind.Var.Attribs then - errorR(Error(FSComp.SR.tcDllImportNotAllowed(),bind.Var.Range)) + errorR(Error(FSComp.SR.tcDllImportNotAllowed(), bind.Var.Range)) let nm = bind.Var.DisplayName let ty = generalizedTyconRef tcref let ad = envNonRec.eAccessRights - match TryFindIntrinsicMethInfo cenv.infoReader bind.Var.Range ad nm ty, + match TryFindIntrinsicMethInfo cenv.infoReader bind.Var.Range ad nm ty, TryFindPropInfo cenv.infoReader bind.Var.Range ad nm ty with - | [],[] -> () - | _ -> errorR (Error(FSComp.SR.tcMemberAndLocalClassBindingHaveSameName(nm),bind.Var.Range)) + | [], [] -> () + | _ -> errorR (Error(FSComp.SR.tcMemberAndLocalClassBindingHaveSameName(nm), bind.Var.Range)) // Also add static entries to the envInstance if necessary - let envInstance = (if isStatic then (binds,envInstance) ||> List.foldBack (fun b e -> AddLocalVal cenv.tcSink scopem b.Var e) else env) + let envInstance = (if isStatic then (binds, envInstance) ||> List.foldBack (fun b e -> AddLocalVal cenv.tcSink scopem b.Var e) else env) let envStatic = (if isStatic then env else envStatic) let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - Phase2BIncrClassBindings bindRs,innerState + Phase2BIncrClassBindings bindRs, innerState | Phase2AIncrClassCtorJustAfterSuperInit -> let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) @@ -13266,11 +13266,11 @@ module MutRecBindingChecking = #if OPEN_IN_TYPE_DECLARATIONS - | Phase2AOpen(mp,m) -> + | Phase2AOpen(mp, m) -> let envInstance = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem envInstance mp let envStatic = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem envStatic mp let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) - Phase2BOpen,innerState + Phase2BOpen, innerState #endif @@ -13299,7 +13299,7 @@ module MutRecBindingChecking = // Type check the member and apply early generalization. // We ignore the tpenv returned by checking each member. Each member gets checked in a fresh, clean tpenv let (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, _, uncheckedRecBindsTable) = - TcLetrecBinding (cenv,envForBinding,scopem,extraGeneralizableTypars,reqdThisValTyOpt) (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, tpenv, uncheckedRecBindsTable) rbind + TcLetrecBinding (cenv, envForBinding, scopem, extraGeneralizableTypars, reqdThisValTyOpt) (envNonRec, generalizedRecBinds, preGeneralizationRecBinds, tpenv, uncheckedRecBindsTable) rbind let innerState = (tpenv, envInstance, envStatic, envNonRec, generalizedRecBinds, preGeneralizationRecBinds, uncheckedRecBindsTable) Phase2BMember rbind.RecBindingInfo.Index, innerState) @@ -13338,8 +13338,8 @@ module MutRecBindingChecking = AdjustRecType cenv incrClassCtorLhs.InstanceCtorVal valscheme Phase2CIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt) - | Phase2BInherit (inheritsExpr,basevOpt) -> - Phase2CInherit (inheritsExpr,basevOpt) + | Phase2BInherit (inheritsExpr, basevOpt) -> + Phase2CInherit (inheritsExpr, basevOpt) | Phase2BIncrClassBindings bindRs -> Phase2CIncrClassBindings bindRs @@ -13372,7 +13372,7 @@ module MutRecBindingChecking = let TcMutRecBindings_Phase2D_ExtractImplicitFieldAndMethodBindings cenv envMutRec tpenv (denv, generalizedTyparsForRecursiveBlock, defnsCs: MutRecDefnsPhase2CData) = // let (fixupValueExprBinds, methodBinds) = - (envMutRec, defnsCs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (TyconBindingsPhase2C(tyconOpt, tcref,defnCs)) -> + (envMutRec, defnsCs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (TyconBindingsPhase2C(tyconOpt, tcref, defnCs)) -> match defnCs with | Phase2CIncrClassCtor (incrClassCtorLhs, safeThisValBindOpt) :: defnCs -> @@ -13402,7 +13402,7 @@ module MutRecBindingChecking = defnCs |> List.exists (function | Phase2CIncrClassBindings groups -> groups |> List.exists (function - | IncrClassBindingGroup(binds,isStatic,_) -> + | IncrClassBindingGroup(binds, isStatic, _) -> isStatic && (binds |> List.exists (IncrClassReprInfo.IsMethodRepr cenv >> not)) | _ -> false) | _ -> false) @@ -13418,17 +13418,17 @@ module MutRecBindingChecking = let tcref = incrClassCtorLhs.TyconRef // Assumes inherit call immediately follows implicit ctor. Checked by CheckMembersForm - let inheritsExpr,inheritsIsVisible,_,defnCs = + let inheritsExpr, inheritsIsVisible, _, defnCs = match defnCs |> List.partition (function Phase2CInherit _ -> true | _ -> false) with - | [Phase2CInherit (inheritsExpr,baseValOpt)], defnCs -> - inheritsExpr,true,baseValOpt,defnCs + | [Phase2CInherit (inheritsExpr, baseValOpt)], defnCs -> + inheritsExpr, true, baseValOpt, defnCs | _ -> if tcref.IsStructOrEnumTycon then - mkUnit cenv.g tcref.Range, false,None, defnCs + mkUnit cenv.g tcref.Range, false, None, defnCs else - let inheritsExpr,_ = TcNewExpr cenv envForDecls tpenv cenv.g.obj_ty None true (SynExpr.Const(SynConst.Unit,tcref.Range)) tcref.Range - inheritsExpr,false,None,defnCs + let inheritsExpr, _ = TcNewExpr cenv envForDecls tpenv cenv.g.obj_ty None true (SynExpr.Const(SynConst.Unit, tcref.Range)) tcref.Range + inheritsExpr, false, None, defnCs let envForTycon = MakeInnerEnvForTyconRef cenv envForDecls tcref false @@ -13447,10 +13447,10 @@ module MutRecBindingChecking = let localDecs = match safeThisValBindOpt with | None -> localDecs - | Some bind -> Phase2CIncrClassBindings [IncrClassBindingGroup([bind],false,false)] :: localDecs + | Some bind -> Phase2CIncrClassBindings [IncrClassBindingGroup([bind], false, false)] :: localDecs // Carve out the initialization sequence and decide on the localRep - let ctorBodyLambdaExpr,cctorBodyLambdaExprOpt,methodBinds,localReps = + let ctorBodyLambdaExpr, cctorBodyLambdaExprOpt, methodBinds, localReps = let localDecs = [ for localDec in localDecs do @@ -13460,20 +13460,20 @@ module MutRecBindingChecking = | Phase2CIncrClassCtorJustAfterLastLet -> yield Phase2CCtorJustAfterLastLet | _ -> () ] let memberBinds = memberBindsWithFixups |> List.map (fun x -> x.Binding) - MakeCtorForIncrClassConstructionPhase2C(cenv,envForTycon,incrClassCtorLhs,inheritsExpr,inheritsIsVisible,localDecs,memberBinds,generalizedTyparsForRecursiveBlock,safeStaticInitInfo) + MakeCtorForIncrClassConstructionPhase2C(cenv, envForTycon, incrClassCtorLhs, inheritsExpr, inheritsIsVisible, localDecs, memberBinds, generalizedTyparsForRecursiveBlock, safeStaticInitInfo) - // Generate the (value,expr) pairs for the implicit + // Generate the (value, expr) pairs for the implicit // object constructor and implicit static initializer let ctorValueExprBindings = - [ (let ctorValueExprBinding = TBind(incrClassCtorLhs.InstanceCtorVal,ctorBodyLambdaExpr,NoSequencePointAtStickyBinding) + [ (let ctorValueExprBinding = TBind(incrClassCtorLhs.InstanceCtorVal, ctorBodyLambdaExpr, NoSequencePointAtStickyBinding) let rbind = { ValScheme = incrClassCtorLhs.InstanceCtorValScheme ; Binding = ctorValueExprBinding } FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind) ] @ ( match cctorBodyLambdaExprOpt with | None -> [] | Some(cctorBodyLambdaExpr) -> - [ (let _,cctorVal, cctorValScheme = incrClassCtorLhs.StaticCtorValInfo.Force() - let cctorValueExprBinding = TBind(cctorVal,cctorBodyLambdaExpr,NoSequencePointAtStickyBinding) + [ (let _, cctorVal, cctorValScheme = incrClassCtorLhs.StaticCtorValInfo.Force() + let cctorValueExprBinding = TBind(cctorVal, cctorBodyLambdaExpr, NoSequencePointAtStickyBinding) let rbind = { ValScheme = cctorValScheme; Binding = cctorValueExprBinding } FixupLetrecBind cenv envForDecls.DisplayEnv generalizedTyparsForRecursiveBlock rbind) ] ) @@ -13483,34 +13483,34 @@ module MutRecBindingChecking = // Fixup members let memberBindsWithFixups = memberBindsWithFixups |> List.map (fun pgrbind -> - let (TBind(v,x,spBind)) = pgrbind.Binding + let (TBind(v, x, spBind)) = pgrbind.Binding // Work out the 'this' variable and type instantiation for field fixups. // We use the instantiation from the instance member if any. Note: It is likely this is not strictly needed // since we unify the types of the 'this' variables with those of the ctor declared typars. - let thisValOpt = GetInstanceMemberThisVariable (v,x) + let thisValOpt = GetInstanceMemberThisVariable (v, x) // Members have at least as many type parameters as the enclosing class. Just grab the type variables for the type. let thisTyInst = List.map mkTyparTy (List.take (tcref.Typars(v.Range).Length) v.Typars) let x = localReps.FixupIncrClassExprPhase2C thisValOpt safeStaticInitInfo thisTyInst x - { pgrbind with Binding = TBind(v,x,spBind) } ) + { pgrbind with Binding = TBind(v, x, spBind) } ) tyconOpt, ctorValueExprBindings @ memberBindsWithFixups, methodBinds // Cover the case where this is not a class with an implicit constructor | defnCs -> let memberBindsWithFixups = defnCs |> List.choose (function Phase2CMember pgrbind -> Some pgrbind | _ -> None) - tyconOpt, memberBindsWithFixups,[]) + tyconOpt, memberBindsWithFixups, []) /// Check a "module X = A.B.C" module abbreviation declaration - let TcModuleAbbrevDecl (cenv:cenv) scopem env (id,p,m) = + let TcModuleAbbrevDecl (cenv:cenv) scopem env (id, p, m) = let ad = env.eAccessRights let mvvs = ForceRaise (ResolveLongIndentAsModuleOrNamespace ResultCollectionSettings.AllResults cenv.amap m OpenQualified env.eNameResEnv ad p) let modrefs = mvvs |> List.map p23 if modrefs.Length > 0 && modrefs |> List.forall (fun modref -> modref.IsNamespace) then - errorR(Error(FSComp.SR.tcModuleAbbreviationForNamespace(fullDisplayTextOfModRef (List.head modrefs)),m)) + errorR(Error(FSComp.SR.tcModuleAbbreviationForNamespace(fullDisplayTextOfModRef (List.head modrefs)), m)) let modrefs = modrefs |> List.filter (fun mvv -> not mvv.IsNamespace) modrefs |> List.iter (fun modref -> CheckEntityAttributes cenv.g modref m |> CommitOperationResult) let env = (if modrefs.Length > 0 then AddModuleAbbreviationAndReport cenv.tcSink scopem id modrefs env else env) @@ -13539,9 +13539,9 @@ module MutRecBindingChecking = // Collect the type definitions, exception definitions, modules and "open" declarations let tycons = decls |> List.choose (function MutRecShape.Tycon d -> getTyconOpt d | _ -> None) - let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec),_) -> Some mspec | _ -> None) - let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id,mp,m)) -> Some (id,mp,m) | _ -> None) - let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (mp,m)) -> Some (mp,m) | _ -> None) + let mspecs = decls |> List.choose (function MutRecShape.Module (MutRecDefnsPhase2DataForModule (_, mspec), _) -> Some mspec | _ -> None) + let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) + let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (mp, m)) -> Some (mp, m) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) let exns = tycons |> List.filter (fun (tycon:Tycon) -> tycon.IsExceptionDecl) @@ -13567,7 +13567,7 @@ module MutRecBindingChecking = // Add the modules being defined let envForDecls = (envForDecls, mspecs) ||> List.fold ((if report then AddLocalSubModuleAndReport cenv.tcSink scopem else AddLocalSubModule) cenv.g cenv.amap m) // Process the 'open' declarations - let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp,m) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp) + let envForDecls = (envForDecls, opens) ||> List.fold (fun env (mp, m) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp) // Add the type definitions being defined let envForDecls = (if report then AddLocalTyconsAndReport cenv.tcSink scopem else AddLocalTycons) cenv.g cenv.amap m tycons envForDecls // Add the exception definitions being defined @@ -13601,14 +13601,14 @@ module MutRecBindingChecking = let envMutRec, defnsAs = (envInitial, MutRecShapes.dropEnvs defnsAs) ||> TcMutRecDefns_ComputeEnvs - (fun (TyconBindingsPhase2A(tyconOpt,_,_,_,_,_,_)) -> tyconOpt) + (fun (TyconBindingsPhase2A(tyconOpt, _, _, _, _, _, _)) -> tyconOpt) (fun binds -> [ for bind in binds -> bind.RecBindingInfo.Val ]) cenv false scopem scopem ||> MutRecShapes.extendEnvs (fun envForDecls decls -> let prelimRecValues = decls |> List.collect (function - | MutRecShape.Tycon (TyconBindingsPhase2A(_,_,prelimRecValues,_,_,_,_)) -> prelimRecValues + | MutRecShape.Tycon (TyconBindingsPhase2A(_, _, prelimRecValues, _, _, _, _)) -> prelimRecValues | MutRecShape.Lets binds -> [ for bind in binds -> bind.RecBindingInfo.Val ] | _ -> []) @@ -13651,7 +13651,7 @@ module MutRecBindingChecking = for extraTypar in allExtraGeneralizableTypars do if Zset.memberOf freeInInitialEnv extraTypar then let ty = mkTyparTy extraTypar - error(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty),extraTypar.Range)) + error(Error(FSComp.SR.tcNotSufficientlyGenericBecauseOfScope(NicePrint.prettyStringOfTy denv ty), extraTypar.Range)) // Solve any type variables in any part of the overall type signature of the class whose // constraints involve generalized type variables. @@ -13706,12 +13706,12 @@ module MutRecBindingChecking = let defnsEs = EliminateInitializationGraphs p23 - (fun morpher (tyconOpt,fixupValueExprBinds,methodBinds) -> (tyconOpt, morpher fixupValueExprBinds @ methodBinds)) + (fun morpher (tyconOpt, fixupValueExprBinds, methodBinds) -> (tyconOpt, morpher fixupValueExprBinds @ methodBinds)) id (fun morpher oldBinds -> morpher oldBinds) g true denv defnsDs bindsm - defnsEs,envMutRec + defnsEs, envMutRec /// Check and generalize the interface implementations, members, 'let' definitions in a mutually recursive group of definitions. let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: TcEnv) (mutRecDefns: MutRecDefnsPhase2Data) = @@ -13719,46 +13719,46 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, declaredTyconTypars, members, _, _, _)) = tyconMembersData let overridesOK = DeclKind.CanOverrideOrImplement(declKind) members |> List.collect (function - | SynMemberDefn.Interface(ity,defnOpt,_) -> - let _,typ = if tcref.Deref.IsExceptionDecl then [],cenv.g.exn_ty else generalizeTyconRef tcref + | SynMemberDefn.Interface(ity, defnOpt, _) -> + let _, typ = if tcref.Deref.IsExceptionDecl then [], cenv.g.exn_ty else generalizeTyconRef tcref let m = ity.Range - if tcref.IsTypeAbbrev then error(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveInterfaceDeclaration(),m)) - if tcref.IsEnumTycon then error(Error(FSComp.SR.tcEnumerationsCannotHaveInterfaceDeclaration(),m)) + if tcref.IsTypeAbbrev then error(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveInterfaceDeclaration(), m)) + if tcref.IsEnumTycon then error(Error(FSComp.SR.tcEnumerationsCannotHaveInterfaceDeclaration(), m)) let ity' = let envinner = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForTycon TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner emptyUnscopedTyparEnv ity |> fst - if not (isInterfaceTy cenv.g ity') then errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType0(),ity.Range)) + if not (isInterfaceTy cenv.g ity') then errorR(Error(FSComp.SR.tcTypeIsNotInterfaceType0(), ity.Range)) if not (tcref.HasInterface cenv.g ity') then - error(Error(FSComp.SR.tcAllImplementedInterfacesShouldBeDeclared(),ity.Range)) + error(Error(FSComp.SR.tcAllImplementedInterfacesShouldBeDeclared(), ity.Range)) if (typeEquiv cenv.g ity' cenv.g.mk_IComparable_ty && Option.isSome tcref.GeneratedCompareToValues) || (typeEquiv cenv.g ity' cenv.g.mk_IStructuralComparable_ty && Option.isSome tcref.GeneratedCompareToWithComparerValues) || (typeEquiv cenv.g ity' ((mkAppTy cenv.g.system_GenericIComparable_tcref [typ])) && Option.isSome tcref.GeneratedCompareToValues) || (typeEquiv cenv.g ity' ((mkAppTy cenv.g.system_GenericIEquatable_tcref [typ])) && Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues) || (typeEquiv cenv.g ity' cenv.g.mk_IStructuralEquatable_ty && Option.isSome tcref.GeneratedHashAndEqualsWithComparerValues) then - errorR(Error(FSComp.SR.tcDefaultImplementationForInterfaceHasAlreadyBeenAdded(),ity.Range)) + errorR(Error(FSComp.SR.tcDefaultImplementationForInterfaceHasAlreadyBeenAdded(), ity.Range)) if overridesOK = WarnOnOverrides then warning(IntfImplInIntrinsicAugmentation(ity.Range)) if overridesOK = ErrorOnOverrides then errorR(IntfImplInExtrinsicAugmentation(ity.Range)) match defnOpt with - | Some(defn) -> [ (ity',defn,m) ] + | Some(defn) -> [ (ity', defn, m) ] | _-> [] | _ -> []) - let interfaceMembersFromTypeDefn tyconMembersData (ity',defn,_) implTySet = + let interfaceMembersFromTypeDefn tyconMembersData (ity', defn, _) implTySet = let (MutRecDefnsPhase2DataForTycon(_, parent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, _, _, newslotsOK, _)) = tyconMembersData - let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, Some(ity',implTySet), baseValOpt, safeInitInfo, declaredTyconTypars))) + let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, Some(ity', implTySet), baseValOpt, safeInitInfo, declaredTyconTypars))) defn |> List.choose (fun mem -> match mem with - | SynMemberDefn.Member(_,m) -> Some(TyconBindingDefn(containerInfo,newslotsOK,declKind,mem,m)) - | SynMemberDefn.AutoProperty(_,_,_,_,_,_,_,_,_,_,m) -> Some(TyconBindingDefn(containerInfo,newslotsOK,declKind,mem,m)) - | _ -> errorR(Error(FSComp.SR.tcMemberNotPermittedInInterfaceImplementation(),mem.Range)); None) + | SynMemberDefn.Member(_, m) -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, mem, m)) + | SynMemberDefn.AutoProperty(_, _, _, _, _, _, _, _, _, _, m) -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, mem, m)) + | _ -> errorR(Error(FSComp.SR.tcMemberNotPermittedInInterfaceImplementation(), mem.Range)); None) let tyconBindingsOfTypeDefn (MutRecDefnsPhase2DataForTycon(_, parent, declKind, tcref, baseValOpt, safeInitInfo, declaredTyconTypars, members, _, newslotsOK, _)) = - let containerInfo = ContainerInfo(parent,Some(MemberOrValContainerInfo(tcref, None, baseValOpt, safeInitInfo, declaredTyconTypars))) + let containerInfo = ContainerInfo(parent, Some(MemberOrValContainerInfo(tcref, None, baseValOpt, safeInitInfo, declaredTyconTypars))) members |> List.choose (fun memb -> match memb with @@ -13768,7 +13768,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: | SynMemberDefn.AutoProperty _ | SynMemberDefn.Member _ | SynMemberDefn.Open _ - -> Some(TyconBindingDefn(containerInfo,newslotsOK,declKind,memb,memb.Range)) + -> Some(TyconBindingDefn(containerInfo, newslotsOK, declKind, memb, memb.Range)) // Interfaces exist in the member list - handled above in interfaceMembersFromTypeDefn | SynMemberDefn.Interface _ -> None @@ -13776,8 +13776,8 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: // The following should have been List.unzip out already in SplitTyconDefn | SynMemberDefn.AbstractSlot _ | SynMemberDefn.ValField _ - | SynMemberDefn.Inherit _ -> error(InternalError("Unexpected declaration element",memb.Range)) - | SynMemberDefn.NestedType _ -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(),memb.Range))) + | SynMemberDefn.Inherit _ -> error(InternalError("Unexpected declaration element", memb.Range)) + | SynMemberDefn.NestedType _ -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), memb.Range))) let tpenv = emptyUnscopedTyparEnv @@ -13787,7 +13787,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, _, members, m, newslotsOK, _)) = tyconData let tcaug = tcref.TypeContents if tcaug.tcaug_closed && declKind <> ExtrinsicExtensionBinding then - error(InternalError("Intrinsic augmentations of types are only permitted in the same file as the definition of the type",m)) + error(InternalError("Intrinsic augmentations of types are only permitted in the same file as the definition of the type", m)) members |> List.iter (fun mem -> match mem with | SynMemberDefn.Member _ -> () @@ -13798,7 +13798,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: | SynMemberDefn.ImplicitCtor _ // accept implicit ctor pattern, should be first! | SynMemberDefn.ImplicitInherit _ when newslotsOK = NewSlotsOK -> () // accept implicit ctor pattern, should be first! // The rest should have been removed by splitting, they belong to "core" (they are "shape" of type, not implementation) - | _ -> error(Error(FSComp.SR.tcDeclarationElementNotPermittedInAugmentation(),mem.Range)))) + | _ -> error(Error(FSComp.SR.tcDeclarationElementNotPermittedInAugmentation(), mem.Range)))) let binds : MutRecDefnsPhase2Info = @@ -13807,7 +13807,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: let obinds = tyconBindingsOfTypeDefn tyconData let ibinds = let intfTypes = interfacesFromTypeDefn envForDecls tyconData - let slotImplSets = DispatchSlotChecking.GetSlotImplSets cenv.infoReader envForDecls.DisplayEnv false (List.map (fun (ity,_,m) -> (ity,m)) intfTypes) + let slotImplSets = DispatchSlotChecking.GetSlotImplSets cenv.infoReader envForDecls.DisplayEnv false (List.map (fun (ity, _, m) -> (ity, m)) intfTypes) (intfTypes, slotImplSets) ||> List.map2 (interfaceMembersFromTypeDefn tyconData) |> List.concat MutRecDefnsPhase2InfoForTycon(tyconOpt, tcref, declaredTyconTypars, declKind, obinds @ ibinds, fixupFinalAttrs)) @@ -13821,7 +13821,7 @@ let TcMutRecDefns_Phase2 cenv envInitial bindsm scopem mutRecNSInfo (envMutRec: module AddAugmentationDeclarations = let tcaugHasNominalInterface g (tcaug: TyconAugmentation) tcref = - tcaug.tcaug_interfaces |> List.exists (fun (x,_,_) -> + tcaug.tcaug_interfaces |> List.exists (fun (x, _, _) -> match tryDestAppTy g x with | Some tcref2 when tyconRefEq g tcref2 tcref -> true | _ -> false) @@ -13830,7 +13830,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && scSet.Contains tycon.Stamp then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let _,typ = if tcref.Deref.IsExceptionDecl then [],cenv.g.exn_ty else generalizeTyconRef tcref + let _, typ = if tcref.Deref.IsExceptionDecl then [], cenv.g.exn_ty else generalizeTyconRef tcref let m = tycon.Range let genericIComparableTy = mkAppTy cenv.g.system_GenericIComparable_tcref [typ] @@ -13840,15 +13840,15 @@ module AddAugmentationDeclarations = let hasExplicitIStructuralComparable = tycon.HasInterface cenv.g cenv.g.mk_IStructuralComparable_ty if hasExplicitIComparable then - errorR(Error(FSComp.SR.tcImplementsIComparableExplicitly(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.tcImplementsIComparableExplicitly(tycon.DisplayName), m)) elif hasExplicitGenericIComparable then - errorR(Error(FSComp.SR.tcImplementsGenericIComparableExplicitly(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.tcImplementsGenericIComparableExplicitly(tycon.DisplayName), m)) elif hasExplicitIStructuralComparable then - errorR(Error(FSComp.SR.tcImplementsIStructuralComparableExplicitly(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.tcImplementsIStructuralComparableExplicitly(tycon.DisplayName), m)) else let hasExplicitGenericIComparable = tycon.HasInterface cenv.g genericIComparableTy - let cvspec1,cvspec2 = AugmentWithHashCompare.MakeValsForCompareAugmentation cenv.g tcref + let cvspec1, cvspec2 = AugmentWithHashCompare.MakeValsForCompareAugmentation cenv.g tcref let cvspec3 = AugmentWithHashCompare.MakeValsForCompareWithComparerAugmentation cenv.g tcref PublishInterface cenv env.DisplayEnv tcref m true cenv.g.mk_IStructuralComparable_ty @@ -13872,9 +13872,9 @@ module AddAugmentationDeclarations = let hasExplicitIStructuralEquatable = tycon.HasInterface cenv.g cenv.g.mk_IStructuralEquatable_ty if hasExplicitIStructuralEquatable then - errorR(Error(FSComp.SR.tcImplementsIStructuralEquatableExplicitly(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.tcImplementsIStructuralEquatableExplicitly(tycon.DisplayName), m)) else - let evspec1,evspec2,evspec3 = AugmentWithHashCompare.MakeValsForEqualityWithComparerAugmentation cenv.g tcref + let evspec1, evspec2, evspec3 = AugmentWithHashCompare.MakeValsForEqualityWithComparerAugmentation cenv.g tcref PublishInterface cenv env.DisplayEnv tcref m true cenv.g.mk_IStructuralEquatable_ty tcaug.SetHashAndEqualsWith (mkLocalValRef evspec1, mkLocalValRef evspec2, mkLocalValRef evspec3) PublishValueDefn cenv env ModuleOrMemberBinding evspec1 @@ -13915,7 +13915,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let _,typ = if tcref.Deref.IsExceptionDecl then [],cenv.g.exn_ty else generalizeTyconRef tcref + let _, typ = if tcref.Deref.IsExceptionDecl then [], cenv.g.exn_ty else generalizeTyconRef tcref let m = tycon.Range // Note: tycon.HasOverride only gives correct results after we've done the type augmentation @@ -13923,14 +13923,14 @@ module AddAugmentationDeclarations = let hasExplicitGenericIEquatable = tcaugHasNominalInterface cenv.g tcaug cenv.g.system_GenericIEquatable_tcref if hasExplicitGenericIEquatable then - errorR(Error(FSComp.SR.tcImplementsIEquatableExplicitly(tycon.DisplayName),m)) + errorR(Error(FSComp.SR.tcImplementsIEquatableExplicitly(tycon.DisplayName), m)) // Note: only provide the equals method if Equals is not implemented explicitly, and // we're actually generating Hash/Equals for this type if not hasExplicitObjectEqualsOverride && Option.isSome tycon.GeneratedHashAndEqualsWithComparerValues then - let vspec1,vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref + let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation cenv.g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) if not tycon.IsExceptionDecl then PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy cenv.g.system_GenericIEquatable_tcref [typ]) @@ -13949,11 +13949,11 @@ module TyconConstraintInference = let InferSetOfTyconsSupportingComparable cenv (denv: DisplayEnv) tyconsWithStructuralTypes = let g = cenv.g - let tab = tyconsWithStructuralTypes |> List.map (fun (tycon:Tycon, structuralTypes) -> tycon.Stamp, (tycon,structuralTypes)) |> Map.ofList + let tab = tyconsWithStructuralTypes |> List.map (fun (tycon:Tycon, structuralTypes) -> tycon.Stamp, (tycon, structuralTypes)) |> Map.ofList // Initially, assume the equality relation is available for all structural type definitions let initialAssumedTycons = - set [ for (tycon,_) in tyconsWithStructuralTypes do + set [ for (tycon, _) in tyconsWithStructuralTypes do if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon then yield tycon.Stamp ] @@ -13994,7 +13994,7 @@ module TyconConstraintInference = | _ -> match ty with - | AppTy g (tcref,tinst) -> + | AppTy g (tcref, tinst) -> // Check the basic requirement - IComparable/IStructuralComparable or assumed-comparable (if initialAssumedTycons.Contains tcref.Stamp then assumedTycons.Contains tcref.Stamp @@ -14016,9 +14016,9 @@ module TyconConstraintInference = let newSet = assumedTycons |> Set.filter (fun tyconStamp -> - let (tycon,structuralTypes) = tab.[tyconStamp] + let (tycon, structuralTypes) = tab.[tyconStamp] if cenv.g.compilingFslib && AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare cenv.g tycon && not (HasFSharpAttribute g g.attrib_StructuralComparisonAttribute tycon.Attribs) && not (HasFSharpAttribute g g.attrib_NoComparisonAttribute tycon.Attribs) then - errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(),tycon.Range)) + errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(), tycon.Range)) let res = (structuralTypes |> List.forall (fst >> checkIfFieldTypeSupportsComparison tycon)) @@ -14030,11 +14030,11 @@ module TyconConstraintInference = | None -> assert false failwith "unreachable" - | Some (ty,_) -> + | Some (ty, _) -> if isTyparTy g ty then - errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied1(tycon.DisplayName,NicePrint.prettyStringOfTy denv ty),tycon.Range)) + errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else - errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied2(tycon.DisplayName,NicePrint.prettyStringOfTy denv ty),tycon.Range)) + errorR(Error(FSComp.SR.tcStructuralComparisonNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) | Some(false) -> () @@ -14043,14 +14043,14 @@ module TyconConstraintInference = | None -> assert false failwith "unreachable" - | Some (ty,_) -> + | Some (ty, _) -> // NOTE: these warnings are off by default - they are level 4 informational warnings // PERF: this call to prettyStringOfTy is always being executed, even when the warning // is not being reported (the normal case). if isTyparTy g ty then - warning(Error(FSComp.SR.tcNoComparisonNeeded1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName),tycon.Range)) + warning(Error(FSComp.SR.tcNoComparisonNeeded1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range)) else - warning(Error(FSComp.SR.tcNoComparisonNeeded2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName),tycon.Range)) + warning(Error(FSComp.SR.tcNoComparisonNeeded2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range)) res) @@ -14064,7 +14064,7 @@ module TyconConstraintInference = // OK, we're done, Record the results for the type variable which provide the support for tyconStamp in uneliminatedTycons do - let (tycon,_) = tab.[tyconStamp] + let (tycon, _) = tab.[tyconStamp] for tp in tycon.Typars(tycon.Range) do if assumedTyparsActual.Contains(tp.Stamp) then tp.SetComparisonDependsOn true @@ -14076,11 +14076,11 @@ module TyconConstraintInference = let InferSetOfTyconsSupportingEquatable cenv (denv: DisplayEnv) (tyconsWithStructuralTypes:(Tycon * _) list) = let g = cenv.g - let tab = tyconsWithStructuralTypes |> List.map (fun (tycon,c) -> tycon.Stamp, (tycon,c)) |> Map.ofList + let tab = tyconsWithStructuralTypes |> List.map (fun (tycon, c) -> tycon.Stamp, (tycon, c)) |> Map.ofList // Initially, assume the equality relation is available for all structural type definitions let initialAssumedTycons = - set [ for (tycon,_) in tyconsWithStructuralTypes do + set [ for (tycon, _) in tyconsWithStructuralTypes do if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon then yield tycon.Stamp ] @@ -14117,7 +14117,7 @@ module TyconConstraintInference = | _ -> // Check the basic requirement - any types except those eliminated match ty with - | AppTy g (tcref,tinst) -> + | AppTy g (tcref, tinst) -> (if initialAssumedTycons.Contains tcref.Stamp then assumedTycons.Contains tcref.Stamp elif AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref then @@ -14139,9 +14139,9 @@ module TyconConstraintInference = let newSet = assumedTycons |> Set.filter (fun tyconStamp -> - let (tycon,structuralTypes) = tab.[tyconStamp] + let (tycon, structuralTypes) = tab.[tyconStamp] if cenv.g.compilingFslib && AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals cenv.g tycon && not (HasFSharpAttribute g g.attrib_StructuralEqualityAttribute tycon.Attribs) && not (HasFSharpAttribute g g.attrib_NoEqualityAttribute tycon.Attribs) then - errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(),tycon.Range)) + errorR(Error(FSComp.SR.tcFSharpCoreRequiresExplicit(), tycon.Range)) // Remove structural types with incomparable elements from the assumedTycons let res = (structuralTypes |> List.forall (fst >> checkIfFieldTypeSupportsEquality tycon)) @@ -14155,11 +14155,11 @@ module TyconConstraintInference = | None -> assert false failwith "unreachable" - | Some (ty,_) -> + | Some (ty, _) -> if isTyparTy g ty then - errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied1(tycon.DisplayName,NicePrint.prettyStringOfTy denv ty),tycon.Range)) + errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else - errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied2(tycon.DisplayName,NicePrint.prettyStringOfTy denv ty),tycon.Range)) + errorR(Error(FSComp.SR.tcStructuralEqualityNotSatisfied2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty), tycon.Range)) else () | Some(false) -> @@ -14170,11 +14170,11 @@ module TyconConstraintInference = | None -> assert false failwith "unreachable" - | Some (ty,_) -> + | Some (ty, _) -> if isTyparTy g ty then - warning(Error(FSComp.SR.tcNoEqualityNeeded1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName),tycon.Range)) + warning(Error(FSComp.SR.tcNoEqualityNeeded1(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range)) else - warning(Error(FSComp.SR.tcNoEqualityNeeded2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName),tycon.Range)) + warning(Error(FSComp.SR.tcNoEqualityNeeded2(tycon.DisplayName, NicePrint.prettyStringOfTy denv ty, tycon.DisplayName), tycon.Range)) res) @@ -14188,7 +14188,7 @@ module TyconConstraintInference = // OK, we're done, Record the results for the type variable which provide the support for tyconStamp in uneliminatedTycons do - let (tycon,_) = tab.[tyconStamp] + let (tycon, _) = tab.[tyconStamp] for tp in tycon.Typars(tycon.Range) do if assumedTyparsActual.Contains(tp.Stamp) then tp.SetEqualityDependsOn true @@ -14202,19 +14202,19 @@ module TyconConstraintInference = //------------------------------------------------------------------------- let ComputeModuleName (longPath: Ident list) = - if longPath.Length <> 1 then error(Error(FSComp.SR.tcInvalidModuleName(),(List.head longPath).idRange)) + if longPath.Length <> 1 then error(Error(FSComp.SR.tcInvalidModuleName(), (List.head longPath).idRange)) longPath.Head let CheckForDuplicateConcreteType env nm m = let curr = GetCurrAccumulatedModuleOrNamespaceType env if Map.containsKey nm curr.AllEntitiesByCompiledAndLogicalMangledNames then // Use 'error' instead of 'errorR' here to avoid cascading errors - see bug 1177 in FSharp 1.0 - error (Duplicate(FSComp.SR.tcTypeExceptionOrModule(),nm,m)) + error (Duplicate(FSComp.SR.tcTypeExceptionOrModule(), nm, m)) let CheckForDuplicateModule env nm m = let curr = GetCurrAccumulatedModuleOrNamespaceType env if curr.ModulesAndNamespacesByDemangledName.ContainsKey(nm) then - errorR (Duplicate(FSComp.SR.tcTypeOrModule(),nm,m)) + errorR (Duplicate(FSComp.SR.tcTypeOrModule(), nm, m)) //------------------------------------------------------------------------- @@ -14224,17 +14224,17 @@ let CheckForDuplicateModule env nm m = /// Check 'exception' declarations in implementations and signatures module TcExceptionDeclarations = - let TcExnDefnCore_Phase1A cenv env parent (SynExceptionDefnRepr(synAttrs,UnionCase(_,id,_,_,_,_),_,doc,vis,m)) = + let TcExnDefnCore_Phase1A cenv env parent (SynExceptionDefnRepr(synAttrs, UnionCase(_, id, _, _, _, _), _, doc, vis, m)) = let attrs = TcAttributes cenv env AttributeTargets.ExnDecl synAttrs if not (String.isUpper id.idText) then errorR(NotUpperCaseConstructor(m)) - let vis,cpath = ComputeAccessAndCompPath env None m vis None parent + let vis, cpath = ComputeAccessAndCompPath env None m vis None parent let vis = TcRecdUnionAndEnumDeclarations.CombineReprAccess parent vis CheckForDuplicateConcreteType env (id.idText + "Exception") id.idRange CheckForDuplicateConcreteType env id.idText id.idRange NewExn cpath id vis (TExnFresh (MakeRecdFieldsTable [])) attrs (doc.ToXmlDoc()) - let TcExnDefnCore_Phase1G_EstablishRepresentation cenv env parent (exnc: Entity) (SynExceptionDefnRepr(_,UnionCase(_,_,args,_,_,_),reprIdOpt,_,_,m)) = - let args = match args with (UnionCaseFields args) -> args | _ -> error(Error(FSComp.SR.tcExplicitTypeSpecificationCannotBeUsedForExceptionConstructors(),m)) + let TcExnDefnCore_Phase1G_EstablishRepresentation cenv env parent (exnc: Entity) (SynExceptionDefnRepr(_, UnionCase(_, _, args, _, _, _), reprIdOpt, _, _, m)) = + let args = match args with (UnionCaseFields args) -> args | _ -> error(Error(FSComp.SR.tcExplicitTypeSpecificationCannotBeUsedForExceptionConstructors(), m)) let ad = env.eAccessRights let id = exnc.Id @@ -14247,13 +14247,13 @@ module TcExceptionDeclarations = | Item.ExnCase exnc, [] -> CheckTyconAccessible cenv.amap m env.eAccessRights exnc |> ignore if not (isNil args') then - errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(),m)) + errorR (Error(FSComp.SR.tcExceptionAbbreviationsShouldNotHaveArgumentList(), m)) TExnAbbrevRepr exnc - | Item.CtorGroup(_,meths) , [] -> + | Item.CtorGroup(_, meths) , [] -> // REVIEW: check this really is an exception type match args' with | [] -> () - | _ -> error (Error(FSComp.SR.tcAbbreviationsFordotNetExceptionsCannotTakeArguments(),m)) + | _ -> error (Error(FSComp.SR.tcAbbreviationsFordotNetExceptionsCannotTakeArguments(), m)) let candidates = meths |> List.filter (fun minfo -> minfo.NumArgs = [args'.Length] && @@ -14261,22 +14261,22 @@ module TcExceptionDeclarations = match candidates with | [minfo] -> match minfo.EnclosingType with - | AppTy cenv.g (tcref,_) as ety when (TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m cenv.g.exn_ty ety) -> + | AppTy cenv.g (tcref, _) as ety when (TypeDefinitelySubsumesTypeNoCoercion 0 cenv.g cenv.amap m cenv.g.exn_ty ety) -> let tref = tcref.CompiledRepresentationForNamedType TExnAsmRepr tref | _ -> - error(Error(FSComp.SR.tcExceptionAbbreviationsMustReferToValidExceptions(),m)) + error(Error(FSComp.SR.tcExceptionAbbreviationsMustReferToValidExceptions(), m)) | _ -> - error (Error(FSComp.SR.tcAbbreviationsFordotNetExceptionsMustHaveMatchingObjectConstructor(),m)) + error (Error(FSComp.SR.tcAbbreviationsFordotNetExceptionsMustHaveMatchingObjectConstructor(), m)) | _ -> - error (Error(FSComp.SR.tcNotAnException(),m)) + error (Error(FSComp.SR.tcNotAnException(), m)) | None -> TExnFresh (MakeRecdFieldsTable args') exnc.entity_exn_info <- repr let item = Item.ExnCase(mkLocalTyconRef exnc) - CallNameResolutionSink cenv.tcSink (id.idRange,env.NameEnv,item,item,emptyTyparInst,ItemOccurence.Binding,env.DisplayEnv,env.eAccessRights) + CallNameResolutionSink cenv.tcSink (id.idRange, env.NameEnv, item, item, emptyTyparInst, ItemOccurence.Binding, env.DisplayEnv, env.eAccessRights) args' let private TcExnDefnCore cenv env parent synExnDefnRepr = @@ -14287,8 +14287,8 @@ module TcExceptionDeclarations = PublishTypeDefn cenv env exnc let structuralTypes = args' |> List.map (fun rf -> (rf.FormalType, rf.Range)) - let scSet = TyconConstraintInference.InferSetOfTyconsSupportingComparable cenv env.DisplayEnv [(exnc,structuralTypes)] - let seSet = TyconConstraintInference.InferSetOfTyconsSupportingEquatable cenv env.DisplayEnv [(exnc,structuralTypes)] + let scSet = TyconConstraintInference.InferSetOfTyconsSupportingComparable cenv env.DisplayEnv [(exnc, structuralTypes)] + let seSet = TyconConstraintInference.InferSetOfTyconsSupportingEquatable cenv env.DisplayEnv [(exnc, structuralTypes)] // Augment the exception constructor with comparison and hash methods if needed let binds = @@ -14298,26 +14298,26 @@ module TcExceptionDeclarations = AddAugmentationDeclarations.AddGenericHashAndComparisonDeclarations cenv env scSet seSet exnc AddAugmentationDeclarations.AddGenericHashAndComparisonBindings cenv exnc - binds,exnc + binds, exnc - let TcExnDefn cenv envInitial parent (SynExceptionDefn(core,aug,m),scopem) = - let binds1,exnc = TcExnDefnCore cenv envInitial parent core + let TcExnDefn cenv envInitial parent (SynExceptionDefn(core, aug, m), scopem) = + let binds1, exnc = TcExnDefnCore cenv envInitial parent core let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc let defns = [MutRecShape.Tycon(MutRecDefnsPhase2DataForTycon(Some exnc, parent, ModuleOrMemberBinding, mkLocalEntityRef exnc, None, NoSafeInitInfo, [], aug, m, NoNewSlots, (fun () -> ())))] - let binds2,envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem None envMutRec defns + let binds2, envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem None envMutRec defns let binds2flat = binds2 |> MutRecShapes.collectTycons |> List.collect snd // Augment types with references to values that implement the pre-baked semantics of the type let binds3 = AddAugmentationDeclarations.AddGenericEqualityBindings cenv envFinal exnc - binds1 @ binds2flat @ binds3,exnc,envFinal + binds1 @ binds2flat @ binds3, exnc, envFinal - let TcExnSignature cenv envInitial parent tpenv (SynExceptionSig(core,aug,_),scopem) = - let binds,exnc = TcExnDefnCore cenv envInitial parent core + let TcExnSignature cenv envInitial parent tpenv (SynExceptionSig(core, aug, _), scopem) = + let binds, exnc = TcExnDefnCore cenv envInitial parent core let envMutRec = AddLocalExnDefnAndReport cenv.tcSink scopem (AddLocalTycons cenv.g cenv.amap scopem [exnc] envInitial) exnc let ecref = mkLocalEntityRef exnc - let vals,_ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent,Some(MemberOrValContainerInfo(ecref,None,None,NoSafeInitInfo,[])))) ModuleOrMemberBinding tpenv aug - binds,vals,ecref,envMutRec + let vals, _ = TcTyconMemberSpecs cenv envMutRec (ContainerInfo(parent, Some(MemberOrValContainerInfo(ecref, None, None, NoSafeInitInfo, [])))) ModuleOrMemberBinding tpenv aug + binds, vals, ecref, envMutRec @@ -14339,7 +14339,7 @@ module EstablishTypeDefinitionCores = /// Compute the mangled name of a type definition. 'doErase' is true for all type definitions except type abbreviations. let private ComputeTyconName (longPath: Ident list, doErase:bool, typars: Typars) = - if longPath.Length <> 1 then error(Error(FSComp.SR.tcInvalidTypeExtension(),longPath.Head.idRange)) + if longPath.Length <> 1 then error(Error(FSComp.SR.tcInvalidTypeExtension(), longPath.Head.idRange)) let id = longPath.Head let erasedArity = if doErase then typars |> Seq.sumBy (fun tp -> if tp.IsErased then 0 else 1) @@ -14352,18 +14352,18 @@ module EstablishTypeDefinitionCores = let hasInterfaceAttr = HasFSharpAttribute g g.attrib_InterfaceAttribute attrs let hasStructAttr = HasFSharpAttribute g g.attrib_StructAttribute attrs let hasMeasureAttr = HasFSharpAttribute g g.attrib_MeasureAttribute attrs - (hasClassAttr,hasAbstractClassAttr,hasInterfaceAttr,hasStructAttr,hasMeasureAttr) + (hasClassAttr, hasAbstractClassAttr, hasInterfaceAttr, hasStructAttr, hasMeasureAttr) //------------------------------------------------------------------------- // Type kind inference //------------------------------------------------------------------------- - let private InferTyconKind g (kind,attrs,slotsigs,fields,inSig,isConcrete,m) = - let (hasClassAttr,hasAbstractClassAttr,hasInterfaceAttr,hasStructAttr,hasMeasureAttr) = GetTyconAttribs g attrs + let private InferTyconKind g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) = + let (hasClassAttr, hasAbstractClassAttr, hasInterfaceAttr, hasStructAttr, hasMeasureAttr) = GetTyconAttribs g attrs let bi b = (if b then 1 else 0) if (bi hasClassAttr + bi hasInterfaceAttr + bi hasStructAttr + bi hasMeasureAttr) > 1 || (bi hasAbstractClassAttr + bi hasInterfaceAttr + bi hasStructAttr + bi hasMeasureAttr) > 1 then - error(Error(FSComp.SR.tcAttributesOfTypeSpecifyMultipleKindsForType(),m)) + error(Error(FSComp.SR.tcAttributesOfTypeSpecifyMultipleKindsForType(), m)) match kind with | TyconUnspecified -> @@ -14378,69 +14378,69 @@ module EstablishTypeDefinitionCores = hasMeasureAttr && not (match k with TyconClass | TyconAbbrev | TyconHiddenRepr -> true | _ -> false) || hasInterfaceAttr && not (match k with TyconInterface -> true | _ -> false) || hasStructAttr && not (match k with TyconStruct | TyconRecord | TyconUnion -> true | _ -> false) then - error(Error(FSComp.SR.tcKindOfTypeSpecifiedDoesNotMatchDefinition(),m)) + error(Error(FSComp.SR.tcKindOfTypeSpecifiedDoesNotMatchDefinition(), m)) k - let private (|TyconCoreAbbrevThatIsReallyAUnion|_|) (hasMeasureAttr,envinner,id:Ident) synTyconRepr = + let private (|TyconCoreAbbrevThatIsReallyAUnion|_|) (hasMeasureAttr, envinner, id:Ident) synTyconRepr = match synTyconRepr with - | SynTypeDefnSimpleRepr.TypeAbbrev(_, SynType.LongIdent(LongIdentWithDots([unionCaseName],_)),m) + | SynTypeDefnSimpleRepr.TypeAbbrev(_, SynType.LongIdent(LongIdentWithDots([unionCaseName], _)), m) when (not hasMeasureAttr && (isNil (LookupTypeNameInEnvNoArity OpenQualified unionCaseName.idText envinner.eNameResEnv) || id.idText = unionCaseName.idText)) -> - Some(unionCaseName,m) + Some(unionCaseName, m) | _ -> None /// Get the component types that make a record, union or struct type. /// /// Used when determining if a structural type supports structural comparison. - let private GetStructuralElementsOfTyconDefn cenv env tpenv (MutRecDefnsPhase1DataForTycon(_,synTyconRepr,_,_,_,_)) tycon = + let private GetStructuralElementsOfTyconDefn cenv env tpenv (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, _, _, _, _)) tycon = let thisTyconRef = mkLocalTyconRef tycon let m = tycon.Range let env = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) env let env = MakeInnerEnvForTyconRef cenv env thisTyconRef false [ match synTyconRepr with | SynTypeDefnSimpleRepr.None _ -> () - | SynTypeDefnSimpleRepr.Union (_,unionCases,_) -> + | SynTypeDefnSimpleRepr.Union (_, unionCases, _) -> - for (UnionCase (_,_,args,_,_,m)) in unionCases do + for (UnionCase (_, _, args, _, _, m)) in unionCases do match args with | UnionCaseFields flds -> - for (Field(_,_,_,ty,_,_,_,m)) in flds do - let ty',_ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty - yield (ty',m) - | UnionCaseFullType (ty,arity) -> - let ty',_ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty - let argtysl,_ = GetTopTauTypeInFSharpForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv env) |> TranslatePartialArity []).ArgInfos ty' m + for (Field(_, _, _, ty, _, _, _, m)) in flds do + let ty', _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + yield (ty', m) + | UnionCaseFullType (ty, arity) -> + let ty', _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + let argtysl, _ = GetTopTauTypeInFSharpForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv env) |> TranslatePartialArity []).ArgInfos ty' m if argtysl.Length > 1 then - errorR(Error(FSComp.SR.tcIllegalFormForExplicitTypeDeclaration(),m)) + errorR(Error(FSComp.SR.tcIllegalFormForExplicitTypeDeclaration(), m)) for argtys in argtysl do - for (argty,_) in argtys do - yield (argty ,m) + for (argty, _) in argtys do + yield (argty , m) - | SynTypeDefnSimpleRepr.General (_,_,_,fields,_,_,implicitCtorSynPats,_) when tycon.IsFSharpStructOrEnumTycon -> // for structs - for (Field(_,isStatic,_,ty,_,_,_,m)) in fields do + | SynTypeDefnSimpleRepr.General (_, _, _, fields, _, _, implicitCtorSynPats, _) when tycon.IsFSharpStructOrEnumTycon -> // for structs + for (Field(_, isStatic, _, ty, _, _, _, m)) in fields do if not isStatic then - let ty',_ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty - yield (ty',m) + let ty', _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + yield (ty', m) match implicitCtorSynPats with | None -> () | Some spats -> - let ctorArgNames,(_,names,_) = TcSimplePatsOfUnknownType cenv true NoCheckCxs env tpenv (SynSimplePats.SimplePats (spats,m)) + let ctorArgNames, (_, names, _) = TcSimplePatsOfUnknownType cenv true NoCheckCxs env tpenv (SynSimplePats.SimplePats (spats, m)) for arg in ctorArgNames do let ty = names.[arg].Type let m = names.[arg].Ident.idRange if not (isNil (ListSet.subtract typarEq (freeInTypeLeftToRight cenv.g false ty) tycon.TyparsNoRange)) then - errorR(Error(FSComp.SR.tcStructsMustDeclareTypesOfImplicitCtorArgsExplicitly(),m)) + errorR(Error(FSComp.SR.tcStructsMustDeclareTypesOfImplicitCtorArgsExplicitly(), m)) yield (ty, m) - | SynTypeDefnSimpleRepr.Record (_,fields,_) -> - for (Field(_,_,_,ty,_,_,_,m)) in fields do - let ty',_ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty - yield (ty',m) + | SynTypeDefnSimpleRepr.Record (_, fields, _) -> + for (Field(_, _, _, ty, _, _, _, m)) in fields do + let ty', _ = TcTypeAndRecover cenv NoNewTypars NoCheckCxs ItemOccurence.UseInType env tpenv ty + yield (ty', m) | _ -> () ] @@ -14456,7 +14456,7 @@ module EstablishTypeDefinitionCores = let TypeNamesInMutRecDecls (compDecls: MutRecShapes) = [ for d in compDecls do match d with - | MutRecShape.Tycon (MutRecDefnsPhase1DataForTycon(ComponentInfo(_,_,_,ids,_,_,_,_),_,_,_,_,isAtOriginalTyconDefn),_) -> + | MutRecShape.Tycon (MutRecDefnsPhase1DataForTycon(ComponentInfo(_, _, _, ids, _, _, _, _), _, _, _, _, isAtOriginalTyconDefn), _) -> if isAtOriginalTyconDefn then yield (List.last ids).idText | _ -> () ] @@ -14465,11 +14465,11 @@ module EstablishTypeDefinitionCores = let TypeNamesInNonMutRecDecls defs = [ for def in defs do match def with - | SynModuleDecl.Types (typeSpecs,_) -> - for (TypeDefn(ComponentInfo(_,typars,_,ids,_,_,_,_),trepr,_,_)) in typeSpecs do + | SynModuleDecl.Types (typeSpecs, _) -> + for (TypeDefn(ComponentInfo(_, typars, _, ids, _, _, _, _), trepr, _, _)) in typeSpecs do if isNil typars then match trepr with - | SynTypeDefnRepr.ObjectModel(TyconAugmentation,_,_) -> () + | SynTypeDefnRepr.ObjectModel(TyconAugmentation, _, _) -> () | _ -> yield (List.last ids).idText | _ -> () ] |> set @@ -14478,23 +14478,23 @@ module EstablishTypeDefinitionCores = let TypeNamesInNonMutRecSigDecls defs = [ for def in defs do match def with - | SynModuleSigDecl.Types (typeSpecs,_) -> - for (TypeDefnSig(ComponentInfo(_,typars,_,ids,_,_,_,_),trepr,extraMembers,_)) in typeSpecs do + | SynModuleSigDecl.Types (typeSpecs, _) -> + for (TypeDefnSig(ComponentInfo(_, typars, _, ids, _, _, _, _), trepr, extraMembers, _)) in typeSpecs do if isNil typars then match trepr with - | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _),_) when not (isNil extraMembers) -> () + | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _), _) when not (isNil extraMembers) -> () | _ -> yield (List.last ids).idText | _ -> () ] |> set let TcTyconDefnCore_Phase1A_BuildInitialModule cenv envInitial parent typeNames compInfo decls = - let (ComponentInfo(attribs,_parms, _constraints,longPath,xml,_,vis,im)) = compInfo + let (ComponentInfo(attribs, _parms, _constraints, longPath, xml, _, vis, im)) = compInfo let id = ComputeModuleName longPath let modAttrs = TcAttributes cenv envInitial AttributeTargets.ModuleDecl attribs let modKind = ComputeModuleOrNamespaceKind cenv.g true typeNames modAttrs id.idText let modName = AdjustModuleName modKind id.idText - let vis,_ = ComputeAccessAndCompPath envInitial None id.idRange vis None parent + let vis, _ = ComputeAccessAndCompPath envInitial None id.idRange vis None parent CheckForDuplicateModule envInitial id.idText id.idRange let id = ident (modName, id.idRange) @@ -14511,8 +14511,8 @@ module EstablishTypeDefinitionCores = /// - computing the mangled name for C /// but /// - we don't yet 'properly' establish constraints on type parameters - let private TcTyconDefnCore_Phase1A_BuildInitialTycon cenv env parent (MutRecDefnsPhase1DataForTycon(synTyconInfo,synTyconRepr,_,preEstablishedHasDefaultCtor,hasSelfReferentialCtor, _)) = - let (ComponentInfo (_, synTypars, _,id, doc, preferPostfix, synVis,_)) = synTyconInfo + let private TcTyconDefnCore_Phase1A_BuildInitialTycon cenv env parent (MutRecDefnsPhase1DataForTycon(synTyconInfo, synTyconRepr, _, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, _)) = + let (ComponentInfo (_, synTypars, _, id, doc, preferPostfix, synVis, _)) = synTyconInfo let checkedTypars = TcTyparDecls cenv env synTypars id |> List.iter (CheckNamespaceModuleOrTypeName cenv.g) match synTyconRepr with @@ -14523,7 +14523,7 @@ module EstablishTypeDefinitionCores = // Augmentations of type definitions are allowed within the same file as long as no new type representation or abbreviation is given CheckForDuplicateConcreteType env id.idText id.idRange - let vis,cpath = ComputeAccessAndCompPath env None id.idRange synVis None parent + let vis, cpath = ComputeAccessAndCompPath env None id.idRange synVis None parent // Establish the visibility of the representation, e.g. // type R = @@ -14533,14 +14533,14 @@ module EstablishTypeDefinitionCores = match synTyconRepr with | SynTypeDefnSimpleRepr.None _ -> None | SynTypeDefnSimpleRepr.TypeAbbrev _ -> None - | SynTypeDefnSimpleRepr.Union (vis,_,_) -> vis + | SynTypeDefnSimpleRepr.Union (vis, _, _) -> vis | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly _ -> None - | SynTypeDefnSimpleRepr.Record (vis,_,_) -> vis + | SynTypeDefnSimpleRepr.Record (vis, _, _) -> vis | SynTypeDefnSimpleRepr.General _ -> None | SynTypeDefnSimpleRepr.Enum _ -> None | SynTypeDefnSimpleRepr.Exception _ -> None - let visOfRepr,_ = ComputeAccessAndCompPath env None id.idRange synVisOfRepr None parent + let visOfRepr, _ = ComputeAccessAndCompPath env None id.idRange synVisOfRepr None parent let visOfRepr = combineAccess vis visOfRepr // If we supported nested types and modules then additions would be needed here let lmtyp = MaybeLazy.Strict (NewEmptyModuleOrNamespaceType ModuleOrType) @@ -14558,8 +14558,8 @@ module EstablishTypeDefinitionCores = /// /// synTyconInfo: Syntactic AST for the name, attributes etc. of the type constructor /// synTyconRepr: Syntactic AST for the RHS of the type definition - let private TcTyconDefnCore_Phase1B_EstablishBasicKind cenv inSig envinner (MutRecDefnsPhase1DataForTycon(synTyconInfo,synTyconRepr,_,_,_,_)) (tycon:Tycon) = - let (ComponentInfo(synAttrs,typars, _,_, _, _,_,_)) = synTyconInfo + let private TcTyconDefnCore_Phase1B_EstablishBasicKind cenv inSig envinner (MutRecDefnsPhase1DataForTycon(synTyconInfo, synTyconRepr, _, _, _, _)) (tycon:Tycon) = + let (ComponentInfo(synAttrs, typars, _, _, _, _, _, _)) = synTyconInfo let m = tycon.Range let id = tycon.Id @@ -14571,7 +14571,7 @@ module EstablishTypeDefinitionCores = let isStructRecordOrUnionType = match synTyconRepr with | SynTypeDefnSimpleRepr.Record _ - | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr,envinner,id) _ + | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) _ | SynTypeDefnSimpleRepr.Union _ -> HasFSharpAttribute cenv.g cenv.g.attrib_StructAttribute attrs | _ -> @@ -14584,16 +14584,16 @@ module EstablishTypeDefinitionCores = if hasMeasureAttr then tycon.entity_kind <- TyparKind.Measure - if not (isNil typars) then error(Error(FSComp.SR.tcMeasureDefinitionsCannotHaveTypeParameters(),m)) + if not (isNil typars) then error(Error(FSComp.SR.tcMeasureDefinitionsCannotHaveTypeParameters(), m)) let repr = match synTyconRepr with | SynTypeDefnSimpleRepr.Exception _ -> TNoRepr | SynTypeDefnSimpleRepr.None m -> // Run InferTyconKind to raise errors on inconsistent attribute sets - InferTyconKind cenv.g (TyconHiddenRepr,attrs,[],[],inSig,true,m) |> ignore + InferTyconKind cenv.g (TyconHiddenRepr, attrs, [], [], inSig, true, m) |> ignore if not inSig && not hasMeasureAttr then - errorR(Error(FSComp.SR.tcTypeRequiresDefinition(),m)) + errorR(Error(FSComp.SR.tcTypeRequiresDefinition(), m)) if hasMeasureAttr then TFSharpObjectRepr { fsobjmodel_kind=TTyconClass fsobjmodel_vslots=[] @@ -14601,31 +14601,31 @@ module EstablishTypeDefinitionCores = else TNoRepr - | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr,envinner,id) (_,m) - | SynTypeDefnSimpleRepr.Union (_,_,m) -> + | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (_, m) + | SynTypeDefnSimpleRepr.Union (_, _, m) -> // Run InferTyconKind to raise errors on inconsistent attribute sets - InferTyconKind cenv.g (TyconUnion,attrs,[],[],inSig,true,m) |> ignore + InferTyconKind cenv.g (TyconUnion, attrs, [], [], inSig, true, m) |> ignore // Note: the table of union cases is initially empty MakeUnionRepr [] | SynTypeDefnSimpleRepr.TypeAbbrev _ -> // Run InferTyconKind to raise errors on inconsistent attribute sets - InferTyconKind cenv.g (TyconAbbrev,attrs,[],[],inSig,true,m) |> ignore + InferTyconKind cenv.g (TyconAbbrev, attrs, [], [], inSig, true, m) |> ignore TNoRepr - | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s,m) -> + | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, m) -> // Run InferTyconKind to raise errors on inconsistent attribute sets - InferTyconKind cenv.g (TyconILAssemblyCode,attrs,[],[],inSig,true,m) |> ignore + InferTyconKind cenv.g (TyconILAssemblyCode, attrs, [], [], inSig, true, m) |> ignore TAsmRepr s - | SynTypeDefnSimpleRepr.Record (_,_,m) -> + | SynTypeDefnSimpleRepr.Record (_, _, m) -> // Run InferTyconKind to raise errors on inconsistent attribute sets - InferTyconKind cenv.g (TyconRecord,attrs,[],[],inSig,true,m) |> ignore + InferTyconKind cenv.g (TyconRecord, attrs, [], [], inSig, true, m) |> ignore // Note: the table of record fields is initially empty TRecdRepr (MakeRecdFieldsTable []) - | SynTypeDefnSimpleRepr.General (kind,_,slotsigs,fields,isConcrete,_,_,_) -> - let kind = InferTyconKind cenv.g (kind,attrs,slotsigs,fields,inSig,isConcrete,m) + | SynTypeDefnSimpleRepr.General (kind, _, slotsigs, fields, isConcrete, _, _, _) -> + let kind = InferTyconKind cenv.g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) match kind with | TyconHiddenRepr -> TNoRepr @@ -14634,9 +14634,9 @@ module EstablishTypeDefinitionCores = match kind with | TyconClass -> TTyconClass | TyconInterface -> TTyconInterface - | TyconDelegate _ -> TTyconDelegate (MakeSlotSig("Invoke",cenv.g.unit_ty,[],[],[], None)) + | TyconDelegate _ -> TTyconDelegate (MakeSlotSig("Invoke", cenv.g.unit_ty, [], [], [], None)) | TyconStruct -> TTyconStruct - | _ -> error(InternalError("should have inferred tycon kind",m)) + | _ -> error(InternalError("should have inferred tycon kind", m)) let repr = { fsobjmodel_kind=kind fsobjmodel_vslots=[] @@ -14658,9 +14658,9 @@ module EstablishTypeDefinitionCores = /// Get the items on the r.h.s. of a 'type X = ABC<...>' definition let private TcTyconDefnCore_GetGenerateDeclaration_Rhs rhsType = match rhsType with - | SynType.App (SynType.LongIdent(LongIdentWithDots(tc,_)),_,args,_commas,_,_postfix,m) -> Some(tc,args,m) - | SynType.LongIdent (LongIdentWithDots(tc,_) as lidwd) -> Some(tc,[],lidwd.Range) - | SynType.LongIdentApp (SynType.LongIdent (LongIdentWithDots(tc,_)),LongIdentWithDots(longId,_),_,args,_commas,_,m) -> Some(tc@longId,args,m) + | SynType.App (SynType.LongIdent(LongIdentWithDots(tc, _)), _, args, _commas, _, _postfix, m) -> Some(tc, args, m) + | SynType.LongIdent (LongIdentWithDots(tc, _) as lidwd) -> Some(tc, [], lidwd.Range) + | SynType.LongIdentApp (SynType.LongIdent (LongIdentWithDots(tc, _)), LongIdentWithDots(longId, _), _, args, _commas, _, m) -> Some(tc@longId, args, m) | _ -> None /// Check whether 'type X = ABC<...>' is a generative provided type definition @@ -14669,7 +14669,7 @@ module EstablishTypeDefinitionCores = let tcref = mkLocalTyconRef tycon match TcTyconDefnCore_GetGenerateDeclaration_Rhs rhsType with | None -> None - | Some (tc,args,m) -> + | Some (tc, args, m) -> let ad = envinner.eAccessRights match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.UseInType OpenQualified envinner.eNameResEnv ad tc TypeNameResolutionStaticArgsInfo.DefiniteEmpty PermitDirectReferenceToGeneratedType.Yes with | Result tcrefBeforeStaticArguments when @@ -14683,8 +14683,8 @@ module EstablishTypeDefinitionCores = if ExtensionTyping.IsGeneratedTypeDirectReference (typeBeforeArguments, m) then let optGeneratedTypePath = Some (tcref.CompilationPath.MangledPath @ [ tcref.LogicalName ]) - let _hasNoArgs,providedTypeAfterStaticArguments,checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv envinner optGeneratedTypePath tpenv tcrefBeforeStaticArguments args m - let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased),m) + let _hasNoArgs, providedTypeAfterStaticArguments, checkTypeName = TcProvidedTypeAppToStaticConstantArgs cenv envinner optGeneratedTypePath tpenv tcrefBeforeStaticArguments args m + let isGenerated = providedTypeAfterStaticArguments.PUntaint((fun st -> not st.IsErased), m) if isGenerated then Some (tcrefBeforeStaticArguments, providedTypeAfterStaticArguments, checkTypeName, args, m) else @@ -14721,32 +14721,32 @@ module EstablishTypeDefinitionCores = let ctxt = ProvidedTypeContext.Create(lookupILTypeRef, lookupTyconRef) // Create a new provided type which captures the reverse-remapping tables. - let theRootTypeWithRemapping = theRootType.PApply ((fun x -> ProvidedType.ApplyContext(x,ctxt)), m) + let theRootTypeWithRemapping = theRootType.PApply ((fun x -> ProvidedType.ApplyContext(x, ctxt)), m) - let isRootGenerated,rootProvAssemStaticLinkInfoOpt = - let stRootAssembly = theRootTypeWithRemapping.PApply((fun st -> st.Assembly),m) + let isRootGenerated, rootProvAssemStaticLinkInfoOpt = + let stRootAssembly = theRootTypeWithRemapping.PApply((fun st -> st.Assembly), m) cenv.amap.assemblyLoader.GetProvidedAssemblyInfo (ctok, m, stRootAssembly) - let isRootGenerated = isRootGenerated || theRootTypeWithRemapping.PUntaint((fun st -> not st.IsErased),m) + let isRootGenerated = isRootGenerated || theRootTypeWithRemapping.PUntaint((fun st -> not st.IsErased), m) if not isRootGenerated then let desig = theRootTypeWithRemapping.TypeProviderDesignation - let nm = theRootTypeWithRemapping.PUntaint((fun st -> st.FullName),m) - error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig,nm),m)) + let nm = theRootTypeWithRemapping.PUntaint((fun st -> st.FullName), m) + error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig, nm), m)) cenv.createsGeneratedProvidedTypes <- true // In compiled code, all types in the set of generated types end up being both generated and relocated, unless relocation is suppressed - let isForcedSuppressRelocate = theRootTypeWithRemapping.PUntaint((fun st -> st.IsSuppressRelocate),m) + let isForcedSuppressRelocate = theRootTypeWithRemapping.PUntaint((fun st -> st.IsSuppressRelocate), m) if isForcedSuppressRelocate && canAccessFromEverywhere tycon.Accessibility && not cenv.isScript then - errorR(Error(FSComp.SR.tcGeneratedTypesShouldBeInternalOrPrivate(),tcref.Range)) + errorR(Error(FSComp.SR.tcGeneratedTypesShouldBeInternalOrPrivate(), tcref.Range)) let isSuppressRelocate = cenv.g.isInteractive || isForcedSuppressRelocate // Adjust the representation of the container type - let repr = Construct.NewProvidedTyconRepr(resolutionEnvironment,theRootTypeWithRemapping, - Import.ImportProvidedType cenv.amap m, + let repr = Construct.NewProvidedTyconRepr(resolutionEnvironment, theRootTypeWithRemapping, + Import.ImportProvidedType cenv.amap m, isSuppressRelocate, m=m) tycon.entity_tycon_repr <- repr @@ -14765,16 +14765,16 @@ module EstablishTypeDefinitionCores = let rec doNestedType (eref: EntityRef) (st: Tainted) = // Check the type is a generated type - let isGenerated,provAssemStaticLinkInfoOpt = - let stAssembly = st.PApply((fun st -> st.Assembly),m) + let isGenerated, provAssemStaticLinkInfoOpt = + let stAssembly = st.PApply((fun st -> st.Assembly), m) cenv.amap.assemblyLoader.GetProvidedAssemblyInfo (ctok, m, stAssembly) - let isGenerated = isGenerated || st.PUntaint((fun st -> not st.IsErased),m) + let isGenerated = isGenerated || st.PUntaint((fun st -> not st.IsErased), m) if not isGenerated then let desig = st.TypeProviderDesignation - let nm = st.PUntaint((fun st -> st.FullName),m) - error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig,nm),m)) + let nm = st.PUntaint((fun st -> st.FullName), m) + error(Error(FSComp.SR.etErasedTypeUsedInGeneration(desig, nm), m)) // Embed the type into the module we're compiling let cpath = eref.CompilationPath.NestedCompPath eref.LogicalName ModuleOrNamespaceKind.ModuleOrType @@ -14839,14 +14839,14 @@ module EstablishTypeDefinitionCores = /// we establish /// /// Entity('B) - /// TypeAbbrev = TType_app(Entity('int'),[]) + /// TypeAbbrev = TType_app(Entity('int'), []) /// /// and for /// /// type C = B /// /// we establish - /// TypeAbbrev = TType_app(Entity('B'),[]) + /// TypeAbbrev = TType_app(Entity('B'), []) /// /// Note that for /// type PairOfInts = int * int @@ -14854,7 +14854,7 @@ module EstablishTypeDefinitionCores = // such as 'isRefTupleTy' will return reliable results, e.g. isRefTupleTy on the /// TAST type for 'PairOfInts' will report 'true' // - let private TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envinner inSig tpenv pass (MutRecDefnsPhase1DataForTycon(_,synTyconRepr,_,_,_,_)) (tycon:Tycon) (attrs:Attribs) = + let private TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envinner inSig tpenv pass (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, _, _, _, _)) (tycon:Tycon) (attrs:Attribs) = let m = tycon.Range let checkCxs = if (pass = SecondPass) then CheckCxs else NoCheckCxs let firstPass = (pass = FirstPass) @@ -14873,9 +14873,9 @@ module EstablishTypeDefinitionCores = // In F# this only defines a new type if A is not in scope // as a type constructor, or if the form type A = A is used. // "type x = | A" can always be used instead. - | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr,envinner,id) _ -> () + | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) _ -> () - | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.Ok, rhsType,m) -> + | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.Ok, rhsType, m) -> #if EXTENSIONTYPING // Check we have not already decided that this is a generative provided type definition. If we have already done this (i.e. this is the second pass @@ -14896,13 +14896,13 @@ module EstablishTypeDefinitionCores = // This case deals with ordinary type and measure abbreviations if not hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type - let ty,_ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkCxs ItemOccurence.UseInType envinner tpenv rhsType + let ty, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars checkCxs ItemOccurence.UseInType envinner tpenv rhsType if not firstPass then let ftyvs = freeInTypeLeftToRight cenv.g false ty let typars = tycon.Typars(m) if ftyvs.Length <> typars.Length then - errorR(Deprecated(FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType(),tycon.Range)) + errorR(Deprecated(FSComp.SR.tcTypeAbbreviationHasTypeParametersMissingOnType(), tycon.Range)) if firstPass then tycon.entity_tycon_abbrev <- Some ty @@ -14914,61 +14914,61 @@ module EstablishTypeDefinitionCores = // Third phase: check and publish the supr types. Run twice, once before constraints are established // and once after - let private TcTyconDefnCore_Phase1D_Phase1F_EstablishSuperTypesAndInterfaceTypes cenv tpenv inSig pass (envMutRec, mutRecDefns:MutRecShape<(_ * (Tycon * (Attribs * _)) option),_,_,_,_> list) = + let private TcTyconDefnCore_Phase1D_Phase1F_EstablishSuperTypesAndInterfaceTypes cenv tpenv inSig pass (envMutRec, mutRecDefns:MutRecShape<(_ * (Tycon * (Attribs * _)) option), _, _, _, _> list) = let checkCxs = if (pass = SecondPass) then CheckCxs else NoCheckCxs let firstPass = (pass = FirstPass) // Publish the immediately declared interfaces. let tyconWithImplementsL = - (envMutRec, mutRecDefns) ||> MutRecShapes.mapTyconsWithEnv (fun envinner (origInfo,tyconAndAttrsOpt) -> + (envMutRec, mutRecDefns) ||> MutRecShapes.mapTyconsWithEnv (fun envinner (origInfo, tyconAndAttrsOpt) -> match origInfo, tyconAndAttrsOpt with - | (typeDefCore,_,_), Some (tycon, (attrs,_)) -> - let (MutRecDefnsPhase1DataForTycon(_,synTyconRepr,explicitImplements,_,_,_)) = typeDefCore + | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> + let (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, explicitImplements, _, _, _)) = typeDefCore let m = tycon.Range let tcref = mkLocalTyconRef tycon let envinner = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) envinner let envinner = MakeInnerEnvForTyconRef cenv envinner tcref false - let implementedTys,_ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkCxs ItemOccurence.UseInType envinner)) tpenv explicitImplements + let implementedTys, _ = List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkCxs ItemOccurence.UseInType envinner)) tpenv explicitImplements if firstPass then tycon.entity_attribs <- attrs - let implementedTys,inheritedTys = + let implementedTys, inheritedTys = match synTyconRepr with | SynTypeDefnSimpleRepr.Exception _ -> [], [] - | SynTypeDefnSimpleRepr.General (kind,inherits,slotsigs,fields,isConcrete,_,_,m) -> - let kind = InferTyconKind cenv.g (kind,attrs,slotsigs,fields,inSig,isConcrete,m) + | SynTypeDefnSimpleRepr.General (kind, inherits, slotsigs, fields, isConcrete, _, _, m) -> + let kind = InferTyconKind cenv.g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) - let inherits = inherits |> List.map (fun (ty,m,_) -> (ty,m)) + let inherits = inherits |> List.map (fun (ty, m, _) -> (ty, m)) let inheritedTys = fst (List.mapFold (mapFoldFst (TcTypeAndRecover cenv NoNewTypars checkCxs ItemOccurence.UseInType envinner)) tpenv inherits) - let implementedTys,inheritedTys = + let implementedTys, inheritedTys = match kind with | TyconInterface -> - explicitImplements |> List.iter (fun (_,m) -> errorR(Error(FSComp.SR.tcInterfacesShouldUseInheritNotInterface(),m))) - (implementedTys @ inheritedTys),[] + explicitImplements |> List.iter (fun (_, m) -> errorR(Error(FSComp.SR.tcInterfacesShouldUseInheritNotInterface(), m))) + (implementedTys @ inheritedTys), [] | _ -> implementedTys, inheritedTys - implementedTys,inheritedTys + implementedTys, inheritedTys | SynTypeDefnSimpleRepr.Enum _ | SynTypeDefnSimpleRepr.None _ | SynTypeDefnSimpleRepr.TypeAbbrev _ | SynTypeDefnSimpleRepr.Union _ | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly _ | SynTypeDefnSimpleRepr.Record _ -> // REVIEW: we could do the IComparable/IStructuralHash interface analysis here. // This would let the type satisfy more recursive IComparable/IStructuralHash constraints - implementedTys,[] + implementedTys, [] - for (implementedTy,m) in implementedTys do + for (implementedTy, m) in implementedTys do if firstPass && isErasedType cenv.g implementedTy then - errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(),m)) + errorR(Error(FSComp.SR.tcCannotInheritFromErasedType(), m)) // Publish interfaces, but only on the first pass, to avoid a duplicate interface check if firstPass then - implementedTys |> List.iter (fun (ty,m) -> PublishInterface cenv envinner.DisplayEnv tcref m false ty) + implementedTys |> List.iter (fun (ty, m) -> PublishInterface cenv envinner.DisplayEnv tcref m false ty) - Some (attrs,inheritedTys,synTyconRepr,tycon) + Some (attrs, inheritedTys, synTyconRepr, tycon) | _ -> None) // Publish the attributes and supertype - tyconWithImplementsL |> MutRecShapes.iterTycons (Option.iter (fun (attrs,inheritedTys, synTyconRepr, tycon) -> + tyconWithImplementsL |> MutRecShapes.iterTycons (Option.iter (fun (attrs, inheritedTys, synTyconRepr, tycon) -> let m = tycon.Range try let super = @@ -14981,8 +14981,8 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.Record _ -> if tycon.IsStructRecordOrUnionTycon then Some(cenv.g.system_Value_typ) else None - | SynTypeDefnSimpleRepr.General (kind,_,slotsigs,fields,isConcrete,_,_,_) -> - let kind = InferTyconKind cenv.g (kind,attrs,slotsigs,fields,inSig,isConcrete,m) + | SynTypeDefnSimpleRepr.General (kind, _, slotsigs, fields, isConcrete, _, _, _) -> + let kind = InferTyconKind cenv.g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) match inheritedTys with | [] -> @@ -14990,20 +14990,20 @@ module EstablishTypeDefinitionCores = | TyconStruct -> Some(cenv.g.system_Value_typ) | TyconDelegate _ -> Some(cenv.g.system_MulticastDelegate_typ ) | TyconHiddenRepr | TyconClass | TyconInterface -> None - | _ -> error(InternalError("should have inferred tycon kind",m)) + | _ -> error(InternalError("should have inferred tycon kind", m)) - | [(ty,m)] -> + | [(ty, m)] -> if not firstPass && not (match kind with TyconClass -> true | _ -> false) then - errorR (Error(FSComp.SR.tcStructsInterfacesEnumsDelegatesMayNotInheritFromOtherTypes(),m)) + errorR (Error(FSComp.SR.tcStructsInterfacesEnumsDelegatesMayNotInheritFromOtherTypes(), m)) CheckSuperType cenv ty m if isTyparTy cenv.g ty then if firstPass then - errorR(Error(FSComp.SR.tcCannotInheritFromVariableType(),m)) + errorR(Error(FSComp.SR.tcCannotInheritFromVariableType(), m)) Some cenv.g.obj_ty // a "super" that is a variable type causes grief later else Some ty | _ -> - error(Error(FSComp.SR.tcTypesCannotInheritFromMultipleConcreteTypes(),m)) + error(Error(FSComp.SR.tcTypesCannotInheritFromMultipleConcreteTypes(), m)) | SynTypeDefnSimpleRepr.Enum _ -> Some(cenv.g.system_Enum_typ) @@ -15014,13 +15014,13 @@ module EstablishTypeDefinitionCores = with e -> errorRecovery e m)) /// Establish the fields, dispatch slots and union cases of a type - let private TcTyconDefnCore_Phase1G_EstablishRepresentation cenv envinner tpenv inSig (MutRecDefnsPhase1DataForTycon(_,synTyconRepr,_,_,_,_)) (tycon:Tycon) (attrs:Attribs) = + let private TcTyconDefnCore_Phase1G_EstablishRepresentation cenv envinner tpenv inSig (MutRecDefnsPhase1DataForTycon(_, synTyconRepr, _, _, _, _)) (tycon:Tycon) (attrs:Attribs) = let m = tycon.Range try let id = tycon.Id let thisTyconRef = mkLocalTyconRef tycon let innerParent = Parent thisTyconRef - let thisTyInst,thisTy = generalizeTyconRef thisTyconRef + let thisTyInst, thisTy = generalizeTyconRef thisTyconRef let hasAbstractAttr = HasFSharpAttribute cenv.g cenv.g.attrib_AbstractClassAttribute attrs let hasSealedAttr = @@ -15044,16 +15044,16 @@ module EstablishTypeDefinitionCores = tycon.entity_attribs <- attrs let noAbstractClassAttributeCheck() = - if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(),m)) + if hasAbstractAttr then errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) let noAllowNullLiteralAttributeCheck() = - if hasAllowNullLiteralAttr then errorR (Error(FSComp.SR.tcRecordsUnionsAbbreviationsStructsMayNotHaveAllowNullLiteralAttribute(),m)) + if hasAllowNullLiteralAttr then errorR (Error(FSComp.SR.tcRecordsUnionsAbbreviationsStructsMayNotHaveAllowNullLiteralAttribute(), m)) let allowNullLiteralAttributeCheck() = if hasAllowNullLiteralAttr then - tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue cenv.g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(),m))) - tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue cenv.g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(),m))) + tycon.TypeContents.tcaug_super |> Option.iter (fun ty -> if not (TypeNullIsExtraValue cenv.g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) + tycon.ImmediateInterfaceTypesOfFSharpTycon |> List.iter (fun ty -> if not (TypeNullIsExtraValue cenv.g m ty) then errorR (Error(FSComp.SR.tcAllowNullTypesMayOnlyInheritFromAllowNullTypes(), m))) let structLayoutAttributeCheck(allowed) = @@ -15064,30 +15064,30 @@ module EstablishTypeDefinitionCores = if kind = explicitKind then warning(PossibleUnverifiableCode(m)) elif thisTyconRef.Typars(m).Length > 0 then - errorR (Error(FSComp.SR.tcGenericTypesCannotHaveStructLayout(),m)) + errorR (Error(FSComp.SR.tcGenericTypesCannotHaveStructLayout(), m)) else - errorR (Error(FSComp.SR.tcOnlyStructsCanHaveStructLayout(),m)) + errorR (Error(FSComp.SR.tcOnlyStructsCanHaveStructLayout(), m)) | None -> () let hiddenReprChecks(hasRepr) = structLayoutAttributeCheck(false) if hasSealedAttr = Some(false) || (hasRepr && hasSealedAttr <> Some(true) && not (id.idText = "Unit" && cenv.g.compilingFslib) ) then - errorR(Error(FSComp.SR.tcRepresentationOfTypeHiddenBySignature(),m)) + errorR(Error(FSComp.SR.tcRepresentationOfTypeHiddenBySignature(), m)) if hasAbstractAttr then - errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(),m)) + errorR (Error(FSComp.SR.tcOnlyClassesCanHaveAbstract(), m)) let noMeasureAttributeCheck() = - if hasMeasureAttr then errorR (Error(FSComp.SR.tcOnlyTypesRepresentingUnitsOfMeasureCanHaveMeasure(),m)) + if hasMeasureAttr then errorR (Error(FSComp.SR.tcOnlyTypesRepresentingUnitsOfMeasureCanHaveMeasure(), m)) let noCLIMutableAttributeCheck() = - if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(),m)) + if hasCLIMutable then errorR (Error(FSComp.SR.tcThisTypeMayNotHaveACLIMutableAttribute(), m)) let noSealedAttributeCheck(k) = - if hasSealedAttr = Some(true) then errorR (Error(k(),m)) + if hasSealedAttr = Some(true) then errorR (Error(k(), m)) let noFieldsCheck(fields':RecdField list) = match fields' with - | (rf :: _) -> errorR (Error(FSComp.SR.tcInterfaceTypesAndDelegatesCannotContainFields(),rf.Range)) + | (rf :: _) -> errorR (Error(FSComp.SR.tcInterfaceTypesAndDelegatesCannotContainFields(), rf.Range)) | _ -> () @@ -15106,7 +15106,7 @@ module EstablishTypeDefinitionCores = let nenv' = AddFakeNameToNameEnv fspec.Name nenv (Item.RecdField info) // Name resolution gives better info for tooltips let item = FreshenRecdFieldRef cenv.nameResolver m (thisTyconRef.MakeNestedRecdFieldRef fspec) - CallNameResolutionSink cenv.tcSink (fspec.Range,nenv,item,item,emptyTyparInst,ItemOccurence.Binding,envinner.DisplayEnv,ad) + CallNameResolutionSink cenv.tcSink (fspec.Range, nenv, item, item, emptyTyparInst, ItemOccurence.Binding, envinner.DisplayEnv, ad) // Environment is needed for completions CallEnvSink cenv.tcSink (fspec.Range, nenv', ad) @@ -15115,11 +15115,11 @@ module EstablishTypeDefinitionCores = let nenv = envinner.NameEnv // Constructors should be visible from IntelliSense, so add fake names for them for unionCase in unionCases do - let info = UnionCaseInfo(thisTyInst,mkUnionCaseRef thisTyconRef unionCase.Id.idText) - let nenv' = AddFakeNameToNameEnv unionCase.Id.idText nenv (Item.UnionCase(info,false)) + let info = UnionCaseInfo(thisTyInst, mkUnionCaseRef thisTyconRef unionCase.Id.idText) + let nenv' = AddFakeNameToNameEnv unionCase.Id.idText nenv (Item.UnionCase(info, false)) // Report to both - as in previous function - let item = Item.UnionCase(info,false) - CallNameResolutionSink cenv.tcSink (unionCase.Range,nenv,item,item,emptyTyparInst,ItemOccurence.Binding,envinner.DisplayEnv,ad) + let item = Item.UnionCase(info, false) + CallNameResolutionSink cenv.tcSink (unionCase.Range, nenv, item, item, emptyTyparInst, ItemOccurence.Binding, envinner.DisplayEnv, ad) CallEnvSink cenv.tcSink (unionCase.Id.idRange, nenv', ad) let typeRepr, baseValOpt, safeInitInfo = @@ -15145,7 +15145,7 @@ module EstablishTypeDefinitionCores = // In F# this only defines a new type if A is not in scope // as a type constructor, or if the form type A = A is used. // "type x = | A" can always be used instead. - | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr,envinner,id) (unionCaseName,_) -> + | TyconCoreAbbrevThatIsReallyAUnion (hasMeasureAttr, envinner, id) (unionCaseName, _) -> structLayoutAttributeCheck(false) noAllowNullLiteralAttributeCheck() @@ -15154,17 +15154,17 @@ module EstablishTypeDefinitionCores = writeFakeUnionCtorsToSink [ unionCase ] MakeUnionRepr [ unionCase ], None, NoSafeInitInfo - | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.ThereWereSignificantParseErrorsSoDoNotTypecheckThisNode, _rhsType,_) -> + | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.ThereWereSignificantParseErrorsSoDoNotTypecheckThisNode, _rhsType, _) -> TNoRepr, None, NoSafeInitInfo - | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.Ok, rhsType,_) -> + | SynTypeDefnSimpleRepr.TypeAbbrev(ParserDetail.Ok, rhsType, _) -> if hasSealedAttr = Some(true) then - errorR (Error(FSComp.SR.tcAbbreviatedTypesCannotBeSealed(),m)) + errorR (Error(FSComp.SR.tcAbbreviatedTypesCannotBeSealed(), m)) noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() if hasMeasureableAttr then let kind = if hasMeasureAttr then TyparKind.Measure else TyparKind.Type - let theTypeAbbrev,_ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv rhsType + let theTypeAbbrev, _ = TcTypeOrMeasureAndRecover (Some kind) cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv rhsType TMeasureableRepr theTypeAbbrev, None, NoSafeInitInfo // If we already computed a representation, e.g. for a generative type definition, then don't change it here. @@ -15173,7 +15173,7 @@ module EstablishTypeDefinitionCores = else TNoRepr, None, NoSafeInitInfo - | SynTypeDefnSimpleRepr.Union (_,unionCases,_) -> + | SynTypeDefnSimpleRepr.Union (_, unionCases, _) -> noCLIMutableAttributeCheck() noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDU @@ -15185,12 +15185,12 @@ module EstablishTypeDefinitionCores = if tycon.IsStructRecordOrUnionTycon && unionCases.Length > 1 then let fieldNames = [ for uc in unionCases do for ft in uc.FieldTable.TrueInstanceFieldsAsList do yield ft.Name ] if fieldNames |> List.distinct |> List.length <> fieldNames.Length then - errorR(Error(FSComp.SR.tcStructUnionMultiCaseDistinctFields(),m)) + errorR(Error(FSComp.SR.tcStructUnionMultiCaseDistinctFields(), m)) writeFakeUnionCtorsToSink unionCases MakeUnionRepr unionCases, None, NoSafeInitInfo - | SynTypeDefnSimpleRepr.Record (_,fields,_) -> + | SynTypeDefnSimpleRepr.Record (_, fields, _) -> noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedRecord noAbstractClassAttributeCheck() @@ -15201,7 +15201,7 @@ module EstablishTypeDefinitionCores = writeFakeRecordFieldsToSink recdFields TRecdRepr (MakeRecdFieldsTable recdFields), None, NoSafeInitInfo - | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s,_) -> + | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly (s, _) -> noCLIMutableAttributeCheck() noMeasureAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedAssemblyCode @@ -15210,7 +15210,7 @@ module EstablishTypeDefinitionCores = noAbstractClassAttributeCheck() TAsmRepr s, None, NoSafeInitInfo - | SynTypeDefnSimpleRepr.General (kind,inherits,slotsigs,fields,isConcrete,isIncrClass,implicitCtorSynPats,_) -> + | SynTypeDefnSimpleRepr.General (kind, inherits, slotsigs, fields, isConcrete, isIncrClass, implicitCtorSynPats, _) -> let userFields = TcRecdUnionAndEnumDeclarations.TcNamedFieldDecls cenv envinner innerParent isIncrClass tpenv fields let implicitStructFields = [ // For structs with an implicit ctor, determine the fields immediately based on the arguments @@ -15219,7 +15219,7 @@ module EstablishTypeDefinitionCores = () | Some spats -> if tycon.IsFSharpStructOrEnumTycon then - let ctorArgNames,(_,names,_) = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv (SynSimplePats.SimplePats (spats,m)) + let ctorArgNames, (_, names, _) = TcSimplePatsOfUnknownType cenv true CheckCxs envinner tpenv (SynSimplePats.SimplePats (spats, m)) for arg in ctorArgNames do let ty = names.[arg].Type let id = names.[arg].Ident @@ -15231,7 +15231,7 @@ module EstablishTypeDefinitionCores = let superTy = tycon.TypeContents.tcaug_super let containerInfo = TyconContainerInfo(innerParent, thisTyconRef, thisTyconRef.Typars(m), NoSafeInitInfo) - let kind = InferTyconKind cenv.g (kind,attrs,slotsigs,fields,inSig,isConcrete,m) + let kind = InferTyconKind cenv.g (kind, attrs, slotsigs, fields, inSig, isConcrete, m) match kind with | TyconHiddenRepr -> hiddenReprChecks(true) @@ -15242,11 +15242,11 @@ module EstablishTypeDefinitionCores = // Note: for a mutually recursive set we can't check this condition // until "isSealedTy" and "isClassTy" give reliable results. superTy |> Option.iter (fun ty -> - let m = match inherits with | [] -> m | ((_,m,_) :: _) -> m + let m = match inherits with | [] -> m | ((_, m, _) :: _) -> m if isSealedTy cenv.g ty then - errorR(Error(FSComp.SR.tcCannotInheritFromSealedType(),m)) + errorR(Error(FSComp.SR.tcCannotInheritFromSealedType(), m)) elif not (isClassTy cenv.g ty) then - errorR(Error(FSComp.SR.tcCannotInheritFromInterfaceType(),m))) + errorR(Error(FSComp.SR.tcCannotInheritFromInterfaceType(), m))) let kind = match kind with @@ -15256,12 +15256,12 @@ module EstablishTypeDefinitionCores = noAbstractClassAttributeCheck() noAllowNullLiteralAttributeCheck() if not (isNil slotsigs) then - errorR (Error(FSComp.SR.tcStructTypesCannotContainAbstractMembers(),m)) + errorR (Error(FSComp.SR.tcStructTypesCannotContainAbstractMembers(), m)) structLayoutAttributeCheck(true) TTyconStruct | TyconInterface -> - if hasSealedAttr = Some(true) then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(),m)) + if hasSealedAttr = Some(true) then errorR (Error(FSComp.SR.tcInterfaceTypesCannotBeSealed(), m)) noCLIMutableAttributeCheck() structLayoutAttributeCheck(false) noAbstractClassAttributeCheck() @@ -15273,22 +15273,22 @@ module EstablishTypeDefinitionCores = structLayoutAttributeCheck(not isIncrClass) allowNullLiteralAttributeCheck() TTyconClass - | TyconDelegate (ty,arity) -> + | TyconDelegate (ty, arity) -> noCLIMutableAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedDelegate structLayoutAttributeCheck(false) noAllowNullLiteralAttributeCheck() noAbstractClassAttributeCheck() noFieldsCheck(userFields) - let ty',_ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty - let _,curriedArgInfos,returnTy,_ = GetTopValTypeInCompiledForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv envinner) |> TranslatePartialArity []) ty' m - if curriedArgInfos.Length < 1 then error(Error(FSComp.SR.tcInvalidDelegateSpecification(),m)) - if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcDelegatesCannotBeCurried(),m)) + let ty', _ = TcTypeAndRecover cenv NoNewTypars CheckCxs ItemOccurence.UseInType envinner tpenv ty + let _, curriedArgInfos, returnTy, _ = GetTopValTypeInCompiledForm cenv.g (arity |> TranslateTopValSynInfo m (TcAttributes cenv envinner) |> TranslatePartialArity []) ty' m + if curriedArgInfos.Length < 1 then error(Error(FSComp.SR.tcInvalidDelegateSpecification(), m)) + if curriedArgInfos.Length > 1 then error(Error(FSComp.SR.tcDelegatesCannotBeCurried(), m)) let ttps = thisTyconRef.Typars(m) let fparams = curriedArgInfos.Head |> List.map MakeSlotParam - TTyconDelegate (MakeSlotSig("Invoke",thisTy,ttps,[],[fparams], returnTy)) + TTyconDelegate (MakeSlotSig("Invoke", thisTy, ttps, [], [fparams], returnTy)) | _ -> - error(InternalError("should have inferred tycon kind",m)) + error(InternalError("should have inferred tycon kind", m)) let baseIdOpt = match synTyconRepr with @@ -15299,24 +15299,24 @@ module EstablishTypeDefinitionCores = | SynTypeDefnSimpleRepr.LibraryOnlyILAssembly _ -> None | SynTypeDefnSimpleRepr.Record _ -> None | SynTypeDefnSimpleRepr.Enum _ -> None - | SynTypeDefnSimpleRepr.General (_,inherits,_,_,_,_,_,_) -> + | SynTypeDefnSimpleRepr.General (_, inherits, _, _, _, _, _, _) -> match inherits with | [] -> None - | ((_,m,baseIdOpt) :: _) -> + | ((_, m, baseIdOpt) :: _) -> match baseIdOpt with - | None -> Some(ident("base",m)) + | None -> Some(ident("base", m)) | Some id -> Some(id) let abstractSlots = - [ for (valSpfn,memberFlags) in slotsigs do + [ for (valSpfn, memberFlags) in slotsigs do - let (ValSpfn(_, _, _, _, _valSynData, _, _, _, _,_, m)) = valSpfn + let (ValSpfn(_, _, _, _, _valSynData, _, _, _, _, _, m)) = valSpfn CheckMemberFlags None NewSlotsOK OverridesOK memberFlags m - let slots = fst (TcAndPublishValSpec (cenv,envinner,containerInfo,ModuleOrMemberBinding,Some memberFlags,tpenv,valSpfn)) + let slots = fst (TcAndPublishValSpec (cenv, envinner, containerInfo, ModuleOrMemberBinding, Some memberFlags, tpenv, valSpfn)) // Multiple slots may be returned, e.g. for - // abstract P : int with get,set + // abstract P : int with get, set for slot in slots do yield mkLocalValRef slot ] @@ -15332,17 +15332,17 @@ module EstablishTypeDefinitionCores = fsobjmodel_rfields=MakeRecdFieldsTable (userFields @ implicitStructFields @ safeInitFields) } repr, baseValOpt, safeInitInfo - | SynTypeDefnSimpleRepr.Enum (decls,m) -> - let fieldTy,fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner innerParent thisTy decls + | SynTypeDefnSimpleRepr.Enum (decls, m) -> + let fieldTy, fields' = TcRecdUnionAndEnumDeclarations.TcEnumDecls cenv envinner innerParent thisTy decls let kind = TTyconEnum structLayoutAttributeCheck(false) noCLIMutableAttributeCheck() noSealedAttributeCheck FSComp.SR.tcTypesAreAlwaysSealedEnum noAllowNullLiteralAttributeCheck() - let vfld = NewRecdField false None (ident("value__",m)) fieldTy false false [] [] XmlDoc.Empty taccessPublic true + let vfld = NewRecdField false None (ident("value__", m)) fieldTy false false [] [] XmlDoc.Empty taccessPublic true if not (ListSet.contains (typeEquiv cenv.g) fieldTy [ cenv.g.int32_ty; cenv.g.int16_ty; cenv.g.sbyte_ty; cenv.g.int64_ty; cenv.g.char_ty; cenv.g.bool_ty; cenv.g.uint32_ty; cenv.g.uint16_ty; cenv.g.byte_ty; cenv.g.uint64_ty ]) then - errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(),m)) + errorR(Error(FSComp.SR.tcInvalidTypeForLiteralEnumeration(), m)) writeFakeRecordFieldsToSink fields' let repr = @@ -15355,13 +15355,13 @@ module EstablishTypeDefinitionCores = tycon.entity_tycon_repr <- typeRepr // We check this just after establishing the representation if TyconHasUseNullAsTrueValueAttribute cenv.g tycon && not (CanHaveUseNullAsTrueValueAttribute cenv.g tycon) then - errorR(Error(FSComp.SR.tcInvalidUseNullAsTrueValue(),m)) + errorR(Error(FSComp.SR.tcInvalidUseNullAsTrueValue(), m)) // validate ConditionalAttribute, should it be applied (it's only valid on a type if the type is an attribute type) match attrs |> List.tryFind (IsMatchingFSharpAttribute cenv.g cenv.g.attrib_ConditionalAttribute) with | Some _ -> if not(ExistsInEntireHierarchyOfType (fun t -> typeEquiv cenv.g t (mkAppTy cenv.g.tcref_System_Attribute [])) cenv.g cenv.amap m AllowMultiIntfInstantiations.Yes thisTy) then - errorR(Error(FSComp.SR.tcConditionalAttributeUsage(),m)) + errorR(Error(FSComp.SR.tcConditionalAttributeUsage(), m)) | _ -> () (baseValOpt, safeInitInfo) @@ -15376,14 +15376,14 @@ module EstablishTypeDefinitionCores = let rec accInAbbrevType ty acc = match stripTyparEqns ty with - | TType_tuple (_,l) -> accInAbbrevTypes l acc - | TType_ucase (UCRef(tc,_),tinst) - | TType_app (tc,tinst) -> + | TType_tuple (_, l) -> accInAbbrevTypes l acc + | TType_ucase (UCRef(tc, _), tinst) + | TType_app (tc, tinst) -> let tycon2 = tc.Deref let acc = accInAbbrevTypes tinst acc // Record immediate recursive references if ListSet.contains (===) tycon2 tycons then - (tycon,tycon2) :: acc + (tycon, tycon2) :: acc // Expand the representation of abbreviations elif tc.IsTypeAbbrev then accInAbbrevType (reduceTyconRefAbbrev tc tinst) acc @@ -15391,12 +15391,12 @@ module EstablishTypeDefinitionCores = else acc - | TType_fun (d,r) -> + | TType_fun (d, r) -> accInAbbrevType d (accInAbbrevType r acc) | TType_var _ -> acc - | TType_forall (_,r) -> accInAbbrevType r acc + | TType_forall (_, r) -> accInAbbrevType r acc | TType_measure ms -> accInMeasure ms acc @@ -15424,7 +15424,7 @@ module EstablishTypeDefinitionCores = // The thing is cyclic. Set the abbreviation and representation to be "None" to stop later VS crashes tycon.entity_tycon_abbrev <- None tycon.entity_tycon_repr <- TNoRepr - errorR(Error(FSComp.SR.tcTypeDefinitionIsCyclic(),tycon.Range))) + errorR(Error(FSComp.SR.tcTypeDefinitionIsCyclic(), tycon.Range))) /// Check that a set of type definitions is free of inheritance cycles @@ -15435,9 +15435,9 @@ module EstablishTypeDefinitionCores = // // The graph is on the (initial) type constructors (not types (e.g. tycon instantiations)). // Closing under edges: - // 1. (tycon,superTycon) -- tycon (initial) to the tycon of its super type. - // 2. (tycon,interfaceTycon) -- tycon (initial) to the tycon of an interface it implements. - // 3. (tycon,T) -- tycon (initial) is a struct with a field (static or instance) that would store a T<_> + // 1. (tycon, superTycon) -- tycon (initial) to the tycon of its super type. + // 2. (tycon, interfaceTycon) -- tycon (initial) to the tycon of an interface it implements. + // 3. (tycon, T) -- tycon (initial) is a struct with a field (static or instance) that would store a T<_> // where storing T<_> means is T<_> // or is a struct with an instance field that stores T<_>. // The implementation only stores edges between (initial) tycons. @@ -15463,15 +15463,15 @@ module EstablishTypeDefinitionCores = // the way the Microsoft desktop CLR class loader works. // END: EARLIER COMMENT - // edgesFrom tycon collects (tycon,tycon2) edges, for edges as described above. + // edgesFrom tycon collects (tycon, tycon2) edges, for edges as described above. let edgesFrom (tycon:Tycon) = - // Record edge (tycon,tycon2), only when tycon2 is an "initial" tycon. + // Record edge (tycon, tycon2), only when tycon2 is an "initial" tycon. let insertEdgeToTycon tycon2 acc = if ListSet.contains (===) tycon2 tycons && // note: only add if tycon2 is initial - not (List.exists (fun (tc,tc2) -> tc === tycon && tc2 === tycon2) acc) // note: only add if (tycon,tycon2) not already an edge + not (List.exists (fun (tc, tc2) -> tc === tycon && tc2 === tycon2) acc) // note: only add if (tycon, tycon2) not already an edge then - (tycon,tycon2)::acc - else acc // note: all edges added are (tycon,_) + (tycon, tycon2)::acc + else acc // note: all edges added are (tycon, _) let insertEdgeToType ty acc = match tryDestAppTy cenv.g ty with | Some tcref -> @@ -15480,44 +15480,45 @@ module EstablishTypeDefinitionCores = acc // collect edges from an a struct field (which is struct-contained in tycon) - let rec accStructField (structTycon:Tycon) structTyInst (fspec:RecdField) (doneTypes,acc) = + let rec accStructField (structTycon:Tycon) structTyInst (fspec:RecdField) (doneTypes, acc) = let fieldTy = actualTyOfRecdFieldForTycon structTycon structTyInst fspec - accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes,acc) + accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes, acc) // collect edges from an a struct field (given the field type, which may be expanded if it is a type abbreviation) - and accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes,acc) = + and accStructFieldType structTycon structTyInst fspec fieldTy (doneTypes, acc) = let fieldTy = stripTyparEqns fieldTy match fieldTy with - | TType_app (tcref2 ,tinst2) when tcref2.IsStructOrEnumTycon -> + | TType_app (tcref2 , tinst2) when tcref2.IsStructOrEnumTycon -> // The field is a struct. - // An edge (tycon,tycon2) should be recorded, unless it is the "static self-typed field" case. + // An edge (tycon, tycon2) should be recorded, unless it is the "static self-typed field" case. let tycon2 = tcref2.Deref let specialCaseStaticField = - // The special case of "static field S<'a> in struct S<'a>" is permitted. (so no (S,S) edge to be collected). + // The special case of "static field S<'a> in struct S<'a>" is permitted. (so no (S, S) edge to be collected). fspec.IsStatic && (structTycon === tycon2) && - (structTyInst,tinst2) ||> List.lengthsEqAndForall2 (fun ty1 ty2 -> match tryDestTyparTy cenv.g ty1 with - | Some destTypar1 -> - match tryDestTyparTy cenv.g ty2 with - | Some destTypar2 -> typarEq destTypar1 destTypar2 - | _ -> false - | _ -> false) + (structTyInst, tinst2) ||> List.lengthsEqAndForall2 (fun ty1 ty2 -> + match tryDestTyparTy cenv.g ty1 with + | Some destTypar1 -> + match tryDestTyparTy cenv.g ty2 with + | Some destTypar2 -> typarEq destTypar1 destTypar2 + | _ -> false + | _ -> false) if specialCaseStaticField then - doneTypes,acc // no edge collected, no recursion. + doneTypes, acc // no edge collected, no recursion. else - let acc = insertEdgeToTycon tycon2 acc // collect edge (tycon,tycon2), if tycon2 is initial. - accStructInstanceFields fieldTy tycon2 tinst2 (doneTypes,acc) // recurse through struct field looking for more edges - | TType_app (tcref2 ,tinst2) when tcref2.IsTypeAbbrev -> + let acc = insertEdgeToTycon tycon2 acc // collect edge (tycon, tycon2), if tycon2 is initial. + accStructInstanceFields fieldTy tycon2 tinst2 (doneTypes, acc) // recurse through struct field looking for more edges + | TType_app (tcref2 , tinst2) when tcref2.IsTypeAbbrev -> // The field is a type abbreviation. Expand and repeat. - accStructFieldType structTycon structTyInst fspec (reduceTyconRefAbbrev tcref2 tinst2) (doneTypes,acc) + accStructFieldType structTycon structTyInst fspec (reduceTyconRefAbbrev tcref2 tinst2) (doneTypes, acc) | _ -> - doneTypes,acc + doneTypes, acc // collect edges from the fields of a given struct type. - and accStructFields includeStaticFields ty (structTycon:Tycon) tinst (doneTypes,acc) = + and accStructFields includeStaticFields ty (structTycon:Tycon) tinst (doneTypes, acc) = if List.exists (typeEquiv cenv.g ty) doneTypes then // This type (type instance) has been seen before, so no need to collect the same edges again (and avoid loops!) - doneTypes,acc + doneTypes, acc else // Only collect once from each type instance. let doneTypes = ty :: doneTypes @@ -15529,16 +15530,16 @@ module EstablishTypeDefinitionCores = else structTycon.AllFieldsAsList let fspecs = fspecs |> List.filter (fun fspec -> includeStaticFields || not fspec.IsStatic) - let doneTypes,acc = List.foldBack (accStructField structTycon tinst) fspecs (doneTypes,acc) - doneTypes,acc - and accStructInstanceFields ty structTycon tinst (doneTypes,acc) = accStructFields false ty structTycon tinst (doneTypes,acc) - and accStructAllFields ty (structTycon: Tycon) tinst (doneTypes,acc) = accStructFields true ty structTycon tinst (doneTypes,acc) + let doneTypes, acc = List.foldBack (accStructField structTycon tinst) fspecs (doneTypes, acc) + doneTypes, acc + and accStructInstanceFields ty structTycon tinst (doneTypes, acc) = accStructFields false ty structTycon tinst (doneTypes, acc) + and accStructAllFields ty (structTycon: Tycon) tinst (doneTypes, acc) = accStructFields true ty structTycon tinst (doneTypes, acc) let acc = [] let acc = if tycon.IsStructOrEnumTycon then - let tinst,ty = generalizeTyconRef (mkLocalTyconRef tycon) - let _,acc = accStructAllFields ty tycon tinst ([],acc) + let tinst, ty = generalizeTyconRef (mkLocalTyconRef tycon) + let _, acc = accStructAllFields ty tycon tinst ([], acc) acc else acc @@ -15558,16 +15559,16 @@ module EstablishTypeDefinitionCores = // The thing is cyclic. Set the abbreviation and representation to be "None" to stop later VS crashes tycon.entity_tycon_abbrev <- None tycon.entity_tycon_repr <- TNoRepr - errorR(Error(FSComp.SR.tcTypeDefinitionIsCyclicThroughInheritance(),tycon.Range))) + errorR(Error(FSComp.SR.tcTypeDefinitionIsCyclicThroughInheritance(), tycon.Range))) // Interlude between Phase1D and Phase1E - Check and publish the explicit constraints. let TcMutRecDefns_CheckExplicitConstraints cenv tpenv m checkCxs envMutRecPrelim withEnvs = - (envMutRecPrelim,withEnvs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> + (envMutRecPrelim, withEnvs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> match origInfo, tyconOpt with - | (typeDefCore,_,_), Some (tycon:Tycon) -> - let (MutRecDefnsPhase1DataForTycon(synTyconInfo,_,_,_,_,_)) = typeDefCore - let (ComponentInfo(_,_, synTyconConstraints,_,_,_, _,_)) = synTyconInfo + | (typeDefCore, _, _), Some (tycon:Tycon) -> + let (MutRecDefnsPhase1DataForTycon(synTyconInfo, _, _, _, _, _)) = typeDefCore + let (ComponentInfo(_, _, synTyconConstraints, _, _, _, _, _)) = synTyconInfo let envForTycon = AddDeclaredTypars CheckForDuplicateTypars (tycon.Typars(m)) envForDecls let thisTyconRef = mkLocalTyconRef tycon let envForTycon = MakeInnerEnvForTyconRef cenv envForTycon thisTyconRef false @@ -15589,8 +15590,8 @@ module EstablishTypeDefinitionCores = TcTyconDefnCore_Phase1A_BuildInitialModule cenv envForDecls innerParent typeNames compInfo decls) // Build the initial Tycon for each type definition - (fun (innerParent, _, envForDecls) (typeDefCore,tyconMemberInfo) -> - let (MutRecDefnsPhase1DataForTycon(_,_,_,_,_,isAtOriginalTyconDefn)) = typeDefCore + (fun (innerParent, _, envForDecls) (typeDefCore, tyconMemberInfo) -> + let (MutRecDefnsPhase1DataForTycon(_, _, _, _, _, isAtOriginalTyconDefn)) = typeDefCore let tyconOpt = if isAtOriginalTyconDefn then Some (TcTyconDefnCore_Phase1A_BuildInitialTycon cenv envForDecls innerParent typeDefCore) @@ -15636,17 +15637,17 @@ module EstablishTypeDefinitionCores = // Here we run InferTyconKind and record partial information about the kind of the type constructor. // This means TyconObjModelKind is set, which means isSealedTy, isInterfaceTy etc. give accurate results. let withAttrs = - (envMutRecPrelim, withEnvs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo,tyconOpt) -> + (envMutRecPrelim, withEnvs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> let res = match origInfo, tyconOpt with - | (typeDefCore,_,_), Some tycon -> Some (tycon,TcTyconDefnCore_Phase1B_EstablishBasicKind cenv inSig envForDecls typeDefCore tycon) + | (typeDefCore, _, _), Some tycon -> Some (tycon, TcTyconDefnCore_Phase1B_EstablishBasicKind cenv inSig envForDecls typeDefCore tycon) | _ -> None origInfo, res) // Phase 1C. Establish the abbreviations (no constraint checking, because constraints not yet established) - (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo,tyconAndAttrsOpt) -> + (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> match origInfo, tyconAndAttrsOpt with - | (typeDefCore, _,_), Some (tycon,(attrs,_)) -> TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envForDecls inSig tpenv FirstPass typeDefCore tycon attrs + | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envForDecls inSig tpenv FirstPass typeDefCore tycon attrs | _ -> ()) // Check for cyclic abbreviations. If this succeeds we can start reducing abbreviations safely. @@ -15663,10 +15664,10 @@ module EstablishTypeDefinitionCores = // // First find all the field types in all the structural types let tyconsWithStructuralTypes = - (envMutRecPrelim,withEnvs) + (envMutRecPrelim, withEnvs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo, tyconOpt) -> match origInfo, tyconOpt with - | (typeDefCore,_,_), Some tycon -> Some (tycon,GetStructuralElementsOfTyconDefn cenv envForDecls tpenv typeDefCore tycon) + | (typeDefCore, _, _), Some tycon -> Some (tycon, GetStructuralElementsOfTyconDefn cenv envForDecls tpenv typeDefCore tycon) | _ -> None) |> MutRecShapes.collectTycons |> List.choose id @@ -15674,20 +15675,20 @@ module EstablishTypeDefinitionCores = let scSet = TyconConstraintInference.InferSetOfTyconsSupportingComparable cenv envMutRecPrelim.DisplayEnv tyconsWithStructuralTypes let seSet = TyconConstraintInference.InferSetOfTyconsSupportingEquatable cenv envMutRecPrelim.DisplayEnv tyconsWithStructuralTypes - (envMutRecPrelim,withEnvs) + (envMutRecPrelim, withEnvs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (_, tyconOpt) -> tyconOpt |> Option.iter (AddAugmentationDeclarations.AddGenericHashAndComparisonDeclarations cenv envForDecls scSet seSet)) TcMutRecDefns_CheckExplicitConstraints cenv tpenv m NoCheckCxs envMutRecPrelim withEnvs // No inferred constraints allowed on declared typars - (envMutRecPrelim,withEnvs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (_, tyconOpt) -> + (envMutRecPrelim, withEnvs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (_, tyconOpt) -> tyconOpt |> Option.iter (fun tycon -> tycon.Typars(m) |> List.iter (SetTyparRigid cenv.g envForDecls.DisplayEnv m))) // Phase1E. OK, now recheck the abbreviations, super/interface and explicit constraints types (this time checking constraints) - (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo,tyconAndAttrsOpt) -> + (envMutRecPrelim, withAttrs) ||> MutRecShapes.iterTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> match origInfo, tyconAndAttrsOpt with - | (typeDefCore, _, _), Some (tycon,(attrs,_)) -> TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envForDecls inSig tpenv SecondPass typeDefCore tycon attrs + | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> TcTyconDefnCore_Phase1C_Phase1E_EstablishAbbreviations cenv envForDecls inSig tpenv SecondPass typeDefCore tycon attrs | _ -> ()) // Phase1F. Establish inheritance hierarchy @@ -15699,7 +15700,7 @@ module EstablishTypeDefinitionCores = let envMutRecPrelim, withAttrs = (envMutRecPrelim, withAttrs) ||> MutRecShapes.extendEnvs (fun envForDecls decls -> - let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon,_)) -> Some tycon | _ -> None) + let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon, _)) -> Some tycon | _ -> None) let exns = tycons |> List.filter (fun tycon -> tycon.IsExceptionDecl) let envForDecls = (envForDecls, exns) ||> List.fold (AddLocalExnDefnAndReport cenv.tcSink scopem) envForDecls) @@ -15709,10 +15710,10 @@ module EstablishTypeDefinitionCores = // Now do the representations. Each baseValOpt is a residue from the representation which is potentially available when // checking the members. let withBaseValsAndSafeInitInfos = - (envMutRecPrelim,withAttrs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo,tyconAndAttrsOpt) -> + (envMutRecPrelim, withAttrs) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls (origInfo, tyconAndAttrsOpt) -> let info = match origInfo, tyconAndAttrsOpt with - | (typeDefCore,_,_), Some (tycon,(attrs,_)) -> TcTyconDefnCore_Phase1G_EstablishRepresentation cenv envForDecls tpenv inSig typeDefCore tycon attrs + | (typeDefCore, _, _), Some (tycon, (attrs, _)) -> TcTyconDefnCore_Phase1G_EstablishRepresentation cenv envForDecls tpenv inSig typeDefCore tycon attrs | _ -> None, NoSafeInitInfo let tyconOpt, fixupFinalAttrs = match tyconAndAttrsOpt with @@ -15753,7 +15754,7 @@ module TcDeclarations = match ResolveTypeLongIdent cenv.tcSink cenv.nameResolver ItemOccurence.Binding OpenQualified envForDecls.eNameResEnv ad longPath resInfo PermitDirectReferenceToGeneratedType.No with | Result res -> res | res when inSig && longPath.Length = 1 -> - errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(),m)) + errorR(Deprecated(FSComp.SR.tcReservedSyntaxForAugmentation(), m)) ForceRaise res | res -> ForceRaise res @@ -15768,14 +15769,14 @@ module TcDeclarations = // a) For interfaces, only if it is in the original defn. // Augmentations to interfaces via partial type defns will always be extensions, e.g. extension members on interfaces. // b) For other types, if the type is isInSameModuleOrNamespace - let declKind,typars = + let declKind, typars = if isAtOriginalTyconDefn then ModuleOrMemberBinding, reqTypars else let isInSameModuleOrNamespace = match envForDecls.eModuleOrNamespaceTypeAccumulator.Value.TypesByMangledName.TryFind(tcref.LogicalName) with - | Some tycon -> (tyconOrder.Compare(tcref.Deref,tycon) = 0) + | Some tycon -> (tyconOrder.Compare(tcref.Deref, tycon) = 0) | None -> //false // There is a special case we allow when compiling FSharp.Core.dll which permits interface implementations across namespace fragments @@ -15798,7 +15799,7 @@ module TcDeclarations = IntrinsicExtensionBinding, reqTypars else if isInSameModuleOrNamespace && isInterfaceOrDelegateOrEnum then - errorR(Error(FSComp.SR.tcMembersThatExtendInterfaceMustBePlacedInSeparateModule(),tcref.Range)) + errorR(Error(FSComp.SR.tcMembersThatExtendInterfaceMustBePlacedInSeparateModule(), tcref.Range)) if nReqTypars <> synTypars.Length then error(Error(FSComp.SR.tcDeclaredTypeParametersForExtensionDoNotMatchOriginal(tcref.DisplayNameWithStaticParametersAndUnderscoreTypars), m)) if not (typarsAEquiv cenv.g TypeEquivEnv.Empty reqTypars declaredTypars) then @@ -15809,7 +15810,7 @@ module TcDeclarations = declKind, tcref, typars - let private isAugmentationTyconDefnRepr = function (SynTypeDefnSimpleRepr.General(TyconAugmentation,_,_,_,_,_,_,_)) -> true | _ -> false + let private isAugmentationTyconDefnRepr = function (SynTypeDefnSimpleRepr.General(TyconAugmentation, _, _, _, _, _, _, _)) -> true | _ -> false let private isAutoProperty = function SynMemberDefn.AutoProperty _ -> true | _ -> false let private isMember = function SynMemberDefn.Member _ -> true | _ -> false let private isImplicitCtor = function SynMemberDefn.ImplicitCtor _ -> true | _ -> false @@ -15817,7 +15818,7 @@ module TcDeclarations = let private isAbstractSlot = function SynMemberDefn.AbstractSlot _ -> true | _ -> false let private isInterface = function SynMemberDefn.Interface _ -> true | _ -> false let private isInherit = function SynMemberDefn.Inherit _ -> true | _ -> false - let private isField = function SynMemberDefn.ValField (_,_) -> true | _ -> false + let private isField = function SynMemberDefn.ValField (_, _) -> true | _ -> false let private isTycon = function SynMemberDefn.NestedType _ -> true | _ -> false let private allFalse ps x = List.forall (fun p -> not (p x)) ps @@ -15845,58 +15846,58 @@ module TcDeclarations = | _ -> ds // Skip over 'let' and 'do' bindings - let _,ds = ds |> List.takeUntil (function SynMemberDefn.LetBindings _ -> false | _ -> true) + let _, ds = ds |> List.takeUntil (function SynMemberDefn.LetBindings _ -> false | _ -> true) // Skip over 'let' and 'do' bindings - let _,ds = ds |> List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isAutoProperty]) + let _, ds = ds |> List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isAutoProperty]) match ds with - | SynMemberDefn.Member (_,m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have binding",m)) - | SynMemberDefn.AbstractSlot (_,_,m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have slotsig",m)) - | SynMemberDefn.Interface (_,_,m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have interface",m)) - | SynMemberDefn.ImplicitCtor (_,_,_,_,m) :: _ -> errorR(InternalError("implicit class construction with two implicit constructions",m)) - | SynMemberDefn.AutoProperty (_,_,_,_,_,_,_,_,_,_,m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have auto property",m)) - | SynMemberDefn.ImplicitInherit (_,_,_,m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveOneInherit(),m)) - | SynMemberDefn.LetBindings (_,_,_,m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(),m)) - | SynMemberDefn.Inherit (_,_,m) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(),m)) - | SynMemberDefn.NestedType (_,_,m) :: _ -> errorR(Error(FSComp.SR.tcTypesCannotContainNestedTypes(),m)) + | SynMemberDefn.Member (_, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have binding", m)) + | SynMemberDefn.AbstractSlot (_, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have slotsig", m)) + | SynMemberDefn.Interface (_, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have interface", m)) + | SynMemberDefn.ImplicitCtor (_, _, _, _, m) :: _ -> errorR(InternalError("implicit class construction with two implicit constructions", m)) + | SynMemberDefn.AutoProperty (_, _, _, _, _, _, _, _, _, _, m) :: _ -> errorR(InternalError("List.takeUntil is wrong, have auto property", m)) + | SynMemberDefn.ImplicitInherit (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveOneInherit(), m)) + | SynMemberDefn.LetBindings (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypeDefinitionsWithImplicitConstructionMustHaveLocalBindingsBeforeMembers(), m)) + | SynMemberDefn.Inherit (_, _, m) :: _ -> errorR(Error(FSComp.SR.tcInheritDeclarationMissingArguments(), m)) + | SynMemberDefn.NestedType (_, _, m) :: _ -> errorR(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)) | _ -> () | ds -> // Classic class construction - let _,ds = List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isInherit;isField;isTycon]) ds + let _, ds = List.takeUntil (allFalse [isMember;isAbstractSlot;isInterface;isInherit;isField;isTycon]) ds match ds with - | SynMemberDefn.Member (_,m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong",m)) - | SynMemberDefn.ImplicitCtor (_,_,_,_,m) :: _ -> errorR(InternalError("CheckMembersForm: implicit ctor line should be first",m)) - | SynMemberDefn.ImplicitInherit (_,_,_,m) :: _ -> errorR(Error(FSComp.SR.tcInheritConstructionCallNotPartOfImplicitSequence(),m)) - | SynMemberDefn.AutoProperty(_,_,_,_,_,_,_,_,_,_,m) :: _ -> errorR(Error(FSComp.SR.tcAutoPropertyRequiresImplicitConstructionSequence(),m)) - | SynMemberDefn.LetBindings (_,false,_,m) :: _ -> errorR(Error(FSComp.SR.tcLetAndDoRequiresImplicitConstructionSequence(),m)) - | SynMemberDefn.AbstractSlot (_,_,m) :: _ - | SynMemberDefn.Interface (_,_,m) :: _ - | SynMemberDefn.Inherit (_,_,m) :: _ - | SynMemberDefn.ValField (_,m) :: _ - | SynMemberDefn.NestedType (_,_,m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong",m)) + | SynMemberDefn.Member (_, m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) + | SynMemberDefn.ImplicitCtor (_, _, _, _, m) :: _ -> errorR(InternalError("CheckMembersForm: implicit ctor line should be first", m)) + | SynMemberDefn.ImplicitInherit (_, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcInheritConstructionCallNotPartOfImplicitSequence(), m)) + | SynMemberDefn.AutoProperty(_, _, _, _, _, _, _, _, _, _, m) :: _ -> errorR(Error(FSComp.SR.tcAutoPropertyRequiresImplicitConstructionSequence(), m)) + | SynMemberDefn.LetBindings (_, false, _, m) :: _ -> errorR(Error(FSComp.SR.tcLetAndDoRequiresImplicitConstructionSequence(), m)) + | SynMemberDefn.AbstractSlot (_, _, m) :: _ + | SynMemberDefn.Interface (_, _, m) :: _ + | SynMemberDefn.Inherit (_, _, m) :: _ + | SynMemberDefn.ValField (_, m) :: _ + | SynMemberDefn.NestedType (_, _, m) :: _ -> errorR(InternalError("CheckMembersForm: List.takeUntil is wrong", m)) | _ -> () /// Separates the definition into core (shape) and body. /// - /// core = synTyconInfo,simpleRepr,interfaceTypes + /// core = synTyconInfo, simpleRepr, interfaceTypes /// where simpleRepr can contain inherit type, declared fields and virtual slots. /// body = members /// where members contain methods/overrides, also implicit ctor, inheritCall and local definitions. - let rec private SplitTyconDefn (TypeDefn(synTyconInfo,trepr,extraMembers,_)) = - let implements1 = List.choose (function SynMemberDefn.Interface (ty,_,_) -> Some(ty,ty.Range) | _ -> None) extraMembers + let rec private SplitTyconDefn (TypeDefn(synTyconInfo, trepr, extraMembers, _)) = + let implements1 = List.choose (function SynMemberDefn.Interface (ty, _, _) -> Some(ty, ty.Range) | _ -> None) extraMembers match trepr with - | SynTypeDefnRepr.ObjectModel(kind,cspec,m) -> + | SynTypeDefnRepr.ObjectModel(kind, cspec, m) -> CheckMembersForm cspec - let fields = cspec |> List.choose (function SynMemberDefn.ValField (f,_) -> Some(f) | _ -> None) - let implements2 = cspec |> List.choose (function SynMemberDefn.Interface (ty,_,_) -> Some(ty,ty.Range) | _ -> None) + let fields = cspec |> List.choose (function SynMemberDefn.ValField (f, _) -> Some(f) | _ -> None) + let implements2 = cspec |> List.choose (function SynMemberDefn.Interface (ty, _, _) -> Some(ty, ty.Range) | _ -> None) let inherits = cspec |> List.choose (function - | SynMemberDefn.Inherit (ty,idOpt,m) -> Some(ty,m,idOpt) - | SynMemberDefn.ImplicitInherit (ty,_,idOpt,m) -> Some(ty,m,idOpt) + | SynMemberDefn.Inherit (ty, idOpt, m) -> Some(ty, m, idOpt) + | SynMemberDefn.ImplicitInherit (ty, _, idOpt, m) -> Some(ty, m, idOpt) | _ -> None) - //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x,_,_) -> Some(x) | _ -> None) - let slotsigs = cspec |> List.choose (function SynMemberDefn.AbstractSlot (x,y,_) -> Some(x,y) | _ -> None) + //let nestedTycons = cspec |> List.choose (function SynMemberDefn.NestedType (x, _, _) -> Some(x) | _ -> None) + let slotsigs = cspec |> List.choose (function SynMemberDefn.AbstractSlot (x, y, _) -> Some(x, y) | _ -> None) let members = let membersIncludingAutoProps = @@ -15909,7 +15910,7 @@ module TcDeclarations = | SynMemberDefn.AutoProperty _ | SynMemberDefn.Open _ | SynMemberDefn.ImplicitInherit _ -> true - | SynMemberDefn.NestedType (_,_,m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(),m)); false + | SynMemberDefn.NestedType (_, _, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false // covered above | SynMemberDefn.ValField _ | SynMemberDefn.Inherit _ @@ -15923,14 +15924,14 @@ module TcDeclarations = let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> true | _ -> false) let mLetPortion = synExpr.Range let fldId = ident (CompilerGeneratedName id.idText, mLetPortion) - let headPat = SynPat.LongIdent (LongIdentWithDots([fldId],[]),None,Some noInferredTypars, SynConstructorArgs.Pats [],None,mLetPortion) - let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty,SynInfo.unnamedRetVal),ty.Range)) + let headPat = SynPat.LongIdent (LongIdentWithDots([fldId], []), None, Some noInferredTypars, SynConstructorArgs.Pats [], None, mLetPortion) + let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) let isMutable = match propKind with | MemberKind.PropertySet | MemberKind.PropertyGetSet -> true | _ -> false - let binding = mkSynBinding (xmlDoc,headPat) (None,false,isMutable,mLetPortion,NoSequencePointAtInvisibleBinding,retInfo,synExpr,synExpr.Range,[],attribs,None) + let binding = mkSynBinding (xmlDoc, headPat) (None, false, isMutable, mLetPortion, NoSequencePointAtInvisibleBinding, retInfo, synExpr, synExpr.Range, [], attribs, None) [(SynMemberDefn.LetBindings ([binding], isStatic, false, mWholeAutoProp))] @@ -15944,16 +15945,16 @@ module TcDeclarations = // Convert autoproperties to member bindings in the post-list let rec postAutoProps memb = match memb with - | SynMemberDefn.AutoProperty (attribs,isStatic,id,tyOpt,propKind,memberFlags,xmlDoc,access,_synExpr,mGetSetOpt,_mWholeAutoProp) -> + | SynMemberDefn.AutoProperty (attribs, isStatic, id, tyOpt, propKind, memberFlags, xmlDoc, access, _synExpr, mGetSetOpt, _mWholeAutoProp) -> let mMemberPortion = id.idRange // Only the keep the non-field-targeted attributes let attribs = attribs |> List.filter (fun a -> match a.Target with Some t when t.idText = "field" -> false | _ -> true) let fldId = ident (CompilerGeneratedName id.idText, mMemberPortion) - let headPatIds = if isStatic then [id] else [ident ("__",mMemberPortion);id] - let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds,[]),None,Some noInferredTypars, SynConstructorArgs.Pats [],None,mMemberPortion) + let headPatIds = if isStatic then [id] else [ident ("__", mMemberPortion);id] + let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds, []), None, Some noInferredTypars, SynConstructorArgs.Pats [], None, mMemberPortion) - match propKind,mGetSetOpt with - | MemberKind.PropertySet,Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(),m)) + match propKind, mGetSetOpt with + | MemberKind.PropertySet, Some m -> errorR(Error(FSComp.SR.parsMutableOnAutoPropertyShouldBeGetSetNotJustSet(), m)) | _ -> () [ @@ -15963,9 +15964,9 @@ module TcDeclarations = | MemberKind.PropertyGetSet -> let getter = let rhsExpr = SynExpr.Ident fldId - let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty,SynInfo.unnamedRetVal),ty.Range)) - let binding = mkSynBinding (xmlDoc,headPat) (access,false,false,mMemberPortion,NoSequencePointAtInvisibleBinding,retInfo,rhsExpr,rhsExpr.Range,[],attribs,Some (memberFlags MemberKind.Member)) - SynMemberDefn.Member (binding,mMemberPortion) + let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, NoSequencePointAtInvisibleBinding, retInfo, rhsExpr, rhsExpr.Range, [], attribs, Some (memberFlags MemberKind.Member)) + SynMemberDefn.Member (binding, mMemberPortion) yield getter | _ -> () @@ -15973,12 +15974,12 @@ module TcDeclarations = | MemberKind.PropertySet | MemberKind.PropertyGetSet -> let setter = - let vId = ident("v",mMemberPortion) - let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds,[]),None,Some noInferredTypars, SynConstructorArgs.Pats [mkSynPatVar None vId],None,mMemberPortion) + let vId = ident("v", mMemberPortion) + let headPat = SynPat.LongIdent (LongIdentWithDots(headPatIds, []), None, Some noInferredTypars, SynConstructorArgs.Pats [mkSynPatVar None vId], None, mMemberPortion) let rhsExpr = mkSynAssign (SynExpr.Ident fldId) (SynExpr.Ident vId) - //let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty,SynInfo.unnamedRetVal),ty.Range)) - let binding = mkSynBinding (xmlDoc,headPat) (access,false,false,mMemberPortion,NoSequencePointAtInvisibleBinding,None,rhsExpr,rhsExpr.Range,[],[],Some (memberFlags MemberKind.PropertySet)) - SynMemberDefn.Member (binding,mMemberPortion) + //let retInfo = match tyOpt with None -> None | Some ty -> Some (SynReturnInfo((ty, SynInfo.unnamedRetVal), ty.Range)) + let binding = mkSynBinding (xmlDoc, headPat) (access, false, false, mMemberPortion, NoSequencePointAtInvisibleBinding, None, rhsExpr, rhsExpr.Range, [], [], Some (memberFlags MemberKind.PropertySet)) + SynMemberDefn.Member (binding, mMemberPortion) yield setter | _ -> ()] | SynMemberDefn.Interface (ty, Some membs, m) -> @@ -15997,8 +15998,8 @@ module TcDeclarations = let isConcrete = members |> List.exists (function - | SynMemberDefn.Member(Binding(_,_,_,_,_,_,SynValData(Some memberFlags,_,_),_,_,_,_,_),_) -> not memberFlags.IsDispatchSlot - | SynMemberDefn.Interface (_,defOpt,_) -> Option.isSome defOpt + | SynMemberDefn.Member(Binding(_, _, _, _, _, _, SynValData(Some memberFlags, _, _), _, _, _, _, _), _) -> not memberFlags.IsDispatchSlot + | SynMemberDefn.Interface (_, defOpt, _) -> Option.isSome defOpt | SynMemberDefn.LetBindings _ -> true | SynMemberDefn.ImplicitCtor _ -> true | SynMemberDefn.ImplicitInherit _ -> true @@ -16011,30 +16012,30 @@ module TcDeclarations = let hasSelfReferentialCtor = members |> List.exists (function - | SynMemberDefn.ImplicitCtor (_,_,_,thisIdOpt,_) - | SynMemberDefn.Member(Binding(_,_,_,_,_,_,SynValData(_,_,thisIdOpt),_,_,_,_,_),_) -> thisIdOpt.IsSome + | SynMemberDefn.ImplicitCtor (_, _, _, thisIdOpt, _) + | SynMemberDefn.Member(Binding(_, _, _, _, _, _, SynValData(_, _, thisIdOpt), _, _, _, _, _), _) -> thisIdOpt.IsSome | _ -> false) let implicitCtorSynPats = members |> List.tryPick (function - | SynMemberDefn.ImplicitCtor (_,_,spats,_, _) -> Some spats + | SynMemberDefn.ImplicitCtor (_, _, spats, _, _) -> Some spats | _ -> None) // An ugly bit of code to pre-determine if a type has a nullary constructor, prior to establishing the // members of the type let preEstablishedHasDefaultCtor = members |> List.exists (function - | SynMemberDefn.Member(Binding(_,_,_,_,_,_,SynValData(Some memberFlags,_,_),SynPatForConstructorDecl(SynPatForNullaryArgs),_,_,_,_),_) -> + | SynMemberDefn.Member(Binding(_, _, _, _, _, _, SynValData(Some memberFlags, _, _), SynPatForConstructorDecl(SynPatForNullaryArgs), _, _, _, _), _) -> memberFlags.MemberKind=MemberKind.Constructor - | SynMemberDefn.ImplicitCtor (_,_,spats,_, _) -> isNil spats + | SynMemberDefn.ImplicitCtor (_, _, spats, _, _) -> isNil spats | _ -> false) - let repr = SynTypeDefnSimpleRepr.General(kind,inherits,slotsigs,fields,isConcrete,isIncrClass,implicitCtorSynPats,m) + let repr = SynTypeDefnSimpleRepr.General(kind, inherits, slotsigs, fields, isConcrete, isIncrClass, implicitCtorSynPats, m) let isAtOriginalTyconDefn = not (isAugmentationTyconDefnRepr repr) let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements2@implements1, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isAtOriginalTyconDefn) core, members @ extraMembers - | SynTypeDefnRepr.Simple(repr,_) -> + | SynTypeDefnRepr.Simple(repr, _) -> let members = [] let isAtOriginalTyconDefn = true let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, repr, implements1, false, false, isAtOriginalTyconDefn) @@ -16057,16 +16058,16 @@ module TcDeclarations = // Create the entities for each module and type definition, and process the core representation of each type definition. let tycons, envMutRecPrelim, mutRecDefnsAfterCore = EstablishTypeDefinitionCores.TcMutRecDefns_Phase1 - (fun containerInfo synBinds -> [ for synBind in synBinds -> RecDefnBindingInfo(containerInfo,NoNewSlots,ModuleOrMemberBinding,synBind) ]) + (fun containerInfo synBinds -> [ for synBind in synBinds -> RecDefnBindingInfo(containerInfo, NoNewSlots, ModuleOrMemberBinding, synBind) ]) cenv envInitial parent typeNames false tpenv m scopem mutRecNSInfo mutRecDefnsAfterSplit // Package up the phase two information for processing members. let mutRecDefnsAfterPrep = - (envMutRecPrelim,mutRecDefnsAfterCore) + (envMutRecPrelim, mutRecDefnsAfterCore) ||> MutRecShapes.mapTyconsWithEnv (fun envForDecls ((typeDefnCore, members, innerParent), tyconOpt, fixupFinalAttrs, (baseValOpt, safeInitInfo)) -> - let (MutRecDefnsPhase1DataForTycon(synTyconInfo,_,_,_,_,isAtOriginalTyconDefn)) = typeDefnCore + let (MutRecDefnsPhase1DataForTycon(synTyconInfo, _, _, _, _, isAtOriginalTyconDefn)) = typeDefnCore let tyDeclRange = synTyconInfo.Range - let (ComponentInfo(_,typars, cs,longPath, _, _, _,_)) = synTyconInfo + let (ComponentInfo(_, typars, cs, longPath, _, _, _, _)) = synTyconInfo let declKind, tcref, declaredTyconTypars = ComputeTyconDeclKind tyconOpt isAtOriginalTyconDefn cenv envForDecls false tyDeclRange typars cs longPath let newslotsOK = (if isAtOriginalTyconDefn && tcref.IsFSharpObjectModelTycon then NewSlotsOK else NoNewSlots) if not (isNil members) && tcref.IsTypeAbbrev then @@ -16079,7 +16080,7 @@ module TcDeclarations = // // We now reconstruct the active environments all over again - this will add the union cases and fields. // - // Note: This environment reconstruction doesn't seem necessary. We're about to create Val's for all members, + // Note: This environment reconstruction doesn't seem necessary. We're about to create Val's for all members, // which does require type checking, but no more information than is already available. let envMutRecPrelimWithReprs, withEnvs = (envInitial, MutRecShapes.dropEnvs mutRecDefnsAfterPrep) @@ -16089,16 +16090,16 @@ module TcDeclarations = cenv true scopem m // Check the members and decide on representations for types with implicit constructors. - let withBindings,envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem mutRecNSInfo envMutRecPrelimWithReprs withEnvs + let withBindings, envFinal = TcMutRecDefns_Phase2 cenv envInitial m scopem mutRecNSInfo envMutRecPrelimWithReprs withEnvs // Generate the hash/compare/equality bindings for all tycons. // // Note: generating these bindings must come after generating the members, since some in the case of structs some fields // may be added by generating the implicit construction syntax let withExtraBindings = - (envFinal,withBindings) ||> MutRecShapes.expandTyconsWithEnv (fun envForDecls (tyconOpt, _) -> + (envFinal, withBindings) ||> MutRecShapes.expandTyconsWithEnv (fun envForDecls (tyconOpt, _) -> match tyconOpt with - | None -> [],[] + | None -> [], [] | Some tycon -> // We put the hash/compare bindings before the type definitions and the // equality bindings after because tha is the order they've always been generated @@ -16110,80 +16111,80 @@ module TcDeclarations = // Check for cyclic structs and inheritance all over again, since we may have added some fields to the struct when generating the implicit construction syntax EstablishTypeDefinitionCores.TcTyconDefnCore_CheckForCyclicStructsAndInheritance cenv tycons - withExtraBindings,envFinal + withExtraBindings, envFinal //------------------------------------------------------------------------- /// Separates the signature declaration into core (shape) and body. - let rec private SplitTyconSignature (TypeDefnSig(synTyconInfo,trepr,extraMembers,_)) = + let rec private SplitTyconSignature (TypeDefnSig(synTyconInfo, trepr, extraMembers, _)) = let implements1 = - extraMembers |> List.choose (function SynMemberSig.Interface (f,m) -> Some(f,m) | _ -> None) + extraMembers |> List.choose (function SynMemberSig.Interface (f, m) -> Some(f, m) | _ -> None) match trepr with - | SynTypeDefnSigRepr.ObjectModel(kind,cspec,m) -> - let fields = cspec |> List.choose (function SynMemberSig.ValField (f,_) -> Some(f) | _ -> None) - let implements2 = cspec |> List.choose (function SynMemberSig.Interface (ty,m) -> Some(ty,m) | _ -> None) - let inherits = cspec |> List.choose (function SynMemberSig.Inherit (ty,_) -> Some(ty,m,None) | _ -> None) - //let nestedTycons = cspec |> List.choose (function SynMemberSig.NestedType (x,_) -> Some(x) | _ -> None) - let slotsigs = cspec |> List.choose (function SynMemberSig.Member (v,fl,_) when fl.IsDispatchSlot -> Some(v,fl) | _ -> None) + | SynTypeDefnSigRepr.ObjectModel(kind, cspec, m) -> + let fields = cspec |> List.choose (function SynMemberSig.ValField (f, _) -> Some(f) | _ -> None) + let implements2 = cspec |> List.choose (function SynMemberSig.Interface (ty, m) -> Some(ty, m) | _ -> None) + let inherits = cspec |> List.choose (function SynMemberSig.Inherit (ty, _) -> Some(ty, m, None) | _ -> None) + //let nestedTycons = cspec |> List.choose (function SynMemberSig.NestedType (x, _) -> Some(x) | _ -> None) + let slotsigs = cspec |> List.choose (function SynMemberSig.Member (v, fl, _) when fl.IsDispatchSlot -> Some(v, fl) | _ -> None) let members = cspec |> List.filter (function | SynMemberSig.Interface _ -> true - | SynMemberSig.Member (_,memberFlags,_) when not memberFlags.IsDispatchSlot -> true - | SynMemberSig.NestedType (_,m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(),m)); false + | SynMemberSig.Member (_, memberFlags, _) when not memberFlags.IsDispatchSlot -> true + | SynMemberSig.NestedType (_, m) -> error(Error(FSComp.SR.tcTypesCannotContainNestedTypes(), m)); false | _ -> false) let isConcrete = members |> List.exists (function - | SynMemberSig.Member (_,memberFlags,_) -> memberFlags.MemberKind=MemberKind.Constructor + | SynMemberSig.Member (_, memberFlags, _) -> memberFlags.MemberKind=MemberKind.Constructor | _ -> false) // An ugly bit of code to pre-determine if a type has a nullary constructor, prior to establishing the // members of the type let preEstablishedHasDefaultCtor = members |> List.exists (function - | SynMemberSig.Member (valSpfn,memberFlags,_) -> + | SynMemberSig.Member (valSpfn, memberFlags, _) -> memberFlags.MemberKind=MemberKind.Constructor && // REVIEW: This is a syntactic approximation (match valSpfn.SynType, valSpfn.SynInfo.ArgInfos with - | SynType.Fun (SynType.LongIdent (LongIdentWithDots([id],_)), _, _), [[_]] when id.idText = "unit" -> true + | SynType.Fun (SynType.LongIdent (LongIdentWithDots([id], _)), _, _), [[_]] when id.idText = "unit" -> true | _ -> false) | _ -> false) let hasSelfReferentialCtor = false - let repr = SynTypeDefnSimpleRepr.General(kind,inherits,slotsigs,fields,isConcrete,false,None,m) + let repr = SynTypeDefnSimpleRepr.General(kind, inherits, slotsigs, fields, isConcrete, false, None, m) let isAtOriginalTyconDefn = true let tyconCore = MutRecDefnsPhase1DataForTycon (synTyconInfo, repr, implements2@implements1, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, isAtOriginalTyconDefn) - tyconCore, (synTyconInfo,members@extraMembers) + tyconCore, (synTyconInfo, members@extraMembers) // 'type X with ...' in a signature is always interpreted as an extrinsic extension. // Representation-hidden types with members and interfaces are written 'type X = ...' - | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _ as r),_) when not (isNil extraMembers) -> + | SynTypeDefnSigRepr.Simple((SynTypeDefnSimpleRepr.None _ as r), _) when not (isNil extraMembers) -> let isAtOriginalTyconDefn = false let tyconCore = MutRecDefnsPhase1DataForTycon (synTyconInfo, r, implements1, false, false, isAtOriginalTyconDefn) - tyconCore, (synTyconInfo,extraMembers) + tyconCore, (synTyconInfo, extraMembers) | SynTypeDefnSigRepr.Exception(r) -> let isAtOriginalTyconDefn = true - let core = MutRecDefnsPhase1DataForTycon(synTyconInfo,SynTypeDefnSimpleRepr.Exception r,implements1,false,false,isAtOriginalTyconDefn) - core, (synTyconInfo,extraMembers) + let core = MutRecDefnsPhase1DataForTycon(synTyconInfo, SynTypeDefnSimpleRepr.Exception r, implements1, false, false, isAtOriginalTyconDefn) + core, (synTyconInfo, extraMembers) - | SynTypeDefnSigRepr.Simple(r,_) -> + | SynTypeDefnSigRepr.Simple(r, _) -> let isAtOriginalTyconDefn = true let tyconCore = MutRecDefnsPhase1DataForTycon (synTyconInfo, r, implements1, false, false, isAtOriginalTyconDefn) - tyconCore, (synTyconInfo,extraMembers) + tyconCore, (synTyconInfo, extraMembers) let private TcMutRecSignatureDecls_Phase2 cenv scopem envMutRec mutRecDefns = - (envMutRec,mutRecDefns) ||> MutRecShapes.mapWithEnv + (envMutRec, mutRecDefns) ||> MutRecShapes.mapWithEnv // Do this for the members in each 'type' declaration - (fun envForDecls ((tyconCore, (synTyconInfo,members), innerParent), tyconOpt, _fixupFinalAttrs, _) -> + (fun envForDecls ((tyconCore, (synTyconInfo, members), innerParent), tyconOpt, _fixupFinalAttrs, _) -> let tpenv = emptyUnscopedTyparEnv let (MutRecDefnsPhase1DataForTycon (_, _, _, _, _, isAtOriginalTyconDefn)) = tyconCore - let (ComponentInfo(_,typars,cs,longPath, _, _, _,m)) = synTyconInfo - let declKind,tcref,declaredTyconTypars = ComputeTyconDeclKind tyconOpt isAtOriginalTyconDefn cenv envForDecls true m typars cs longPath + let (ComponentInfo(_, typars, cs, longPath, _, _, _, m)) = synTyconInfo + let declKind, tcref, declaredTyconTypars = ComputeTyconDeclKind tyconOpt isAtOriginalTyconDefn cenv envForDecls true m typars cs longPath let envForTycon = AddDeclaredTypars CheckForDuplicateTypars declaredTyconTypars envForDecls let envForTycon = MakeInnerEnvForTyconRef cenv envForTycon tcref (declKind = ExtrinsicExtensionBinding) @@ -16193,7 +16194,7 @@ module TcDeclarations = // Do this for each 'val' declaration in a module (fun envForDecls (containerInfo, valSpec) -> let tpenv = emptyUnscopedTyparEnv - let idvs,_ = TcAndPublishValSpec (cenv,envForDecls,containerInfo,ModuleOrMemberBinding,None,tpenv,valSpec) + let idvs, _ = TcAndPublishValSpec (cenv, envForDecls, containerInfo, ModuleOrMemberBinding, None, tpenv, valSpec) let env = List.foldBack (AddLocalVal cenv.tcSink scopem) idvs envForDecls env) @@ -16212,7 +16213,7 @@ module TcDeclarations = // // We now reconstruct the active environments all over again - this will add the union cases and fields. // - // Note: This environment reconstruction doesn't seem necessary. We're about to create Val's for all members, + // Note: This environment reconstruction doesn't seem necessary. We're about to create Val's for all members, // which does require type checking, but no more information than is already available. let envMutRecPrelimWithReprs, withEnvs = (envInitial, MutRecShapes.dropEnvs mutRecDefnsAfterCore) @@ -16232,42 +16233,42 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS eventually { try match synSigDecl with - | SynModuleSigDecl.Exception (edef,m) -> + | SynModuleSigDecl.Exception (edef, m) -> let scopem = unionRanges m.EndRange endm - let _,_,_,env = TcExceptionDeclarations.TcExnSignature cenv env parent emptyUnscopedTyparEnv (edef,scopem) + let _, _, _, env = TcExceptionDeclarations.TcExnSignature cenv env parent emptyUnscopedTyparEnv (edef, scopem) return env - | SynModuleSigDecl.Types (typeSpecs,m) -> + | SynModuleSigDecl.Types (typeSpecs, m) -> let scopem = unionRanges m endm let mutRecDefns = typeSpecs |> List.map MutRecShape.Tycon let env = TcDeclarations.TcMutRecSignatureDecls cenv env parent typeNames emptyUnscopedTyparEnv m scopem None mutRecDefns return env - | SynModuleSigDecl.Open (mp,m) -> + | SynModuleSigDecl.Open (mp, m) -> let scopem = unionRanges m.EndRange endm let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp return env - | SynModuleSigDecl.Val (vspec,m) -> + | SynModuleSigDecl.Val (vspec, m) -> let parentModule = match parent with - | ParentNone -> error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),vspec.RangeOfId)) + | ParentNone -> error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) | Parent p -> p let containerInfo = ModuleOrNamespaceContainerInfo(parentModule) - let idvs,_ = TcAndPublishValSpec (cenv,env,containerInfo,ModuleOrMemberBinding,None,emptyUnscopedTyparEnv,vspec) + let idvs, _ = TcAndPublishValSpec (cenv, env, containerInfo, ModuleOrMemberBinding, None, emptyUnscopedTyparEnv, vspec) let scopem = unionRanges m endm let env = List.foldBack (AddLocalVal cenv.tcSink scopem) idvs env return env - | SynModuleSigDecl.NestedModule(ComponentInfo(attribs,_parms, _constraints,longPath,xml,_,vis,im) as compInfo,isRec,mdefs,m) -> + | SynModuleSigDecl.NestedModule(ComponentInfo(attribs, _parms, _constraints, longPath, xml, _, vis, im) as compInfo, isRec, mdefs, m) -> if isRec then // Treat 'module rec M = ...' as a single mutually recursive definition group 'module M = ...' - let modDecl = SynModuleSigDecl.NestedModule(compInfo,false,mdefs,m) + let modDecl = SynModuleSigDecl.NestedModule(compInfo, false, mdefs, m) return! TcSignatureElementsMutRec cenv parent typeNames endm None env [modDecl] else let id = ComputeModuleName longPath - let vis,_ = ComputeAccessAndCompPath env None im vis None parent + let vis, _ = ComputeAccessAndCompPath env None im vis None parent let attribs = TcAttributes cenv env AttributeTargets.ModuleDecl attribs CheckNamespaceModuleOrTypeName cenv.g id let modKind = EstablishTypeDefinitionCores.ComputeModuleOrNamespaceKind cenv.g true typeNames attribs id.idText @@ -16279,7 +16280,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) - let! (mtyp,_) = TcModuleOrNamespaceSignatureElementsNonMutRec cenv (Parent (mkLocalModRef mspec)) env (id,modKind,mdefs,m,xml) + let! (mtyp, _) = TcModuleOrNamespaceSignatureElementsNonMutRec cenv (Parent (mkLocalModRef mspec)) env (id, modKind, mdefs, m, xml) mspec.entity_modul_contents <- MaybeLazy.Strict mtyp let scopem = unionRanges m endm @@ -16287,7 +16288,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec return env - | SynModuleSigDecl.ModuleAbbrev (id,p,m) -> + | SynModuleSigDecl.ModuleAbbrev (id, p, m) -> let ad = env.eAccessRights let mvvs = ForceRaise (ResolveLongIndentAsModuleOrNamespace ResultCollectionSettings.AllResults cenv.amap m OpenQualified env.eNameResEnv ad p) let scopem = unionRanges m endm @@ -16296,7 +16297,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let modrefs = unfilteredModrefs |> List.filter (fun modref -> not modref.IsNamespace) if unfilteredModrefs.Length > 0 && List.isEmpty modrefs then - errorR(Error(FSComp.SR.tcModuleAbbreviationForNamespace(fullDisplayTextOfModRef (List.head unfilteredModrefs)),m)) + errorR(Error(FSComp.SR.tcModuleAbbreviationForNamespace(fullDisplayTextOfModRef (List.head unfilteredModrefs)), m)) modrefs |> List.iter (fun modref -> CheckEntityAttributes cenv.g modref m |> CommitOperationResult) @@ -16309,7 +16310,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS return env - | SynModuleSigDecl.NamespaceFragment (SynModuleOrNamespaceSig(longId,isRec,isModule,defs,xml,attribs,vis,m)) -> + | SynModuleSigDecl.NamespaceFragment (SynModuleOrNamespaceSig(longId, isRec, isModule, defs, xml, attribs, vis, m)) -> do for id in longId do CheckNamespaceModuleOrTypeName cenv.g id @@ -16323,7 +16324,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS let enclosingNamespacePath, defs = if isModule then let nsp, modName = List.frontAndBack longId - let modDecl = [SynModuleSigDecl.NestedModule(ComponentInfo(attribs,[], [],[modName],xml,false,vis,m),false,defs,m)] + let modDecl = [SynModuleSigDecl.NestedModule(ComponentInfo(attribs, [], [], [modName], xml, false, vis, m), false, defs, m)] nsp, modDecl else longId, defs @@ -16353,7 +16354,7 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment. let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p,_) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] | None -> env // Publish the combined module type @@ -16397,28 +16398,28 @@ and TcSignatureElementsMutRec cenv parent typeNames endm mutRecNSInfo envInitial let rec loop isNamespace defs : MutRecSigsInitialData = ((true, true), defs) ||> List.collectFold (fun (openOk, moduleAbbrevOk) def -> match def with - | SynModuleSigDecl.Types (typeSpecs,_) -> + | SynModuleSigDecl.Types (typeSpecs, _) -> let decls = typeSpecs |> List.map MutRecShape.Tycon decls, (false, false) - | SynModuleSigDecl.Open (lid,m) -> - if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(),m)) + | SynModuleSigDecl.Open (lid, m) -> + if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, m)) ] decls, (openOk, moduleAbbrevOk) - | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr,members,_),_) -> - let ( SynExceptionDefnRepr(synAttrs,UnionCase(_,id,_args,_,_,_),_,doc,vis,m)) = exnRepr - let compInfo = ComponentInfo(synAttrs,[],[],[id],doc,false,vis,id.idRange) + | SynModuleSigDecl.Exception (SynExceptionSig(exnRepr, members, _), _) -> + let ( SynExceptionDefnRepr(synAttrs, UnionCase(_, id, _args, _, _, _), _, doc, vis, m)) = exnRepr + let compInfo = ComponentInfo(synAttrs, [], [], [id], doc, false, vis, id.idRange) let decls = [ MutRecShape.Tycon(SynTypeDefnSig.TypeDefnSig(compInfo, SynTypeDefnSigRepr.Exception exnRepr, members, m)) ] decls, (false, false) - | SynModuleSigDecl.Val (vspec,_) -> - if isNamespace then error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),vspec.RangeOfId)) + | SynModuleSigDecl.Val (vspec, _) -> + if isNamespace then error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), vspec.RangeOfId)) let decls = [ MutRecShape.Lets(vspec) ] decls, (false, false) - | SynModuleSigDecl.NestedModule(compInfo,isRec,synDefs,_) -> - if isRec then warning(Error(FSComp.SR.tcRecImplied(),compInfo.Range)) + | SynModuleSigDecl.NestedModule(compInfo, isRec, synDefs, _) -> + if isRec then warning(Error(FSComp.SR.tcRecImplied(), compInfo.Range)) let mutRecDefs = loop false synDefs let decls = [MutRecShape.Module (compInfo, mutRecDefs)] decls, (false, false) @@ -16427,12 +16428,12 @@ and TcSignatureElementsMutRec cenv parent typeNames endm mutRecNSInfo envInitial [], (openOk, moduleAbbrevOk) | SynModuleSigDecl.ModuleAbbrev (id, p, m) -> - if not moduleAbbrevOk then errorR(Error(FSComp.SR.tcModuleAbbrevFirstInMutRec(),m)) + if not moduleAbbrevOk then errorR(Error(FSComp.SR.tcModuleAbbrevFirstInMutRec(), m)) let decls = [ MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev(id, p, m)) ] decls, (false, moduleAbbrevOk) | SynModuleSigDecl.NamespaceFragment _ -> - error(Error(FSComp.SR.tcUnsupportedMutRecDecl(),def.Range))) + error(Error(FSComp.SR.tcUnsupportedMutRecDecl(), def.Range))) |> fst loop (match parent with ParentNone -> true | Parent _ -> false) defs @@ -16441,13 +16442,13 @@ and TcSignatureElementsMutRec cenv parent typeNames endm mutRecNSInfo envInitial -and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id,modKind,defs,m:range,xml) = +and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id, modKind, defs, m:range, xml) = eventually { let endm = m.EndRange // use end of range for errors // Create the module type that will hold the results of type checking.... - let envForModule,mtypeAcc = MakeInnerEnv env id modKind + let envForModule, mtypeAcc = MakeInnerEnv env id modKind // Now typecheck the signature, using mutation to fill in the submodule description. let! envAtEnd = TcSignatureElements cenv parent endm envForModule xml None defs @@ -16463,12 +16464,12 @@ and TcModuleOrNamespaceSignatureElementsNonMutRec cenv parent env (id,modKind,de let ElimModuleDoBinding bind = match bind with - | SynModuleDecl.DoExpr (spExpr,expr, m) -> - let bind2 = Binding (None,StandaloneExpression,false,false,[],PreXmlDoc.Empty,SynInfo.emptySynValData,SynPat.Wild m,None,expr,m,spExpr) - SynModuleDecl.Let(false,[bind2],m) + | SynModuleDecl.DoExpr (spExpr, expr, m) -> + let bind2 = Binding (None, StandaloneExpression, false, false, [], PreXmlDoc.Empty, SynInfo.emptySynValData, SynPat.Wild m, None, expr, m, spExpr) + SynModuleDecl.Let(false, [bind2], m) | _ -> bind -let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_,_,_,_,_>) env = +let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_, _, _, _, _>) env = let freeInEnv = GeneralizationHelpers.ComputeUnabstractableTycons env let checkTycon (tycon: Tycon) = if not tycon.IsTypeAbbrev && Zset.contains tycon freeInEnv then @@ -16494,12 +16495,12 @@ let TcMutRecDefnsEscapeCheck (binds: MutRecShapes<_,_,_,_,_>) env = let CheckLetOrDoInNamespace binds m = match binds with - | [ Binding (None,(StandaloneExpression | DoBinding),false,false,[],_,_,_,None,(SynExpr.Do (SynExpr.Const (SynConst.Unit,_),_) | SynExpr.Const (SynConst.Unit,_)),_,_) ] -> + | [ Binding (None, (StandaloneExpression | DoBinding), false, false, [], _, _, _, None, (SynExpr.Do (SynExpr.Const (SynConst.Unit, _), _) | SynExpr.Const (SynConst.Unit, _)), _, _) ] -> () | [] -> - error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),m)) + error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), m)) | _ -> - error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(),binds.Head.RangeOfHeadPat)) + error(NumberedError(FSComp.SR.tcNamespaceCannotContainValues(), binds.Head.RangeOfHeadPat)) /// The non-mutually recursive case for a declaration let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem env synDecl = @@ -16511,18 +16512,18 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem try match ElimModuleDoBinding synDecl with - | SynModuleDecl.ModuleAbbrev (id,p,m) -> - let env = MutRecBindingChecking.TcModuleAbbrevDecl cenv scopem env (id,p,m) + | SynModuleDecl.ModuleAbbrev (id, p, m) -> + let env = MutRecBindingChecking.TcModuleAbbrevDecl cenv scopem env (id, p, m) return ((fun e -> e), []), env, env - | SynModuleDecl.Exception (edef,m) -> - let binds,decl,env = TcExceptionDeclarations.TcExnDefn cenv env parent (edef,scopem) - return ((fun e -> TMDefRec(true,[decl], binds |> List.map ModuleOrNamespaceBinding.Binding,m) :: e),[]), env, env + | SynModuleDecl.Exception (edef, m) -> + let binds, decl, env = TcExceptionDeclarations.TcExnDefn cenv env parent (edef, scopem) + return ((fun e -> TMDefRec(true, [decl], binds |> List.map ModuleOrNamespaceBinding.Binding, m) :: e), []), env, env - | SynModuleDecl.Types (typeDefs,m) -> + | SynModuleDecl.Types (typeDefs, m) -> let scopem = unionRanges m scopem let mutRecDefns = typeDefs |> List.map MutRecShape.Tycon - let mutRecDefnsChecked,envAfter = TcDeclarations.TcMutRecDefinitions cenv env parent typeNames tpenv m scopem None mutRecDefns + let mutRecDefnsChecked, envAfter = TcDeclarations.TcMutRecDefinitions cenv env parent typeNames tpenv m scopem None mutRecDefns // Check the non-escaping condition as we build the expression on the way back up let exprfWithEscapeCheck e = TcMutRecDefnsEscapeCheck mutRecDefnsChecked env @@ -16530,32 +16531,32 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem return (exprfWithEscapeCheck, []), envAfter, envAfter - | SynModuleDecl.Open (LongIdentWithDots(mp,_),m) -> + | SynModuleDecl.Open (LongIdentWithDots(mp, _), m) -> let scopem = unionRanges m.EndRange scopem let env = TcOpenDecl cenv.tcSink cenv.g cenv.amap m scopem env mp - return ((fun e -> e),[]), env, env + return ((fun e -> e), []), env, env | SynModuleDecl.Let (letrec, binds, m) -> match parent with | ParentNone -> CheckLetOrDoInNamespace binds m - return (id,[]), env, env + return (id, []), env, env | Parent parentModule -> let containerInfo = ModuleOrNamespaceContainerInfo(parentModule) if letrec then let scopem = unionRanges m scopem - let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(containerInfo,NoNewSlots,ModuleOrMemberBinding,bind)) - let binds,env,_ = TcLetrec WarnOnOverrides cenv env tpenv (binds,m, scopem) - return ((fun e -> TMDefRec(true,[],binds |> List.map ModuleOrNamespaceBinding.Binding,m) :: e),[]), env, env + let binds = binds |> List.map (fun bind -> RecDefnBindingInfo(containerInfo, NoNewSlots, ModuleOrMemberBinding, bind)) + let binds, env, _ = TcLetrec WarnOnOverrides cenv env tpenv (binds, m, scopem) + return ((fun e -> TMDefRec(true, [], binds |> List.map ModuleOrNamespaceBinding.Binding, m) :: e), []), env, env else - let binds,env,_ = TcLetBindings cenv env containerInfo ModuleOrMemberBinding tpenv (binds,m,scopem) - return ((fun e -> binds@e),[]), env, env + let binds, env, _ = TcLetBindings cenv env containerInfo ModuleOrMemberBinding tpenv (binds, m, scopem) + return ((fun e -> binds@e), []), env, env | SynModuleDecl.DoExpr _ -> return! failwith "unreachable" - | SynModuleDecl.Attributes (synAttrs,_) -> + | SynModuleDecl.Attributes (synAttrs, _) -> let attrs, _ = TcAttributesWithPossibleTargets false cenv env AttributeTargets.Top synAttrs return ((fun e -> e), attrs), env, env @@ -16570,7 +16571,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem let modDecl = SynModuleDecl.NestedModule(compInfo, false, mdefs, isContinuingModule, m) return! TcModuleOrNamespaceElementsMutRec cenv parent typeNames m env None [modDecl] else - let (ComponentInfo(attribs,_parms, _constraints,longPath,xml,_,vis,im)) = compInfo + let (ComponentInfo(attribs, _parms, _constraints, longPath, xml, _, vis, im)) = compInfo let id = ComputeModuleName longPath let modAttrs = TcAttributes cenv env AttributeTargets.ModuleDecl attribs @@ -16578,7 +16579,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem let modName = EstablishTypeDefinitionCores.AdjustModuleName modKind id.idText CheckForDuplicateConcreteType env modName im CheckForDuplicateModule env id.idText id.idRange - let vis,_ = ComputeAccessAndCompPath env None id.idRange vis None parent + let vis, _ = ComputeAccessAndCompPath env None id.idRange vis None parent let endm = m.EndRange let id = ident (modName, id.idRange) @@ -16596,7 +16597,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem // Get the inferred type of the decls and record it in the mspec. mspec.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc - let modDefn = TMDefRec(false,[],[ModuleOrNamespaceBinding.Module(mspec,mexpr)],m) + let modDefn = TMDefRec(false, [], [ModuleOrNamespaceBinding.Module(mspec, mexpr)], m) PublishModuleDefn cenv env mspec let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec @@ -16609,10 +16610,10 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem // but does contain the results of all the 'open' declarations and so on. let envAtEnd = (if isContinuingModule then envAtEnd else env) - return ((fun modDefs -> modDefn :: modDefs),topAttrsNew), env, envAtEnd + return ((fun modDefs -> modDefn :: modDefs), topAttrsNew), env, envAtEnd - | SynModuleDecl.NamespaceFragment(SynModuleOrNamespace(longId,isRec,isModule,defs,xml,attribs,vis,m)) -> + | SynModuleDecl.NamespaceFragment(SynModuleOrNamespace(longId, isRec, isModule, defs, xml, attribs, vis, m)) -> if !progress then dprintn ("Typecheck implementation " + textOfLid longId) let endm = m.EndRange @@ -16629,7 +16630,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem let enclosingNamespacePath, defs = if isModule then let nsp, modName = List.frontAndBack longId - let modDecl = [SynModuleDecl.NestedModule(ComponentInfo(attribs,[], [],[modName],xml,false,vis,m),false,defs,true,m)] + let modDecl = [SynModuleDecl.NestedModule(ComponentInfo(attribs, [], [], [modName], xml, false, vis, m), false, defs, true, m)] nsp, modDecl else longId, defs @@ -16658,7 +16659,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem // If the namespace is an interactive fragment e.g. FSI_0002, then open FSI_0002 in the subsequent environment let env = match TryStripPrefixPath cenv.g enclosingNamespacePath with - | Some(p,_) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] + | Some(p, _) -> TcOpenDecl cenv.tcSink cenv.g cenv.amap m.EndRange m.EndRange env [p] | None -> env // Publish the combined module type @@ -16667,7 +16668,7 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem let modExprRoot = BuildRootModuleExpr enclosingNamespacePath envNS.eCompPath modExpr - return ((fun modExprs -> modExprRoot :: modExprs),topAttrs), env, envAtEnd + return ((fun modExprs -> modExprRoot :: modExprs), topAttrs), env, envAtEnd with exn -> errorRecovery exn synDecl.Range @@ -16687,7 +16688,7 @@ and TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm (defsSoFar, // Possibly better: //let scopem = unionRanges h1.Range.EndRange endm - let! firstDef',env', envAtEnd' = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef + let! firstDef', env', envAtEnd' = TcModuleOrNamespaceElementNonMutRec cenv parent typeNames scopem env firstDef // tail recursive return! TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ( (firstDef' :: defsSoFar), env', envAtEnd') otherDefs | [] -> @@ -16703,10 +16704,10 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames endm envInitial mutR let (mutRecDefns, (_, _, synAttrs)) = let rec loop isNamespace attrs defs : (MutRecDefnsInitialData * _) = - ((true, true, attrs),defs) ||> List.collectFold (fun (openOk,moduleAbbrevOk,attrs) def -> + ((true, true, attrs), defs) ||> List.collectFold (fun (openOk, moduleAbbrevOk, attrs) def -> match ElimModuleDoBinding def with - | SynModuleDecl.Types (typeDefs,_) -> + | SynModuleDecl.Types (typeDefs, _) -> let decls = typeDefs |> List.map MutRecShape.Tycon decls, (false, false, attrs) @@ -16719,42 +16720,42 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames endm envInitial mutR else List.map (List.singleton >> MutRecShape.Lets) binds binds, (false, false, attrs) - | SynModuleDecl.NestedModule(compInfo, isRec, synDefs,_isContinuingModule,_) -> - if isRec then warning(Error(FSComp.SR.tcRecImplied(),compInfo.Range)) + | SynModuleDecl.NestedModule(compInfo, isRec, synDefs, _isContinuingModule, _) -> + if isRec then warning(Error(FSComp.SR.tcRecImplied(), compInfo.Range)) let mutRecDefs, (_, _, attrs) = loop false attrs synDefs let decls = [MutRecShape.Module (compInfo, mutRecDefs)] decls, (false, false, attrs) - | SynModuleDecl.Open (LongIdentWithDots(lid,_), m) -> - if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(),m)) + | SynModuleDecl.Open (LongIdentWithDots(lid, _), m) -> + if not openOk then errorR(Error(FSComp.SR.tcOpenFirstInMutRec(), m)) let decls = [ MutRecShape.Open (MutRecDataForOpen(lid, m)) ] decls, (openOk, moduleAbbrevOk, attrs) - | SynModuleDecl.Exception (SynExceptionDefn(repr,members,_),_m) -> - let (SynExceptionDefnRepr(synAttrs,UnionCase(_,id,_args,_,_,_),_repr,doc,vis,m)) = repr - let compInfo = ComponentInfo(synAttrs,[],[],[id],doc,false,vis,id.idRange) + | SynModuleDecl.Exception (SynExceptionDefn(repr, members, _), _m) -> + let (SynExceptionDefnRepr(synAttrs, UnionCase(_, id, _args, _, _, _), _repr, doc, vis, m)) = repr + let compInfo = ComponentInfo(synAttrs, [], [], [id], doc, false, vis, id.idRange) let decls = [ MutRecShape.Tycon(SynTypeDefn.TypeDefn(compInfo, SynTypeDefnRepr.Exception repr, members, m)) ] decls, (false, false, attrs) | SynModuleDecl.HashDirective _ -> [ ], (openOk, moduleAbbrevOk, attrs) - | SynModuleDecl.Attributes (synAttrs,_) -> + | SynModuleDecl.Attributes (synAttrs, _) -> [ ], (false, false, synAttrs) | SynModuleDecl.ModuleAbbrev (id, p, m) -> - if not moduleAbbrevOk then errorR(Error(FSComp.SR.tcModuleAbbrevFirstInMutRec(),m)) + if not moduleAbbrevOk then errorR(Error(FSComp.SR.tcModuleAbbrevFirstInMutRec(), m)) let decls = [ MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev(id, p, m)) ] decls, (false, moduleAbbrevOk, attrs) | SynModuleDecl.DoExpr _ -> failwith "unreachable: SynModuleDecl.DoExpr - ElimModuleDoBinding" - | (SynModuleDecl.NamespaceFragment _ as d) -> error(Error(FSComp.SR.tcUnsupportedMutRecDecl(),d.Range))) + | (SynModuleDecl.NamespaceFragment _ as d) -> error(Error(FSComp.SR.tcUnsupportedMutRecDecl(), d.Range))) loop (match parent with ParentNone -> true | Parent _ -> false) [] defs let tpenv = emptyUnscopedTyparEnv - let mutRecDefnsChecked,envAfter = TcDeclarations.TcMutRecDefinitions cenv envInitial parent typeNames tpenv m scopem mutRecNSInfo mutRecDefns + let mutRecDefnsChecked, envAfter = TcDeclarations.TcMutRecDefinitions cenv envInitial parent typeNames tpenv m scopem mutRecNSInfo mutRecDefns // Check the assembly attributes let attrs, _ = TcAttributesWithPossibleTargets false cenv envAfter AttributeTargets.Top synAttrs @@ -16765,25 +16766,25 @@ and TcModuleOrNamespaceElementsMutRec cenv parent typeNames endm envInitial mutR let modExpr = TcMutRecDefsFinish cenv mutRecDefnsChecked m modExpr :: modExprs - return (exprfWithEscapeCheck,attrs),envAfter, envAfter + return (exprfWithEscapeCheck, attrs), envAfter, envAfter } and TcMutRecDefsFinish cenv defs m = - let tycons = defs |> List.choose (function MutRecShape.Tycon (Some tycon,_) -> Some tycon | _ -> None) + let tycons = defs |> List.choose (function MutRecShape.Tycon (Some tycon, _) -> Some tycon | _ -> None) let binds = defs |> List.collect (function | MutRecShape.Open _ -> [] | MutRecShape.ModuleAbbrev _ -> [] - | MutRecShape.Tycon (_,binds) + | MutRecShape.Tycon (_, binds) | MutRecShape.Lets binds -> binds |> List.map ModuleOrNamespaceBinding.Binding - | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(mtypeAcc, mspec), _),mdefs) -> + | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(mtypeAcc, mspec), _), mdefs) -> let mexpr = TcMutRecDefsFinish cenv mdefs m mspec.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc - [ ModuleOrNamespaceBinding.Module(mspec,mexpr) ]) + [ ModuleOrNamespaceBinding.Module(mspec, mexpr) ]) - TMDefRec(true,tycons,binds,m) + TMDefRec(true, tycons, binds, m) and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo defs = eventually { @@ -16806,10 +16807,10 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo defs = let! compiledDefs, envAtEnd = TcModuleOrNamespaceElementsNonMutRec cenv parent typeNames endm ([], env, env) defs // Apply the functions for each declaration to build the overall expression-builder - let mexpr = TMDefs(List.foldBack (fun (f,_) x -> f x) compiledDefs []) + let mexpr = TMDefs(List.foldBack (fun (f, _) x -> f x) compiledDefs []) // Collect up the attributes that are global to the file - let topAttrsNew = List.foldBack (fun (_,y) x -> y@x) compiledDefs [] + let topAttrsNew = List.foldBack (fun (_, y) x -> y@x) compiledDefs [] return (mexpr, topAttrsNew, envAtEnd) } @@ -16821,24 +16822,24 @@ and TcModuleOrNamespaceElements cenv parent endm env xml mutRecNSInfo defs = let ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap (ccu: CcuThunk) scopem env (p, root) = let warn() = - warning(Error(FSComp.SR.tcAttributeAutoOpenWasIgnored(p, ccu.AssemblyName),scopem)) + warning(Error(FSComp.SR.tcAttributeAutoOpenWasIgnored(p, ccu.AssemblyName), scopem)) env let p = splitNamespace p if isNil p then warn() else - let h,t = List.frontAndBack p + let h, t = List.frontAndBack p let modref = mkNonLocalTyconRef (mkNonLocalEntityRef ccu (Array.ofList h)) t match modref.TryDeref with | VNone -> warn() | VSome _ -> OpenModulesOrNamespaces TcResultsSink.NoSink g amap scopem root env [modref] // Add the CCU and apply the "AutoOpen" attributes -let AddCcuToTcEnv(g,amap,scopem,env,assemblyName,ccu,autoOpens,internalsVisible) = - let env = AddNonLocalCcu g amap scopem env assemblyName (ccu,internalsVisible) +let AddCcuToTcEnv(g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsVisible) = + let env = AddNonLocalCcu g amap scopem env assemblyName (ccu, internalsVisible) // See https://fslang.uservoice.com/forums/245727-f-language/suggestions/6107641-make-microsoft-prefix-optional-when-using-core-f // "Microsoft" is opened by default in FSharp.Core let autoOpens = - let autoOpens = autoOpens |> List.map (fun p -> (p,false)) + let autoOpens = autoOpens |> List.map (fun p -> (p, false)) if ccuEq ccu g.fslibCcu then // Auto open 'Microsoft' in FSharp.Core.dll. Even when using old versions of FSharp.Core.dll that do // not have this attribute. The 'true' means 'treat all namespaces so revealed as "roots" accessible via @@ -16847,13 +16848,13 @@ let AddCcuToTcEnv(g,amap,scopem,env,assemblyName,ccu,autoOpens,internalsVisible) else autoOpens - let env = (env,autoOpens) ||> List.fold (ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap ccu scopem) + let env = (env, autoOpens) ||> List.fold (ApplyAssemblyLevelAutoOpenAttributeToTcEnv g amap ccu scopem) env -let CreateInitialTcEnv(g,amap,scopem,assemblyName,ccus) = - (emptyTcEnv g, ccus) ||> List.fold (fun env (ccu,autoOpens,internalsVisible) -> +let CreateInitialTcEnv(g, amap, scopem, assemblyName, ccus) = + (emptyTcEnv g, ccus) ||> List.fold (fun env (ccu, autoOpens, internalsVisible) -> try - AddCcuToTcEnv(g,amap,scopem,env,assemblyName,ccu,autoOpens,internalsVisible) + AddCcuToTcEnv(g, amap, scopem, env, assemblyName, ccu, autoOpens, internalsVisible) with e -> errorRecovery e scopem env) @@ -16888,9 +16889,9 @@ let rec IterTyconsOfModuleOrNamespaceType f (mty:ModuleOrNamespaceType) = // Defaults get applied in priority order. Defaults listed last get priority 0 (lowest), 2nd last priority 1 etc. let ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs = try - let unsolved = Microsoft.FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr,extraAttribs) + let unsolved = Microsoft.FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr, extraAttribs) - GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv,denvAtEnd,m) unsolved + GeneralizationHelpers.CanonicalizePartialInferenceProblem (cenv, denvAtEnd, m) unsolved let applyDefaults priority = unsolved |> List.iter (fun tp -> @@ -16899,13 +16900,13 @@ let ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs = // the defaults will be propagated to the new type variable. tp.Constraints |> List.iter (fun tpc -> match tpc with - | TyparConstraint.DefaultsTo(priority2,ty2,m) when priority2 = priority -> + | TyparConstraint.DefaultsTo(priority2, ty2, m) when priority2 = priority -> let ty1 = mkTyparTy tp if not tp.IsSolved && not (typeEquiv cenv.g ty1 ty2) then let csenv = MakeConstraintSolverEnv ContextInfo.NoContext cenv.css m denvAtEnd TryD (fun () -> ConstraintSolver.SolveTyparEqualsTyp csenv 0 m NoTrace ty1 ty2) (fun e -> solveTypAsError cenv denvAtEnd m ty1 - ErrorD(ErrorFromApplyingDefault(g,denvAtEnd,tp,ty2,e,m))) + ErrorD(ErrorFromApplyingDefault(g, denvAtEnd, tp, ty2, e, m))) |> RaiseOperationResult | _ -> ())) @@ -16927,20 +16928,20 @@ let CheckValueRestriction denvAtEnd rootSigOpt implFileTypePriorToSig m = if (not v.IsCompilerGenerated && not (ftyvs |> List.exists (fun tp -> tp.IsFromError)) && // Do not apply the value restriction to methods and functions - // Note, normally these completely generalize their argument types anyway. However, + // Note, normally these completely generalize their argument types anyway. However, // some methods (property getters/setters, constructors) can't be as generic // as they might naturally be, and these can leave type variables unsolved. See // for example FSharp 1.0 3661. (match v.ValReprInfo with None -> true | Some tvi -> tvi.HasNoArgs)) then match ftyvs with - | tp :: _ -> errorR (ValueRestriction(denvAtEnd,false,v, tp,v.Range)) + | tp :: _ -> errorR (ValueRestriction(denvAtEnd, false, v, tp, v.Range)) | _ -> () mty.ModuleAndNamespaceDefinitions |> List.iter (fun v -> check v.ModuleOrNamespaceType) try check implFileTypePriorToSig with e -> errorRecovery e m let SolveInternalUnknowns g cenv denvAtEnd mexpr extraAttribs = - let unsolved = Microsoft.FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr,extraAttribs) + let unsolved = Microsoft.FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr, extraAttribs) unsolved |> List.iter (fun tp -> if (tp.Rigidity <> TyparRigidity.Rigid) && not tp.IsSolved then @@ -16952,7 +16953,7 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im // Deep copy the inferred type of the module let implFileTypePriorToSigCopied = copyModuleOrNamespaceType g CloneAll implFileTypePriorToSig - ModuleOrNamespaceExprWithSig(implFileTypePriorToSigCopied,mexpr,m) + ModuleOrNamespaceExprWithSig(implFileTypePriorToSigCopied, mexpr, m) | Some sigFileType -> @@ -16968,7 +16969,7 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im raise (ReportedError None) // Compute the remapping from implementation to signature - let remapInfo ,_ = ComputeRemappingFromInferredSignatureToExplicitSignature cenv.g implFileTypePriorToSig sigFileType + let remapInfo , _ = ComputeRemappingFromInferredSignatureToExplicitSignature cenv.g implFileTypePriorToSig sigFileType let aenv = { TypeEquivEnv.Empty with EquivTycons = TyconRefMap.OfList remapInfo.mrpiEntities } @@ -16979,7 +16980,7 @@ let CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig im with e -> errorRecovery e m end - ModuleOrNamespaceExprWithSig(sigFileType,mexpr,m) + ModuleOrNamespaceExprWithSig(sigFileType, mexpr, m) /// Check an entire implementation file @@ -16989,7 +16990,7 @@ let TypeCheckOneImplFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink) env (rootSigOpt : ModuleOrNamespaceType option) - (ParsedImplFileInput(_,isScript,qualNameOfFile,scopedPragmas,_,implFileFrags,isLastCompiland)) = + (ParsedImplFileInput(_, isScript, qualNameOfFile, scopedPragmas, _, implFileFrags, isLastCompiland)) = eventually { let cenv = cenv.Create (g, isScript, niceNameGen, amap, topCcu, false, Option.isSome rootSigOpt, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) @@ -17002,10 +17003,10 @@ let TypeCheckOneImplFile let implFileTypePriorToSig = !mtypeAcc let topAttrs = - let mainMethodAttrs,others = topAttrs |> List.partition (fun (possTargets,_) -> possTargets &&& AttributeTargets.Method <> enum 0) - let assemblyAttrs,others = others |> List.partition (fun (possTargets,_) -> possTargets &&& AttributeTargets.Assembly <> enum 0) + let mainMethodAttrs, others = topAttrs |> List.partition (fun (possTargets, _) -> possTargets &&& AttributeTargets.Method <> enum 0) + let assemblyAttrs, others = others |> List.partition (fun (possTargets, _) -> possTargets &&& AttributeTargets.Assembly <> enum 0) // REVIEW: consider checking if '_others' is empty - let netModuleAttrs, _others = others |> List.partition (fun (possTargets,_) -> possTargets &&& AttributeTargets.Module <> enum 0) + let netModuleAttrs, _others = others |> List.partition (fun (possTargets, _) -> possTargets &&& AttributeTargets.Module <> enum 0) { mainMethodAttrs = List.map snd mainMethodAttrs netModuleAttrs = List.map snd netModuleAttrs assemblyAttrs = List.map snd assemblyAttrs} @@ -17056,23 +17057,23 @@ let TypeCheckOneImplFile conditionallySuppressErrorReporting (checkForErrors()) (fun () -> try let reportErrors = not (checkForErrors()) - PostTypeCheckSemanticChecks.CheckTopImpl (g,cenv.amap,reportErrors,cenv.infoReader,env.eInternalsVisibleCompPaths,cenv.topCcu,envAtEnd.DisplayEnv, implFileExprAfterSig,extraAttribs,isLastCompiland) + PostTypeCheckSemanticChecks.CheckTopImpl (g, cenv.amap, reportErrors, cenv.infoReader, env.eInternalsVisibleCompPaths, cenv.topCcu, envAtEnd.DisplayEnv, implFileExprAfterSig, extraAttribs, isLastCompiland) with e -> errorRecovery e m false) let implFile = TImplFile(qualNameOfFile, scopedPragmas, implFileExprAfterSig, hasExplicitEntryPoint, isScript) - return (topAttrs,implFile,envAtEnd,cenv.createsGeneratedProvidedTypes) + return (topAttrs, implFile, envAtEnd, cenv.createsGeneratedProvidedTypes) } /// Check an entire signature file -let TypeCheckOneSigFile (g,niceNameGen,amap,topCcu,checkForErrors,conditionalDefines,tcSink) tcEnv (ParsedSigFileInput(_,qualNameOfFile,_, _,sigFileFrags)) = +let TypeCheckOneSigFile (g, niceNameGen, amap, topCcu, checkForErrors, conditionalDefines, tcSink) tcEnv (ParsedSigFileInput(_, qualNameOfFile, _, _, sigFileFrags)) = eventually { - let cenv = cenv.Create (g,false,niceNameGen,amap,topCcu,true,false,conditionalDefines,tcSink, (LightweightTcValForUsingInBuildMethodCall g)) - let envinner,mtypeAcc = MakeInitialEnv tcEnv + let cenv = cenv.Create (g, false, niceNameGen, amap, topCcu, true, false, conditionalDefines, tcSink, (LightweightTcValForUsingInBuildMethodCall g)) + let envinner, mtypeAcc = MakeInitialEnv tcEnv let specs = [ for x in sigFileFrags -> SynModuleSigDecl.NamespaceFragment(x) ] let! tcEnv = TcSignatureElements cenv ParentNone qualNameOfFile.Range envinner PreXmlDocEmpty None specs @@ -17083,5 +17084,5 @@ let TypeCheckOneSigFile (g,niceNameGen,amap,topCcu,checkForErrors,conditionalDe try sigFileType |> IterTyconsOfModuleOrNamespaceType (FinalTypeDefinitionChecksAtEndOfInferenceScope(cenv.infoReader, tcEnv.NameEnv, cenv.tcSink, false, tcEnv.DisplayEnv)) with e -> errorRecovery e qualNameOfFile.Range - return (tcEnv,sigFileType,cenv.createsGeneratedProvidedTypes) + return (tcEnv, sigFileType, cenv.createsGeneratedProvidedTypes) } diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index d7ab5629391cb8d4251e11f414659768bc3b16e7..5a8141fb7037b3da7c01ee720dfddcb91f738bec 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -39,7 +39,7 @@ module ExprTranslationImpl = substVals = ValMap<_>.Empty } member env.BindTypar (v:Typar, gp) = - { env with tyvs = env.tyvs.Add(v.Stamp,gp ) } + { env with tyvs = env.tyvs.Add(v.Stamp, gp ) } member env.BindTypars vs = (env, vs) ||> List.fold (fun env v -> env.BindTypar v) // fold left-to-right because indexes are left-to-right @@ -47,18 +47,18 @@ module ExprTranslationImpl = member env.BindVal v = { env with vs = env.vs.Add v () } - member env.BindIsInstVal v (ty,e) = - { env with isinstVals = env.isinstVals.Add v (ty,e) } + member env.BindIsInstVal v (ty, e) = + { env with isinstVals = env.isinstVals.Add v (ty, e) } member env.BindSubstVal v e = { env with substVals = env.substVals.Add v e } - member env.BindVals vs = (env,vs) ||> List.fold (fun env v -> env.BindVal v) - member env.BindCurriedVals vsl = (env,vsl) ||> List.fold (fun env vs -> env.BindVals vs) + member env.BindVals vs = (env, vs) ||> List.fold (fun env v -> env.BindVal v) + member env.BindCurriedVals vsl = (env, vsl) ||> List.fold (fun env vs -> env.BindVals vs) exception IgnoringPartOfQuotedTermWarning of string * Range.range - let wfail (msg,m:range) = failwith (msg + sprintf " at %s" (m.ToString())) + let wfail (msg, m:range) = failwith (msg + sprintf " at %s" (m.ToString())) /// The core tree of data produced by converting F# compiler TAST expressions into the form which we make available through the compiler API @@ -187,16 +187,16 @@ module FSharpExprConvert = rfref.RecdField.IsMutable && rfref.RecdField.Name.StartsWith "init" - // Match "if [AI_clt](init@41,6) then IntrinsicFunctions.FailStaticInit () else ()" + // Match "if [AI_clt](init@41, 6) then IntrinsicFunctions.FailStaticInit () else ()" let (|StaticInitializationCheck|_|) e = match e with - | Expr.Match (_,_,TDSwitch(Expr.Op(TOp.ILAsm ([ AI_clt ],_),_,[Expr.Op(TOp.ValFieldGet rfref,_,_,_) ;_],_),_,_,_),_,_,_) when IsStaticInitializationField rfref -> Some () + | Expr.Match (_, _, TDSwitch(Expr.Op(TOp.ILAsm ([ AI_clt ], _), _, [Expr.Op(TOp.ValFieldGet rfref, _, _, _) ;_], _), _, _, _), _, _, _) when IsStaticInitializationField rfref -> Some () | _ -> None // Match "init@41 <- 6" let (|StaticInitializationCount|_|) e = match e with - | Expr.Op(TOp.ValFieldSet rfref,_,_,_) when IsStaticInitializationField rfref -> Some () + | Expr.Op(TOp.ValFieldSet rfref, _, _, _) when IsStaticInitializationField rfref -> Some () | _ -> None let ConvType cenv typ = FSharpType(cenv, typ) @@ -206,19 +206,19 @@ module FSharpExprConvert = ConvType cenv (mkAppTy tcref tyargs) let ConvUnionCaseRef cenv (ucref:UnionCaseRef) = FSharpUnionCase(cenv, ucref) - let ConvRecdFieldRef cenv (rfref:RecdFieldRef) = FSharpField(cenv,rfref ) + let ConvRecdFieldRef cenv (rfref:RecdFieldRef) = FSharpField(cenv, rfref ) let rec exprOfExprAddr (cenv:Impl.cenv) expr = match expr with - | Expr.Op(op,tyargs,args,m) -> + | Expr.Op(op, tyargs, args, m) -> match op, args, tyargs with - | TOp.LValueOp(LGetAddr,vref),_,_ -> exprForValRef m vref - | TOp.ValFieldGetAddr(rfref),[],_ -> mkStaticRecdFieldGet(rfref,tyargs,m) - | TOp.ValFieldGetAddr(rfref),[arg],_ -> mkRecdFieldGetViaExprAddr(exprOfExprAddr cenv arg,rfref,tyargs,m) - | TOp.UnionCaseFieldGetAddr(uref,n),[arg],_ -> mkUnionCaseFieldGetProvenViaExprAddr(exprOfExprAddr cenv arg,uref,tyargs,n,m) - | TOp.ILAsm([ I_ldflda(fspec) ],rtys),[arg],_ -> mkAsmExpr([ mkNormalLdfld(fspec) ],tyargs, [exprOfExprAddr cenv arg], rtys, m) - | TOp.ILAsm([ I_ldsflda(fspec) ],rtys),_,_ -> mkAsmExpr([ mkNormalLdsfld(fspec) ],tyargs, args, rtys, m) - | TOp.ILAsm(([ I_ldelema(_ro,_isNativePtr,shape,_tyarg) ] ),_), (arr::idxs), [elemty] -> + | TOp.LValueOp(LGetAddr, vref), _, _ -> exprForValRef m vref + | TOp.ValFieldGetAddr(rfref), [], _ -> mkStaticRecdFieldGet(rfref, tyargs, m) + | TOp.ValFieldGetAddr(rfref), [arg], _ -> mkRecdFieldGetViaExprAddr(exprOfExprAddr cenv arg, rfref, tyargs, m) + | TOp.UnionCaseFieldGetAddr(uref, n), [arg], _ -> mkUnionCaseFieldGetProvenViaExprAddr(exprOfExprAddr cenv arg, uref, tyargs, n, m) + | TOp.ILAsm([ I_ldflda(fspec) ], rtys), [arg], _ -> mkAsmExpr([ mkNormalLdfld(fspec) ], tyargs, [exprOfExprAddr cenv arg], rtys, m) + | TOp.ILAsm([ I_ldsflda(fspec) ], rtys), _, _ -> mkAsmExpr([ mkNormalLdsfld(fspec) ], tyargs, args, rtys, m) + | TOp.ILAsm(([ I_ldelema(_ro, _isNativePtr, shape, _tyarg) ] ), _), (arr::idxs), [elemty] -> match shape.Rank, idxs with | 1, [idx1] -> mkCallArrayGet cenv.g m elemty arr idx1 | 2, [idx1; idx2] -> mkCallArray2DGet cenv.g m elemty arr idx1 idx2 @@ -246,7 +246,7 @@ module FSharpExprConvert = match expr with // Large lists - | Expr.Op(TOp.UnionCase ucref,tyargs,[e1;e2],_) -> + | Expr.Op(TOp.UnionCase ucref, tyargs, [e1;e2], _) -> let mkR = ConvUnionCaseRef cenv ucref let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) let e1R = ConvExpr cenv env e1 @@ -254,12 +254,12 @@ module FSharpExprConvert = ConvExprLinear cenv env e2 (contf << (fun e2R -> E.NewUnionCase(typR, mkR, [e1R; e2R]) )) // Large sequences of let bindings - | Expr.Let (bind,body,_,_) -> + | Expr.Let (bind, body, _, _) -> match ConvLetBind cenv env bind with | None, env -> ConvExprPrimLinear cenv env body contf - | Some(bindR),env -> + | Some(bindR), env -> // tail recursive - ConvExprLinear cenv env body (contf << (fun bodyR -> E.Let(bindR,bodyR))) + ConvExprLinear cenv env body (contf << (fun bodyR -> E.Let(bindR, bodyR))) // Remove initialization checks // Remove static initialization counter updates @@ -269,22 +269,22 @@ module FSharpExprConvert = // // TODO: allow clients to see static initialization checks if they want to | Expr.Sequential(ObjectInitializationCheck cenv.g, x1, NormalSeq, _, _) - | Expr.Sequential (StaticInitializationCount,x1,NormalSeq,_,_) - | Expr.Sequential (StaticInitializationCheck,x1,NormalSeq,_,_) -> + | Expr.Sequential (StaticInitializationCount, x1, NormalSeq, _, _) + | Expr.Sequential (StaticInitializationCheck, x1, NormalSeq, _, _) -> ConvExprPrim cenv env x1 |> contf // Large sequences of sequential code - | Expr.Sequential (e1,e2,NormalSeq,_,_) -> + | Expr.Sequential (e1, e2, NormalSeq, _, _) -> let e1R = ConvExpr cenv env e1 // tail recursive ConvExprLinear cenv env e2 (contf << (fun e2R -> E.Sequential(e1R, e2R))) - | Expr.Sequential (x0,x1,ThenDoSeq,_,_) -> E.Sequential(ConvExpr cenv env x0, ConvExpr cenv env x1) + | Expr.Sequential (x0, x1, ThenDoSeq, _, _) -> E.Sequential(ConvExpr cenv env x0, ConvExpr cenv env x1) - | ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs) when (nonNil tyargs || nonNil curriedArgs) && vref.IsMemberOrModuleBinding -> - ConvModuleValueOrMemberUseLinear cenv env (expr,vref,vFlags,tyargs,curriedArgs) contf + | ModuleValueOrMemberUse cenv.g (vref, vFlags, _f, _fty, tyargs, curriedArgs) when (nonNil tyargs || nonNil curriedArgs) && vref.IsMemberOrModuleBinding -> + ConvModuleValueOrMemberUseLinear cenv env (expr, vref, vFlags, tyargs, curriedArgs) contf - | Expr.Match (_spBind,m,dtree,tgs,_,retTy) -> + | Expr.Match (_spBind, m, dtree, tgs, _, retTy) -> let dtreeR = ConvDecisionTree cenv env retTy dtree m // tailcall ConvTargetsLinear cenv env (List.ofArray tgs) (contf << fun (targetsR: _ list) -> @@ -292,8 +292,8 @@ module FSharpExprConvert = // If the match is really an "if-then-else" then return it as such. match dtreeR with - | E(E.IfThenElse(a,E(E.DecisionTreeSuccess(0,[])), E(E.DecisionTreeSuccess(1,[])))) -> E.IfThenElse(a,snd targetsR.[0],snd targetsR.[1]) - | _ -> E.DecisionTree(dtreeR,targetsR)) + | E(E.IfThenElse(a, E(E.DecisionTreeSuccess(0, [])), E(E.DecisionTreeSuccess(1, [])))) -> E.IfThenElse(a, snd targetsR.[0], snd targetsR.[1]) + | _ -> E.DecisionTree(dtreeR, targetsR)) | _ -> ConvExprPrim cenv env expr |> contf @@ -301,38 +301,38 @@ module FSharpExprConvert = /// A nasty function copied from creflect.fs. Made nastier by taking a continuation to process the /// arguments to the call in a tail-recursive fashion. - and ConvModuleValueOrMemberUseLinear (cenv:Impl.cenv) env (expr:Expr,vref,vFlags,tyargs,curriedArgs) contf = + and ConvModuleValueOrMemberUseLinear (cenv:Impl.cenv) env (expr:Expr, vref, vFlags, tyargs, curriedArgs) contf = let m = expr.Range - let (numEnclTypeArgs,_,isNewObj,_valUseFlags,_isSelfInit,takesInstanceArg,_isPropGet,_isPropSet) = - GetMemberCallInfo cenv.g (vref,vFlags) + let (numEnclTypeArgs, _, isNewObj, _valUseFlags, _isSelfInit, takesInstanceArg, _isPropGet, _isPropSet) = + GetMemberCallInfo cenv.g (vref, vFlags) - let isMember,curriedArgInfos = + let isMember, curriedArgInfos = match vref.MemberInfo with | Some _ when not vref.IsExtensionMember -> // This is an application of a member method // We only count one argument block for these. - let _tps,curriedArgInfos,_,_ = GetTypeOfMemberInFSharpForm cenv.g vref - true,curriedArgInfos + let _tps, curriedArgInfos, _, _ = GetTypeOfMemberInFSharpForm cenv.g vref + true, curriedArgInfos | _ -> // This is an application of a module value or extension member let arities = arityOfVal vref.Deref - let _tps,curriedArgInfos,_,_ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m - false,curriedArgInfos + let _tps, curriedArgInfos, _, _ = GetTopValTypeInFSharpForm cenv.g arities vref.Type m + false, curriedArgInfos // Compute the object arguments as they appear in a compiled call // Strip off the object argument, if any. The curriedArgInfos are already adjusted to compiled member form - let objArgs,curriedArgs = - match takesInstanceArg,curriedArgs with - | false,curriedArgs -> [],curriedArgs - | true,(objArg::curriedArgs) -> [objArg],curriedArgs - | true,[] -> failwith ("warning: unexpected missing object argument when generating quotation for call to F# object member "+vref.LogicalName) + let objArgs, curriedArgs = + match takesInstanceArg, curriedArgs with + | false, curriedArgs -> [], curriedArgs + | true, (objArg::curriedArgs) -> [objArg], curriedArgs + | true, [] -> failwith ("warning: unexpected missing object argument when generating quotation for call to F# object member "+vref.LogicalName) // Check to see if there aren't enough arguments or if there is a tuple-arity mismatch // If so, adjust and try again if curriedArgs.Length < curriedArgInfos.Length || - ((List.take curriedArgInfos.Length curriedArgs,curriedArgInfos) ||> List.exists2 (fun arg argInfo -> (argInfo.Length > (tryDestRefTupleExpr arg).Length))) then + ((List.take curriedArgInfos.Length curriedArgs, curriedArgInfos) ||> List.exists2 (fun arg argInfo -> (argInfo.Length > (tryDestRefTupleExpr arg).Length))) then // Too few arguments or incorrect tupling? Convert to a lambda and beta-reduce the // partially applied arguments to 'let' bindings @@ -341,17 +341,17 @@ module FSharpExprConvert = | None -> failwith ("no arity information found for F# value "+vref.LogicalName) | Some a -> a - let expr,exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo - let splitCallExpr = MakeApplicationAndBetaReduce cenv.g (expr,exprty,[tyargs],curriedArgs,m) + let expr, exprty = AdjustValForExpectedArity cenv.g m vref vFlags topValInfo + let splitCallExpr = MakeApplicationAndBetaReduce cenv.g (expr, exprty, [tyargs], curriedArgs, m) // tailcall ConvExprPrimLinear cenv env splitCallExpr contf else - let curriedArgs,laterArgs = List.chop curriedArgInfos.Length curriedArgs + let curriedArgs, laterArgs = List.chop curriedArgInfos.Length curriedArgs // detuple the args let untupledCurriedArgs = - (curriedArgs,curriedArgInfos) ||> List.map2 (fun arg curriedArgInfo -> + (curriedArgs, curriedArgInfos) ||> List.map2 (fun arg curriedArgInfo -> let numUntupledArgs = curriedArgInfo.Length (if numUntupledArgs = 0 then [] elif numUntupledArgs = 1 then [arg] @@ -360,13 +360,13 @@ module FSharpExprConvert = let contf2 = match laterArgs with | [] -> contf - | _ -> (fun subCallR -> (subCallR, laterArgs) ||> List.fold (fun fR arg -> E.Application (Mk2 cenv arg fR,[],[ConvExpr cenv env arg])) |> contf) + | _ -> (fun subCallR -> (subCallR, laterArgs) ||> List.fold (fun fR arg -> E.Application (Mk2 cenv arg fR, [], [ConvExpr cenv env arg])) |> contf) if isMember then let callArgs = (objArgs::untupledCurriedArgs) |> List.concat let enclTyArgs, methTyArgs = List.splitAfter numEnclTypeArgs tyargs // tailcall - ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv,vref), enclTyArgs, methTyArgs, callArgs) contf2 + ConvObjectModelCallLinear cenv env (isNewObj, FSharpMemberOrFunctionOrValue(cenv, vref), enclTyArgs, methTyArgs, callArgs) contf2 else let v = FSharpMemberOrFunctionOrValue(cenv, vref) // tailcall @@ -386,182 +386,182 @@ module FSharpExprConvert = match expr with // Uses of possibly-polymorphic values which were not polymorphic in the end - | Expr.App(InnerExprPat(Expr.Val _ as ve),_fty,[],[],_) -> + | Expr.App(InnerExprPat(Expr.Val _ as ve), _fty, [], [], _) -> ConvExprPrim cenv env ve // These cases are the start of a "linear" sequence where we use tail recursion to allow use to // deal with large expressions. - | Expr.Op(TOp.UnionCase _,_,[_;_],_) // big lists + | Expr.Op(TOp.UnionCase _, _, [_;_], _) // big lists | Expr.Let _ // big linear sequences of 'let' | Expr.Match _ // big linear sequences of 'match ... -> ....' | Expr.Sequential _ -> ConvExprPrimLinear cenv env expr (fun e -> e) - | ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs) when (* (nonNil tyargs || nonNil curriedArgs) && *) vref.IsMemberOrModuleBinding -> + | ModuleValueOrMemberUse cenv.g (vref, vFlags, _f, _fty, tyargs, curriedArgs) when (* (nonNil tyargs || nonNil curriedArgs) && *) vref.IsMemberOrModuleBinding -> // Process applications of top-level values in a tail-recursive way - ConvModuleValueOrMemberUseLinear cenv env (expr,vref,vFlags,tyargs,curriedArgs) (fun e -> e) + ConvModuleValueOrMemberUseLinear cenv env (expr, vref, vFlags, tyargs, curriedArgs) (fun e -> e) - | Expr.Val(vref,_vFlags,m) -> + | Expr.Val(vref, _vFlags, m) -> ConvValRef cenv env m vref // Simple applications - | Expr.App(f,_fty,tyargs,args,_m) -> + | Expr.App(f, _fty, tyargs, args, _m) -> E.Application (ConvExpr cenv env f, ConvTypes cenv tyargs, ConvExprs cenv env args) - | Expr.Const(c,m,ty) -> + | Expr.Const(c, m, ty) -> ConvConst cenv env m c ty - | Expr.LetRec(binds,body,_,_) -> + | Expr.LetRec(binds, body, _, _) -> let vs = valsOfBinds binds let vsR = vs |> List.map (ConvVal cenv) let env = env.BindVals vs let bodyR = ConvExpr cenv env body let bindsR = List.zip vsR (binds |> List.map (fun b -> b.Expr |> ConvExpr cenv env)) - E.LetRec(bindsR,bodyR) + E.LetRec(bindsR, bodyR) - | Expr.Lambda(_,_,_,vs,b,_,_) -> - let v,b = MultiLambdaToTupledLambda cenv.g vs b + | Expr.Lambda(_, _, _, vs, b, _, _) -> + let v, b = MultiLambdaToTupledLambda cenv.g vs b let vR = ConvVal cenv v let bR = ConvExpr cenv (env.BindVal v) b E.Lambda(vR, bR) - | Expr.Quote(ast,_,_,_,_) -> + | Expr.Quote(ast, _, _, _, _) -> E.Quote(ConvExpr cenv env ast) - | Expr.TyLambda (_,tps,b,_,_) -> - let gps = [ for tp in tps -> FSharpGenericParameter(cenv,tp) ] + | Expr.TyLambda (_, tps, b, _, _) -> + let gps = [ for tp in tps -> FSharpGenericParameter(cenv, tp) ] let env = env.BindTypars (Seq.zip tps gps |> Seq.toList) E.TypeLambda(gps, ConvExpr cenv env b) - | Expr.Obj (_,typ,_,_,[TObjExprMethod(TSlotSig(_,ctyp, _,_,_,_),_,tps,[tmvs],e,_) as tmethod],_,m) when isDelegateTy cenv.g typ -> - let f = mkLambdas m tps tmvs (e,GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) + | Expr.Obj (_, typ, _, _, [TObjExprMethod(TSlotSig(_, ctyp, _, _, _, _), _, tps, [tmvs], e, _) as tmethod], _, m) when isDelegateTy cenv.g typ -> + let f = mkLambdas m tps tmvs (e, GetFSharpViewOfReturnType cenv.g (returnTyOfMethod cenv.g tmethod)) let fR = ConvExpr cenv env f let tyargR = ConvType cenv ctyp E.NewDelegate(tyargR, fR) - | Expr.StaticOptimization (_,_,x,_) -> + | Expr.StaticOptimization (_, _, x, _) -> ConvExprPrim cenv env x | Expr.TyChoose _ -> ConvExprPrim cenv env (ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr) - | Expr.Obj (_lambdaId,typ,_basev,basecall,overrides, iimpls,_m) -> + | Expr.Obj (_lambdaId, typ, _basev, basecall, overrides, iimpls, _m) -> let basecallR = ConvExpr cenv env basecall let ConvertMethods methods = - [ for (TObjExprMethod(slotsig,_,tps,tmvs,body,_)) in methods -> + [ for (TObjExprMethod(slotsig, _, tps, tmvs, body, _)) in methods -> let vslR = List.map (List.map (ConvVal cenv)) tmvs let sgn = FSharpAbstractSignature(cenv, slotsig) - let tpsR = [ for tp in tps -> FSharpGenericParameter(cenv,tp) ] + let tpsR = [ for tp in tps -> FSharpGenericParameter(cenv, tp) ] let env = ExprTranslationEnv.Empty.BindTypars (Seq.zip tps tpsR |> Seq.toList) let env = env.BindCurriedVals tmvs let bodyR = ConvExpr cenv env body FSharpObjectExprOverride(sgn, tpsR, vslR, bodyR) ] let overridesR = ConvertMethods overrides - let iimplsR = List.map (fun (ty,impls) -> ConvType cenv ty, ConvertMethods impls) iimpls + let iimplsR = List.map (fun (ty, impls) -> ConvType cenv ty, ConvertMethods impls) iimpls E.ObjectExpr(ConvType cenv typ, basecallR, overridesR, iimplsR) - | Expr.Op(op,tyargs,args,m) -> - match op,tyargs,args with - | TOp.UnionCase ucref,_,_ -> + | Expr.Op(op, tyargs, args, m) -> + match op, tyargs, args with + | TOp.UnionCase ucref, _, _ -> let mkR = ConvUnionCaseRef cenv ucref let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) let argsR = ConvExprs cenv env args E.NewUnionCase(typR, mkR, argsR) - | TOp.Tuple tupInfo,tyargs,_ -> + | TOp.Tuple tupInfo, tyargs, _ -> let tyR = ConvType cenv (mkAnyTupledTy cenv.g tupInfo tyargs) let argsR = ConvExprs cenv env args E.NewTuple(tyR, argsR) - | TOp.Recd (_,tcref),_,_ -> + | TOp.Recd (_, tcref), _, _ -> let typR = ConvType cenv (mkAppTy tcref tyargs) let argsR = ConvExprs cenv env args E.NewRecord(typR, argsR) - | TOp.UnionCaseFieldGet (ucref,n),tyargs,[e1] -> + | TOp.UnionCaseFieldGet (ucref, n), tyargs, [e1] -> let mkR = ConvUnionCaseRef cenv ucref let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) let projR = FSharpField(cenv, ucref, n) E.UnionCaseGet(ConvExpr cenv env e1, typR, mkR, projR) - | TOp.UnionCaseFieldSet (ucref,n),tyargs,[e1;e2] -> + | TOp.UnionCaseFieldSet (ucref, n), tyargs, [e1;e2] -> let mkR = ConvUnionCaseRef cenv ucref let typR = ConvType cenv (mkAppTy ucref.TyconRef tyargs) let projR = FSharpField(cenv, ucref, n) E.UnionCaseSet(ConvExpr cenv env e1, typR, mkR, projR, ConvExpr cenv env e2) - | TOp.UnionCaseFieldGetAddr (_ucref,_n),_tyargs,_ -> + | TOp.UnionCaseFieldGetAddr (_ucref, _n), _tyargs, _ -> E.AddressOf(ConvLValueExpr cenv env expr) - | TOp.ValFieldGetAddr(_rfref),_tyargs,_ -> + | TOp.ValFieldGetAddr(_rfref), _tyargs, _ -> E.AddressOf(ConvLValueExpr cenv env expr) - | TOp.ValFieldGet(rfref),tyargs,[] -> + | TOp.ValFieldGet(rfref), tyargs, [] -> let projR = ConvRecdFieldRef cenv rfref let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) E.FSharpFieldGet(None, typR, projR) - | TOp.ValFieldGet(rfref),tyargs,[obj] -> + | TOp.ValFieldGet(rfref), tyargs, [obj] -> let objR = ConvLValueExpr cenv env obj let projR = ConvRecdFieldRef cenv rfref let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) E.FSharpFieldGet(Some objR, typR, projR) - | TOp.TupleFieldGet(tupInfo,n),tyargs,[e] -> + | TOp.TupleFieldGet(tupInfo, n), tyargs, [e] -> let tyR = ConvType cenv (mkAnyTupledTy cenv.g tupInfo tyargs) E.TupleGet(tyR, n, ConvExpr cenv env e) - | TOp.ILAsm([ I_ldfld(_,_,fspec) ],_), enclTypeArgs, [obj] -> + | TOp.ILAsm([ I_ldfld(_, _, fspec) ], _), enclTypeArgs, [obj] -> let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs let objR = ConvLValueExpr cenv env obj E.ILFieldGet(Some objR, typR, fspec.Name) - | TOp.ILAsm(( [ I_ldsfld (_,fspec) ] | [ I_ldsfld (_,fspec); AI_nop ]),_),enclTypeArgs,[] -> + | TOp.ILAsm(( [ I_ldsfld (_, fspec) ] | [ I_ldsfld (_, fspec); AI_nop ]), _), enclTypeArgs, [] -> let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs E.ILFieldGet(None, typR, fspec.Name) - | TOp.ILAsm([ I_stfld(_,_,fspec) ],_),enclTypeArgs,[obj;arg] -> + | TOp.ILAsm([ I_stfld(_, _, fspec) ], _), enclTypeArgs, [obj;arg] -> let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs let objR = ConvLValueExpr cenv env obj let argR = ConvExpr cenv env arg E.ILFieldSet(Some objR, typR, fspec.Name, argR) - | TOp.ILAsm([ I_stsfld(_,fspec) ],_),enclTypeArgs,[arg] -> + | TOp.ILAsm([ I_stsfld(_, fspec) ], _), enclTypeArgs, [arg] -> let typR = ConvILTypeRefApp cenv m fspec.EnclosingTypeRef enclTypeArgs let argR = ConvExpr cenv env arg E.ILFieldSet(None, typR, fspec.Name, argR) - | TOp.ILAsm([ AI_ceq ],_),_,[arg1;arg2] -> + | TOp.ILAsm([ AI_ceq ], _), _, [arg1;arg2] -> let ty = tyOfExpr cenv.g arg1 let eq = mkCallEqualsOperator cenv.g m ty arg1 arg2 ConvExprPrim cenv env eq - | TOp.ILAsm([ I_throw ],_),_,[arg1] -> + | TOp.ILAsm([ I_throw ], _), _, [arg1] -> let raiseExpr = mkCallRaise cenv.g m (tyOfExpr cenv.g expr) arg1 ConvExprPrim cenv env raiseExpr - | TOp.ILAsm(il,_),tyargs,args -> + | TOp.ILAsm(il, _), tyargs, args -> E.ILAsm(sprintf "%+A" il, ConvTypes cenv tyargs, ConvExprs cenv env args) - | TOp.ExnConstr tcref,tyargs,args -> + | TOp.ExnConstr tcref, tyargs, args -> E.NewRecord(ConvType cenv (mkAppTy tcref tyargs), ConvExprs cenv env args) - | TOp.ValFieldSet rfref, _tinst,[obj;arg] -> + | TOp.ValFieldSet rfref, _tinst, [obj;arg] -> let objR = ConvLValueExpr cenv env obj let argR = ConvExpr cenv env arg let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) let projR = ConvRecdFieldRef cenv rfref E.FSharpFieldSet(Some objR, typR, projR, argR) - | TOp.ValFieldSet rfref, _tinst,[arg] -> + | TOp.ValFieldSet rfref, _tinst, [arg] -> let argR = ConvExpr cenv env arg let typR = ConvType cenv (mkAppTy rfref.TyconRef tyargs) let projR = ConvRecdFieldRef cenv rfref E.FSharpFieldSet(None, typR, projR, argR) - | TOp.ExnFieldGet(tcref,i),[],[obj] -> + | TOp.ExnFieldGet(tcref, i), [], [obj] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList.[i] let fref = mkRecdFieldRef tcref fspec.Name @@ -569,7 +569,7 @@ module FSharpExprConvert = let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, cenv.g.exn_ty)) E.FSharpFieldGet(Some objR, typR, ConvRecdFieldRef cenv fref) - | TOp.ExnFieldSet(tcref,i),[],[obj;e2] -> + | TOp.ExnFieldSet(tcref, i), [], [obj;e2] -> let exnc = stripExnEqns tcref let fspec = exnc.TrueInstanceFieldsAsList.[i] let fref = mkRecdFieldRef tcref fspec.Name @@ -577,77 +577,77 @@ module FSharpExprConvert = let objR = ConvExpr cenv env (mkCoerceExpr (obj, mkAppTy tcref [], m, cenv.g.exn_ty)) E.FSharpFieldSet(Some objR, typR, ConvRecdFieldRef cenv fref, ConvExpr cenv env e2) - | TOp.Coerce,[tgtTy;srcTy],[x] -> + | TOp.Coerce, [tgtTy;srcTy], [x] -> if typeEquiv cenv.g tgtTy srcTy then ConvExprPrim cenv env x else - E.Coerce(ConvType cenv tgtTy,ConvExpr cenv env x) + E.Coerce(ConvType cenv tgtTy, ConvExpr cenv env x) - | TOp.Reraise,[toTy],[] -> + | TOp.Reraise, [toTy], [] -> // rebuild reraise() and Convert mkReraiseLibCall cenv.g toTy m |> ConvExprPrim cenv env - | TOp.LValueOp(LGetAddr,vref),[],[] -> + | TOp.LValueOp(LGetAddr, vref), [], [] -> E.AddressOf(ConvExpr cenv env (exprForValRef m vref)) - | TOp.LValueOp(LByrefSet,vref),[],[e] -> + | TOp.LValueOp(LByrefSet, vref), [], [e] -> E.AddressSet(ConvExpr cenv env (exprForValRef m vref), ConvExpr cenv env e) - | TOp.LValueOp(LSet,vref),[],[e] -> + | TOp.LValueOp(LSet, vref), [], [e] -> E.ValueSet(FSharpMemberOrFunctionOrValue(cenv, vref), ConvExpr cenv env e) - | TOp.LValueOp(LByrefGet,vref),[],[] -> + | TOp.LValueOp(LByrefGet, vref), [], [] -> ConvValRef cenv env m vref - | TOp.Array,[ty],xa -> - E.NewArray(ConvType cenv ty,ConvExprs cenv env xa) + | TOp.Array, [ty], xa -> + E.NewArray(ConvType cenv ty, ConvExprs cenv env xa) - | TOp.While _,[],[Expr.Lambda(_,_,_,[_],test,_,_);Expr.Lambda(_,_,_,[_],body,_,_)] -> + | TOp.While _, [], [Expr.Lambda(_, _, _, [_], test, _, _);Expr.Lambda(_, _, _, [_], body, _, _)] -> E.WhileLoop(ConvExpr cenv env test, ConvExpr cenv env body) - | TOp.For(_, (FSharpForLoopUp |FSharpForLoopDown as dir) ), [], [Expr.Lambda(_,_,_,[_], lim0,_,_); Expr.Lambda(_,_,_,[_], SimpleArrayLoopUpperBound, lm,_); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> + | TOp.For(_, (FSharpForLoopUp |FSharpForLoopDown as dir) ), [], [Expr.Lambda(_, _, _, [_], lim0, _, _); Expr.Lambda(_, _, _, [_], SimpleArrayLoopUpperBound, lm, _); SimpleArrayLoopBody cenv.g (arr, elemTy, body)] -> let lim1 = let len = mkCallArrayLength cenv.g lm elemTy arr // Array.length arr mkCallSubtractionOperator cenv.g lm cenv.g.int32_ty len (Expr.Const(Const.Int32 1, m, cenv.g.int32_ty)) // len - 1 E.FastIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, (dir = FSharpForLoopUp)) - | TOp.For(_,dir),[],[Expr.Lambda(_,_,_,[_],lim0,_,_);Expr.Lambda(_,_,_,[_],lim1,_,_);body] -> + | TOp.For(_, dir), [], [Expr.Lambda(_, _, _, [_], lim0, _, _);Expr.Lambda(_, _, _, [_], lim1, _, _);body] -> match dir with - | FSharpForLoopUp -> E.FastIntegerForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body,true) - | FSharpForLoopDown -> E.FastIntegerForLoop(ConvExpr cenv env lim0,ConvExpr cenv env lim1, ConvExpr cenv env body,false) + | FSharpForLoopUp -> E.FastIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, true) + | FSharpForLoopDown -> E.FastIntegerForLoop(ConvExpr cenv env lim0, ConvExpr cenv env lim1, ConvExpr cenv env body, false) | _ -> failwith "unexpected for-loop form" - | TOp.ILCall(_,_,_,isNewObj,valUseFlags,_isProp,_,ilMethRef,enclTypeArgs,methTypeArgs,_tys),[],callArgs -> + | TOp.ILCall(_, _, _, isNewObj, valUseFlags, _isProp, _, ilMethRef, enclTypeArgs, methTypeArgs, _tys), [], callArgs -> ConvILCall cenv env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) - | TOp.TryFinally _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)] -> - E.TryFinally(ConvExpr cenv env e1,ConvExpr cenv env e2) + | TOp.TryFinally _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [_], e2, _, _)] -> + E.TryFinally(ConvExpr cenv env e1, ConvExpr cenv env e2) - | TOp.TryCatch _,[_resty],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[vf],ef,_,_); Expr.Lambda(_,_,_,[vh],eh,_,_)] -> + | TOp.TryCatch _, [_resty], [Expr.Lambda(_, _, _, [_], e1, _, _); Expr.Lambda(_, _, _, [vf], ef, _, _); Expr.Lambda(_, _, _, [vh], eh, _, _)] -> let vfR = ConvVal cenv vf let envf = env.BindVal vf let vhR = ConvVal cenv vh let envh = env.BindVal vh - E.TryWith(ConvExpr cenv env e1,vfR,ConvExpr cenv envf ef,vhR,ConvExpr cenv envh eh) + E.TryWith(ConvExpr cenv env e1, vfR, ConvExpr cenv envf ef, vhR, ConvExpr cenv envh eh) - | TOp.Bytes bytes,[],[] -> E.Const(box bytes, ConvType cenv (tyOfExpr cenv.g expr)) + | TOp.Bytes bytes, [], [] -> E.Const(box bytes, ConvType cenv (tyOfExpr cenv.g expr)) - | TOp.UInt16s arr,[],[] -> E.Const(box arr, ConvType cenv (tyOfExpr cenv.g expr)) + | TOp.UInt16s arr, [], [] -> E.Const(box arr, ConvType cenv (tyOfExpr cenv.g expr)) - | TOp.UnionCaseProof _,_,[e] -> ConvExprPrim cenv env e // Note: we erase the union case proof conversions when converting to quotations - | TOp.UnionCaseTagGet tycr,tyargs,[arg1] -> + | TOp.UnionCaseProof _, _, [e] -> ConvExprPrim cenv env e // Note: we erase the union case proof conversions when converting to quotations + | TOp.UnionCaseTagGet tycr, tyargs, [arg1] -> let typR = ConvType cenv (mkAppTy tycr tyargs) E.UnionCaseTag(ConvExpr cenv env arg1, typR) - | TOp.TraitCall (TTrait(tys,nm,memFlags,argtys,_rty,_colution)),_,_ -> + | TOp.TraitCall (TTrait(tys, nm, memFlags, argtys, _rty, _colution)), _, _ -> let tysR = ConvTypes cenv tys let tyargsR = ConvTypes cenv tyargs let argtysR = ConvTypes cenv argtys let argsR = ConvExprs cenv env args E.TraitCall(tysR, nm, memFlags, argtysR, tyargsR, argsR) - | TOp.RefAddrGet,[ty],[e] -> - let replExpr = mkRecdFieldGetAddrViaExprAddr(e, mkRefCellContentsRef cenv.g, [ty],m) + | TOp.RefAddrGet, [ty], [e] -> + let replExpr = mkRecdFieldGetAddrViaExprAddr(e, mkRefCellContentsRef cenv.g, [ty], m) ConvExprPrim cenv env replExpr | _ -> wfail (sprintf "unhandled construct in AST", m) @@ -663,19 +663,19 @@ module FSharpExprConvert = // 'if istype e then ...unbox e .... ' // It's bit annoying that pattern matching does this tranformation. Like all premature optimization we pay a // cost here to undo it. - | Expr.Op(TOp.ILAsm([ I_isinst _ ],_),[ty],[e],_) -> - None, env.BindIsInstVal bind.Var (ty,e) + | Expr.Op(TOp.ILAsm([ I_isinst _ ], _), [ty], [e], _) -> + None, env.BindIsInstVal bind.Var (ty, e) // Remove let = from quotation tree | Expr.Val _ when bind.Var.IsCompilerGenerated -> None, env.BindSubstVal bind.Var bind.Expr // Remove let = () from quotation tree - | Expr.Const(Const.Unit,_,_) when bind.Var.IsCompilerGenerated -> + | Expr.Const(Const.Unit, _, _) when bind.Var.IsCompilerGenerated -> None, env.BindSubstVal bind.Var bind.Expr // Remove let unionCase = ... from quotation tree - | Expr.Op(TOp.UnionCaseProof _,_,[e],_) -> + | Expr.Op(TOp.UnionCaseProof _, _, [e], _) -> None, env.BindSubstVal bind.Var e | _ -> @@ -683,13 +683,13 @@ module FSharpExprConvert = let vR = ConvVal cenv v let rhsR = ConvExpr cenv env bind.Expr let envinner = env.BindVal v - Some(vR,rhsR),envinner + Some(vR, rhsR), envinner and ConvILCall (cenv:Impl.cenv) env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) = let isNewObj = (isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false)) let methName = ilMethRef.Name - let isPropGet = methName.StartsWith("get_",System.StringComparison.Ordinal) - let isPropSet = methName.StartsWith("set_",System.StringComparison.Ordinal) + let isPropGet = methName.StartsWith("get_", System.StringComparison.Ordinal) + let isPropSet = methName.StartsWith("set_", System.StringComparison.Ordinal) let isProp = isPropGet || isPropSet let tcref, subClass = @@ -815,7 +815,7 @@ module FSharpExprConvert = | None -> failwith "Type of signature could not be resolved" | Some keyTy -> let findBySig = - findByName |> List.tryFind (fun v -> ccu.MemberSignatureEquality(keyTy,v.Type)) + findByName |> List.tryFind (fun v -> ccu.MemberSignatureEquality(keyTy, v.Type)) match findBySig with | Some v -> makeFSCall isMember v @@ -874,7 +874,7 @@ module FSharpExprConvert = tryMkForallTy (typars1 @ typars2) ty let argCount = List.sum (List.map List.length argtys) + (if isStatic then 0 else 1) - let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount },Some linkageType) + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= argCount }, Some linkageType) let (PubPath p) = tcref.PublicPath.Value let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu p @@ -882,14 +882,14 @@ module FSharpExprConvert = makeFSExpr isMember vref else - let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 },None) + let key = ValLinkageFullKey({ MemberParentMangledName=memberParentName; MemberIsOverride=false; LogicalName=logicalName; TotalArgCount= 0 }, None) let vref = mkNonLocalValRef tcref.nlr key makeFSExpr isMember vref with e -> failwithf "An IL call to '%s' could not be resolved: %s" (ilMethRef.ToString()) e.Message - and ConvObjectModelCallLinear cenv env (isNewObj, v:FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs,callArgs) contf = + and ConvObjectModelCallLinear cenv env (isNewObj, v:FSharpMemberOrFunctionOrValue, enclTyArgs, methTyArgs, callArgs) contf = let enclTyArgsR = ConvTypes cenv enclTyArgs let methTyArgsR = ConvTypes cenv methTyArgs let obj, callArgs = @@ -920,7 +920,7 @@ module FSharpExprConvert = and ConvTargetsLinear cenv env tgs contf = match tgs with | [] -> contf [] - | TTarget(vars,rhs,_)::rest -> + | TTarget(vars, rhs, _)::rest -> let varsR = (List.rev vars) |> List.map (ConvVal cenv) ConvExprLinear cenv env rhs (fun targetR -> ConvTargetsLinear cenv env rest (fun restR -> @@ -929,7 +929,7 @@ module FSharpExprConvert = and ConvValRef cenv env m (vref:ValRef) = let v = vref.Deref if env.isinstVals.ContainsVal v then - let (ty,e) = env.isinstVals.[v] + let (ty, e) = env.isinstVals.[v] ConvExprPrim cenv env (mkCallUnbox cenv.g m ty e) elif env.substVals.ContainsVal v then let e = env.substVals.[v] @@ -943,7 +943,7 @@ module FSharpExprConvert = and ConvVal cenv (v:Val) = let vref = mkLocalValRef v - FSharpMemberOrFunctionOrValue(cenv, vref) + FSharpMemberOrFunctionOrValue(cenv, vref) and ConvConst cenv env m c ty = match TryEliminateDesugaredConstants cenv.g m c with @@ -976,12 +976,12 @@ module FSharpExprConvert = and ConvDecisionTreePrim cenv env dtreeRetTy x = match x with - | TDSwitch(e1,csl,dfltOpt,m) -> + | TDSwitch(e1, csl, dfltOpt, m) -> let acc = match dfltOpt with | Some d -> ConvDecisionTreePrim cenv env dtreeRetTy d | None -> wfail( "FSharp.Compiler.Service cannot yet return this kind of pattern match", m) - (csl,acc) ||> List.foldBack (fun (TCase(discrim,dtree)) acc -> + (csl, acc) ||> List.foldBack (fun (TCase(discrim, dtree)) acc -> let acc = acc |> Mk cenv m dtreeRetTy match discrim with | DecisionTreeTest.UnionCase (ucref, tyargs) -> @@ -1004,12 +1004,12 @@ module FSharpExprConvert = | DecisionTreeTest.IsNull -> // Decompile cached isinst tests match e1 with - | Expr.Val(vref,_,_) when env.isinstVals.ContainsVal vref.Deref -> - let (ty,e) = env.isinstVals.[vref.Deref] + | Expr.Val(vref, _, _) when env.isinstVals.ContainsVal vref.Deref -> + let (ty, e) = env.isinstVals.[vref.Deref] let tyR = ConvType cenv ty let eR = ConvExpr cenv env e // note: reverse the branches - a null test is a failure of an isinst test - E.IfThenElse (E.TypeTest (tyR,eR) |> Mk cenv m cenv.g.bool_ty, acc, ConvDecisionTree cenv env dtreeRetTy dtree m) + E.IfThenElse (E.TypeTest (tyR, eR) |> Mk cenv m cenv.g.bool_ty, acc, ConvDecisionTree cenv env dtreeRetTy dtree m) | _ -> let ty = tyOfExpr cenv.g e1 let eq = mkCallEqualsOperator cenv.g m ty e1 (Expr.Const (Const.Zero, m, ty)) @@ -1018,21 +1018,21 @@ module FSharpExprConvert = | DecisionTreeTest.IsInst (_srcty, tgty) -> let e1R = ConvExpr cenv env e1 E.IfThenElse (E.TypeTest (ConvType cenv tgty, e1R) |> Mk cenv m cenv.g.bool_ty, ConvDecisionTree cenv env dtreeRetTy dtree m, acc) - | DecisionTreeTest.ActivePatternCase _ -> wfail("unexpected Test.ActivePatternCase test in quoted expression",m) + | DecisionTreeTest.ActivePatternCase _ -> wfail("unexpected Test.ActivePatternCase test in quoted expression", m) | DecisionTreeTest.ArrayLength _ -> wfail("FSharp.Compiler.Service cannot yet return array pattern matching", m)) - | TDSuccess (args,n) -> + | TDSuccess (args, n) -> // TAST stores pattern bindings in reverse order for some reason // Reverse them here to give a good presentation to the user let args = List.rev args let argsR = ConvExprs cenv env args E.DecisionTreeSuccess(n, argsR) - | TDBind(bind,rest) -> + | TDBind(bind, rest) -> // The binding may be a compiler-generated binding that gets removed in the quotation presentation match ConvLetBind cenv env bind with | None, env -> ConvDecisionTreePrim cenv env dtreeRetTy rest - | Some(bindR),env -> E.Let(bindR,ConvDecisionTree cenv env dtreeRetTy rest bind.Var.Range) + | Some(bindR), env -> E.Let(bindR, ConvDecisionTree cenv env dtreeRetTy rest bind.Var.Range) /// Wrap the conversion in a function to make it on-demand. Any pattern matching on the FSharpExpr will /// force the evaluation of the entire conversion process eagerly. @@ -1044,7 +1044,7 @@ module FSharpExprConvert = /// The contents of the F# assembly as provided through the compiler API type FSharpAssemblyContents(cenv: Impl.cenv, mimpls: TypedImplFile list) = - new (g, thisCcu, tcImports, mimpls) = FSharpAssemblyContents(Impl.cenv(g,thisCcu,tcImports), mimpls) + new (g, thisCcu, tcImports, mimpls) = FSharpAssemblyContents(Impl.cenv(g, thisCcu, tcImports), mimpls) member __.ImplementationFiles = [ for mimpl in mimpls -> FSharpImplementationFileContents(cenv, mimpl)] @@ -1055,13 +1055,13 @@ and FSharpImplementationFileDeclaration = | InitAction of FSharpExpr and FSharpImplementationFileContents(cenv, mimpl) = - let (TImplFile(qname,_pragmas,ModuleOrNamespaceExprWithSig(_mty,mdef,_),hasExplicitEntryPoint,isScript)) = mimpl - let rec getDecls2 (ModuleOrNamespaceExprWithSig(_mty,def,_m)) = getDecls def + let (TImplFile(qname, _pragmas, ModuleOrNamespaceExprWithSig(_mty, mdef, _), hasExplicitEntryPoint, isScript)) = mimpl + let rec getDecls2 (ModuleOrNamespaceExprWithSig(_mty, def, _m)) = getDecls def and getBind (bind: Binding) = let v = bind.Var assert v.IsCompiledAsTopLevel let topValInfo = InferArityOfExprBinding cenv.g AllowTypeDirectedDetupling.Yes v bind.Expr - let tps,_ctorThisValOpt,_baseValOpt,vsl,body,_bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo bind.Expr + let tps, _ctorThisValOpt, _baseValOpt, vsl, body, _bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo bind.Expr let v = FSharpMemberOrFunctionOrValue(cenv, mkLocalValRef v) let gps = v.GenericParameters let vslR = List.map (List.map (FSharpExprConvert.ConvVal cenv)) vsl @@ -1072,7 +1072,7 @@ and FSharpImplementationFileContents(cenv, mimpl) = and getDecls mdef = match mdef with - | TMDefRec(_isRec,tycons,mbinds,_m) -> + | TMDefRec(_isRec, tycons, mbinds, _m) -> [ for tycon in tycons do let entity = FSharpEntity(cenv, mkLocalEntityRef tycon) yield FSharpImplementationFileDeclaration.Entity(entity, []) @@ -1084,9 +1084,9 @@ and FSharpImplementationFileContents(cenv, mimpl) = | ModuleOrNamespaceBinding.Binding(bind) -> yield getBind bind ] | TMAbstract(mexpr) -> getDecls2 mexpr - | TMDefLet(bind,_m) -> + | TMDefLet(bind, _m) -> [ yield getBind bind ] - | TMDefDo(expr,_m) -> + | TMDefDo(expr, _m) -> [ let expr = FSharpExprConvert.ConvExprOnDemand cenv ExprTranslationEnv.Empty expr yield FSharpImplementationFileDeclaration.InitAction(expr) ] | TMDefs(mdefs) -> @@ -1101,46 +1101,46 @@ and FSharpImplementationFileContents(cenv, mimpl) = module BasicPatterns = let (|Value|_|) (e:FSharpExpr) = match e.E with E.Value (v) -> Some (v) | _ -> None - let (|Const|_|) (e:FSharpExpr) = match e.E with E.Const (v,ty) -> Some (v,ty) | _ -> None - let (|TypeLambda|_|) (e:FSharpExpr) = match e.E with E.TypeLambda (v,e) -> Some (v,e) | _ -> None - let (|Lambda|_|) (e:FSharpExpr) = match e.E with E.Lambda (v,e) -> Some (v,e) | _ -> None - let (|Application|_|) (e:FSharpExpr) = match e.E with E.Application (f,tys,e) -> Some (f,tys,e) | _ -> None - let (|IfThenElse|_|) (e:FSharpExpr) = match e.E with E.IfThenElse (e1,e2,e3) -> Some (e1,e2,e3) | _ -> None - let (|Let|_|) (e:FSharpExpr) = match e.E with E.Let ((v,e),b) -> Some ((v,e),b) | _ -> None - let (|LetRec|_|) (e:FSharpExpr) = match e.E with E.LetRec (ves,b) -> Some (ves,b) | _ -> None - let (|NewRecord|_|) (e:FSharpExpr) = match e.E with E.NewRecord (ty,es) -> Some (ty,es) | _ -> None - let (|NewUnionCase|_|) (e:FSharpExpr) = match e.E with E.NewUnionCase (e,tys,es) -> Some (e,tys,es) | _ -> None - let (|NewTuple|_|) (e:FSharpExpr) = match e.E with E.NewTuple (ty,es) -> Some (ty,es) | _ -> None - let (|TupleGet|_|) (e:FSharpExpr) = match e.E with E.TupleGet (ty,n,es) -> Some (ty,n,es) | _ -> None - let (|Call|_|) (e:FSharpExpr) = match e.E with E.Call (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None - let (|NewObject|_|) (e:FSharpExpr) = match e.E with E.NewObject (a,b,c) -> Some (a,b,c) | _ -> None - let (|FSharpFieldGet|_|) (e:FSharpExpr) = match e.E with E.FSharpFieldGet (a,b,c) -> Some (a,b,c) | _ -> None - let (|FSharpFieldSet|_|) (e:FSharpExpr) = match e.E with E.FSharpFieldSet (a,b,c,d) -> Some (a,b,c,d) | _ -> None - let (|UnionCaseGet|_|) (e:FSharpExpr) = match e.E with E.UnionCaseGet (a,b,c,d) -> Some (a,b,c,d) | _ -> None - let (|UnionCaseTag|_|) (e:FSharpExpr) = match e.E with E.UnionCaseTag (a,b) -> Some (a,b) | _ -> None - let (|UnionCaseTest|_|) (e:FSharpExpr) = match e.E with E.UnionCaseTest (a,b,c) -> Some (a,b,c) | _ -> None - let (|NewArray|_|) (e:FSharpExpr) = match e.E with E.NewArray (a,b) -> Some (a,b) | _ -> None - let (|Coerce|_|) (e:FSharpExpr) = match e.E with E.Coerce (a,b) -> Some (a,b) | _ -> None + let (|Const|_|) (e:FSharpExpr) = match e.E with E.Const (v, ty) -> Some (v, ty) | _ -> None + let (|TypeLambda|_|) (e:FSharpExpr) = match e.E with E.TypeLambda (v, e) -> Some (v, e) | _ -> None + let (|Lambda|_|) (e:FSharpExpr) = match e.E with E.Lambda (v, e) -> Some (v, e) | _ -> None + let (|Application|_|) (e:FSharpExpr) = match e.E with E.Application (f, tys, e) -> Some (f, tys, e) | _ -> None + let (|IfThenElse|_|) (e:FSharpExpr) = match e.E with E.IfThenElse (e1, e2, e3) -> Some (e1, e2, e3) | _ -> None + let (|Let|_|) (e:FSharpExpr) = match e.E with E.Let ((v, e), b) -> Some ((v, e), b) | _ -> None + let (|LetRec|_|) (e:FSharpExpr) = match e.E with E.LetRec (ves, b) -> Some (ves, b) | _ -> None + let (|NewRecord|_|) (e:FSharpExpr) = match e.E with E.NewRecord (ty, es) -> Some (ty, es) | _ -> None + let (|NewUnionCase|_|) (e:FSharpExpr) = match e.E with E.NewUnionCase (e, tys, es) -> Some (e, tys, es) | _ -> None + let (|NewTuple|_|) (e:FSharpExpr) = match e.E with E.NewTuple (ty, es) -> Some (ty, es) | _ -> None + let (|TupleGet|_|) (e:FSharpExpr) = match e.E with E.TupleGet (ty, n, es) -> Some (ty, n, es) | _ -> None + let (|Call|_|) (e:FSharpExpr) = match e.E with E.Call (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None + let (|NewObject|_|) (e:FSharpExpr) = match e.E with E.NewObject (a, b, c) -> Some (a, b, c) | _ -> None + let (|FSharpFieldGet|_|) (e:FSharpExpr) = match e.E with E.FSharpFieldGet (a, b, c) -> Some (a, b, c) | _ -> None + let (|FSharpFieldSet|_|) (e:FSharpExpr) = match e.E with E.FSharpFieldSet (a, b, c, d) -> Some (a, b, c, d) | _ -> None + let (|UnionCaseGet|_|) (e:FSharpExpr) = match e.E with E.UnionCaseGet (a, b, c, d) -> Some (a, b, c, d) | _ -> None + let (|UnionCaseTag|_|) (e:FSharpExpr) = match e.E with E.UnionCaseTag (a, b) -> Some (a, b) | _ -> None + let (|UnionCaseTest|_|) (e:FSharpExpr) = match e.E with E.UnionCaseTest (a, b, c) -> Some (a, b, c) | _ -> None + let (|NewArray|_|) (e:FSharpExpr) = match e.E with E.NewArray (a, b) -> Some (a, b) | _ -> None + let (|Coerce|_|) (e:FSharpExpr) = match e.E with E.Coerce (a, b) -> Some (a, b) | _ -> None let (|Quote|_|) (e:FSharpExpr) = match e.E with E.Quote (a) -> Some (a) | _ -> None - let (|TypeTest|_|) (e:FSharpExpr) = match e.E with E.TypeTest (a,b) -> Some (a,b) | _ -> None - let (|Sequential|_|) (e:FSharpExpr) = match e.E with E.Sequential (a,b) -> Some (a,b) | _ -> None - let (|FastIntegerForLoop|_|) (e:FSharpExpr) = match e.E with E.FastIntegerForLoop (a,b,c,d) -> Some (a,b,c,d) | _ -> None - let (|WhileLoop|_|) (e:FSharpExpr) = match e.E with E.WhileLoop (a,b) -> Some (a,b) | _ -> None - let (|TryFinally|_|) (e:FSharpExpr) = match e.E with E.TryFinally (a,b) -> Some (a,b) | _ -> None - let (|TryWith|_|) (e:FSharpExpr) = match e.E with E.TryWith (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None - let (|NewDelegate|_|) (e:FSharpExpr) = match e.E with E.NewDelegate (ty,e) -> Some (ty,e) | _ -> None + let (|TypeTest|_|) (e:FSharpExpr) = match e.E with E.TypeTest (a, b) -> Some (a, b) | _ -> None + let (|Sequential|_|) (e:FSharpExpr) = match e.E with E.Sequential (a, b) -> Some (a, b) | _ -> None + let (|FastIntegerForLoop|_|) (e:FSharpExpr) = match e.E with E.FastIntegerForLoop (a, b, c, d) -> Some (a, b, c, d) | _ -> None + let (|WhileLoop|_|) (e:FSharpExpr) = match e.E with E.WhileLoop (a, b) -> Some (a, b) | _ -> None + let (|TryFinally|_|) (e:FSharpExpr) = match e.E with E.TryFinally (a, b) -> Some (a, b) | _ -> None + let (|TryWith|_|) (e:FSharpExpr) = match e.E with E.TryWith (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None + let (|NewDelegate|_|) (e:FSharpExpr) = match e.E with E.NewDelegate (ty, e) -> Some (ty, e) | _ -> None let (|DefaultValue|_|) (e:FSharpExpr) = match e.E with E.DefaultValue (ty) -> Some (ty) | _ -> None - let (|AddressSet|_|) (e:FSharpExpr) = match e.E with E.AddressSet (a,b) -> Some (a,b) | _ -> None - let (|ValueSet|_|) (e:FSharpExpr) = match e.E with E.ValueSet (a,b) -> Some (a,b) | _ -> None + let (|AddressSet|_|) (e:FSharpExpr) = match e.E with E.AddressSet (a, b) -> Some (a, b) | _ -> None + let (|ValueSet|_|) (e:FSharpExpr) = match e.E with E.ValueSet (a, b) -> Some (a, b) | _ -> None let (|AddressOf|_|) (e:FSharpExpr) = match e.E with E.AddressOf (a) -> Some (a) | _ -> None let (|ThisValue|_|) (e:FSharpExpr) = match e.E with E.ThisValue (a) -> Some (a) | _ -> None let (|BaseValue|_|) (e:FSharpExpr) = match e.E with E.BaseValue (a) -> Some (a) | _ -> None - let (|ILAsm|_|) (e:FSharpExpr) = match e.E with E.ILAsm (a,b,c) -> Some (a,b,c) | _ -> None - let (|ILFieldGet|_|) (e:FSharpExpr) = match e.E with E.ILFieldGet (a,b,c) -> Some (a,b,c) | _ -> None - let (|ILFieldSet|_|) (e:FSharpExpr) = match e.E with E.ILFieldSet (a,b,c,d) -> Some (a,b,c,d) | _ -> None - let (|ObjectExpr|_|) (e:FSharpExpr) = match e.E with E.ObjectExpr (a,b,c,d) -> Some (a,b,c,d) | _ -> None - let (|DecisionTree|_|) (e:FSharpExpr) = match e.E with E.DecisionTree (a,b) -> Some (a,b) | _ -> None - let (|DecisionTreeSuccess|_|) (e:FSharpExpr) = match e.E with E.DecisionTreeSuccess (a,b) -> Some (a,b) | _ -> None - let (|UnionCaseSet|_|) (e:FSharpExpr) = match e.E with E.UnionCaseSet (a,b,c,d,e) -> Some (a,b,c,d,e) | _ -> None - 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 (|ILAsm|_|) (e:FSharpExpr) = match e.E with E.ILAsm (a, b, c) -> Some (a, b, c) | _ -> None + let (|ILFieldGet|_|) (e:FSharpExpr) = match e.E with E.ILFieldGet (a, b, c) -> Some (a, b, c) | _ -> None + let (|ILFieldSet|_|) (e:FSharpExpr) = match e.E with E.ILFieldSet (a, b, c, d) -> Some (a, b, c, d) | _ -> None + let (|ObjectExpr|_|) (e:FSharpExpr) = match e.E with E.ObjectExpr (a, b, c, d) -> Some (a, b, c, d) | _ -> None + let (|DecisionTree|_|) (e:FSharpExpr) = match e.E with E.DecisionTree (a, b) -> Some (a, b) | _ -> None + let (|DecisionTreeSuccess|_|) (e:FSharpExpr) = match e.E with E.DecisionTreeSuccess (a, b) -> Some (a, b) | _ -> None + let (|UnionCaseSet|_|) (e:FSharpExpr) = match e.E with E.UnionCaseSet (a, b, c, d, e) -> Some (a, b, c, d, e) | _ -> None + let (|TraitCall|_|) (e:FSharpExpr) = match e.E with E.TraitCall (a, b, c, d, e, f) -> Some (a, b, c, d, e, f) | _ -> None diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 6ea48c3225dcc19880d30c2cfbe8c458bb535569..98229231b52ed3ab7c5df93d635b3a13900c1b6c 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. //---------------------------------------------------------------------------- -// Open up the compiler as an incremental service for parsing, +// Open up the compiler as an incremental service for parsing, // type checking and intellisense-like environment-reporting. //-------------------------------------------------------------------------- @@ -45,7 +45,7 @@ type FSharpErrorSeverity = | Warning | Error -type FSharpErrorInfo(fileName, s:pos, e:pos, severity: FSharpErrorSeverity, message: string, subcategory: string, errorNum: int) = +type FSharpErrorInfo(fileName, s: pos, e: pos, severity: FSharpErrorSeverity, message: string, subcategory: string, errorNum: int) = member __.StartLine = Line.toZ s.Line member __.StartLineAlternate = s.Line member __.EndLine = Line.toZ e.Line @@ -71,11 +71,11 @@ type FSharpErrorInfo(fileName, s:pos, e:pos, severity: FSharpErrorSeverity, mess /// Decompose a warning or error into parts: position, severity, message, error number static member CreateFromExceptionAndAdjustEof(exn, isError, trim:bool, fallbackRange:range, (linesCount:int, lastLength:int)) = - let r = FSharpErrorInfo.CreateFromException(exn,isError,trim,fallbackRange) + let r = FSharpErrorInfo.CreateFromException(exn, isError, trim, fallbackRange) // Adjust to make sure that errors reported at Eof are shown at the linesCount let startline, schange = min (r.StartLineAlternate, false) (linesCount, true) - let endline, echange = min (r.EndLineAlternate, false) (linesCount, true) + let endline, echange = min (r.EndLineAlternate, false) (linesCount, true) if not (schange || echange) then r else @@ -93,7 +93,7 @@ type ErrorScope() = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> { new ErrorLogger("ErrorScope") with member x.DiagnosticSink(exn, isError) = - let err = FSharpErrorInfo.CreateFromException(exn,isError,false,range.Zero) + let err = FSharpErrorInfo.CreateFromException(exn, isError, false, range.Zero) errors <- err :: errors if isError && firstError.IsNone then firstError <- Some err.Message @@ -116,7 +116,7 @@ type ErrorScope() = /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and /// perform other operations which might expose us to either bona-fide F# error messages such - /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, + /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, /// may hit internal compiler failures. /// /// In some calling cases, we get a chance to report the error as part of user text. For example @@ -161,7 +161,7 @@ type internal CompilationErrorLogger (debugName:string, tcConfig:TcConfig) = override x.ErrorCount = errorCount member x.GetErrors() = - [ for (e,isError) in diagnostics -> e, (if isError then FSharpErrorSeverity.Error else FSharpErrorSeverity.Warning) ] + [ for (e, isError) in diagnostics -> e, (if isError then FSharpErrorSeverity.Error else FSharpErrorSeverity.Warning) ] /// This represents the global state established as each task function runs as part of the build. @@ -188,14 +188,14 @@ module ErrorHelpers = if allErrors || (ei.FileName=mainInputFileName) || (ei.FileName=Microsoft.FSharp.Compiler.TcGlobals.DummyFileNameForRangesWithoutASpecificLocation) then yield ei ] - let mainError,relatedErrors = SplitRelatedDiagnostics exn + let mainError, relatedErrors = SplitRelatedDiagnostics exn yield! oneError false mainError for e in relatedErrors do yield! oneError true e ] let CreateErrorInfos (tcConfig:TcConfig, allErrors, mainInputFileName, errors) = let fileInfo = (Int32.MaxValue, Int32.MaxValue) - [| for (exn,isError) in errors do + [| for (exn, isError) in errors do yield! ReportError (tcConfig, allErrors, mainInputFileName, fileInfo, (exn, isError)) |] @@ -224,7 +224,7 @@ type FSharpToolTipElementData<'T> = TypeMapping: 'T list Remarks: 'T option ParamName : string option } - static member Create(layout:'T,xml,?typeMapping,?paramName,?remarks) = + static member Create(layout:'T, xml, ?typeMapping, ?paramName, ?remarks) = { MainDescription=layout; XmlDoc=xml; TypeMapping=defaultArg typeMapping []; ParamName=paramName; Remarks=remarks } /// A single data tip display element @@ -238,8 +238,8 @@ type FSharpToolTipElement<'T> = /// An error occurred formatting this element | CompositionError of string - static member Single(layout,xml,?typeMapping,?paramName,?remarks) = - Group [ FSharpToolTipElementData<'T>.Create(layout,xml,?typeMapping=typeMapping,?paramName=paramName,?remarks=remarks) ] + static member Single(layout, xml, ?typeMapping, ?paramName, ?remarks) = + Group [ FSharpToolTipElementData<'T>.Create(layout, xml, ?typeMapping=typeMapping, ?paramName=paramName, ?remarks=remarks) ] /// A single data tip display element with where text is expressed as string #if COMPILER_PUBLIC_API @@ -316,7 +316,7 @@ type CompletionItem = module internal SymbolHelpers = let isFunction g typ = - let _,tau = tryDestForallTy g typ + let _, tau = tryDestForallTy g typ isFunTy g tau let OutputFullName isListItem ppF fnF r = @@ -343,14 +343,14 @@ module internal SymbolHelpers = let rangeOfPropInfo preferFlag (pinfo:PropInfo) = match pinfo with #if EXTENSIONTYPING - | ProvidedProp(_,pi,_) -> ComputeDefinitionLocationOfProvidedItem pi + | ProvidedProp(_, pi, _) -> ComputeDefinitionLocationOfProvidedItem pi #endif | _ -> pinfo.ArbitraryValRef |> Option.map (rangeOfValRef preferFlag) let rangeOfMethInfo (g:TcGlobals) preferFlag (minfo:MethInfo) = match minfo with #if EXTENSIONTYPING - | ProvidedMeth(_,mi,_,_) -> ComputeDefinitionLocationOfProvidedItem mi + | ProvidedMeth(_, mi, _, _) -> ComputeDefinitionLocationOfProvidedItem mi #endif | DefaultStructCtor(_, AppTy g (tcref, _)) -> Some(rangeOfEntityRef preferFlag tcref) | _ -> minfo.ArbitraryValRef |> Option.map (rangeOfValRef preferFlag) @@ -358,7 +358,7 @@ module internal SymbolHelpers = let rangeOfEventInfo preferFlag (einfo:EventInfo) = match einfo with #if EXTENSIONTYPING - | ProvidedEvent (_,ei,_) -> ComputeDefinitionLocationOfProvidedItem ei + | ProvidedEvent (_, ei, _) -> ComputeDefinitionLocationOfProvidedItem ei #endif | _ -> einfo.ArbitraryValRef |> Option.map (rangeOfValRef preferFlag) @@ -376,24 +376,24 @@ module internal SymbolHelpers = let rec rangeOfItem (g:TcGlobals) preferFlag d = match d with - | Item.Value vref | Item.CustomBuilder (_,vref) -> Some (rangeOfValRef preferFlag vref) - | Item.UnionCase(ucinfo,_) -> Some (rangeOfUnionCaseInfo preferFlag ucinfo) + | Item.Value vref | Item.CustomBuilder (_, vref) -> Some (rangeOfValRef preferFlag vref) + | Item.UnionCase(ucinfo, _) -> Some (rangeOfUnionCaseInfo preferFlag ucinfo) | Item.ActivePatternCase apref -> Some (rangeOfValRef preferFlag apref.ActivePatternVal) | Item.ExnCase tcref -> Some tcref.Range | Item.RecdField rfinfo -> Some (rangeOfRecdFieldInfo preferFlag rfinfo) | Item.Event einfo -> rangeOfEventInfo preferFlag einfo | Item.ILField _ -> None - | Item.Property(_,pinfos) -> rangeOfPropInfo preferFlag pinfos.Head - | Item.Types(_,typs) -> typs |> List.tryPick (tryNiceEntityRefOfTy >> Option.map (rangeOfEntityRef preferFlag)) - | Item.CustomOperation (_,_,Some minfo) -> rangeOfMethInfo g preferFlag minfo - | Item.TypeVar (_,tp) -> Some tp.Range + | Item.Property(_, pinfos) -> rangeOfPropInfo preferFlag pinfos.Head + | Item.Types(_, typs) -> typs |> List.tryPick (tryNiceEntityRefOfTy >> Option.map (rangeOfEntityRef preferFlag)) + | Item.CustomOperation (_, _, Some minfo) -> rangeOfMethInfo g preferFlag minfo + | Item.TypeVar (_, tp) -> Some tp.Range | Item.ModuleOrNamespaces(modrefs) -> modrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) - | Item.MethodGroup(_,minfos,_) - | Item.CtorGroup(_,minfos) -> minfos |> List.tryPick (rangeOfMethInfo g preferFlag) - | Item.ActivePatternResult(APInfo _,_, _, m) -> Some m - | Item.SetterArg (_,item) -> rangeOfItem g preferFlag item - | Item.ArgName (id,_, _) -> Some id.idRange - | Item.CustomOperation (_,_,implOpt) -> implOpt |> Option.bind (rangeOfMethInfo g preferFlag) + | Item.MethodGroup(_, minfos, _) + | Item.CtorGroup(_, minfos) -> minfos |> List.tryPick (rangeOfMethInfo g preferFlag) + | Item.ActivePatternResult(APInfo _, _, _, m) -> Some m + | Item.SetterArg (_, item) -> rangeOfItem g preferFlag item + | Item.ArgName (id, _, _) -> Some id.idRange + | Item.CustomOperation (_, _, implOpt) -> implOpt |> Option.bind (rangeOfMethInfo g preferFlag) | Item.ImplicitOp (_, {contents = Some(TraitConstraintSln.FSMethSln(_, vref, _))}) -> Some vref.Range | Item.ImplicitOp _ -> None | Item.UnqualifiedType tcrefs -> tcrefs |> List.tryPick (rangeOfEntityRef preferFlag >> Some) @@ -419,33 +419,33 @@ module internal SymbolHelpers = let rec ccuOfItem (g:TcGlobals) d = match d with - | Item.Value vref | Item.CustomBuilder (_,vref) -> ccuOfValRef vref - | Item.UnionCase(ucinfo,_) -> computeCcuOfTyconRef ucinfo.TyconRef + | Item.Value vref | Item.CustomBuilder (_, vref) -> ccuOfValRef vref + | Item.UnionCase(ucinfo, _) -> computeCcuOfTyconRef ucinfo.TyconRef | Item.ActivePatternCase apref -> ccuOfValRef apref.ActivePatternVal | Item.ExnCase tcref -> computeCcuOfTyconRef tcref | Item.RecdField rfinfo -> computeCcuOfTyconRef rfinfo.RecdFieldRef.TyconRef | Item.Event einfo -> einfo.EnclosingType |> tcrefOfAppTy g |> computeCcuOfTyconRef | Item.ILField finfo -> finfo.EnclosingType |> tcrefOfAppTy g |> computeCcuOfTyconRef - | Item.Property(_,pinfos) -> + | Item.Property(_, pinfos) -> pinfos |> List.tryPick (fun pinfo -> pinfo.ArbitraryValRef |> Option.bind ccuOfValRef |> Option.orElseWith (fun () -> pinfo.EnclosingType |> tcrefOfAppTy g |> computeCcuOfTyconRef)) - | Item.ArgName (_,_,Some (ArgumentContainer.Method minfo)) -> ccuOfMethInfo g minfo + | Item.ArgName (_, _, Some (ArgumentContainer.Method minfo)) -> ccuOfMethInfo g minfo - | Item.MethodGroup(_,minfos,_) - | Item.CtorGroup(_,minfos) -> minfos |> List.tryPick (ccuOfMethInfo g) - | Item.CustomOperation (_,_,Some minfo) -> ccuOfMethInfo g minfo + | Item.MethodGroup(_, minfos, _) + | Item.CtorGroup(_, minfos) -> minfos |> List.tryPick (ccuOfMethInfo g) + | Item.CustomOperation (_, _, Some minfo) -> ccuOfMethInfo g minfo - | Item.Types(_,typs) -> typs |> List.tryPick (tryNiceEntityRefOfTy >> Option.bind computeCcuOfTyconRef) + | Item.Types(_, typs) -> typs |> List.tryPick (tryNiceEntityRefOfTy >> Option.bind computeCcuOfTyconRef) - | Item.ArgName (_,_,Some (ArgumentContainer.Type eref)) -> computeCcuOfTyconRef eref + | Item.ArgName (_, _, Some (ArgumentContainer.Type eref)) -> computeCcuOfTyconRef eref | Item.ModuleOrNamespaces(erefs) | Item.UnqualifiedType(erefs) -> erefs |> List.tryPick computeCcuOfTyconRef - | Item.SetterArg (_,item) -> ccuOfItem g item + | Item.SetterArg (_, item) -> ccuOfItem g item | Item.TypeVar _ -> None | _ -> None @@ -473,11 +473,11 @@ module internal SymbolHelpers = let ParamNameAndTypesOfUnaryCustomOperation g minfo = match minfo with - | FSMeth(_,_,vref,_) -> + | FSMeth(_, _, vref, _) -> let argInfos = ArgInfosOfMember g vref |> List.concat // Drop the first 'seq' argument representing the computation space let argInfos = if argInfos.IsEmpty then [] else argInfos.Tail - [ for (ty,argInfo) in argInfos do + [ for (ty, argInfo) in argInfos do let isPP = HasFSharpAttribute g g.attrib_ProjectionParameterAttribute argInfo.Attribs // Strip the tuple space type of the type of projection parameters let ty = if isPP && isFunTy g ty then rangeOfFunTy g ty else ty @@ -493,10 +493,10 @@ module internal SymbolHelpers = // Generalize to get a formal signature let formalTypars = tcref.Typars(m) let formalTypeInst = generalizeTypars formalTypars - let ty = TType_app(tcref,formalTypeInst) + let ty = TType_app(tcref, formalTypeInst) if isILAppTy g ty then let formalTypeInfo = ILTypeInfo.FromType g ty - Some(nlref.Ccu.FileName,formalTypars,formalTypeInfo) + Some(nlref.Ccu.FileName, formalTypars, formalTypeInfo) else None let mkXmlComment thing = @@ -508,7 +508,7 @@ module internal SymbolHelpers = if eref.IsILTycon then match metaInfoOfEntityRef infoReader m eref with | None -> None - | Some (ccuFileName,_,formalTypeInfo) -> Some(ccuFileName,"T:"+formalTypeInfo.ILTypeRef.FullName) + | Some (ccuFileName, _, formalTypeInfo) -> Some(ccuFileName, "T:"+formalTypeInfo.ILTypeRef.FullName) else let ccuFileName = libFileOfEntityRef eref let m = eref.Deref @@ -535,32 +535,32 @@ module internal SymbolHelpers = let ccuFileName = libFileOfEntityRef tcref if ucinfo.UnionCase.XmlDocSig = "" then ucinfo.UnionCase.XmlDocSig <- XmlDocSigOfUnionCase [tcref.CompiledRepresentationForNamedType.FullName; ucinfo.Name] - Some (ccuFileName, ucinfo.UnionCase.XmlDocSig) + Some (ccuFileName, ucinfo.UnionCase.XmlDocSig) let GetXmlDocSigOfMethInfo (infoReader:InfoReader) m (minfo:MethInfo) = let amap = infoReader.amap match minfo with - | FSMeth (g,_,vref,_) -> + | FSMeth (g, _, vref, _) -> GetXmlDocSigOfScopedValRef g minfo.DeclaringEntityRef vref - | ILMeth (g,ilminfo,_) -> + | ILMeth (g, ilminfo, _) -> let actualTypeName = ilminfo.DeclaringTyconRef.CompiledRepresentationForNamedType.FullName let fmtps = ilminfo.FormalMethodTypars let genArity = if fmtps.Length=0 then "" else sprintf "``%d" fmtps.Length match metaInfoOfEntityRef infoReader m ilminfo.DeclaringTyconRef with | None -> None - | Some (ccuFileName,formalTypars,formalTypeInfo) -> - let filminfo = ILMethInfo(g,formalTypeInfo.ToType,None,ilminfo.RawMetadata,fmtps) + | Some (ccuFileName, formalTypars, formalTypeInfo) -> + let filminfo = ILMethInfo(g, formalTypeInfo.ToType, None, ilminfo.RawMetadata, fmtps) let args = match ilminfo.IsILExtensionMethod with - | true -> filminfo.GetRawArgTypes(amap,m,minfo.FormalMethodInst) - | false -> filminfo.GetParamTypes(amap,m,minfo.FormalMethodInst) + | true -> filminfo.GetRawArgTypes(amap, m, minfo.FormalMethodInst) + | false -> filminfo.GetParamTypes(amap, m, minfo.FormalMethodInst) // http://msdn.microsoft.com/en-us/library/fsbx0t7x.aspx // If the name of the item itself has periods, they are replaced by the hash-sign ('#'). It is assumed that no item has a hash-sign directly in its name. For example, the fully qualified name of the String constructor would be "System.String.#ctor". - let normalizedName = ilminfo.ILName.Replace(".","#") + let normalizedName = ilminfo.ILName.Replace(".", "#") - Some (ccuFileName,"M:"+actualTypeName+"."+normalizedName+genArity+XmlDocArgsEnc g (formalTypars,fmtps) args) + Some (ccuFileName, "M:"+actualTypeName+"."+normalizedName+genArity+XmlDocArgsEnc g (formalTypars, fmtps) args) | DefaultStructCtor _ -> None #if EXTENSIONTYPING | ProvidedMeth _ -> None @@ -581,34 +581,34 @@ module internal SymbolHelpers = #if EXTENSIONTYPING | ProvidedProp _ -> None // No signature is possible. If an xml comment existed it would have been returned by PropInfo.XmlDoc in infos.fs #endif - | FSProp (g,typ,_,_) as fspinfo -> + | FSProp (g, typ, _, _) as fspinfo -> let tcref = tcrefOfAppTy g typ match fspinfo.ArbitraryValRef with | None -> None | Some vref -> GetXmlDocSigOfScopedValRef g tcref vref - | ILProp(g, (ILPropInfo(tinfo,pdef))) -> + | ILProp(g, (ILPropInfo(tinfo, pdef))) -> let tcref = tinfo.TyconRef match metaInfoOfEntityRef infoReader m tcref with - | Some (ccuFileName,formalTypars,formalTypeInfo) -> - let filpinfo = ILPropInfo(formalTypeInfo,pdef) - Some (ccuFileName,"P:"+formalTypeInfo.ILTypeRef.FullName+"."+pdef.Name+XmlDocArgsEnc g (formalTypars,[]) (filpinfo.GetParamTypes(infoReader.amap,m))) + | Some (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 let GetXmlDocSigOfEvent infoReader m (einfo:EventInfo) = match einfo with - | ILEvent(_,ilEventInfo) -> + | ILEvent(_, ilEventInfo) -> let tinfo = ilEventInfo.ILTypeInfo let tcref = tinfo.TyconRef match metaInfoOfEntityRef infoReader m tcref with - | Some (ccuFileName,_,formalTypeInfo) -> - Some(ccuFileName,"E:"+formalTypeInfo.ILTypeRef.FullName+"."+einfo.EventName) + | Some (ccuFileName, _, formalTypeInfo) -> + Some(ccuFileName, "E:"+formalTypeInfo.ILTypeRef.FullName+"."+einfo.EventName) | _ -> None | _ -> None let GetXmlDocSigOfILFieldInfo infoReader m (finfo:ILFieldInfo) = match metaInfoOfEntityRef infoReader m (tcrefOfAppTy infoReader.g finfo.EnclosingType) with - | Some (ccuFileName,_,formalTypeInfo) -> - Some(ccuFileName,"F:"+formalTypeInfo.ILTypeRef.FullName+"."+finfo.FieldName) + | Some (ccuFileName, _, formalTypeInfo) -> + Some(ccuFileName, "F:"+formalTypeInfo.ILTypeRef.FullName+"."+finfo.FieldName) | _ -> None /// This function gets the signature to pass to Visual Studio to use its lookup functions for .NET stuff. @@ -617,23 +617,23 @@ module internal SymbolHelpers = match d with | Item.ActivePatternCase (APElemRef(_, vref, _)) - | Item.Value vref | Item.CustomBuilder (_,vref) -> + | Item.Value vref | Item.CustomBuilder (_, vref) -> mkXmlComment (GetXmlDocSigOfValRef g vref) - | Item.UnionCase (ucinfo,_) -> mkXmlComment (GetXmlDocSigOfUnionCaseInfo ucinfo) + | Item.UnionCase (ucinfo, _) -> mkXmlComment (GetXmlDocSigOfUnionCaseInfo ucinfo) | Item.ExnCase tcref -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) | Item.RecdField rfinfo -> mkXmlComment (GetXmlDocSigOfRecdFieldInfo rfinfo) | Item.NewDef _ -> FSharpXmlDoc.None | Item.ILField finfo -> mkXmlComment (GetXmlDocSigOfILFieldInfo infoReader m finfo) - | Item.Types(_,((TType_app(tcref,_)) :: _)) -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) - | Item.CustomOperation (_,_,Some minfo) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) + | Item.Types(_, ((TType_app(tcref, _)) :: _)) -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m tcref) + | Item.CustomOperation (_, _, Some minfo) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) | Item.TypeVar _ -> FSharpXmlDoc.None | Item.ModuleOrNamespaces(modref :: _) -> mkXmlComment (GetXmlDocSigOfEntityRef infoReader m modref) - | Item.Property(_,(pinfo :: _)) -> mkXmlComment (GetXmlDocSigOfProp infoReader m pinfo) + | Item.Property(_, (pinfo :: _)) -> mkXmlComment (GetXmlDocSigOfProp infoReader m pinfo) | Item.Event(einfo) -> mkXmlComment (GetXmlDocSigOfEvent infoReader m einfo) - | Item.MethodGroup(_,minfo :: _,_) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) - | Item.CtorGroup(_,minfo :: _) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) + | Item.MethodGroup(_, minfo :: _, _) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) + | Item.CtorGroup(_, minfo :: _) -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) | Item.ArgName(_, _, Some argContainer) -> match argContainer with | ArgumentContainer.Method minfo -> mkXmlComment (GetXmlDocSigOfMethInfo infoReader m minfo) @@ -664,13 +664,13 @@ module internal SymbolHelpers = GetXmlCommentForItemAux (if minfo.HasDirectXmlComment then Some minfo.XmlDoc else None) infoReader m d let FormatTyparMapping denv (prettyTyparInst: TyparInst) = - [ for (tp,ty) in prettyTyparInst -> + [ for (tp, ty) in prettyTyparInst -> wordL (tagTypeParameter ("'" + tp.DisplayName)) ^^ wordL (tagText (FSComp.SR.descriptionWordIs())) ^^ NicePrint.layoutType denv ty ] /// Generate the structured tooltip for a method info let FormatOverloadsToList (infoReader:InfoReader) m denv (item: ItemWithInst) minfos : FSharpStructuredToolTipElement = ToolTipFault |> Option.iter (fun msg -> - let exn = Error((0,msg),range.Zero) + let exn = Error((0, msg), range.Zero) let ph = PhasedDiagnostic.Create(exn, BuildPhase.TypeCheck) simulateError ph) @@ -691,9 +691,9 @@ module internal SymbolHelpers = let (|ItemWhereTypIsPreferred|_|) item = match item with | Item.DelegateCtor ty - | Item.CtorGroup(_, [DefaultStructCtor(_,ty)]) + | Item.CtorGroup(_, [DefaultStructCtor(_, ty)]) | Item.FakeInterfaceCtor ty - | Item.Types(_,[ty]) -> Some ty + | Item.Types(_, [ty]) -> Some ty | _ -> None /// Specifies functions for comparing 'Item' objects with respect to the user @@ -704,7 +704,7 @@ module internal SymbolHelpers = { new IPartialEqualityComparer<_> with member x.InEqualityRelation item = match item with - | Item.Types(_,[_]) -> true + | Item.Types(_, [_]) -> true | Item.ILField(ILFieldInfo _) -> true | Item.RecdField _ -> true | Item.SetterArg _ -> true @@ -734,9 +734,9 @@ module internal SymbolHelpers = ItemsAreEffectivelyEqual g item1 item2 || // Much of this logic is already covered by 'ItemsAreEffectivelyEqual' - match item1,item2 with + match item1, item2 with | Item.DelegateCtor(ty1), Item.DelegateCtor(ty2) -> equalTypes(ty1, ty2) - | Item.Types(dn1,[ty1]), Item.Types(dn2,[ty2]) -> + | Item.Types(dn1, [ty1]), Item.Types(dn2, [ty2]) -> // Bug 4403: We need to compare names as well, because 'int' and 'Int32' are physically the same type, but we want to show both dn1 = dn2 && equalTypes(ty1, ty2) @@ -746,20 +746,20 @@ module internal SymbolHelpers = | Item.ExnCase(tcref1), Item.ExnCase(tcref2) -> tyconRefEq g tcref1 tcref2 | Item.ILField(ILFieldInfo(_, fld1)), Item.ILField(ILFieldInfo(_, fld2)) -> fld1 === fld2 // reference equality on the object identity of the AbstractIL metadata blobs for the fields - | Item.CustomOperation (_,_,Some minfo1), Item.CustomOperation (_,_,Some minfo2) -> + | Item.CustomOperation (_, _, Some minfo1), Item.CustomOperation (_, _, Some minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 - | Item.TypeVar (nm1,tp1), Item.TypeVar (nm2,tp2) -> + | Item.TypeVar (nm1, tp1), Item.TypeVar (nm2, tp2) -> (nm1 = nm2) && typarRefEq tp1 tp2 | Item.ModuleOrNamespaces(modref1 :: _), Item.ModuleOrNamespaces(modref2 :: _) -> fullDisplayTextOfModRef modref1 = fullDisplayTextOfModRef modref2 - | Item.SetterArg(id1,_), Item.SetterArg(id2,_) -> (id1.idRange, id1.idText) = (id2.idRange, id2.idText) - | Item.MethodGroup(_, meths1,_), Item.MethodGroup(_, meths2,_) -> + | Item.SetterArg(id1, _), Item.SetterArg(id2, _) -> (id1.idRange, id1.idText) = (id2.idRange, id2.idText) + | Item.MethodGroup(_, meths1, _), Item.MethodGroup(_, meths2, _) -> Seq.zip meths1 meths2 |> Seq.forall (fun (minfo1, minfo2) -> MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2) - | (Item.Value vref1 | Item.CustomBuilder (_,vref1)), (Item.Value vref2 | Item.CustomBuilder (_,vref2)) -> + | (Item.Value vref1 | Item.CustomBuilder (_, vref1)), (Item.Value vref2 | Item.CustomBuilder (_, vref2)) -> valRefEq g vref1 vref2 | Item.ActivePatternCase(APElemRef(_apinfo1, vref1, idx1)), Item.ActivePatternCase(APElemRef(_apinfo2, vref2, idx2)) -> idx1 = idx2 && valRefEq g vref1 vref2 - | Item.UnionCase(UnionCaseInfo(_, ur1),_), Item.UnionCase(UnionCaseInfo(_, ur2),_) -> + | Item.UnionCase(UnionCaseInfo(_, ur1), _), Item.UnionCase(UnionCaseInfo(_, ur2), _) -> g.unionCaseRefEq ur1 ur2 | Item.RecdField(RecdFieldInfo(_, RFRef(tcref1, n1))), Item.RecdField(RecdFieldInfo(_, RFRef(tcref2, n2))) -> (tyconRefEq g tcref1 tcref2) && (n1 = n2) // there is no direct function as in the previous case @@ -773,8 +773,8 @@ module internal SymbolHelpers = | Item.UnqualifiedType(tcRefs1), Item.UnqualifiedType(tcRefs2) -> List.zip tcRefs1 tcRefs2 |> List.forall (fun (tcRef1, tcRef2) -> tyconRefEq g tcRef1 tcRef2) - | Item.Types(_,[TType.TType_app(tcRef1,_)]), Item.UnqualifiedType([tcRef2]) -> tyconRefEq g tcRef1 tcRef2 - | Item.UnqualifiedType([tcRef1]), Item.Types(_,[TType.TType_app(tcRef2,_)]) -> tyconRefEq g tcRef1 tcRef2 + | Item.Types(_, [TType.TType_app(tcRef1, _)]), Item.UnqualifiedType([tcRef2]) -> tyconRefEq g tcRef1 tcRef2 + | Item.UnqualifiedType([tcRef1]), Item.Types(_, [TType.TType_app(tcRef2, _)]) -> tyconRefEq g tcRef1 tcRef2 | _ -> false) member x.GetHashCode item = @@ -787,17 +787,17 @@ module internal SymbolHelpers = else 1010 | Item.ILField(ILFieldInfo(_, fld)) -> System.Runtime.CompilerServices.RuntimeHelpers.GetHashCode fld // hash on the object identity of the AbstractIL metadata blob for the field - | Item.TypeVar (nm,_tp) -> hash nm - | Item.CustomOperation (_,_,Some minfo) -> minfo.ComputeHashCode() - | Item.CustomOperation (_,_,None) -> 1 + | Item.TypeVar (nm, _tp) -> hash nm + | Item.CustomOperation (_, _, Some minfo) -> minfo.ComputeHashCode() + | Item.CustomOperation (_, _, None) -> 1 | Item.ModuleOrNamespaces(modref :: _) -> hash (fullDisplayTextOfModRef modref) - | Item.SetterArg(id,_) -> hash (id.idRange, id.idText) - | Item.MethodGroup(_, meths,_) -> meths |> List.fold (fun st a -> st + a.ComputeHashCode()) 0 + | Item.SetterArg(id, _) -> hash (id.idRange, id.idText) + | Item.MethodGroup(_, meths, _) -> meths |> List.fold (fun st a -> st + a.ComputeHashCode()) 0 | Item.CtorGroup(name, meths) -> name.GetHashCode() + (meths |> List.fold (fun st a -> st + a.ComputeHashCode()) 0) - | (Item.Value vref | Item.CustomBuilder (_,vref)) -> hash vref.LogicalName + | (Item.Value vref | Item.CustomBuilder (_, vref)) -> hash vref.LogicalName | Item.ActivePatternCase(APElemRef(_apinfo, vref, idx)) -> hash (vref.LogicalName, idx) | Item.ExnCase(tcref) -> hash tcref.Stamp - | Item.UnionCase(UnionCaseInfo(_, UCRef(tcref, n)),_) -> hash(tcref.Stamp, n) + | Item.UnionCase(UnionCaseInfo(_, UCRef(tcref, n)), _) -> hash(tcref.Stamp, n) | Item.RecdField(RecdFieldInfo(_, RFRef(tcref, n))) -> hash(tcref.Stamp, n) | Item.Event evt -> evt.ComputeHashCode() | Item.Property(_name, pis) -> hash (pis |> List.map (fun pi -> pi.ComputeHashCode())) @@ -874,8 +874,8 @@ module internal SymbolHelpers = let denv = DisplayEnv.Empty(g) match item with | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) - | Item.Value vref | Item.CustomBuilder (_,vref) -> fullDisplayTextOfValRef vref - | Item.UnionCase (ucinfo,_) -> fullDisplayTextOfUnionCaseRef ucinfo.UnionCaseRef + | Item.Value vref | Item.CustomBuilder (_, vref) -> fullDisplayTextOfValRef vref + | Item.UnionCase (ucinfo, _) -> fullDisplayTextOfUnionCaseRef ucinfo.UnionCaseRef | Item.ActivePatternResult(apinfo, _ty, idx, _) -> apinfo.Names.[idx] | Item.ActivePatternCase apref -> FullNameOfItem g (Item.Value apref.ActivePatternVal) + "." + apref.Name | Item.ExnCase ecref -> fullDisplayTextOfExnRef ecref @@ -883,15 +883,15 @@ module internal SymbolHelpers = | Item.NewDef id -> id.idText | Item.ILField finfo -> bufs (fun os -> NicePrint.outputILTypeRef denv os finfo.ILTypeRef; bprintf os ".%s" finfo.FieldName) | Item.Event einfo -> bufs (fun os -> NicePrint.outputTyconRef denv os (tcrefOfAppTy g einfo.EnclosingType); bprintf os ".%s" einfo.EventName) - | Item.Property(_,(pinfo::_)) -> bufs (fun os -> NicePrint.outputTyconRef denv os (tcrefOfAppTy g pinfo.EnclosingType); bprintf os ".%s" pinfo.PropertyName) - | Item.CustomOperation (customOpName,_,_) -> customOpName - | Item.CtorGroup(_,minfo :: _) -> bufs (fun os -> NicePrint.outputTyconRef denv os minfo.DeclaringEntityRef) - | Item.MethodGroup(_,_,Some minfo) -> bufs (fun os -> NicePrint.outputTyconRef denv os minfo.DeclaringEntityRef; bprintf os ".%s" minfo.DisplayName) - | Item.MethodGroup(_,minfo :: _,_) -> bufs (fun os -> NicePrint.outputTyconRef denv os minfo.DeclaringEntityRef; bprintf os ".%s" minfo.DisplayName) + | Item.Property(_, (pinfo::_)) -> bufs (fun os -> NicePrint.outputTyconRef denv os (tcrefOfAppTy g pinfo.EnclosingType); bprintf os ".%s" pinfo.PropertyName) + | Item.CustomOperation (customOpName, _, _) -> customOpName + | Item.CtorGroup(_, minfo :: _) -> bufs (fun os -> NicePrint.outputTyconRef denv os minfo.DeclaringEntityRef) + | Item.MethodGroup(_, _, Some minfo) -> bufs (fun os -> NicePrint.outputTyconRef denv os minfo.DeclaringEntityRef; bprintf os ".%s" minfo.DisplayName) + | Item.MethodGroup(_, minfo :: _, _) -> bufs (fun os -> NicePrint.outputTyconRef denv os minfo.DeclaringEntityRef; bprintf os ".%s" minfo.DisplayName) | Item.UnqualifiedType (tcref :: _) -> bufs (fun os -> NicePrint.outputTyconRef denv os tcref) | Item.FakeInterfaceCtor typ | Item.DelegateCtor typ - | Item.Types(_,typ:: _) -> + | Item.Types(_, typ:: _) -> match tryDestAppTy g typ with | Some tcref -> bufs (fun os -> NicePrint.outputTyconRef denv os tcref) | _ -> "" @@ -904,11 +904,11 @@ module internal SymbolHelpers = | Item.ImplicitOp(id, _) -> id.idText // unreachable | Item.UnqualifiedType([]) - | Item.Types(_,[]) - | Item.CtorGroup(_,[]) - | Item.MethodGroup(_,[],_) + | Item.Types(_, []) + | Item.CtorGroup(_, []) + | Item.MethodGroup(_, [], _) | Item.ModuleOrNamespaces [] - | Item.Property(_,[]) -> "" + | Item.Property(_, []) -> "" /// Output a the description of a language item let rec GetXmlCommentForItem (infoReader:InfoReader) m item = @@ -917,10 +917,10 @@ module internal SymbolHelpers = | Item.ImplicitOp(_, { contents = Some(TraitConstraintSln.FSMethSln(_, vref, _)) }) -> GetXmlCommentForItem infoReader m (Item.Value vref) - | Item.Value vref | Item.CustomBuilder (_,vref) -> + | Item.Value vref | Item.CustomBuilder (_, vref) -> GetXmlCommentForItemAux (if valRefInThisAssembly g.compilingFslib vref then Some vref.XmlDoc else None) infoReader m item - | Item.UnionCase(ucinfo,_) -> + | Item.UnionCase(ucinfo, _) -> GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib ucinfo.TyconRef then Some ucinfo.UnionCase .XmlDoc else None) infoReader m item | Item.ActivePatternCase apref -> @@ -935,16 +935,16 @@ module internal SymbolHelpers = | Item.Event einfo -> GetXmlCommentForItemAux (if einfo.HasDirectXmlComment then Some einfo.XmlDoc else None) infoReader m item - | Item.Property(_,pinfos) -> + | Item.Property(_, pinfos) -> let pinfo = pinfos.Head GetXmlCommentForItemAux (if pinfo.HasDirectXmlComment then Some pinfo.XmlDoc else None) infoReader m item - | Item.CustomOperation (_,_,Some minfo) - | Item.CtorGroup(_,minfo :: _) - | Item.MethodGroup(_,minfo :: _,_) -> + | Item.CustomOperation (_, _, Some minfo) + | Item.CtorGroup(_, minfo :: _) + | Item.MethodGroup(_, minfo :: _, _) -> GetXmlCommentForMethInfoItem infoReader m item minfo - | Item.Types(_,((TType_app(tcref,_)):: _)) -> + | Item.Types(_, ((TType_app(tcref, _)):: _)) -> GetXmlCommentForItemAux (if tyconRefUsesLocalXmlDoc g.compilingFslib tcref then Some tcref.XmlDoc else None) infoReader m item | Item.ModuleOrNamespaces((modref :: _) as modrefs) -> @@ -983,7 +983,7 @@ module internal SymbolHelpers = let g = infoReader.g let amap = infoReader.amap match item with - | Item.Types(_,((TType_app(tcref,_)):: _)) -> + | Item.Types(_, ((TType_app(tcref, _)):: _)) -> let ty = generalizedTyconRef tcref Infos.ExistsHeadTypeInEntireHierarchy g amap range0 ty g.tcref_System_Attribute | _ -> false @@ -1000,14 +1000,14 @@ module internal SymbolHelpers = // operator with solution FormatItemDescriptionToToolTipElement isListItem infoReader m denv { item with Item = Item.Value vref } - | Item.Value vref | Item.CustomBuilder (_,vref) -> + | Item.Value vref | Item.CustomBuilder (_, vref) -> let prettyTyparInst, resL = NicePrint.layoutQualifiedValOrMember denv item.TyparInst vref.Deref let remarks = OutputFullName isListItem pubpathOfValRef fullDisplayTextOfValRefAsLayout vref let tpsL = FormatTyparMapping denv prettyTyparInst FSharpStructuredToolTipElement.Single(resL, xml, tpsL, remarks=remarks) // Union tags (constructors) - | Item.UnionCase(ucinfo,_) -> + | Item.UnionCase(ucinfo, _) -> let uc = ucinfo.UnionCase let rty = generalizedTyconRef ucinfo.TyconRef let recd = uc.RecdFields @@ -1037,7 +1037,7 @@ module internal SymbolHelpers = // Format the type parameters to get e.g. ('a -> 'a) rather than ('?1234 -> '?1234) let tau = v.TauType // REVIEW: use _cxs here - let (prettyTyparInst,ptau), _cxs = PrettyTypes.PrettifyInstAndType denv.g (item.TyparInst, tau) + let (prettyTyparInst, ptau), _cxs = PrettyTypes.PrettifyInstAndType denv.g (item.TyparInst, tau) let remarks = OutputFullName isListItem pubpathOfValRef fullDisplayTextOfValRefAsLayout v let layout = wordL (tagText (FSComp.SR.typeInfoActiveRecognizer())) ^^ @@ -1116,7 +1116,7 @@ module internal SymbolHelpers = FSharpStructuredToolTipElement.Single (layout, xml) // Custom operations in queries - | Item.CustomOperation (customOpName,usageText,Some minfo) -> + | Item.CustomOperation (customOpName, usageText, Some minfo) -> // Build 'custom operation: where (bool) // @@ -1128,7 +1128,7 @@ module internal SymbolHelpers = match usageText() with | Some t -> wordL (tagText t) | None -> - let argTys = ParamNameAndTypesOfUnaryCustomOperation g minfo |> List.map (fun (ParamNameAndType(_,ty)) -> ty) + let argTys = ParamNameAndTypesOfUnaryCustomOperation g minfo |> List.map (fun (ParamNameAndType(_, ty)) -> ty) let argTys, _ = PrettyTypes.PrettifyTypes g argTys wordL (tagMethod customOpName) ^^ sepListL SepL.space (List.map (fun ty -> LeftL.leftParen ^^ NicePrint.layoutType denv ty ^^ SepL.rightParen) argTys) ) ^^ @@ -1141,8 +1141,8 @@ module internal SymbolHelpers = FSharpStructuredToolTipElement.Single (layout, xml) // F# constructors and methods - | Item.CtorGroup(_,minfos) - | Item.MethodGroup(_,minfos,_) -> + | Item.CtorGroup(_, minfos) + | Item.MethodGroup(_, minfos, _) -> FormatOverloadsToList infoReader m denv item minfos // The 'fake' zero-argument constructors of .NET interfaces. @@ -1167,7 +1167,7 @@ module internal SymbolHelpers = FSharpStructuredToolTipElement.Single(layout, xml) // Types. - | Item.Types(_,((TType_app(tcref,_)):: _)) + | Item.Types(_, ((TType_app(tcref, _)):: _)) | Item.UnqualifiedType (tcref :: _) -> let denv = { denv with shortTypeNames = true } let layout = NicePrint.layoutTycon denv infoReader AccessibleFromSomewhere m (* width *) tcref.Deref @@ -1191,12 +1191,12 @@ module internal SymbolHelpers = |> wordL) if not definiteNamespace then let namesToAdd = - ([],modrefs) + ([], modrefs) ||> Seq.fold (fun st modref -> match fullDisplayTextOfParentOfModRef modref with | Some(txt) -> txt::st | _ -> st) - |> Seq.mapi (fun i x -> i,x) + |> Seq.mapi (fun i x -> i, x) |> Seq.toList let layout = layout ^^ @@ -1236,9 +1236,9 @@ module internal SymbolHelpers = /// Determine if an item is a provided type let (|ItemIsProvidedType|_|) g item = match item with - | Item.Types(_name,tys) -> + | Item.Types(_name, tys) -> match tys with - | [AppTy g (tyconRef,_typeInst)] -> + | [AppTy g (tyconRef, _typeInst)] -> if tyconRef.IsProvidedErasedTycon || tyconRef.IsProvidedGeneratedTycon then Some tyconRef else @@ -1249,16 +1249,16 @@ module internal SymbolHelpers = /// Determine if an item is a provided type that has static parameters let (|ItemIsProvidedTypeWithStaticArguments|_|) m g item = match item with - | Item.Types(_name,tys) -> + | Item.Types(_name, tys) -> match tys with - | [AppTy g (tyconRef,_typeInst)] -> + | [AppTy g (tyconRef, _typeInst)] -> if tyconRef.IsProvidedErasedTycon || tyconRef.IsProvidedGeneratedTycon then let typeBeforeArguments = match tyconRef.TypeReprInfo with | TProvidedTypeExtensionPoint info -> info.ProvidedType | _ -> failwith "unreachable" - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments,provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) - let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters",m) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) + let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m) Some staticParameters else None @@ -1269,13 +1269,13 @@ module internal SymbolHelpers = let (|ItemIsProvidedMethodWithStaticArguments|_|) item = match item with // Prefer the static parameters from the uninstantiated method info - | Item.MethodGroup(_,_,Some minfo) -> + | Item.MethodGroup(_, _, Some minfo) -> match minfo.ProvidedStaticParameterInfo with - | Some (_,staticParameters) -> Some staticParameters + | Some (_, staticParameters) -> Some staticParameters | _ -> None - | Item.MethodGroup(_,[minfo],_) -> + | Item.MethodGroup(_, [minfo], _) -> match minfo.ProvidedStaticParameterInfo with - | Some (_,staticParameters) -> Some staticParameters + | Some (_, staticParameters) -> Some staticParameters | _ -> None | _ -> None @@ -1299,7 +1299,7 @@ module internal SymbolHelpers = (tcref |> ticksAndArgCountTextOfTyconRef)+"."+vref.CompiledName|> Some | ParentNone -> None - | ILMeth (_,minfo,_) -> + | ILMeth (_, minfo, _) -> let typeString = minfo.DeclaringTyconRef |> ticksAndArgCountTextOfTyconRef let paramString = let nGenericParams = minfo.RawMetadata.GenericParams.Length @@ -1312,7 +1312,7 @@ module internal SymbolHelpers = #endif match item with - | Item.Value vref | Item.CustomBuilder (_,vref) -> + | Item.Value vref | Item.CustomBuilder (_, vref) -> let v = vref.Deref if v.IsModuleBinding && v.HasTopValActualParent then let tyconRef = v.TopValActualParent @@ -1328,7 +1328,7 @@ module internal SymbolHelpers = | Item.ActivePatternCase apref -> GetF1Keyword g (Item.Value apref.ActivePatternVal) - | Item.UnionCase(ucinfo,_) -> + | Item.UnionCase(ucinfo, _) -> (ucinfo.TyconRef |> ticksAndArgCountTextOfTyconRef)+"."+ucinfo.Name |> Some | Item.RecdField rfi -> @@ -1341,9 +1341,9 @@ module internal SymbolHelpers = #if EXTENSIONTYPING | ProvidedField _ -> None #endif - | Item.Types(_,((AppTy g (tcref,_)) :: _)) - | Item.DelegateCtor(AppTy g (tcref,_)) - | Item.FakeInterfaceCtor(AppTy g (tcref,_)) + | Item.Types(_, ((AppTy g (tcref, _)) :: _)) + | Item.DelegateCtor(AppTy g (tcref, _)) + | Item.FakeInterfaceCtor(AppTy g (tcref, _)) | Item.UnqualifiedType (tcref::_) | Item.ExnCase tcref -> // strip off any abbreviation @@ -1378,7 +1378,7 @@ module internal SymbolHelpers = | _ -> modref.Deref.CompiledRepresentationForNamedType.FullName |> Some | [] -> None // Pathological case of the above - | Item.Property(_,(pinfo :: _)) -> + | Item.Property(_, (pinfo :: _)) -> match pinfo with | FSProp(_, _, Some vref, _) | FSProp(_, _, _, Some vref) -> @@ -1388,22 +1388,22 @@ module internal SymbolHelpers = (tcref |> ticksAndArgCountTextOfTyconRef)+"."+vref.PropertyName|> Some | ParentNone -> None - | ILProp(_, (ILPropInfo(tinfo,pdef))) -> + | ILProp(_, (ILPropInfo(tinfo, pdef))) -> let tcref = tinfo.TyconRef (tcref |> ticksAndArgCountTextOfTyconRef)+"."+pdef.Name |> Some | FSProp _ -> None #if EXTENSIONTYPING | ProvidedProp _ -> None #endif - | Item.Property(_,[]) -> None // Pathological case of the above + | Item.Property(_, []) -> None // Pathological case of the above | Item.Event einfo -> match einfo with - | ILEvent(_,ilEventInfo) -> + | ILEvent(_, ilEventInfo) -> let tinfo = ilEventInfo.ILTypeInfo let tcref = tinfo.TyconRef (tcref |> ticksAndArgCountTextOfTyconRef)+"."+einfo.EventName |> Some - | FSEvent(_,pinfo,_,_) -> + | FSEvent(_, pinfo, _, _) -> match pinfo.ArbitraryValRef with | Some vref -> // per spec, members in F1 keywords are qualified with definition class @@ -1414,28 +1414,28 @@ module internal SymbolHelpers = #if EXTENSIONTYPING | ProvidedEvent _ -> None #endif - | Item.CtorGroup(_,minfos) -> + | Item.CtorGroup(_, minfos) -> match minfos with | [] -> None | FSMeth(_, _, vref, _) :: _ -> match vref.ActualParent with | Parent tcref -> (tcref |> ticksAndArgCountTextOfTyconRef) + ".#ctor"|> Some | ParentNone -> None - | (ILMeth (_,minfo,_)) :: _ -> + | (ILMeth (_, minfo, _)) :: _ -> let tcref = minfo.DeclaringTyconRef (tcref |> ticksAndArgCountTextOfTyconRef)+".#ctor" |> Some - | (DefaultStructCtor (g,typ) :: _) -> + | (DefaultStructCtor (g, typ) :: _) -> let tcref = tcrefOfAppTy g typ (ticksAndArgCountTextOfTyconRef tcref) + ".#ctor" |> Some #if EXTENSIONTYPING | ProvidedMeth _::_ -> None #endif - | Item.CustomOperation (_,_,Some minfo) -> getKeywordForMethInfo minfo - | Item.MethodGroup(_,_,Some minfo) -> getKeywordForMethInfo minfo - | Item.MethodGroup(_,minfo :: _,_) -> getKeywordForMethInfo minfo + | Item.CustomOperation (_, _, Some minfo) -> getKeywordForMethInfo minfo + | Item.MethodGroup(_, _, Some minfo) -> getKeywordForMethInfo minfo + | Item.MethodGroup(_, minfo :: _, _) -> getKeywordForMethInfo minfo | Item.SetterArg (_, propOrField) -> GetF1Keyword g propOrField - | Item.MethodGroup(_,[],_) - | Item.CustomOperation (_,_,None) // "into" + | Item.MethodGroup(_, [], _) + | Item.CustomOperation (_, _, None) // "into" | Item.NewDef _ // "let x$yz = ..." - no keyword | Item.ArgName _ // no keyword on named parameters | Item.TypeVar _ @@ -1453,8 +1453,8 @@ module internal SymbolHelpers = /// Get rid of groups of overloads an replace them with single items. let FlattenItems g (m: range) item = match item with - | Item.MethodGroup(nm,minfos,orig) -> minfos |> List.map (fun minfo -> Item.MethodGroup(nm,[minfo],orig)) - | Item.CtorGroup(nm,cinfos) -> cinfos |> List.map (fun minfo -> Item.CtorGroup(nm,[minfo])) + | Item.MethodGroup(nm, minfos, orig) -> minfos |> List.map (fun minfo -> Item.MethodGroup(nm, [minfo], orig)) + | Item.CtorGroup(nm, cinfos) -> cinfos |> List.map (fun minfo -> Item.CtorGroup(nm, [minfo])) | Item.FakeInterfaceCtor _ | Item.DelegateCtor _ -> [item] | Item.NewDef _ @@ -1462,9 +1462,9 @@ module internal SymbolHelpers = | Item.Event _ -> [] | Item.RecdField(rfinfo) -> if isFunction g rfinfo.FieldType then [item] else [] | Item.Value v -> if isFunction g v.Type then [item] else [] - | Item.UnionCase(ucr,_) -> if not ucr.UnionCase.IsNullary then [item] else [] + | Item.UnionCase(ucr, _) -> if not ucr.UnionCase.IsNullary then [item] else [] | Item.ExnCase(ecr) -> if isNil (recdFieldsOfExnDefRef ecr) then [] else [item] - | Item.Property(_,pinfos) -> + | Item.Property(_, pinfos) -> let pinfo = List.head pinfos if pinfo.IsIndexer then [item] else [] #if EXTENSIONTYPING diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index d9353bae22802d643f28338132e2066dfb205308..db5f96b3d1758b86d31fb109584d60c4068ab473 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -26,7 +26,7 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = let isInternalCompPath x = match x with - | CompPath(ILScopeRef.Local,[]) -> true + | CompPath(ILScopeRef.Local, []) -> true | _ -> false let (|Public|Internal|Private|) (TAccess p) = @@ -47,22 +47,22 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = override __.ToString() = let (TAccess paths) = a - let mangledTextOfCompPath (CompPath(scoref,path)) = getNameOfScopeRef scoref + "/" + textOfPath (List.map fst path) + let mangledTextOfCompPath (CompPath(scoref, path)) = getNameOfScopeRef scoref + "/" + textOfPath (List.map fst path) String.concat ";" (List.map mangledTextOfCompPath paths) [] module Impl = let protect f = ErrorLogger.protectAssemblyExplorationF - (fun (asmName,path) -> invalidOp (sprintf "The entity or value '%s' does not exist or is in an unresolved assembly. You may need to add a reference to assembly '%s'" path asmName)) + (fun (asmName, path) -> invalidOp (sprintf "The entity or value '%s' does not exist or is in an unresolved assembly. You may need to add a reference to assembly '%s'" path asmName)) f - let makeReadOnlyCollection (arr : seq<'T>) = + let makeReadOnlyCollection (arr: seq<'T>) = System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_> let makeXmlDoc (XmlDoc x) = makeReadOnlyCollection (x) - let rescopeEntity optViewedCcu (entity : Entity) = + let rescopeEntity optViewedCcu (entity: Entity) = match optViewedCcu with | None -> mkLocalEntityRef entity | Some viewedCcu -> @@ -88,17 +88,17 @@ module Impl = /// Checking accessibility that arise from different compilations needs more care - this is a duplicate of the F# compiler code for this case let checkForCrossProjectAccessibility (thisCcu2:CcuThunk, ad2) (thisCcu1, taccess1) = match ad2 with - | AccessibleFrom(cpaths2,_) -> + | AccessibleFrom(cpaths2, _) -> let nameOfScoRef (thisCcu:CcuThunk) scoref = match scoref with | ILScopeRef.Local -> thisCcu.AssemblyName | ILScopeRef.Assembly aref -> aref.Name | ILScopeRef.Module mref -> mref.Name - let canAccessCompPathFromCrossProject (CompPath(scoref1,cpath1)) (CompPath(scoref2,cpath2)) = + let canAccessCompPathFromCrossProject (CompPath(scoref1, cpath1)) (CompPath(scoref2, cpath2)) = let rec loop p1 p2 = - match p1,p2 with - | (a1,k1)::rest1, (a2,k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 - | [],_ -> true + match p1, p2 with + | (a1, k1)::rest1, (a2, k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 + | [], _ -> true | _ -> false // cpath1 is longer loop cpath1 cpath2 && nameOfScoRef thisCcu1 scoref1 = nameOfScoRef thisCcu2 scoref2 @@ -108,11 +108,11 @@ module Impl = /// Convert an IL member accessibility into an F# accessibility - let getApproxFSharpAccessibilityOfMember (declaringEntity: EntityRef) (ilAccess : ILMemberAccess) = + let getApproxFSharpAccessibilityOfMember (declaringEntity: EntityRef) (ilAccess: ILMemberAccess) = match ilAccess with | ILMemberAccess.FamilyAndAssembly | ILMemberAccess.Assembly -> - taccessPrivate (CompPath(declaringEntity.CompilationPath.ILScopeRef,[])) + taccessPrivate (CompPath(declaringEntity.CompilationPath.ILScopeRef, [])) | ILMemberAccess.CompilerControlled | ILMemberAccess.Private -> @@ -134,11 +134,11 @@ module Impl = taccessPublic #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> match td.Access with | ILTypeDefAccess.Public | ILTypeDefAccess.Nested ILMemberAccess.Public -> taccessPublic - | ILTypeDefAccess.Private -> taccessPrivate (CompPath(entity.CompilationPath.ILScopeRef,[])) + | ILTypeDefAccess.Private -> taccessPrivate (CompPath(entity.CompilationPath.ILScopeRef, [])) | ILTypeDefAccess.Nested nested -> getApproxFSharpAccessibilityOfMember entity nested | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> @@ -192,7 +192,7 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT member x.Assembly = let ccu = defaultArg (SymbolHelpers.ccuOfItem cenv.g x.Item) cenv.thisCcu - FSharpAssembly(cenv, ccu) + FSharpAssembly(cenv, ccu) member x.IsAccessible(rights: FSharpAccessibilityRights) = access x rights.ThisCcu rights.Contents @@ -213,9 +213,9 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT member x.DisplayName = item().DisplayName - // This is actually overridden in all cases below. However some symbols are still just of type FSharpSymbol, + // This is actually overridden in all cases below. However some symbols are still just of type FSharpSymbol, // see 'FSharpSymbol.Create' further below. - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpSymbol as otherSymbol -> ItemsAreEffectivelyEqual cenv.g x.Item otherSymbol.Item @@ -227,7 +227,7 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT and FSharpEntity(cenv:cenv, entity:EntityRef) = - inherit FSharpSymbol(cenv, + inherit FSharpSymbol(cenv, (fun () -> checkEntityIsResolved(entity); if entity.IsModule then Item.ModuleOrNamespaces [entity] @@ -237,7 +237,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = // && AccessibilityLogic.IsEntityAccessible cenv.amap range0 ad entity) ) - // If an entity is in an assembly not available to us in the resolution set, + // If an entity is in an assembly not available to us in the resolution set, // we generally return "false" from predicates like IsClass, since we know // nothing about that type. let isResolvedAndFSharp() = @@ -273,15 +273,15 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = checkIsResolved() match entity.CompilationPathOpt with | None -> "global" - | Some (CompPath(_,[])) -> "global" + | Some (CompPath(_, [])) -> "global" | Some cp -> buildAccessPath (Some cp) member __.Namespace = checkIsResolved() match entity.CompilationPathOpt with | None -> None - | Some (CompPath(_,[])) -> None - | Some cp when cp.AccessPath |> List.forall (function (_,ModuleOrNamespaceKind.Namespace) -> true | _ -> false) -> + | Some (CompPath(_, [])) -> None + | Some cp when cp.AccessPath |> List.forall (function (_, ModuleOrNamespaceKind.Namespace) -> true | _ -> false) -> Some (buildAccessPath (Some cp)) | Some _ -> None @@ -294,7 +294,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = if entity.IsTypeAbbrev || entity.IsNamespace then fail() #endif match entity.CompiledRepresentation with - | CompiledTypeRepr.ILAsmNamed(tref,_,_) -> tref.QualifiedName + | CompiledTypeRepr.ILAsmNamed(tref, _, _) -> tref.QualifiedName | CompiledTypeRepr.ILAsmOpen _ -> fail() member x.FullName = @@ -313,7 +313,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = elif entity.IsNamespace then Some entity.DemangledModuleOrNamespaceName else match entity.CompiledRepresentation with - | CompiledTypeRepr.ILAsmNamed(tref,_,_) -> Some tref.FullName + | CompiledTypeRepr.ILAsmNamed(tref, _, _) -> Some tref.FullName | CompiledTypeRepr.ILAsmOpen _ -> None member __.DeclarationLocation = @@ -322,7 +322,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = member x.GenericParameters = checkIsResolved() - entity.TyparsNoRange |> List.map (fun tp -> FSharpGenericParameter(cenv, tp)) |> makeReadOnlyCollection + entity.TyparsNoRange |> List.map (fun tp -> FSharpGenericParameter(cenv, tp)) |> makeReadOnlyCollection member __.IsMeasure = isResolvedAndFSharp() && (entity.TypeOrMeasureKind = TyparKind.Measure) @@ -369,7 +369,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.IsClass #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> (td.tdKind = ILTypeDefKind.Class) + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> (td.tdKind = ILTypeDefKind.Class) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> entity.Deref.IsFSharpClassTycon member __.IsByRef = @@ -390,7 +390,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = #if EXTENSIONTYPING | ProvidedTypeMetadata info -> info.IsDelegate () #endif - | ILTypeMetadata (TILObjectReprData(_,_,td)) -> (td.tdKind = ILTypeDefKind.Delegate) + | ILTypeMetadata (TILObjectReprData(_, _, td)) -> (td.tdKind = ILTypeDefKind.Delegate) | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> entity.IsFSharpDelegateTycon member __.IsEnum = @@ -423,7 +423,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = match entity.TypeReprInfo with | TFSharpObjectRepr r when entity.IsFSharpDelegateTycon -> match r.fsobjmodel_kind with - | TTyconDelegate ss -> FSharpDelegateSignature(cenv, ss) + | TTyconDelegate ss -> FSharpDelegateSignature(cenv, ss) | _ -> invalidOp "not a delegate type" | _ -> invalidOp "not a delegate type" @@ -441,14 +441,14 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = if isUnresolved() then makeReadOnlyCollection [] else ErrorLogger.protectAssemblyExploration [] (fun () -> [ for ty in GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes cenv.g cenv.amap range0 (generalizedTyconRef entity) do - yield FSharpType(cenv, ty) ]) + yield FSharpType(cenv, ty) ]) |> makeReadOnlyCollection member x.AllInterfaces = if isUnresolved() then makeReadOnlyCollection [] else ErrorLogger.protectAssemblyExploration [] (fun () -> [ for ty in AllInterfacesOfType cenv.g cenv.amap range0 AllowMultiIntfInstantiations.Yes (generalizedTyconRef entity) do - yield FSharpType(cenv, ty) ]) + yield FSharpType(cenv, ty) ]) |> makeReadOnlyCollection member x.IsAttributeType = @@ -466,7 +466,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = member x.BaseType = checkIsResolved() GetSuperTypeOfType cenv.g cenv.amap range0 (generalizedTyconRef entity) - |> Option.map (fun ty -> FSharpType(cenv, ty)) + |> Option.map (fun ty -> FSharpType(cenv, ty)) member __.UsesPrefixDisplay = if isUnresolved() then true else @@ -478,7 +478,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = if isUnresolved() then makeReadOnlyCollection[] else protect <| fun () -> ([ let _, entityTy = generalizeTyconRef entity - let createMember (minfo : MethInfo) = + let createMember (minfo: MethInfo) = if minfo.IsConstructor then FSharpMemberOrFunctionOrValue(cenv, C minfo, Item.CtorGroup (minfo.DisplayName, [minfo])) else FSharpMemberOrFunctionOrValue(cenv, M minfo, Item.MethodGroup (minfo.DisplayName, [minfo], None)) if x.IsFSharpAbbreviation then @@ -495,7 +495,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = let props = GetImmediateIntrinsicPropInfosOfType (None, AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 entityTy let events = cenv.infoReader.GetImmediateIntrinsicEventsOfType (None, AccessibleFromSomeFSharpCode, range0, entityTy) for pinfo in props do - yield FSharpMemberOrFunctionOrValue(cenv, P pinfo, Item.Property (pinfo.PropertyName,[pinfo])) + yield FSharpMemberOrFunctionOrValue(cenv, P pinfo, Item.Property (pinfo.PropertyName, [pinfo])) for einfo in events do yield FSharpMemberOrFunctionOrValue(cenv, E einfo, Item.Event einfo) @@ -505,19 +505,19 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = // For F#-declared extension members, yield a value-backed member and a property info if possible let vref = mkNestedValRef entity v - yield FSharpMemberOrFunctionOrValue(cenv, V vref, Item.Value vref) + yield FSharpMemberOrFunctionOrValue(cenv, V vref, Item.Value vref) match v.MemberInfo.Value.MemberFlags.MemberKind, v.ApparentParent with | MemberKind.PropertyGet, Parent p -> let pinfo = FSProp(cenv.g, generalizedTyconRef p, Some vref, None) - yield FSharpMemberOrFunctionOrValue(cenv, P pinfo, Item.Property (pinfo.PropertyName, [pinfo])) + yield FSharpMemberOrFunctionOrValue(cenv, P pinfo, Item.Property (pinfo.PropertyName, [pinfo])) | MemberKind.PropertySet, Parent p -> let pinfo = FSProp(cenv.g, generalizedTyconRef p, None, Some vref) - yield FSharpMemberOrFunctionOrValue(cenv, P pinfo, Item.Property (pinfo.PropertyName, [pinfo])) + yield FSharpMemberOrFunctionOrValue(cenv, P pinfo, Item.Property (pinfo.PropertyName, [pinfo])) | _ -> () elif not v.IsMember then let vref = mkNestedValRef entity v - yield FSharpMemberOrFunctionOrValue(cenv, V vref, Item.Value vref) ] + yield FSharpMemberOrFunctionOrValue(cenv, V vref, Item.Value vref) ] |> makeReadOnlyCollection) member __.XmlDocSig = @@ -534,9 +534,9 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = | TProvidedTypeExtensionPoint info -> let m = x.DeclarationLocation let typeBeforeArguments = info.ProvidedType - let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments,provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) + let staticParameters = typeBeforeArguments.PApplyWithProvider((fun (typeBeforeArguments, provider) -> typeBeforeArguments.GetStaticParameters(provider)), range=m) let staticParameters = staticParameters.PApplyArray(id, "GetStaticParameters", m) - [| for p in staticParameters -> FSharpStaticParameter(cenv, p, m) |] + [| for p in staticParameters -> FSharpStaticParameter(cenv, p, m) |] #endif | _ -> [| |] |> makeReadOnlyCollection @@ -545,13 +545,13 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = if isUnresolved() then makeReadOnlyCollection[] else entity.ModuleOrNamespaceType.AllEntities |> QueueList.toList - |> List.map (fun x -> FSharpEntity(cenv, entity.NestedTyconRef x)) + |> List.map (fun x -> FSharpEntity(cenv, entity.NestedTyconRef x)) |> makeReadOnlyCollection member x.UnionCases = if isUnresolved() then makeReadOnlyCollection[] else entity.UnionCasesAsRefList - |> List.map (fun x -> FSharpUnionCase(cenv, x)) + |> List.map (fun x -> FSharpUnionCase(cenv, x)) |> makeReadOnlyCollection member x.RecordFields = x.FSharpFields @@ -559,10 +559,10 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = if isUnresolved() then makeReadOnlyCollection[] else if entity.IsILEnumTycon then - let (TILObjectReprData(_scoref,_enc,tdef)) = entity.ILTyconInfo + let (TILObjectReprData(_scoref, _enc, tdef)) = entity.ILTyconInfo let formalTypars = entity.Typars(range.Zero) let formalTypeInst = generalizeTypars formalTypars - let ty = TType_app(entity,formalTypeInst) + let ty = TType_app(entity, formalTypeInst) let formalTypeInfo = ILTypeInfo.FromType cenv.g ty tdef.Fields.AsList |> List.map (fun tdef -> let ilFieldInfo = ILFieldInfo(formalTypeInfo, tdef) @@ -571,7 +571,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = else entity.AllFieldsAsList - |> List.map (fun x -> FSharpField(cenv, mkRecdFieldRef entity x.Name)) + |> List.map (fun x -> FSharpField(cenv, mkRecdFieldRef entity x.Name)) |> makeReadOnlyCollection member x.AbbreviatedType = @@ -579,12 +579,12 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = match entity.TypeAbbrev with | None -> invalidOp "not a type abbreviation" - | Some ty -> FSharpType(cenv, ty) + | Some ty -> FSharpType(cenv, ty) member __.Attributes = if isUnresolved() then makeReadOnlyCollection[] else GetAttribInfosOfEntity cenv.g cenv.amap range0 entity - |> List.map (fun a -> FSharpAttribute(cenv, a)) + |> List.map (fun a -> FSharpAttribute(cenv, a)) |> makeReadOnlyCollection member __.AllCompilationPaths = @@ -619,7 +619,7 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = yield! walkParts parts ] res - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpEntity as otherEntity -> tyconRefEq cenv.g entity otherEntity.Entity @@ -632,10 +632,10 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = override x.ToString() = x.CompiledName and FSharpUnionCase(cenv, v: UnionCaseRef) = - inherit FSharpSymbol (cenv, + inherit FSharpSymbol (cenv, (fun () -> checkEntityIsResolved v.TyconRef - Item.UnionCase(UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange,v),false)), + Item.UnionCase(UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange, v), false)), (fun _this thisCcu2 ad -> checkForCrossProjectAccessibility (thisCcu2, ad) (cenv.thisCcu, v.UnionCase.Accessibility)) //&& AccessibilityLogic.IsUnionCaseAccessible cenv.amap range0 ad v) @@ -662,11 +662,11 @@ and FSharpUnionCase(cenv, v: UnionCaseRef) = member __.UnionCaseFields = if isUnresolved() then makeReadOnlyCollection [] else - v.UnionCase.RecdFields |> List.mapi (fun i _ -> FSharpField(cenv, FSharpFieldData.Union (v, i))) |> makeReadOnlyCollection + v.UnionCase.RecdFields |> List.mapi (fun i _ -> FSharpField(cenv, FSharpFieldData.Union (v, i))) |> makeReadOnlyCollection member __.ReturnType = checkIsResolved() - FSharpType(cenv, v.ReturnType) + FSharpType(cenv, v.ReturnType) member __.CompiledName = checkIsResolved() @@ -674,7 +674,7 @@ and FSharpUnionCase(cenv, v: UnionCaseRef) = member __.XmlDocSig = checkIsResolved() - let unionCase = UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange,v) + let unionCase = UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange, v) match SymbolHelpers.GetXmlDocSigOfUnionCaseInfo unionCase with | Some (_, docsig) -> docsig | _ -> "" @@ -692,7 +692,7 @@ and FSharpUnionCase(cenv, v: UnionCaseRef) = FSharpAccessibility(v.UnionCase.Accessibility) member private x.V = v - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpUnionCase as uc -> v === uc.V @@ -710,39 +710,39 @@ and FSharpFieldData = member x.TryRecdField = match x with | RecdOrClass v -> v.RecdField |> Choice1Of2 - | Union (v,n) -> v.FieldByIndex(n) |> Choice1Of2 - | ILField (_,f) -> f |> Choice2Of2 + | Union (v, n) -> v.FieldByIndex(n) |> Choice1Of2 + | ILField (_, f) -> f |> Choice2Of2 member x.DeclaringTyconRef = match x with | RecdOrClass v -> v.TyconRef - | Union (v,_) -> v.TyconRef - | ILField (g,f) -> tcrefOfAppTy g f.EnclosingType + | Union (v, _) -> v.TyconRef + | ILField (g, f) -> tcrefOfAppTy g f.EnclosingType and FSharpField(cenv: cenv, d: FSharpFieldData) = - inherit FSharpSymbol (cenv, + inherit FSharpSymbol (cenv, (fun () -> match d with | RecdOrClass v -> checkEntityIsResolved v.TyconRef - Item.RecdField(RecdFieldInfo(generalizeTypars v.TyconRef.TyparsNoRange,v)) - | Union (v,_) -> + Item.RecdField(RecdFieldInfo(generalizeTypars v.TyconRef.TyparsNoRange, v)) + | Union (v, _) -> // This is not correct: there is no "Item" for a named union case field - Item.UnionCase(UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange,v),false) + Item.UnionCase(UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange, v), false) | ILField (_, f) -> - Item.ILField(f)), + Item.ILField(f)), (fun this thisCcu2 ad -> checkForCrossProjectAccessibility (thisCcu2, ad) (cenv.thisCcu, (this :?> FSharpField).Accessibility.Contents)) //&& //match d with //| Recd v -> AccessibilityLogic.IsRecdFieldAccessible cenv.amap range0 ad v - //| Union (v,_) -> AccessibilityLogic.IsUnionCaseAccessible cenv.amap range0 ad v) + //| Union (v, _) -> AccessibilityLogic.IsUnionCaseAccessible cenv.amap range0 ad v) ) let isUnresolved() = entityIsUnresolved d.DeclaringTyconRef || match d with | RecdOrClass v -> v.TryRecdField.IsNone - | Union (v,_) -> v.TryUnionCase.IsNone + | Union (v, _) -> v.TryUnionCase.IsNone | ILField _ -> false let checkIsResolved() = @@ -751,12 +751,12 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = | RecdOrClass v -> if v.TryRecdField.IsNone then invalidOp (sprintf "The record field '%s' could not be found in the target type" v.FieldName) - | Union (v,_) -> + | Union (v, _) -> if v.TryUnionCase.IsNone then invalidOp (sprintf "The union case '%s' could not be found in the target type" v.CaseName) | ILField _ -> () - new (cenv, ucref, n) = FSharpField(cenv, FSharpFieldData.Union(ucref,n)) + new (cenv, ucref, n) = FSharpField(cenv, FSharpFieldData.Union(ucref, n)) new (cenv, rfref) = FSharpField(cenv, FSharpFieldData.RecdOrClass(rfref)) member __.DeclaringEntity = @@ -800,12 +800,12 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = let xmlsig = match d with | RecdOrClass v -> - let recd = RecdFieldInfo(generalizeTypars v.TyconRef.TyparsNoRange,v) + let recd = RecdFieldInfo(generalizeTypars v.TyconRef.TyparsNoRange, v) SymbolHelpers.GetXmlDocSigOfRecdFieldInfo recd - | Union (v,_) -> - let unionCase = UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange,v) + | Union (v, _) -> + let unionCase = UnionCaseInfo(generalizeTypars v.TyconRef.TyparsNoRange, v) SymbolHelpers.GetXmlDocSigOfUnionCaseInfo unionCase - | ILField (_,f) -> + | ILField (_, f) -> SymbolHelpers.GetXmlDocSigOfILFieldInfo cenv.infoReader range0 f match xmlsig with | Some (_, docsig) -> docsig @@ -824,7 +824,7 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = match d.TryRecdField with | Choice1Of2 r -> r.FormalType | Choice2Of2 f -> f.FieldType(cenv.amap, range0) - FSharpType(cenv, fty) + FSharpType(cenv, fty) member __.IsStatic = if isUnresolved() then false else @@ -853,18 +853,18 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = member __.FieldAttributes = if isUnresolved() then makeReadOnlyCollection [] else match d.TryRecdField with - | Choice1Of2 r -> r.FieldAttribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) + | Choice1Of2 r -> r.FieldAttribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) | Choice2Of2 _ -> [] |> makeReadOnlyCollection member __.PropertyAttributes = if isUnresolved() then makeReadOnlyCollection [] else match d.TryRecdField with - | Choice1Of2 r -> r.PropertyAttribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) + | Choice1Of2 r -> r.PropertyAttribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) | Choice2Of2 _ -> [] |> makeReadOnlyCollection - member __.Accessibility : FSharpAccessibility = + member __.Accessibility: FSharpAccessibility = if isUnresolved() then FSharpAccessibility(taccessPublic) else let access = match d.TryRecdField with @@ -873,13 +873,13 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = FSharpAccessibility(access) member private x.V = d - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpField as uc -> match d, uc.V with | RecdOrClass r1, RecdOrClass r2 -> recdFieldRefOrder.Compare(r1, r2) = 0 - | Union (u1,n1), Union (u2,n2) -> cenv.g.unionCaseRefEq u1 u2 && n1 = n2 + | Union (u1, n1), Union (u2, n2) -> cenv.g.unionCaseRefEq u1 u2 && n1 = n2 | _ -> false | _ -> false @@ -895,8 +895,8 @@ and [] FSharpAccessibilityRights(thisCcu: CcuThunk, ad:AccessorDomain) = and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, typ, n, valOpt: ValRef option, item) = - inherit FSharpSymbol (cenv, - (fun () -> item), + inherit FSharpSymbol (cenv, + (fun () -> item), (fun _ _ _ -> true)) member __.Name = apinfo.ActiveTags.[n] @@ -931,12 +931,12 @@ and FSharpActivePatternGroup(cenv, apinfo:PrettyNaming.ActivePatternInfo, typ, v |> Option.bind (fun vref -> match vref.ActualParent with | ParentNone -> None - | Parent p -> Some (FSharpEntity(cenv, p))) + | Parent p -> Some (FSharpEntity(cenv, p))) and FSharpGenericParameter(cenv, v:Typar) = - inherit FSharpSymbol (cenv, - (fun () -> Item.TypeVar(v.Name, v)), + inherit FSharpSymbol (cenv, + (fun () -> Item.TypeVar(v.Name, v)), (fun _ _ _ad -> true)) member __.Name = v.DisplayName member __.DeclarationLocation = v.Range @@ -949,12 +949,12 @@ and FSharpGenericParameter(cenv, v:Typar) = // INCOMPLETENESS: If the type parameter comes from .NET then the .NET metadata for the type parameter // has been lost (it is not accessible via Typar). So we can't easily report the attributes in this // case. - v.Attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection + v.Attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection member __.Constraints = v.Constraints |> List.map (fun a -> FSharpGenericParameterConstraint(cenv, a)) |> makeReadOnlyCollection member internal x.V = v - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpGenericParameter as p -> typarRefEq v p.V @@ -964,20 +964,20 @@ and FSharpGenericParameter(cenv, v:Typar) = override x.ToString() = "generic parameter " + x.Name -and FSharpDelegateSignature(cenv, info : SlotSig) = +and FSharpDelegateSignature(cenv, info: SlotSig) = member __.DelegateArguments = info.FormalParams.Head - |> List.map (fun (TSlotParam(nm, ty, _, _, _, _)) -> nm, FSharpType(cenv, ty)) + |> List.map (fun (TSlotParam(nm, ty, _, _, _, _)) -> nm, FSharpType(cenv, ty)) |> makeReadOnlyCollection member __.DelegateReturnType = match info.FormalReturnType with - | None -> FSharpType(cenv, cenv.g.unit_ty) - | Some ty -> FSharpType(cenv, ty) + | None -> FSharpType(cenv, cenv.g.unit_ty) + | Some ty -> FSharpType(cenv, ty) override x.ToString() = "" -and FSharpAbstractParameter(cenv, info : SlotParam) = +and FSharpAbstractParameter(cenv, info: SlotParam) = member __.Name = let (TSlotParam(name, _, _, _, _, _)) = info @@ -1002,7 +1002,7 @@ and FSharpAbstractParameter(cenv, info : SlotParam) = attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection -and FSharpAbstractSignature(cenv, info : SlotSig) = +and FSharpAbstractSignature(cenv, info: SlotSig) = member __.AbstractArguments = info.FormalParams @@ -1011,8 +1011,8 @@ and FSharpAbstractSignature(cenv, info : SlotSig) = member __.AbstractReturnType = match info.FormalReturnType with - | None -> FSharpType(cenv, cenv.g.unit_ty) - | Some ty -> FSharpType(cenv, ty) + | None -> FSharpType(cenv, cenv.g.unit_ty) + | Some ty -> FSharpType(cenv, ty) member __.DeclaringTypeGenericParameters = info.ClassTypars @@ -1028,35 +1028,35 @@ and FSharpAbstractSignature(cenv, info : SlotSig) = member __.DeclaringType = FSharpType(cenv, info.ImplementedType) -and FSharpGenericParameterMemberConstraint(cenv, info : TraitConstraintInfo) = - let (TTrait(tys,nm,flags,atys,rty,_)) = info +and FSharpGenericParameterMemberConstraint(cenv, info: TraitConstraintInfo) = + let (TTrait(tys, nm, flags, atys, rty, _)) = info member __.MemberSources = - tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection member __.MemberName = nm member __.MemberIsStatic = not flags.IsInstance - member __.MemberArgumentTypes = atys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + member __.MemberArgumentTypes = atys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection member x.MemberReturnType = match rty with - | None -> FSharpType(cenv, cenv.g.unit_ty) - | Some ty -> FSharpType(cenv, ty) + | None -> FSharpType(cenv, cenv.g.unit_ty) + | Some ty -> FSharpType(cenv, ty) override x.ToString() = "" and FSharpGenericParameterDelegateConstraint(cenv, tupledArgTyp: TType, rty: TType) = - member __.DelegateTupledArgumentType = FSharpType(cenv, tupledArgTyp) - member __.DelegateReturnType = FSharpType(cenv, rty) + member __.DelegateTupledArgumentType = FSharpType(cenv, tupledArgTyp) + member __.DelegateReturnType = FSharpType(cenv, rty) override x.ToString() = "" and FSharpGenericParameterDefaultsToConstraint(cenv, pri:int, ty:TType) = member __.DefaultsToPriority = pri - member __.DefaultsToTarget = FSharpType(cenv, ty) + member __.DefaultsToTarget = FSharpType(cenv, ty) override x.ToString() = "" -and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = +and FSharpGenericParameterConstraint(cenv, cx: TyparConstraint) = member __.IsCoercesToConstraint = match cx with @@ -1065,7 +1065,7 @@ and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = member __.CoercesToTarget = match cx with - | TyparConstraint.CoercesTo(ty,_) -> FSharpType(cenv, ty) + | TyparConstraint.CoercesTo(ty, _) -> FSharpType(cenv, ty) | _ -> invalidOp "not a coerces-to constraint" member __.IsDefaultsToConstraint = @@ -1075,7 +1075,7 @@ and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = member __.DefaultsToConstraintData = match cx with - | TyparConstraint.DefaultsTo(pri, ty, _) -> FSharpGenericParameterDefaultsToConstraint(cenv, pri, ty) + | TyparConstraint.DefaultsTo(pri, ty, _) -> FSharpGenericParameterDefaultsToConstraint(cenv, pri, ty) | _ -> invalidOp "not a 'defaults-to' constraint" member __.IsSupportsNullConstraint = match cx with TyparConstraint.SupportsNull _ -> true | _ -> false @@ -1087,7 +1087,7 @@ and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = member __.MemberConstraintData = match cx with - | TyparConstraint.MayResolveMember(info, _) -> FSharpGenericParameterMemberConstraint(cenv, info) + | TyparConstraint.MayResolveMember(info, _) -> FSharpGenericParameterMemberConstraint(cenv, info) | _ -> invalidOp "not a member constraint" member __.IsNonNullableValueTypeConstraint = @@ -1107,8 +1107,8 @@ and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = member __.SimpleChoices = match cx with - | TyparConstraint.SimpleChoice (tys,_) -> - tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection + | TyparConstraint.SimpleChoice (tys, _) -> + tys |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection | _ -> invalidOp "incorrect constraint kind" member __.IsRequiresDefaultConstructorConstraint = @@ -1123,7 +1123,7 @@ and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = member __.EnumConstraintTarget = match cx with - | TyparConstraint.IsEnum(ty,_) -> FSharpType(cenv, ty) + | TyparConstraint.IsEnum(ty, _) -> FSharpType(cenv, ty) | _ -> invalidOp "incorrect constraint kind" member __.IsComparisonConstraint = @@ -1148,7 +1148,7 @@ and FSharpGenericParameterConstraint(cenv, cx : TyparConstraint) = member __.DelegateConstraintData = match cx with - | TyparConstraint.IsDelegate(ty1,ty2, _) -> FSharpGenericParameterDelegateConstraint(cenv, ty1, ty2) + | TyparConstraint.IsDelegate(ty1, ty2, _) -> FSharpGenericParameterDelegateConstraint(cenv, ty1, ty2) | _ -> invalidOp "not a delegate constraint" override x.ToString() = "" @@ -1173,8 +1173,8 @@ and FSharpMemberFunctionOrValue = FSharpMemberOrFunctionOrValue and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = - inherit FSharpSymbol(cenv, - (fun () -> item), + inherit FSharpSymbol(cenv, + (fun () -> item), (fun this thisCcu2 ad -> let this = this :?> FSharpMemberOrFunctionOrValue checkForCrossProjectAccessibility (thisCcu2, ad) (cenv.thisCcu, this.Accessibility.Contents)) @@ -1182,8 +1182,8 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = //match d with //| E e -> // match e with - // | EventInfo.ILEvent (_,e) -> AccessibilityLogic.IsILEventInfoAccessible g cenv.amap range0 ad e - // | EventInfo.FSEvent (_,_,vref,_) -> AccessibilityLogic.IsValAccessible ad vref + // | EventInfo.ILEvent (_, e) -> AccessibilityLogic.IsILEventInfoAccessible g cenv.amap range0 ad e + // | EventInfo.FSEvent (_, _, vref, _) -> AccessibilityLogic.IsValAccessible ad vref // | _ -> true //| M m -> AccessibilityLogic.IsMethInfoAccessible cenv.amap range0 ad m //| P p -> AccessibilityLogic.IsPropInfoAccessible g cenv.amap range0 ad p @@ -1250,13 +1250,13 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member __.LogicalEnclosingEntity = checkIsResolved() match d with - | E m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) - | P m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) - | M m | C m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) + | E m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) + | P m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) + | M m | C m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) | V v -> match v.ApparentParent with | ParentNone -> invalidOp "the value or member doesn't have a logical parent" - | Parent p -> FSharpEntity(cenv, p) + | Parent p -> FSharpEntity(cenv, p) member x.GenericParameters = checkIsResolved() @@ -1266,20 +1266,20 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | P _ -> [] | M m | C m -> m.FormalMethodTypars | V v -> v.Typars - tps |> List.map (fun tp -> FSharpGenericParameter(cenv, tp)) |> makeReadOnlyCollection + tps |> List.map (fun tp -> FSharpGenericParameter(cenv, tp)) |> makeReadOnlyCollection member x.FullType = checkIsResolved() let ty = match d with - | E e -> e.GetDelegateType(cenv.amap,range0) - | P p -> p.GetPropertyType(cenv.amap,range0) + | E e -> e.GetDelegateType(cenv.amap, range0) + | P p -> p.GetPropertyType(cenv.amap, range0) | M m | C m -> - let rty = m.GetFSharpReturnTy(cenv.amap,range0,m.FormalMethodInst) - let argtysl = m.GetParamTypes(cenv.amap,range0,m.FormalMethodInst) + let rty = m.GetFSharpReturnTy(cenv.amap, range0, m.FormalMethodInst) + let argtysl = m.GetParamTypes(cenv.amap, range0, m.FormalMethodInst) mkIteratedFunTy (List.map (mkRefTupledTy cenv.g) argtysl) rty | V v -> v.TauType - FSharpType(cenv, ty) + FSharpType(cenv, ty) member __.HasGetterMethod = if isUnresolved() then false @@ -1312,14 +1312,14 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member __.EventDelegateType = checkIsResolved() match d with - | E e -> FSharpType(cenv, e.GetDelegateType(cenv.amap,range0)) + | 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" member __.EventIsStandard = checkIsResolved() match d with | E e -> - let dty = e.GetDelegateType(cenv.amap,range0) + let dty = e.GetDelegateType(cenv.amap, range0) TryDestStandardDelegateTyp cenv.infoReader range0 AccessibleFromSomewhere dty |> Option.isSome | P _ | M _ | C _ | V _ -> invalidOp "the value or member is not an event" @@ -1342,13 +1342,13 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member __.EnclosingEntity = checkIsResolved() match d with - | E m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) |> Some - | P m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) |> Some - | M m | C m -> FSharpEntity(cenv, m.DeclaringEntityRef) |> Some + | E m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) |> Some + | P m -> FSharpEntity(cenv, tcrefOfAppTy cenv.g m.EnclosingType) |> Some + | M m | C m -> FSharpEntity(cenv, m.DeclaringEntityRef) |> Some | V v -> match v.ActualParent with | ParentNone -> None - | Parent p -> FSharpEntity(cenv, p) |> Some + | Parent p -> FSharpEntity(cenv, p) |> Some member __.IsCompilerGenerated = if isUnresolved() then false else @@ -1407,10 +1407,10 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = member x.EventForFSharpProperty = match d with | P p when p.IsFSharpEventProperty -> - let minfos1 = GetImmediateIntrinsicMethInfosOfType (Some("add_"+p.PropertyName),AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 p.EnclosingType - let minfos2 = GetImmediateIntrinsicMethInfosOfType (Some("remove_"+p.PropertyName),AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 p.EnclosingType - match minfos1,minfos2 with - | [addMeth],[removeMeth] -> + let minfos1 = GetImmediateIntrinsicMethInfosOfType (Some("add_"+p.PropertyName), AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 p.EnclosingType + let minfos2 = GetImmediateIntrinsicMethInfosOfType (Some("remove_"+p.PropertyName), AccessibleFromSomeFSharpCode) cenv.g cenv.amap range0 p.EnclosingType + match minfos1, minfos2 with + | [addMeth], [removeMeth] -> match addMeth.ArbitraryValRef, removeMeth.ArbitraryValRef with | Some addVal, Some removeVal -> Some (mkEventSym (FSEvent(cenv.g, p, addVal, removeVal))) | _ -> None @@ -1612,23 +1612,23 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | P p -> - [ [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,_callerInfoInfo,nmOpt,_reflArgInfo,pty)) in p.GetParamDatas(cenv.amap,range0) do + [ [ for (ParamData(isParamArrayArg, isOutArg, optArgInfo, _callerInfoInfo, nmOpt, _reflArgInfo, pty)) in p.GetParamDatas(cenv.amap, range0) do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters - let argInfo : ArgReprInfo = { Name=nmOpt; Attribs= [] } + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs= [] } yield FSharpParameter(cenv, pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ] |> makeReadOnlyCollection ] |> makeReadOnlyCollection | E _ -> [] |> makeReadOnlyCollection | M m | C m -> - [ for argtys in m.GetParamDatas(cenv.amap,range0,m.FormalMethodInst) do + [ for argtys in m.GetParamDatas(cenv.amap, range0, m.FormalMethodInst) do yield - [ for (ParamData(isParamArrayArg,isOutArg,optArgInfo,_callerInfoInfo,nmOpt,_reflArgInfo,pty)) in argtys do + [ for (ParamData(isParamArrayArg, isOutArg, optArgInfo, _callerInfoInfo, nmOpt, _reflArgInfo, pty)) in argtys do // INCOMPLETENESS: Attribs is empty here, so we can't look at attributes for // either .NET or F# parameters - let argInfo : ArgReprInfo = { Name=nmOpt; Attribs= [] } - yield FSharpParameter(cenv, pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ] + let argInfo: ArgReprInfo = { Name=nmOpt; Attribs= [] } + yield FSharpParameter(cenv, pty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, optArgInfo.IsOptional) ] |> makeReadOnlyCollection ] |> makeReadOnlyCollection @@ -1645,13 +1645,13 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = else [typ] yield allArguments - |> List.map (fun arg -> FSharpParameter(cenv, arg, { Name=None; Attribs= [] }, x.DeclarationLocationOpt, false, false, false)) + |> List.map (fun arg -> FSharpParameter(cenv, arg, { Name=None; Attribs= [] }, x.DeclarationLocationOpt, false, false, false)) |> makeReadOnlyCollection ] |> makeReadOnlyCollection else makeReadOnlyCollection [] - | Some (ValReprInfo(_typars,curriedArgInfos,_retInfo)) -> + | Some (ValReprInfo(_typars, curriedArgInfos, _retInfo)) -> let tau = v.TauType - let argtysl,_ = GetTopTauTypeInFSharpForm cenv.g curriedArgInfos tau range0 + let argtysl, _ = GetTopTauTypeInFSharpForm cenv.g curriedArgInfos tau range0 let argtysl = if v.IsInstanceMember then argtysl.Tail else argtysl [ for argtys in argtysl do yield @@ -1659,7 +1659,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = let isParamArrayArg = HasFSharpAttribute cenv.g cenv.g.attrib_ParamArrayAttribute argInfo.Attribs let isOutArg = HasFSharpAttribute cenv.g cenv.g.attrib_OutAttribute argInfo.Attribs && isByrefTy cenv.g argty let isOptionalArg = HasFSharpAttribute cenv.g cenv.g.attrib_OptionalArgumentAttribute argInfo.Attribs - yield FSharpParameter(cenv, argty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, isOptionalArg) ] + yield FSharpParameter(cenv, argty, argInfo, x.DeclarationLocationOpt, isParamArrayArg, isOutArg, isOptionalArg) ] |> makeReadOnlyCollection ] |> makeReadOnlyCollection @@ -1668,36 +1668,36 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = match d with | E e -> // INCOMPLETENESS: Attribs is empty here, so we can't look at return attributes for .NET or F# methods - let retInfo : ArgReprInfo = { Name=None; Attribs= [] } + let retInfo: ArgReprInfo = { Name=None; Attribs= [] } let rty = try PropTypOfEventInfo cenv.infoReader range0 AccessibleFromSomewhere e with _ -> // For non-standard events, just use the delegate type as the ReturnParameter type - e.GetDelegateType(cenv.amap,range0) + e.GetDelegateType(cenv.amap, range0) - FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) + FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) | P p -> // INCOMPLETENESS: Attribs is empty here, so we can't look at return attributes for .NET or F# methods - let retInfo : ArgReprInfo = { Name=None; Attribs= [] } - let rty = p.GetPropertyType(cenv.amap,range0) - FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) + let retInfo: ArgReprInfo = { Name=None; Attribs= [] } + let rty = p.GetPropertyType(cenv.amap, range0) + FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) | M m | C m -> // INCOMPLETENESS: Attribs is empty here, so we can't look at return attributes for .NET or F# methods - let retInfo : ArgReprInfo = { Name=None; Attribs= [] } - let rty = m.GetFSharpReturnTy(cenv.amap,range0,m.FormalMethodInst) - FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) + let retInfo: ArgReprInfo = { Name=None; Attribs= [] } + let rty = m.GetFSharpReturnTy(cenv.amap, range0, m.FormalMethodInst) + FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) | V v -> match v.ValReprInfo with | None -> let _, tau = v.TypeScheme let _argtysl, rty = stripFunTy cenv.g tau - let empty : ArgReprInfo = { Name=None; Attribs= [] } - FSharpParameter(cenv, rty, empty, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) - | Some (ValReprInfo(_typars,argInfos,retInfo)) -> + let empty: ArgReprInfo = { Name=None; Attribs= [] } + FSharpParameter(cenv, rty, empty, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) + | Some (ValReprInfo(_typars, argInfos, retInfo)) -> let tau = v.TauType - let _c,rty = GetTopTauTypeInFSharpForm cenv.g argInfos tau range0 - FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) + let _c, rty = GetTopTauTypeInFSharpForm cenv.g argInfos tau range0 + FSharpParameter(cenv, rty, retInfo, x.DeclarationLocationOpt, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) member __.Attributes = @@ -1705,13 +1705,13 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = let m = range0 match d with | E einfo -> - GetAttribInfosOfEvent cenv.amap m einfo |> List.map (fun a -> FSharpAttribute(cenv, a)) + GetAttribInfosOfEvent cenv.amap m einfo |> List.map (fun a -> FSharpAttribute(cenv, a)) | P pinfo -> - GetAttribInfosOfProp cenv.amap m pinfo |> List.map (fun a -> FSharpAttribute(cenv, a)) + GetAttribInfosOfProp cenv.amap m pinfo |> List.map (fun a -> FSharpAttribute(cenv, a)) | M minfo | C minfo -> - GetAttribInfosOfMethod cenv.amap m minfo |> List.map (fun a -> FSharpAttribute(cenv, a)) + GetAttribInfosOfMethod cenv.amap m minfo |> List.map (fun a -> FSharpAttribute(cenv, a)) | V v -> - v.Attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) + v.Attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection /// Is this "base" in "base.M(...)" @@ -1743,7 +1743,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | V v -> getLiteralValue v.LiteralValue /// How visible is this? - member this.Accessibility : FSharpAccessibility = + member this.Accessibility: FSharpAccessibility = if isUnresolved() then FSharpAccessibility(taccessPublic) else match fsharpInfo() with | Some v -> FSharpAccessibility(v.Accessibility) @@ -1755,7 +1755,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = // For IL events, we get an approximate accessiblity that at least reports "internal" as "internal" and "private" as "private" let access = match e with - | ILEvent (_,x) -> + | ILEvent (_, x) -> let ilAccess = AccessibilityLogic.GetILAccessOfILEventInfo x getApproxFSharpAccessibilityOfMember this.EnclosingEntity.Value.Entity ilAccess | _ -> taccessPublic @@ -1766,7 +1766,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = // For IL properties, we get an approximate accessiblity that at least reports "internal" as "internal" and "private" as "private" let access = match p with - | ILProp (_,x) -> + | ILProp (_, x) -> let ilAccess = AccessibilityLogic.GetILAccessOfILPropInfo x getApproxFSharpAccessibilityOfMember this.EnclosingEntity.Value.Entity ilAccess | _ -> taccessPublic @@ -1778,10 +1778,10 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = // For IL methods, we get an approximate accessiblity that at least reports "internal" as "internal" and "private" as "private" let access = match m with - | ILMeth (_,x,_) -> getApproxFSharpAccessibilityOfMember x.DeclaringTyconRef x.RawMetadata.Access + | ILMeth (_, x, _) -> getApproxFSharpAccessibilityOfMember x.DeclaringTyconRef x.RawMetadata.Access | _ -> taccessPublic - FSharpAccessibility(access,isProtected=m.IsProtectedAccessiblity) + FSharpAccessibility(access, isProtected=m.IsProtectedAccessiblity) | V v -> FSharpAccessibility(v.Accessibility) @@ -1797,7 +1797,7 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | V valRef -> IlxGen.IsValCompiledAsMethod cenv.g valRef.Deref | _ -> false - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpMemberOrFunctionOrValue as other -> @@ -1822,16 +1822,16 @@ and FSharpType(cenv, typ:TType) = let isUnresolved() = ErrorLogger.protectAssemblyExploration true <| fun () -> match stripTyparEqns typ with - | TType_app (tcref,_) -> FSharpEntity(cenv, tcref).IsUnresolved - | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref).IsUnresolved - | TType_measure (Measure.Prod _) -> FSharpEntity(cenv, cenv.g.measureproduct_tcr).IsUnresolved - | TType_measure Measure.One -> FSharpEntity(cenv, cenv.g.measureone_tcr).IsUnresolved - | TType_measure (Measure.Inv _) -> FSharpEntity(cenv, cenv.g.measureinverse_tcr).IsUnresolved + | TType_app (tcref, _) -> FSharpEntity(cenv, tcref).IsUnresolved + | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref).IsUnresolved + | TType_measure (Measure.Prod _) -> FSharpEntity(cenv, cenv.g.measureproduct_tcr).IsUnresolved + | TType_measure Measure.One -> FSharpEntity(cenv, cenv.g.measureone_tcr).IsUnresolved + | TType_measure (Measure.Inv _) -> FSharpEntity(cenv, cenv.g.measureinverse_tcr).IsUnresolved | _ -> false let isResolved() = not (isUnresolved()) - new (g, thisCcu, tcImports, typ) = FSharpType(cenv(g,thisCcu,tcImports), typ) + new (g, thisCcu, tcImports, typ) = FSharpType(cenv(g, thisCcu, tcImports), typ) member __.IsUnresolved = isUnresolved() @@ -1853,7 +1853,7 @@ and FSharpType(cenv, typ:TType) = isResolved() && protect <| fun () -> match stripTyparEqns typ with - | TType_tuple (tupInfo,_) -> evalTupInfoIsStruct tupInfo + | TType_tuple (tupInfo, _) -> evalTupInfoIsStruct tupInfo | _ -> false member x.IsNamedType = x.HasTypeDefinition @@ -1862,23 +1862,23 @@ and FSharpType(cenv, typ:TType) = member __.TypeDefinition = protect <| fun () -> match stripTyparEqns typ with - | TType_app (tcref,_) -> FSharpEntity(cenv, tcref) - | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref) - | TType_measure (Measure.Prod _) -> FSharpEntity(cenv, cenv.g.measureproduct_tcr) - | TType_measure Measure.One -> FSharpEntity(cenv, cenv.g.measureone_tcr) - | TType_measure (Measure.Inv _) -> FSharpEntity(cenv, cenv.g.measureinverse_tcr) + | TType_app (tcref, _) -> FSharpEntity(cenv, tcref) + | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref) + | TType_measure (Measure.Prod _) -> FSharpEntity(cenv, cenv.g.measureproduct_tcr) + | TType_measure Measure.One -> FSharpEntity(cenv, cenv.g.measureone_tcr) + | TType_measure (Measure.Inv _) -> FSharpEntity(cenv, cenv.g.measureinverse_tcr) | _ -> invalidOp "not a named type" member __.GenericArguments = protect <| fun () -> match stripTyparEqns typ with - | TType_app (_,tyargs) - | TType_tuple (_,tyargs) -> (tyargs |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection) - | TType_fun(d,r) -> [| FSharpType(cenv, d); FSharpType(cenv, r) |] |> makeReadOnlyCollection + | TType_app (_, tyargs) + | TType_tuple (_, tyargs) -> (tyargs |> List.map (fun ty -> FSharpType(cenv, ty)) |> makeReadOnlyCollection) + | TType_fun(d, r) -> [| FSharpType(cenv, d); FSharpType(cenv, r) |] |> makeReadOnlyCollection | TType_measure (Measure.Con _) -> [| |] |> makeReadOnlyCollection - | TType_measure (Measure.Prod (t1,t2)) -> [| FSharpType(cenv, TType_measure t1); FSharpType(cenv, TType_measure t2) |] |> makeReadOnlyCollection + | TType_measure (Measure.Prod (t1, t2)) -> [| FSharpType(cenv, TType_measure t1); FSharpType(cenv, TType_measure t2) |] |> makeReadOnlyCollection | TType_measure Measure.One -> [| |] |> makeReadOnlyCollection - | TType_measure (Measure.Inv t1) -> [| FSharpType(cenv, TType_measure t1) |] |> makeReadOnlyCollection + | TType_measure (Measure.Inv t1) -> [| FSharpType(cenv, TType_measure t1) |] |> makeReadOnlyCollection | _ -> invalidOp "not a named type" (* @@ -1887,14 +1887,14 @@ and FSharpType(cenv, typ:TType) = try PrettyNaming.demangleProvidedTypeName typeLogicalName with PrettyNaming.InvalidMangledStaticArg piece -> - error(Error(FSComp.SR.etProvidedTypeReferenceInvalidText(piece),range0)) + error(Error(FSComp.SR.etProvidedTypeReferenceInvalidText(piece), range0)) *) member typ.IsAbbreviation = isResolved() && typ.HasTypeDefinition && typ.TypeDefinition.IsFSharpAbbreviation member __.AbbreviatedType = - protect <| fun () -> FSharpType(cenv, stripTyEqns cenv.g typ) + protect <| fun () -> FSharpType(cenv, stripTyEqns cenv.g typ) member __.IsFunctionType = isResolved() && @@ -1915,7 +1915,7 @@ and FSharpType(cenv, typ:TType) = match stripTyparEqns typ with | TType_var tp | TType_measure (Measure.Var tp) -> - FSharpGenericParameter (cenv, tp) + FSharpGenericParameter (cenv, tp) | _ -> invalidOp "not a generic parameter type" member x.AllInterfaces = @@ -1929,7 +1929,7 @@ and FSharpType(cenv, typ:TType) = |> Option.map (fun ty -> FSharpType(cenv, ty)) member x.Instantiate(instantiation:(FSharpGenericParameter * FSharpType) list) = - let typI = instType (instantiation |> List.map (fun (tyv,typ) -> tyv.V, typ.V)) typ + let typI = instType (instantiation |> List.map (fun (tyv, typ) -> tyv.V, typ.V)) typ FSharpType(cenv, typI) member private x.V = typ @@ -1939,7 +1939,7 @@ and FSharpType(cenv, typ:TType) = FSharpType(typ.cenv, t) // Note: This equivalence relation is modulo type abbreviations - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpType as t -> typeEquiv cenv.g typ t.V @@ -1952,10 +1952,10 @@ and FSharpType(cenv, typ:TType) = match typ with | TType_forall _ -> 10000 | TType_var tp -> 10100 + int32 tp.Stamp - | TType_app (tc1,b1) -> 10200 + int32 tc1.Stamp + List.sumBy hashType b1 + | TType_app (tc1, b1) -> 10200 + int32 tc1.Stamp + List.sumBy hashType b1 | TType_ucase _ -> 10300 // shouldn't occur in symbols - | TType_tuple (_,l1) -> 10400 + List.sumBy hashType l1 - | TType_fun (dty,rty) -> 10500 + hashType dty + hashType rty + | TType_tuple (_, l1) -> 10400 + List.sumBy hashType l1 + | TType_fun (dty, rty) -> 10500 + hashType dty + hashType rty | TType_measure _ -> 10600 hashType typ @@ -2009,7 +2009,7 @@ and FSharpType(cenv, typ:TType) = static member Prettify(parameters: IList>, returnParameter: FSharpParameter) = let xs = parameters |> List.ofSeq |> List.map List.ofSeq let cenv = returnParameter.cenv - let prettyTyps, prettyRetTy = xs |> List.mapSquared (fun p -> p.V) |> (fun tys -> PrettyTypes.PrettifyCurriedSigTypes cenv.g (tys,returnParameter.V) )|> fst + let prettyTyps, prettyRetTy = xs |> List.mapSquared (fun p -> p.V) |> (fun tys -> PrettyTypes.PrettifyCurriedSigTypes cenv.g (tys, returnParameter.V) )|> fst let ps = (xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection ps, returnParameter.AdjustType(prettyRetTy) @@ -2022,7 +2022,7 @@ and FSharpAttribute(cenv: cenv, attrib: AttribInfo) = | _ -> arg member __.AttributeType = - FSharpEntity(cenv, attrib.TyconRef) + FSharpEntity(cenv, attrib.TyconRef) member __.IsUnresolved = entityIsUnresolved(attrib.TyconRef) @@ -2048,13 +2048,13 @@ and FSharpAttribute(cenv: cenv, attrib: AttribInfo) = override __.ToString() = if entityIsUnresolved attrib.TyconRef then "attribute ???" else "attribute " + attrib.TyconRef.CompiledName + "(...)" #if EXTENSIONTYPING -and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterInfo >, m) = - inherit FSharpSymbol(cenv, +and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterInfo >, m) = + inherit FSharpSymbol(cenv, (fun () -> protect <| fun () -> let spKind = Import.ImportProvidedType cenv.amap m (sp.PApply((fun x -> x.ParameterType), m)) let nm = sp.PUntaint((fun p -> p.Name), m) - Item.ArgName((mkSynId m nm, spKind, None))), + Item.ArgName((mkSynId m nm, spKind, None))), (fun _ _ _ -> true)) member __.Name = @@ -2066,7 +2066,7 @@ and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterI member __.Kind = protect <| fun () -> let typ = Import.ImportProvidedType cenv.amap m (sp.PApply((fun x -> x.ParameterType), m)) - FSharpType(cenv, typ) + FSharpType(cenv, typ) member __.IsOptional = protect <| fun () -> sp.PUntaint((fun x -> x.IsOptional), m) @@ -2077,7 +2077,7 @@ and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterI member __.DefaultValue = protect <| fun () -> sp.PUntaint((fun x -> x.RawDefaultValue), m) - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpStaticParameter as p -> x.Name = p.Name && x.DeclarationLocation = p.DeclarationLocation @@ -2088,29 +2088,29 @@ and FSharpStaticParameter(cenv, sp: Tainted< ExtensionTyping.ProvidedParameterI "static parameter " + x.Name #endif and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayArg, isOutArg, isOptionalArg) = - inherit FSharpSymbol(cenv, + inherit FSharpSymbol(cenv, (fun () -> let m = match mOpt with Some m -> m | None -> range0 - Item.ArgName((match topArgInfo.Name with None -> mkSynId m "" | Some v -> v), typ, None)), + Item.ArgName((match topArgInfo.Name with None -> mkSynId m "" | Some v -> v), typ, None)), (fun _ _ _ -> true)) let attribs = topArgInfo.Attribs let idOpt = topArgInfo.Name let m = match mOpt with Some m -> m | None -> range0 member __.Name = match idOpt with None -> None | Some v -> Some v.idText - member __.cenv : cenv = cenv + member __.cenv: cenv = cenv member __.AdjustType(t) = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isOutArg, isOptionalArg) - member __.Type : FSharpType = FSharpType(cenv, typ) + member __.Type: FSharpType = FSharpType(cenv, typ) member __.V = typ member __.DeclarationLocation = match idOpt with None -> m | Some v -> v.idRange member __.Attributes = - attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection + attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection member __.IsParamArrayArg = isParamArrayArg member __.IsOutArg = isOutArg member __.IsOptionalArg = isOptionalArg member private x.ValReprInfo = topArgInfo - override x.Equals(other : obj) = + override x.Equals(other: obj) = box x === other || match other with | :? FSharpParameter as p -> x.Name = p.Name && x.DeclarationLocation = p.DeclarationLocation @@ -2130,13 +2130,13 @@ and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs op member __.Entities = - let rec loop (rmtyp : ModuleOrNamespaceType) = + let rec loop (rmtyp: ModuleOrNamespaceType) = [| for entity in rmtyp.AllEntities do if entity.IsNamespace then yield! loop entity.ModuleOrNamespaceType else let entityRef = rescopeEntity optViewedCcu entity - yield FSharpEntity(cenv, entityRef) |] + yield FSharpEntity(cenv, entityRef) |] loop mtyp |> makeReadOnlyCollection @@ -2145,11 +2145,11 @@ and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs op | None -> makeReadOnlyCollection [] | Some tA -> tA.assemblyAttrs - |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection + |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection member __.FindEntityByPath path = let inline findNested name = function - | Some (e : Entity) when e.IsModuleOrNamespace -> + | Some (e: Entity) when e.IsModuleOrNamespace -> e.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind name | _ -> None @@ -2180,60 +2180,60 @@ and FSharpAssembly internal (cenv, ccu: CcuThunk) = type FSharpSymbol with // TODO: there are several cases where we may need to report more interesting // symbol information below. By default we return a vanilla symbol. - static member Create(g, thisCcu, tcImports, item) : FSharpSymbol = - FSharpSymbol.Create (cenv(g,thisCcu,tcImports), item) + static member Create(g, thisCcu, tcImports, item): FSharpSymbol = + FSharpSymbol.Create (cenv(g, thisCcu, tcImports), item) - static member Create(cenv, item) : FSharpSymbol = - let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) + static member Create(cenv, item): FSharpSymbol = + let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) match item with - | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ - | Item.UnionCase (uinfo,_) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ - | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ - | Item.RecdField rfinfo -> FSharpField(cenv, RecdOrClass rfinfo.RecdFieldRef) :> _ + | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ + | Item.UnionCase (uinfo, _) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ + | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ + | Item.RecdField rfinfo -> FSharpField(cenv, RecdOrClass rfinfo.RecdFieldRef) :> _ - | Item.ILField finfo -> FSharpField(cenv, ILField (cenv.g, finfo)) :> _ + | Item.ILField finfo -> FSharpField(cenv, ILField (cenv.g, finfo)) :> _ | Item.Event einfo -> - FSharpMemberOrFunctionOrValue(cenv, E einfo, item) :> _ + FSharpMemberOrFunctionOrValue(cenv, E einfo, item) :> _ - | Item.Property(_,pinfo :: _) -> - FSharpMemberOrFunctionOrValue(cenv, P pinfo, item) :> _ + | Item.Property(_, pinfo :: _) -> + FSharpMemberOrFunctionOrValue(cenv, P pinfo, item) :> _ - | Item.MethodGroup(_,minfo :: _, _) -> - FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + | Item.MethodGroup(_, minfo :: _, _) -> + FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ - | Item.CtorGroup(_,cinfo :: _) -> - FSharpMemberOrFunctionOrValue(cenv, C cinfo, item) :> _ + | Item.CtorGroup(_, cinfo :: _) -> + FSharpMemberOrFunctionOrValue(cenv, C cinfo, item) :> _ | Item.DelegateCtor (AbbrevOrAppTy tcref) -> - FSharpEntity(cenv, tcref) :>_ + FSharpEntity(cenv, tcref) :>_ | Item.UnqualifiedType(tcref :: _) - | Item.Types(_,AbbrevOrAppTy tcref :: _) -> - FSharpEntity(cenv, tcref) :>_ + | Item.Types(_, AbbrevOrAppTy tcref :: _) -> + FSharpEntity(cenv, tcref) :>_ | Item.ModuleOrNamespaces(modref :: _) -> - FSharpEntity(cenv, modref) :> _ + FSharpEntity(cenv, modref) :> _ - | Item.SetterArg (_id, item) -> FSharpSymbol.Create(cenv, item) + | Item.SetterArg (_id, item) -> FSharpSymbol.Create(cenv, item) - | Item.CustomOperation (_customOpName,_, Some minfo) -> - FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + | Item.CustomOperation (_customOpName, _, Some minfo) -> + FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ - | Item.CustomBuilder (_,vref) -> - FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ + | Item.CustomBuilder (_, vref) -> + FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ | Item.TypeVar (_, tp) -> - FSharpGenericParameter(cenv, tp) :> _ + FSharpGenericParameter(cenv, tp) :> _ | Item.ActivePatternCase apref -> - FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ + FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ | Item.ActivePatternResult (apinfo, typ, n, _) -> - FSharpActivePatternCase(cenv, apinfo, typ, n, None, item) :> _ + FSharpActivePatternCase(cenv, apinfo, typ, n, None, item) :> _ - | Item.ArgName(id,ty,_) -> - FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) :> _ + | Item.ArgName(id, ty, _) -> + FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) :> _ // TODO: the following don't currently return any interesting subtype | Item.ImplicitOp _ @@ -2244,9 +2244,9 @@ type FSharpSymbol with | Item.CustomOperation (_, _, None) | Item.UnqualifiedType [] | Item.ModuleOrNamespaces [] - | Item.Property (_,[]) - | Item.MethodGroup (_,[],_) - | Item.CtorGroup (_,[]) + | Item.Property (_, []) + | Item.MethodGroup (_, [], _) + | Item.CtorGroup (_, []) // These cases cover misc. corned cases (non-symbol types) | Item.Types _ | Item.DelegateCtor _ -> dflt()