Skip to content
Fetching contributors…
Cannot retrieve contributors at this time
executable file 5248 lines (4715 sloc) 277 KB
//----------------------------------------------------------------------------
//
// Copyright (c) 2002-2012 Microsoft Corporation.
//
// This source code is subject to terms and conditions of the Apache License, Version 2.0. A
// copy of the license can be found in the License.html file at the root of this distribution.
// By using this source code in any fashion, you are agreeing to be bound
// by the terms of the Apache License, Version 2.0.
//
// You must not remove this notice, or any other, from this software.
//----------------------------------------------------------------------------
/// Loading initial context, reporting errors etc.
module internal Microsoft.FSharp.Compiler.Build
open System
open System.Text
open System.IO
open System.Collections.Generic
open Internal.Utilities
open Internal.Utilities.Text
open Microsoft.FSharp.Compiler.AbstractIL
open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.AbstractIL.Internal
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX
open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
open Microsoft.FSharp.Compiler.Pickle
open Microsoft.FSharp.Compiler.Range
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.TypeChecker
open Microsoft.FSharp.Compiler.SR
open Microsoft.FSharp.Compiler.DiagnosticMessage
module Tc = Microsoft.FSharp.Compiler.TypeChecker
module SR = Microsoft.FSharp.Compiler.SR
open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.Range
open Microsoft.FSharp.Compiler.Ast
open Microsoft.FSharp.Compiler.ErrorLogger
open Microsoft.FSharp.Compiler.Tast
open Microsoft.FSharp.Compiler.Tastops
open Microsoft.FSharp.Compiler.Tastops.DebugPrint
open Microsoft.FSharp.Compiler.Env
open Microsoft.FSharp.Compiler.Lexhelp
open Microsoft.FSharp.Compiler.Lib
open Microsoft.FSharp.Compiler.Infos
open Microsoft.FSharp.Compiler.ConstraintSolver
open Microsoft.FSharp.Compiler.MSBuildResolver
open Microsoft.FSharp.Compiler.Typrelns
open Microsoft.FSharp.Compiler.Nameres
open Microsoft.FSharp.Compiler.PrettyNaming
open Internal.Utilities.FileSystem
open Internal.Utilities.Collections
open Internal.Utilities.Filename
open Microsoft.FSharp.Compiler.Import
#if EXTENSIONTYPING
open Microsoft.FSharp.Compiler.ExtensionTyping
open Microsoft.FSharp.Core.CompilerServices
#endif
open System.Runtime.CompilerServices
#if DEBUG
#if COMPILED_AS_LANGUAGE_SERVICE_DLL
module internal CompilerService =
#else
module internal FullCompiler =
#endif
let showAssertForUnexpectedException = ref true
#if COMPILED_AS_LANGUAGE_SERVICE_DLL
open CompilerService
#else
open FullCompiler
#endif
#endif
//----------------------------------------------------------------------------
// Some Globals
//--------------------------------------------------------------------------
let sigSuffixes = [".mli";".fsi"]
let mlCompatSuffixes = [".mli";".ml"]
let implSuffixes = [".ml";".fs";".fsscript";".fsx"]
let resSuffixes = [".resx"]
let scriptSuffixes = [".fsscript";".fsx"]
let doNotRequireNamespaceOrModuleSuffixes = [".mli";".ml"] @ scriptSuffixes
let lightSyntaxDefaultExtensions : string list = [ ".fs";".fsscript";".fsx";".fsi" ]
//----------------------------------------------------------------------------
// ERROR REPORTING
//--------------------------------------------------------------------------
exception HashIncludeNotAllowedInNonScript of range
exception HashReferenceNotAllowedInNonScript of range
exception HashDirectiveNotAllowedInNonScript of range
exception FileNameNotResolved of (*filename*) string * (*description of searched locations*) string * range
exception AssemblyNotResolved of (*originalName*) string * range
exception LoadedSourceNotFoundIgnoring of (*filename*) string * range
exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range
exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range
exception DeprecatedCommandLineOptionFull of string * range
exception DeprecatedCommandLineOptionForHtmlDoc of string * range
exception DeprecatedCommandLineOptionSuggestAlternative of string * string * range
exception DeprecatedCommandLineOptionNoDescription of string * range
exception InternalCommandLineOption of string * range
exception HashLoadedSourceHasIssues of (*warnings*) exn list * (*errors*) exn list * range
exception HashLoadedScriptConsideredSource of range
exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileName option*) string option
let RangeOfError(err:PhasedError) =
let rec RangeFromException = function
| ErrorFromAddingConstraint(_,err2,_) -> RangeFromException err2
#if EXTENSIONTYPING
| ExtensionTyping.ProvidedTypeResolutionNoRange(e) -> RangeFromException e
| ExtensionTyping.ProvidedTypeResolution(m,_)
#endif
| 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)
| UpcastUnnecessary(m)
| QuotationTranslator.IgnoringPartOfQuotedTermWarning (_,m)
| TypeTestUnnecessary(m)
| RuntimeCoercionSourceSealed(_,_,m)
| OverrideDoesntOverride(_,_,_,_,_,m)
| UnionPatternsBindDifferentNames m
| UnionCaseWrongArguments (_,_,_,m)
| TypeIsImplicitlyAbstract m
| RequiredButNotSpecified (_,_,_,_,m)
| FunctionValueUnexpected (_,_,m)
| UnitTypeExpected (_,_,_,m )
| UseOfAddressOfOperator m
| DeprecatedThreadStaticBindingWarning(m)
| NonUniqueInferredAbstractSlot (_,_,_,_,_,m)
| DefensiveCopyWarning (_,m)
| LetRecCheckedAtRuntime m
| UpperCaseIdentifierInPattern m
| NotUpperCaseConstructor m
| RecursiveUseCheckedAtRuntime (_,_,m)
| LetRecEvaluatedOutOfOrder (_,_,_,m)
| Error (_,m)
| NumberedError (_,m)
| SyntaxError (_,m)
| InternalError (_,m)
| FullAbstraction(_,m)
| InterfaceNotRevealed(_,_,m)
| WrappedError (_,m)
| Patcompile.MatchIncomplete (_,_,m)
| Patcompile.RuleNeverMatched 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)
| PossibleUnverifiableCode m
| UserCompilerMessage (_,_,m)
| Deprecated(_,m)
| LibraryUseOnly(m)
| FieldsFromDifferentTypes (_,_,_,m)
| IndeterminateType(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
| VarBoundTwice(id)
| UndefinedName(_,_,id,_) ->
Some id.idRange
| Duplicate(_,_,m)
| NameClash(_,_,_,m,_,_,_)
| UnresolvedOverloading(_,_,_,m)
| UnresolvedConversionOperator (_,_,_,m)
| PossibleOverload(_,_,_, m)
//| PossibleBestOverload(_,_,m)
| VirtualAugmentationOnNullValuedType(m)
| NonVirtualAugmentationOnNullValuedType(m)
| NonRigidTypar(_,_,_,_,_,m)
| ConstraintSolverTupleDiffLengths(_,_,_,m,_)
| ConstraintSolverInfiniteTypes(_,_,_,m,_)
| ConstraintSolverMissingConstraint(_,_,_,m,_)
| ConstraintSolverTypesNotInEqualityRelation(_,_,_,m,_)
| ConstraintSolverError(_,m,_)
| ConstraintSolverTypesNotInSubsumptionRelation(_,_,_,m,_)
| ConstraintSolverRelatedInformation(_,m,_)
| SelfRefObjCtor(_,m) ->
Some m
| NotAFunction(_,_,mfun,_) ->
Some mfun
| IllegalFileNameChar(_) -> Some rangeCmdArgs
| 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)
| HashLoadedScriptConsideredSource(m) ->
Some m
// Strip TargetInvocationException wrappers
| :? System.Reflection.TargetInvocationException as e ->
RangeFromException e.InnerException
#if EXTENSIONTYPING
| :? TypeProviderError as e -> e.Range |> Some
#endif
| _ -> None
RangeFromException err.Exception
let GetErrorNumber(err:PhasedError) =
let rec GetFromException(e:exn) =
match e with
(* DO NOT CHANGE THESE NUMBERS *)
| ErrorFromAddingTypeEquation _ -> 1
| FunctionExpected _ -> 2
| NotAFunction _ -> 3
| FieldNotMutable _ -> 5
| Recursion _ -> 6
| InvalidRuntimeCoercion _ -> 7
| IndeterminateRuntimeCoercion _ -> 8
| PossibleUnverifiableCode _ -> 9
| SyntaxError _ -> 10
// 11 cannot be reused
// 12 cannot be reused
| IndeterminateStaticCoercion _ -> 13
| StaticCoercionShouldUseBox _ -> 14
// 15 cannot be reused
| RuntimeCoercionSourceSealed _ -> 16
| OverrideDoesntOverride _ -> 17
| UnionPatternsBindDifferentNames _ -> 18
| UnionCaseWrongArguments _ -> 19
| UnitTypeExpected _ -> 20
| RecursiveUseCheckedAtRuntime _ -> 21
| LetRecEvaluatedOutOfOrder _ -> 22
| NameClash _ -> 23
// 24 cannot be reused
| Patcompile.MatchIncomplete _ -> 25
| Patcompile.RuleNeverMatched _ -> 26
| ValNotMutable _ -> 27
| ValNotLocal _ -> 28
| MissingFields _ -> 29
| ValueRestriction _ -> 30
| LetRecUnsound _ -> 31
| FieldsFromDifferentTypes _ -> 32
| TyconBadArgs _ -> 33
| ValueNotContained _ -> 34
| Deprecated _ -> 35
| ConstrNotContained _ -> 36
| Duplicate _ -> 37
| VarBoundTwice _ -> 38
| UndefinedName _ -> 39
| LetRecCheckedAtRuntime _ -> 40
| UnresolvedOverloading _ -> 41
| LibraryUseOnly _ -> 42
| ErrorFromAddingConstraint _ -> 43
| ObsoleteWarning _ -> 44
| FullAbstraction _ -> 45
| ReservedKeyword _ -> 46
| SelfRefObjCtor _ -> 47
| VirtualAugmentationOnNullValuedType _ -> 48
| UpperCaseIdentifierInPattern _ -> 49
| InterfaceNotRevealed _ -> 50
| UseOfAddressOfOperator _ -> 51
| DefensiveCopyWarning _ -> 52
| NotUpperCaseConstructor _ -> 53
| TypeIsImplicitlyAbstract _ -> 54
// 55 cannot be reused
| DeprecatedThreadStaticBindingWarning _ -> 56
| Experimental _ -> 57
| IndentationProblem _ -> 58
| CoercionTargetSealed _ -> 59
| OverrideInIntrinsicAugmentation _ -> 60
| NonVirtualAugmentationOnNullValuedType _ -> 61
| UserCompilerMessage (_,n,_) -> n
| ExnconstrNotContained _ -> 63
| NonRigidTypar _ -> 64
// 65 cannot be reused
| UpcastUnnecessary _ -> 66
| TypeTestUnnecessary _ -> 67
| QuotationTranslator.IgnoringPartOfQuotedTermWarning _ -> 68
| IntfImplInIntrinsicAugmentation _ -> 69
| NonUniqueInferredAbstractSlot _ -> 70
| ErrorFromApplyingDefault _ -> 71
| IndeterminateType _ -> 72
| InternalError _ -> 73
| UnresolvedReferenceNoRange _
| UnresolvedReferenceError _
| UnresolvedPathReferenceNoRange _
| UnresolvedPathReference _ -> 74
| DeprecatedCommandLineOptionFull _
| DeprecatedCommandLineOptionForHtmlDoc _
| DeprecatedCommandLineOptionSuggestAlternative _
| DeprecatedCommandLineOptionNoDescription _
| InternalCommandLineOption _ -> 75
| HashIncludeNotAllowedInNonScript _
| HashReferenceNotAllowedInNonScript _
| HashDirectiveNotAllowedInNonScript _ -> 76
| BakedInMemberConstraintName _ -> 77
| FileNameNotResolved _ -> 78
| LoadedSourceNotFoundIgnoring _ -> 79
// 80 cannot be reused
| ParameterlessStructCtor _ -> 81
| MSBuildReferenceResolutionWarning _ -> 82
| MSBuildReferenceResolutionError _ -> 83
| AssemblyNotResolved _ -> 84
| HashLoadedSourceHasIssues _ -> 85
| StandardOperatorRedefinitionWarning _ -> 86
| InvalidInternalsVisibleToAssemblyName _ -> 87
// 88 cannot be reused
| OverrideInExtrinsicAugmentation _ -> 89
| IntfImplInExtrinsicAugmentation _ -> 90
| BadEventTransformation _ -> 91
| HashLoadedScriptConsideredSource _ -> 92
| UnresolvedConversionOperator _ -> 93
// avoid 94-100 for safety
| ObsoleteError _ -> 101
#if EXTENSIONTYPING
| ExtensionTyping.ProvidedTypeResolutionNoRange _
| ExtensionTyping.ProvidedTypeResolution _ -> 103
#endif
(* DO NOT CHANGE THE NUMBERS *)
// Strip TargetInvocationException wrappers
| :? System.Reflection.TargetInvocationException as e ->
GetFromException e.InnerException
| WrappedError(e,_) -> GetFromException e
| Error ((n,_),_) -> n
| Failure _ -> 192
| NumberedError((n,_),_) -> n
| IllegalFileNameChar(fileName,invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName,string invalidChar))
#if EXTENSIONTYPING
| :? TypeProviderError as e -> e.Number
#endif
| _ -> 193
GetFromException err.Exception
let GetWarningLevel err =
match err.Exception with
// Level 5 warnings
| RecursiveUseCheckedAtRuntime _
| LetRecEvaluatedOutOfOrder _
| DefensiveCopyWarning _
| FullAbstraction _ -> 5
| NumberedError((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
let warningOn err level specificWarnOn =
let n = GetErrorNumber err
List.mem n specificWarnOn ||
// Some specific warnings are never on by default, i.e. unused variable warnings
match n with
| 1182 -> false
| _ -> level >= GetWarningLevel err
let SplitRelatedErrors(err:PhasedError) =
let ToPhased(e) = {Exception=e; Phase = err.Phase}
let rec SplitRelatedException = function
| 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,m) ->
let e,related = SplitRelatedException e
ErrorsFromAddingSubsumptionConstraint(g,denv,t1,t2,e.Exception,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
| e ->
ToPhased(e), []
SplitRelatedException(err.Exception)
let DeclareMesssage = Microsoft.FSharp.Compiler.DiagnosticMessage.DeclareResourceString
do FSComp.SR.RunStartupValidation()
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 ConstraintSolverTypesNotInEqualityRelation2E() = DeclareResourceString("ConstraintSolverTypesNotInEqualityRelation2", "%s%s")
let ConstraintSolverTypesNotInSubsumptionRelationE() = DeclareResourceString("ConstraintSolverTypesNotInSubsumptionRelation","%s%s%s")
let ConstraintSolverErrorE() = DeclareResourceString("ConstraintSolverError","%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 NotAFunction1E() = DeclareResourceString("NotAFunction1","")
let NotAFunction2E() = DeclareResourceString("NotAFunction2","")
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 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 UnitTypeExpected1E() = DeclareResourceString("UnitTypeExpected1","%s")
let UnitTypeExpected2E() = DeclareResourceString("UnitTypeExpected2","%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","")
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:System.Text.StringBuilder) (err:PhasedError) =
let rec OutputExceptionR (os:System.Text.StringBuilder) = function
| 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(denv,t1,t2,m,m2) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
os.Append(ConstraintSolverInfiniteTypesE().Format t1 t2) |> ignore
(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
(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) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
os.Append(ConstraintSolverTypesNotInEqualityRelation1E().Format t1 t2) |> ignore
(if m.StartLine <> m2.StartLine then
os.Append(SeeAlsoE().Format (stringOfRange m)) |> ignore)
| ConstraintSolverTypesNotInEqualityRelation(denv,t1,t2,m,m2) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
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) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
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) ->
os.Append(ConstraintSolverErrorE().Format msg) |> ignore
if m.StartLine <> m2.StartLine then
os.Append(SeeAlsoE().Format (stringOfRange m2)) |> ignore
| 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',_ ,_ ),_)
when typeEquiv g t1 t1'
&& typeEquiv g t2 t2' ->
let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
os.Append(ErrorFromAddingTypeEquation1E().Format t2 t1 tpcs) |> ignore
| ErrorFromAddingTypeEquation(_,_,_,_,((ConstraintSolverTypesNotInSubsumptionRelation _ | ConstraintSolverError _) as e),_) ->
OutputExceptionR os e
| ErrorFromAddingTypeEquation(g,denv,t1,t2,e,_) ->
if not (typeEquiv g t1 t2) then (
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,_) ->
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,_) ->
if not (typeEquiv g t1 t2) then (
let t1,t2,tpcs = NicePrint.minimalStringsOfTwoTypes denv t1 t2
if t1 <> (t2 + tpcs) then
os.Append(ErrorsFromAddingSubsumptionConstraintE().Format t2 t1 tpcs) |> ignore
)
OutputExceptionR os e
| UpperCaseIdentifierInPattern(_) ->
os.Append(UpperCaseIdentifierInPatternE().Format) |> ignore
| NotUpperCaseConstructor(_) ->
os.Append(NotUpperCaseConstructorE().Format) |> ignore
| ErrorFromAddingConstraint(_,e,_) ->
OutputExceptionR os e
#if EXTENSIONTYPING
| ExtensionTyping.ProvidedTypeResolutionNoRange(e)
| ExtensionTyping.ProvidedTypeResolution(_,e) ->
OutputExceptionR os e
| :? TypeProviderError as e ->
os.Append(e.ContextualErrorMessage) |> ignore
#endif
| 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, _) ->
// 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) ->
// Printf.bprintf os "\n\nPossible best overload: '%s'." minfo
| FunctionExpected _ ->
os.Append(FunctionExpectedE().Format) |> ignore
| BakedInMemberConstraintName(nm,_) ->
os.Append(BakedInMemberConstraintNameE().Format nm) |> ignore
| StandardOperatorRedefinitionWarning(msg,_) ->
os.Append(msg) |> ignore
| BadEventTransformation(_) ->
os.Append(BadEventTransformationE().Format) |> ignore
| ParameterlessStructCtor(_) ->
os.Append(ParameterlessStructCtorE().Format) |> ignore
| InterfaceNotRevealed(denv,ity,_) ->
os.Append(InterfaceNotRevealedE().Format (NicePrint.minimalStringOfType denv ity)) |> ignore
| NotAFunction(_,_,_,marg) ->
if marg.StartColumn = 0 then
os.Append(NotAFunction1E().Format) |> ignore
else
os.Append(NotAFunction2E().Format) |> ignore
| 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,_) ->
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,_) ->
if k = "member" then
os.Append(Duplicate1E().Format (DecompileOpName s)) |> ignore
else
os.Append(Duplicate2E().Format k (DecompileOpName s)) |> ignore
| UndefinedName(_,k,id,_) ->
os.Append(k (DecompileOpName id.idText)) |> ignore
| InternalUndefinedTyconItem(f,tcref,s) ->
let _, errs = f((fullDisplayTextOfTyconRef tcref), s)
os.Append(errs) |> ignore
| InternalUndefinedItemRef(f,smr,ccuName,s) ->
let _, errs = f(smr, ccuName, s)
os.Append(errs) |> ignore
| FieldNotMutable _ ->
os.Append(FieldNotMutableE().Format) |> ignore
| 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
os.Append(RecursionE().Format (DecompileOpName id.idText) t1 t2 tpcs) |> ignore
| 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,_) ->
let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
os.Append(IndeterminateRuntimeCoercionE().Format t1 t2) |> ignore
| IndeterminateStaticCoercion(denv,ty1,ty2,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
os.Append(IndeterminateStaticCoercionE().Format t1 t2) |> ignore
| StaticCoercionShouldUseBox(denv,ty1,ty2,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
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,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let _, (ty1,ty), _cxs = PrettyTypes.PrettifyTypes2 denv.g (ty1,ty)
match tpnmOpt with
| None ->
os.Append(NonRigidTypar1E().Format (stringOfRange typarRange) (NicePrint.stringOfTy denv ty)) |> ignore
| Some tpnm ->
match ty1 with
| TType_measure _ ->
os.Append(NonRigidTypar2E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore
| _ ->
os.Append(NonRigidTypar3E().Format tpnm (NicePrint.stringOfTy denv ty)) |> ignore
| SyntaxError (ctxt,_) ->
let ctxt = unbox<Parsing.ParseErrorContext<Parser.token>>(ctxt)
let (|EndOfStructuredConstructToken|_|) token =
match token with
| Parser.TOKEN_ODECLEND
| Parser.TOKEN_OBLOCKSEP
| Parser.TOKEN_OEND
| Parser.TOKEN_ORIGHT_BLOCK_END
| Parser.TOKEN_OBLOCKEND | Parser.TOKEN_OBLOCKEND_COMING_SOON | Parser.TOKEN_OBLOCKEND_IS_HERE -> Some()
| _ -> None
let tokenIdToText tid =
match tid with
| Parser.TOKEN_IDENT -> getErrorString("Parser.TOKEN.IDENT")
| Parser.TOKEN_BIGNUM
| Parser.TOKEN_INT8
| Parser.TOKEN_UINT8
| Parser.TOKEN_INT16
| Parser.TOKEN_UINT16
| Parser.TOKEN_INT32
| Parser.TOKEN_UINT32
| Parser.TOKEN_INT64
| Parser.TOKEN_UINT64
| Parser.TOKEN_UNATIVEINT
| Parser.TOKEN_NATIVEINT -> getErrorString("Parser.TOKEN.INT")
| Parser.TOKEN_IEEE32
| Parser.TOKEN_IEEE64 -> getErrorString("Parser.TOKEN.FLOAT")
| Parser.TOKEN_DECIMAL -> getErrorString("Parser.TOKEN.DECIMAL")
| Parser.TOKEN_CHAR -> getErrorString("Parser.TOKEN.CHAR")
| Parser.TOKEN_BASE -> getErrorString("Parser.TOKEN.BASE")
| Parser.TOKEN_LPAREN_STAR_RPAREN -> getErrorString("Parser.TOKEN.LPAREN.STAR.RPAREN")
| Parser.TOKEN_DOLLAR -> getErrorString("Parser.TOKEN.DOLLAR")
| Parser.TOKEN_INFIX_STAR_STAR_OP -> getErrorString("Parser.TOKEN.INFIX.STAR.STAR.OP")
| Parser.TOKEN_INFIX_COMPARE_OP -> getErrorString("Parser.TOKEN.INFIX.COMPARE.OP")
| Parser.TOKEN_COLON_GREATER -> getErrorString("Parser.TOKEN.COLON.GREATER")
| Parser.TOKEN_COLON_COLON ->getErrorString("Parser.TOKEN.COLON.COLON")
| Parser.TOKEN_PERCENT_OP -> getErrorString("Parser.TOKEN.PERCENT.OP")
| Parser.TOKEN_INFIX_AT_HAT_OP -> getErrorString("Parser.TOKEN.INFIX.AT.HAT.OP")
| Parser.TOKEN_INFIX_BAR_OP -> getErrorString("Parser.TOKEN.INFIX.BAR.OP")
| Parser.TOKEN_PLUS_MINUS_OP -> getErrorString("Parser.TOKEN.PLUS.MINUS.OP")
| Parser.TOKEN_PREFIX_OP -> getErrorString("Parser.TOKEN.PREFIX.OP")
| Parser.TOKEN_COLON_QMARK_GREATER -> getErrorString("Parser.TOKEN.COLON.QMARK.GREATER")
| Parser.TOKEN_INFIX_STAR_DIV_MOD_OP -> getErrorString("Parser.TOKEN.INFIX.STAR.DIV.MOD.OP")
| Parser.TOKEN_INFIX_AMP_OP -> getErrorString("Parser.TOKEN.INFIX.AMP.OP")
| Parser.TOKEN_AMP -> getErrorString("Parser.TOKEN.AMP")
| Parser.TOKEN_AMP_AMP -> getErrorString("Parser.TOKEN.AMP.AMP")
| Parser.TOKEN_BAR_BAR -> getErrorString("Parser.TOKEN.BAR.BAR")
| Parser.TOKEN_LESS -> getErrorString("Parser.TOKEN.LESS")
| Parser.TOKEN_GREATER -> getErrorString("Parser.TOKEN.GREATER")
| Parser.TOKEN_QMARK -> getErrorString("Parser.TOKEN.QMARK")
| Parser.TOKEN_QMARK_QMARK -> getErrorString("Parser.TOKEN.QMARK.QMARK")
| Parser.TOKEN_COLON_QMARK-> getErrorString("Parser.TOKEN.COLON.QMARK")
| Parser.TOKEN_INT32_DOT_DOT -> getErrorString("Parser.TOKEN.INT32.DOT.DOT")
| Parser.TOKEN_DOT_DOT -> getErrorString("Parser.TOKEN.DOT.DOT")
| Parser.TOKEN_QUOTE -> getErrorString("Parser.TOKEN.QUOTE")
| Parser.TOKEN_STAR -> getErrorString("Parser.TOKEN.STAR")
| Parser.TOKEN_HIGH_PRECEDENCE_TYAPP -> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.TYAPP")
| Parser.TOKEN_COLON -> getErrorString("Parser.TOKEN.COLON")
| Parser.TOKEN_COLON_EQUALS -> getErrorString("Parser.TOKEN.COLON.EQUALS")
| Parser.TOKEN_LARROW -> getErrorString("Parser.TOKEN.LARROW")
| Parser.TOKEN_EQUALS -> getErrorString("Parser.TOKEN.EQUALS")
| Parser.TOKEN_GREATER_BAR_RBRACK -> getErrorString("Parser.TOKEN.GREATER.BAR.RBRACK")
| Parser.TOKEN_MINUS -> getErrorString("Parser.TOKEN.MINUS")
| Parser.TOKEN_ADJACENT_PREFIX_OP -> getErrorString("Parser.TOKEN.ADJACENT.PREFIX.OP")
| Parser.TOKEN_FUNKY_OPERATOR_NAME -> getErrorString("Parser.TOKEN.FUNKY.OPERATOR.NAME")
| Parser.TOKEN_COMMA-> getErrorString("Parser.TOKEN.COMMA")
| Parser.TOKEN_DOT -> getErrorString("Parser.TOKEN.DOT")
| Parser.TOKEN_BAR-> getErrorString("Parser.TOKEN.BAR")
| Parser.TOKEN_HASH -> getErrorString("Parser.TOKEN.HASH")
| Parser.TOKEN_UNDERSCORE -> getErrorString("Parser.TOKEN.UNDERSCORE")
| Parser.TOKEN_SEMICOLON -> getErrorString("Parser.TOKEN.SEMICOLON")
| Parser.TOKEN_SEMICOLON_SEMICOLON-> getErrorString("Parser.TOKEN.SEMICOLON.SEMICOLON")
| Parser.TOKEN_LPAREN-> getErrorString("Parser.TOKEN.LPAREN")
| Parser.TOKEN_RPAREN | Parser.TOKEN_RPAREN_COMING_SOON | Parser.TOKEN_RPAREN_IS_HERE -> getErrorString("Parser.TOKEN.RPAREN")
| Parser.TOKEN_LQUOTE -> getErrorString("Parser.TOKEN.LQUOTE")
| Parser.TOKEN_LBRACK -> getErrorString("Parser.TOKEN.LBRACK")
| Parser.TOKEN_LBRACK_BAR -> getErrorString("Parser.TOKEN.LBRACK.BAR")
| Parser.TOKEN_LBRACK_LESS -> getErrorString("Parser.TOKEN.LBRACK.LESS")
| Parser.TOKEN_LBRACE -> getErrorString("Parser.TOKEN.LBRACE")
| Parser.TOKEN_LBRACE_LESS-> getErrorString("Parser.TOKEN.LBRACE.LESS")
| Parser.TOKEN_BAR_RBRACK -> getErrorString("Parser.TOKEN.BAR.RBRACK")
| Parser.TOKEN_GREATER_RBRACE -> getErrorString("Parser.TOKEN.GREATER.RBRACE")
| Parser.TOKEN_GREATER_RBRACK -> getErrorString("Parser.TOKEN.GREATER.RBRACK")
| Parser.TOKEN_RQUOTE_DOT _
| Parser.TOKEN_RQUOTE -> getErrorString("Parser.TOKEN.RQUOTE")
| Parser.TOKEN_RBRACK -> getErrorString("Parser.TOKEN.RBRACK")
| Parser.TOKEN_RBRACE | Parser.TOKEN_RBRACE_COMING_SOON | Parser.TOKEN_RBRACE_IS_HERE -> getErrorString("Parser.TOKEN.RBRACE")
| Parser.TOKEN_PUBLIC -> getErrorString("Parser.TOKEN.PUBLIC")
| Parser.TOKEN_PRIVATE -> getErrorString("Parser.TOKEN.PRIVATE")
| Parser.TOKEN_INTERNAL -> getErrorString("Parser.TOKEN.INTERNAL")
| Parser.TOKEN_CONSTRAINT -> getErrorString("Parser.TOKEN.CONSTRAINT")
| Parser.TOKEN_INSTANCE -> getErrorString("Parser.TOKEN.INSTANCE")
| Parser.TOKEN_DELEGATE -> getErrorString("Parser.TOKEN.DELEGATE")
| Parser.TOKEN_INHERIT -> getErrorString("Parser.TOKEN.INHERIT")
| Parser.TOKEN_CONSTRUCTOR-> getErrorString("Parser.TOKEN.CONSTRUCTOR")
| Parser.TOKEN_DEFAULT -> getErrorString("Parser.TOKEN.DEFAULT")
| Parser.TOKEN_OVERRIDE-> getErrorString("Parser.TOKEN.OVERRIDE")
| Parser.TOKEN_ABSTRACT-> getErrorString("Parser.TOKEN.ABSTRACT")
| Parser.TOKEN_CLASS-> getErrorString("Parser.TOKEN.CLASS")
| Parser.TOKEN_MEMBER -> getErrorString("Parser.TOKEN.MEMBER")
| Parser.TOKEN_STATIC -> getErrorString("Parser.TOKEN.STATIC")
| Parser.TOKEN_NAMESPACE-> getErrorString("Parser.TOKEN.NAMESPACE")
| Parser.TOKEN_OBLOCKBEGIN -> getErrorString("Parser.TOKEN.OBLOCKBEGIN")
| EndOfStructuredConstructToken -> getErrorString("Parser.TOKEN.OBLOCKEND")
| Parser.TOKEN_THEN
| Parser.TOKEN_OTHEN -> getErrorString("Parser.TOKEN.OTHEN")
| Parser.TOKEN_ELSE
| Parser.TOKEN_OELSE -> getErrorString("Parser.TOKEN.OELSE")
| Parser.TOKEN_LET(_)
| Parser.TOKEN_OLET(_) -> getErrorString("Parser.TOKEN.OLET")
| Parser.TOKEN_OBINDER
| Parser.TOKEN_BINDER -> getErrorString("Parser.TOKEN.BINDER")
| Parser.TOKEN_ODO -> getErrorString("Parser.TOKEN.ODO")
| Parser.TOKEN_OWITH -> getErrorString("Parser.TOKEN.OWITH")
| Parser.TOKEN_OFUNCTION -> getErrorString("Parser.TOKEN.OFUNCTION")
| Parser.TOKEN_OFUN -> getErrorString("Parser.TOKEN.OFUN")
| Parser.TOKEN_ORESET -> getErrorString("Parser.TOKEN.ORESET")
| Parser.TOKEN_ODUMMY -> getErrorString("Parser.TOKEN.ODUMMY")
| Parser.TOKEN_DO_BANG
| Parser.TOKEN_ODO_BANG -> getErrorString("Parser.TOKEN.ODO.BANG")
| Parser.TOKEN_YIELD -> getErrorString("Parser.TOKEN.YIELD")
| Parser.TOKEN_YIELD_BANG -> getErrorString("Parser.TOKEN.YIELD.BANG")
| Parser.TOKEN_OINTERFACE_MEMBER-> getErrorString("Parser.TOKEN.OINTERFACE.MEMBER")
| Parser.TOKEN_ELIF -> getErrorString("Parser.TOKEN.ELIF")
| Parser.TOKEN_RARROW -> getErrorString("Parser.TOKEN.RARROW")
| Parser.TOKEN_SIG -> getErrorString("Parser.TOKEN.SIG")
| Parser.TOKEN_STRUCT -> getErrorString("Parser.TOKEN.STRUCT")
| Parser.TOKEN_UPCAST -> getErrorString("Parser.TOKEN.UPCAST")
| Parser.TOKEN_DOWNCAST -> getErrorString("Parser.TOKEN.DOWNCAST")
| Parser.TOKEN_NULL -> getErrorString("Parser.TOKEN.NULL")
| Parser.TOKEN_RESERVED -> getErrorString("Parser.TOKEN.RESERVED")
| Parser.TOKEN_MODULE | Parser.TOKEN_MODULE_COMING_SOON | Parser.TOKEN_MODULE_IS_HERE -> getErrorString("Parser.TOKEN.MODULE")
| Parser.TOKEN_AND -> getErrorString("Parser.TOKEN.AND")
| Parser.TOKEN_AS -> getErrorString("Parser.TOKEN.AS")
| Parser.TOKEN_ASSERT -> getErrorString("Parser.TOKEN.ASSERT")
| Parser.TOKEN_OASSERT -> getErrorString("Parser.TOKEN.ASSERT")
| Parser.TOKEN_ASR-> getErrorString("Parser.TOKEN.ASR")
| Parser.TOKEN_DOWNTO -> getErrorString("Parser.TOKEN.DOWNTO")
| Parser.TOKEN_EXCEPTION -> getErrorString("Parser.TOKEN.EXCEPTION")
| Parser.TOKEN_FALSE -> getErrorString("Parser.TOKEN.FALSE")
| Parser.TOKEN_FOR -> getErrorString("Parser.TOKEN.FOR")
| Parser.TOKEN_FUN -> getErrorString("Parser.TOKEN.FUN")
| Parser.TOKEN_FUNCTION-> getErrorString("Parser.TOKEN.FUNCTION")
| Parser.TOKEN_FINALLY -> getErrorString("Parser.TOKEN.FINALLY")
| Parser.TOKEN_LAZY -> getErrorString("Parser.TOKEN.LAZY")
| Parser.TOKEN_OLAZY -> getErrorString("Parser.TOKEN.LAZY")
| Parser.TOKEN_MATCH -> getErrorString("Parser.TOKEN.MATCH")
| Parser.TOKEN_MUTABLE -> getErrorString("Parser.TOKEN.MUTABLE")
| Parser.TOKEN_NEW -> getErrorString("Parser.TOKEN.NEW")
| Parser.TOKEN_OF -> getErrorString("Parser.TOKEN.OF")
| Parser.TOKEN_OPEN -> getErrorString("Parser.TOKEN.OPEN")
| Parser.TOKEN_OR -> getErrorString("Parser.TOKEN.OR")
| Parser.TOKEN_VOID -> getErrorString("Parser.TOKEN.VOID")
| Parser.TOKEN_EXTERN-> getErrorString("Parser.TOKEN.EXTERN")
| Parser.TOKEN_INTERFACE -> getErrorString("Parser.TOKEN.INTERFACE")
| Parser.TOKEN_REC -> getErrorString("Parser.TOKEN.REC")
| Parser.TOKEN_TO -> getErrorString("Parser.TOKEN.TO")
| Parser.TOKEN_TRUE -> getErrorString("Parser.TOKEN.TRUE")
| Parser.TOKEN_TRY -> getErrorString("Parser.TOKEN.TRY")
| Parser.TOKEN_TYPE | Parser.TOKEN_TYPE_COMING_SOON | Parser.TOKEN_TYPE_IS_HERE -> getErrorString("Parser.TOKEN.TYPE")
| Parser.TOKEN_VAL -> getErrorString("Parser.TOKEN.VAL")
| Parser.TOKEN_INLINE -> getErrorString("Parser.TOKEN.INLINE")
| Parser.TOKEN_WHEN -> getErrorString("Parser.TOKEN.WHEN")
| Parser.TOKEN_WHILE -> getErrorString("Parser.TOKEN.WHILE")
| Parser.TOKEN_WITH-> getErrorString("Parser.TOKEN.WITH")
| Parser.TOKEN_IF -> getErrorString("Parser.TOKEN.IF")
| Parser.TOKEN_DO -> getErrorString("Parser.TOKEN.DO")
| Parser.TOKEN_GLOBAL -> getErrorString("Parser.TOKEN.GLOBAL")
| Parser.TOKEN_DONE -> getErrorString("Parser.TOKEN.DONE")
| Parser.TOKEN_IN | Parser.TOKEN_JOIN_IN -> getErrorString("Parser.TOKEN.IN")
| Parser.TOKEN_HIGH_PRECEDENCE_PAREN_APP-> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.PAREN.APP")
| Parser.TOKEN_HIGH_PRECEDENCE_BRACK_APP-> getErrorString("Parser.TOKEN.HIGH.PRECEDENCE.BRACK.APP")
| Parser.TOKEN_BEGIN -> getErrorString("Parser.TOKEN.BEGIN")
| Parser.TOKEN_END -> getErrorString("Parser.TOKEN.END")
| Parser.TOKEN_HASH_LIGHT
| Parser.TOKEN_HASH_LINE
| Parser.TOKEN_HASH_IF
| Parser.TOKEN_HASH_ELSE
| Parser.TOKEN_HASH_ENDIF -> getErrorString("Parser.TOKEN.HASH.ENDIF")
| Parser.TOKEN_INACTIVECODE -> getErrorString("Parser.TOKEN.INACTIVECODE")
| Parser.TOKEN_LEX_FAILURE-> getErrorString("Parser.TOKEN.LEX.FAILURE")
| Parser.TOKEN_WHITESPACE -> getErrorString("Parser.TOKEN.WHITESPACE")
| Parser.TOKEN_COMMENT -> getErrorString("Parser.TOKEN.COMMENT")
| Parser.TOKEN_LINE_COMMENT -> getErrorString("Parser.TOKEN.LINE.COMMENT")
| Parser.TOKEN_STRING_TEXT -> getErrorString("Parser.TOKEN.STRING.TEXT")
| Parser.TOKEN_BYTEARRAY -> getErrorString("Parser.TOKEN.BYTEARRAY")
| Parser.TOKEN_STRING -> getErrorString("Parser.TOKEN.STRING")
| Parser.TOKEN_KEYWORD_STRING -> getErrorString("Parser.TOKEN.KEYWORD_STRING")
| Parser.TOKEN_EOF -> getErrorString("Parser.TOKEN.EOF")
| Parser.TOKEN_CONST -> getErrorString("Parser.TOKEN.CONST")
| unknown ->
System.Diagnostics.Debug.Assert(false,"unknown token tag")
let result = sprintf "%+A" unknown
System.Diagnostics.Debug.Assert(false, result)
result
match ctxt.CurrentToken with
| None -> os.Append(UnexpectedEndOfInputE().Format) |> ignore
| Some token ->
match (token |> Parser.tagOfToken |> Parser.tokenTagToTokenId), token with
| 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
(* Search for a state producing a single recognized non-terminal in the states on the stack *)
let foundInContext =
(* Merge a bunch of expression non terminals *)
let (|NONTERM_Category_Expr|_|) = function
| Parser.NONTERM_argExpr|Parser.NONTERM_minusExpr|Parser.NONTERM_parenExpr|Parser.NONTERM_atomicExpr
| Parser.NONTERM_appExpr|Parser.NONTERM_tupleExpr|Parser.NONTERM_declExpr|Parser.NONTERM_braceExpr
| Parser.NONTERM_typedSeqExprBlock
| Parser.NONTERM_interactiveExpr -> Some()
| _ -> None
(* Merge a bunch of pattern non terminals *)
let (|NONTERM_Category_Pattern|_|) = function
| Parser.NONTERM_constrPattern|Parser.NONTERM_parenPattern|Parser.NONTERM_atomicPattern -> Some()
| _ -> None
(* Merge a bunch of if/then/else non terminals *)
let (|NONTERM_Category_IfThenElse|_|) = function
| Parser.NONTERM_ifExprThen|Parser.NONTERM_ifExprElifs|Parser.NONTERM_ifExprCases -> Some()
| _ -> None
(* Merge a bunch of non terminals *)
let (|NONTERM_Category_SignatureFile|_|) = function
| Parser.NONTERM_signatureFile|Parser.NONTERM_moduleSpfn|Parser.NONTERM_moduleSpfns -> Some()
| _ -> None
let (|NONTERM_Category_ImplementationFile|_|) = function
| Parser.NONTERM_implementationFile|Parser.NONTERM_fileNamespaceImpl|Parser.NONTERM_fileNamespaceImpls -> Some()
| _ -> None
let (|NONTERM_Category_Definition|_|) = function
| Parser.NONTERM_fileModuleImpl|Parser.NONTERM_moduleDefn|Parser.NONTERM_interactiveModuleDefns
|Parser.NONTERM_moduleDefns|Parser.NONTERM_moduleDefnsOrExpr -> Some()
| _ -> None
let (|NONTERM_Category_Type|_|) = function
| Parser.NONTERM_typ|Parser.NONTERM_tupleType -> Some()
| _ -> None
let (|NONTERM_Category_Interaction|_|) = function
| Parser.NONTERM_interactiveItemsTerminator|Parser.NONTERM_interaction|Parser.NONTERM__startinteraction -> Some()
| _ -> None
// Canonicalize the categories and check for a unique category
ctxt.ReducibleProductions |> List.exists (fun prods ->
match prods
|> List.map Parser.prodIdxToNonTerminal
|> List.map (function
| NONTERM_Category_Type -> Parser.NONTERM_typ
| NONTERM_Category_Expr -> Parser.NONTERM_declExpr
| NONTERM_Category_Pattern -> Parser.NONTERM_atomicPattern
| NONTERM_Category_IfThenElse -> Parser.NONTERM_ifExprThen
| NONTERM_Category_SignatureFile -> Parser.NONTERM_signatureFile
| NONTERM_Category_ImplementationFile -> Parser.NONTERM_implementationFile
| NONTERM_Category_Definition -> Parser.NONTERM_moduleDefn
| NONTERM_Category_Interaction -> Parser.NONTERM_interaction
| nt -> nt)
|> Set.ofList
|> Set.toList with
| [Parser.NONTERM_interaction] -> os.Append(NONTERM_interactionE().Format) |> ignore; true
| [Parser.NONTERM_hashDirective] -> os.Append(NONTERM_hashDirectiveE().Format) |> ignore; true
| [Parser.NONTERM_fieldDecl] -> os.Append(NONTERM_fieldDeclE().Format) |> ignore; true
| [Parser.NONTERM_unionCaseRepr] -> os.Append(NONTERM_unionCaseReprE().Format) |> ignore; true
| [Parser.NONTERM_localBinding] -> os.Append(NONTERM_localBindingE().Format) |> ignore; true
| [Parser.NONTERM_hardwhiteLetBindings] -> os.Append(NONTERM_hardwhiteLetBindingsE().Format) |> ignore; true
| [Parser.NONTERM_classDefnMember] -> os.Append(NONTERM_classDefnMemberE().Format) |> ignore; true
| [Parser.NONTERM_defnBindings] -> os.Append(NONTERM_defnBindingsE().Format) |> ignore; true
| [Parser.NONTERM_classMemberSpfn] -> os.Append(NONTERM_classMemberSpfnE().Format) |> ignore; true
| [Parser.NONTERM_valSpfn] -> os.Append(NONTERM_valSpfnE().Format) |> ignore; true
| [Parser.NONTERM_tyconSpfn] -> os.Append(NONTERM_tyconSpfnE().Format) |> ignore; true
| [Parser.NONTERM_anonLambdaExpr] -> os.Append(NONTERM_anonLambdaExprE().Format) |> ignore; true
| [Parser.NONTERM_attrUnionCaseDecl] -> os.Append(NONTERM_attrUnionCaseDeclE().Format) |> ignore; true
| [Parser.NONTERM_cPrototype] -> os.Append(NONTERM_cPrototypeE().Format) |> ignore; true
| [Parser.NONTERM_objExpr|Parser.NONTERM_objectImplementationMembers] -> os.Append(NONTERM_objectImplementationMembersE().Format) |> ignore; true
| [Parser.NONTERM_ifExprThen|Parser.NONTERM_ifExprElifs|Parser.NONTERM_ifExprCases] -> os.Append(NONTERM_ifExprCasesE().Format) |> ignore; true
| [Parser.NONTERM_openDecl] -> os.Append(NONTERM_openDeclE().Format) |> ignore; true
| [Parser.NONTERM_fileModuleSpec] -> os.Append(NONTERM_fileModuleSpecE().Format) |> ignore; true
| [Parser.NONTERM_patternClauses] -> os.Append(NONTERM_patternClausesE().Format) |> ignore; true
| [Parser.NONTERM_beginEndExpr] -> os.Append(NONTERM_beginEndExprE().Format) |> ignore; true
| [Parser.NONTERM_recdExpr] -> os.Append(NONTERM_recdExprE().Format) |> ignore; true
| [Parser.NONTERM_tyconDefn] -> os.Append(NONTERM_tyconDefnE().Format) |> ignore; true
| [Parser.NONTERM_exconCore] -> os.Append(NONTERM_exconCoreE().Format) |> ignore; true
| [Parser.NONTERM_typeNameInfo] -> os.Append(NONTERM_typeNameInfoE().Format) |> ignore; true
| [Parser.NONTERM_attributeList] -> os.Append(NONTERM_attributeListE().Format) |> ignore; true
| [Parser.NONTERM_quoteExpr] -> os.Append(NONTERM_quoteExprE().Format) |> ignore; true
| [Parser.NONTERM_typeConstraint] -> os.Append(NONTERM_typeConstraintE().Format) |> ignore; true
| [NONTERM_Category_ImplementationFile] -> os.Append(NONTERM_Category_ImplementationFileE().Format) |> ignore; true
| [NONTERM_Category_Definition] -> os.Append(NONTERM_Category_DefinitionE().Format) |> ignore; true
| [NONTERM_Category_SignatureFile] -> os.Append(NONTERM_Category_SignatureFileE().Format) |> ignore; true
| [NONTERM_Category_Pattern] -> os.Append(NONTERM_Category_PatternE().Format) |> ignore; true
| [NONTERM_Category_Expr] -> os.Append(NONTERM_Category_ExprE().Format) |> ignore; true
| [NONTERM_Category_Type] -> os.Append(NONTERM_Category_TypeE().Format) |> ignore; true
| [Parser.NONTERM_typeArgsActual] -> os.Append(NONTERM_typeArgsActualE().Format) |> ignore; true
| _ ->
false)
#if DEBUG
if not foundInContext then
Printf.bprintf os ". (no 'in' context found: %+A)" (List.map (List.map Parser.prodIdxToNonTerminal) ctxt.ReducibleProductions);
#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"),"")
match (ctxt.ShiftTokens
|> List.map Parser.tokenTagToTokenId
|> List.filter (function Parser.TOKEN_error | Parser.TOKEN_EOF -> false | _ -> true)
|> List.map tokenIdToText
|> Set.ofList
|> Set.toList) with
| [tokenName1] -> os.Append(TokenName1E().Format (fix tokenName1)) |> ignore
| [tokenName1;tokenName2] -> os.Append(TokenName1TokenName2E().Format (fix tokenName1) (fix tokenName2)) |> ignore
| [tokenName1;tokenName2;tokenName3] -> os.Append(TokenName1TokenName2TokenName3E().Format (fix tokenName1) (fix tokenName2) (fix tokenName3)) |> ignore
| _ -> ()
(*
Printf.bprintf os ".\n\n state = %A\n token = %A\n expect (shift) %A\n expect (reduce) %A\n prods=%A\n non terminals: %A"
ctxt.StateStack
ctxt.CurrentToken
(List.map Parser.tokenTagToTokenId ctxt.ShiftTokens)
(List.map Parser.tokenTagToTokenId ctxt.ReduceTokens)
ctxt.ReducibleProductions
(List.mapSquared Parser.prodIdxToNonTerminal ctxt.ReducibleProductions)
*)
| RuntimeCoercionSourceSealed(denv,ty,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let _, ty, _cxs = PrettyTypes.PrettifyTypes1 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,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let _, ty, _cxs= PrettyTypes.PrettifyTypes1 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,_) ->
Printf.bprintf os "%s" msg
| OverrideDoesntOverride(denv,impl,minfoVirtOpt,g,amap,m) ->
let sig1 = DispatchSlotChecking.FormatOverride denv impl
begin match minfoVirtOpt with
| None ->
os.Append(OverrideDoesntOverride1E().Format sig1) |> ignore
| Some minfoVirt ->
os.Append(OverrideDoesntOverride2E().Format sig1) |> ignore
let sig2 = DispatchSlotChecking.FormatMethInfoSig g amap m denv minfoVirt
if sig1 <> sig2 then
os.Append(OverrideDoesntOverride3E().Format sig2) |> ignore
end
| 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
os.Append(f((fullDisplayTextOfModRef mref), text1, text2)) |> ignore
| ConstrNotContained (denv,v1,v2,f) ->
os.Append(f((NicePrint.stringOfUnionCase denv v1), (NicePrint.stringOfUnionCase denv v2))) |> ignore
| ExnconstrNotContained (denv,v1,v2,f) ->
os.Append(f((NicePrint.stringOfExnDef denv v1), (NicePrint.stringOfExnDef denv v2))) |> ignore
| FieldNotContained (denv,v1,v2,f) ->
os.Append(f((NicePrint.stringOfRecdField denv v1), (NicePrint.stringOfRecdField denv v2))) |> ignore
| 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
| DeprecatedThreadStaticBindingWarning(_) ->
os.Append(DeprecatedThreadStaticBindingWarningE().Format) |> ignore
| FunctionValueUnexpected (denv,ty,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let _, ty, _cxs = PrettyTypes.PrettifyTypes1 denv.g ty
os.Append(FunctionValueUnexpectedE().Format (NicePrint.stringOfTy denv ty)) |> ignore
| UnitTypeExpected (denv,ty,perhapsProp,_) ->
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let _, ty, _cxs = PrettyTypes.PrettifyTypes1 denv.g ty
if perhapsProp then
os.Append(UnitTypeExpected2E().Format (NicePrint.stringOfTy denv ty)) |> ignore
else
os.Append(UnitTypeExpected1E().Format (NicePrint.stringOfTy denv ty)) |> ignore
| RecursiveUseCheckedAtRuntime _ ->
os.Append(RecursiveUseCheckedAtRuntimeE().Format) |> ignore
| LetRecUnsound (_,[v],_) ->
os.Append(LetRecUnsound1E().Format v.DisplayName) |> ignore
| 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 (_,_,_,_) ->
os.Append(LetRecEvaluatedOutOfOrderE().Format) |> ignore
| LetRecCheckedAtRuntime _ ->
os.Append(LetRecCheckedAtRuntimeE().Format) |> ignore
| SelfRefObjCtor(false,_) ->
os.Append(SelfRefObjCtor1E().Format) |> ignore
| SelfRefObjCtor(true,_) ->
os.Append(SelfRefObjCtor2E().Format) |> ignore
| VirtualAugmentationOnNullValuedType(_) ->
os.Append(VirtualAugmentationOnNullValuedTypeE().Format) |> ignore
| NonVirtualAugmentationOnNullValuedType(_) ->
os.Append(NonVirtualAugmentationOnNullValuedTypeE().Format) |> ignore
| NonUniqueInferredAbstractSlot(_,denv,bindnm,bvirt1,bvirt2,_) ->
os.Append(NonUniqueInferredAbstractSlot1E().Format bindnm) |> ignore
let ty1 = bvirt1.EnclosingType
let ty2 = bvirt2.EnclosingType
// REVIEW: consider if we need to show _cxs (the type parameter constrants)
let t1, t2, _cxs = NicePrint.minimalStringsOfTwoTypes denv ty1 ty2
os.Append(NonUniqueInferredAbstractSlot2E().Format) |> ignore
if t1 <> t2 then
os.Append(NonUniqueInferredAbstractSlot3E().Format t1 t2) |> ignore
os.Append(NonUniqueInferredAbstractSlot4E().Format) |> ignore
| Error ((_,s),_) -> os.Append(s) |> ignore
| 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")
let f2 = SR.GetString("Failure2")
match s with
| f when f = f1 -> os.Append(Failure3E().Format s) |> ignore
| f when f = f2 -> os.Append(Failure3E().Format s) |> ignore
| _ -> os.Append(Failure4E().Format s) |> ignore
#if DEBUG
Printf.bprintf os "\nStack Trace\n%s\n" (exn.ToString())
if !showAssertForUnexpectedException then
System.Diagnostics.Debug.Assert(false,sprintf "Bug seen in compiler: %s" (exn.ToString()))
#endif
| FullAbstraction(s,_) -> os.Append(FullAbstractionE().Format s) |> ignore
| WrappedError (exn,_) -> OutputExceptionR os exn
| Patcompile.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
if isComp then
os.Append(MatchIncomplete4E().Format) |> ignore
| Patcompile.RuleNeverMatched _ -> os.Append(RuleNeverMatchedE().Format) |> ignore
| ValNotMutable _ -> os.Append(ValNotMutableE().Format) |> 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,_,_) ->
let denv = { denv with showImperativeTyparAnnotations=true; }
let tau = v.TauType
if hassig then
if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then
os.Append(ValueRestriction1E().Format
v.DisplayName
(NicePrint.stringOfQualifiedValOrMember denv v)
v.DisplayName) |> ignore
else
os.Append(ValueRestriction2E().Format
v.DisplayName
(NicePrint.stringOfQualifiedValOrMember denv v)
v.DisplayName) |> ignore
else
match v.MemberInfo with
| Some(membInfo) when
begin match membInfo.MemberFlags.MemberKind with
| MemberKind.PropertyGet
| MemberKind.PropertySet
| MemberKind.Constructor -> true (* can't infer extra polymorphism *)
| _ -> false (* can infer extra polymorphism *)
end ->
os.Append(ValueRestriction3E().Format (NicePrint.stringOfQualifiedValOrMember denv v)) |> ignore
| _ ->
if isFunTy denv.g tau && (arityOfVal v).HasNoArgs then
os.Append(ValueRestriction4E().Format
v.DisplayName
(NicePrint.stringOfQualifiedValOrMember denv v)
v.DisplayName) |> ignore
else
os.Append(ValueRestriction5E().Format
v.DisplayName
(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
| 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,_)
| UnresolvedReferenceNoRange(assemblyname) ->
os.Append(UnresolvedReferenceNoRangeE().Format assemblyname) |> ignore
| UnresolvedPathReference(assemblyname,pathname,_)
| UnresolvedPathReferenceNoRange(assemblyname,pathname) ->
os.Append(UnresolvedPathReferenceNoRangeE().Format pathname assemblyname) |> ignore
| DeprecatedCommandLineOptionFull(fullText,_) ->
os.Append(fullText) |> ignore
| DeprecatedCommandLineOptionForHtmlDoc(optionName,_) ->
os.Append(FSComp.SR.optsDCLOHtmlDoc(optionName)) |> ignore
| DeprecatedCommandLineOptionSuggestAlternative(optionName,altOption,_) ->
os.Append(FSComp.SR.optsDCLODeprecatedSuggestAlternative(optionName, altOption)) |> ignore
| InternalCommandLineOption(optionName,_) ->
os.Append(FSComp.SR.optsInternalNoDescription(optionName)) |> ignore
| 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,_) ->
os.Append(FileNameNotResolvedE().Format filename locations) |> ignore
| AssemblyNotResolved(originalName,_) ->
os.Append(AssemblyNotResolvedE().Format originalName) |> ignore
| 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
os.Append(HashLoadedSourceHasIssues1E().Format) |> ignore
Emit(warnings)
else
os.Append(HashLoadedSourceHasIssues2E().Format) |> ignore
Emit(errors)
| HashLoadedScriptConsideredSource(_) ->
os.Append(HashLoadedScriptConsideredSourceE().Format) |> ignore
| InvalidInternalsVisibleToAssemblyName(badName,fileNameOption) ->
match fileNameOption with
| Some file -> os.Append(InvalidInternalsVisibleToAssemblyName1E().Format badName file) |> ignore
| None -> os.Append(InvalidInternalsVisibleToAssemblyName2E().Format badName) |> ignore
| LoadedSourceNotFoundIgnoring(filename,_) ->
os.Append(LoadedSourceNotFoundIgnoringE().Format filename) |> ignore
| 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 ->
os.Append(TargetInvocationExceptionWrapperE().Format e.Message) |> ignore
#if DEBUG
Printf.bprintf os "\nStack Trace\n%s\n" (e.ToString())
if !showAssertForUnexpectedException then
System.Diagnostics.Debug.Assert(false,sprintf "Bug seen in compiler: %s" (e.ToString()))
#endif
OutputExceptionR os (err.Exception)
// remove any newlines and tabs
let OutputPhasedError (os:System.Text.StringBuilder) (err:PhasedError) (flattenErrors:bool) =
let buf = new System.Text.StringBuilder()
OutputPhasedErrorR buf err
let s = if flattenErrors then ErrorLogger.NormalizeErrorString (buf.ToString()) else buf.ToString()
os.Append(s) |> ignore
type ErrorStyle =
| DefaultErrors
| EmacsErrors
| TestErrors
| VSErrors
let SanitizeFileName fileName implicitIncludeDir =
// 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.
// # 1000 "Line01.fs"
// then it also asserts. But these are edge cases that can be fixed later, e.g. in bug 4651.
//System.Diagnostics.Debug.Assert(System.IO.Path.IsPathRooted(fileName), sprintf "filename should be absolute: '%s'" fileName)
try
let fullPath = FileSystem.GetFullPathShim(fileName)
let currentDir = implicitIncludeDir
// if the file name is not rooted in the current directory, return the full path
if not(fullPath.StartsWith(currentDir)) then
fullPath
// if the file name is rooted in the current directory, return the relative path
else
fullPath.Replace(currentDir+"\\","")
with _ ->
fileName
(* used by fsc.exe and fsi.exe, but not by VS *)
let rec OutputErrorOrWarning (implicitIncludeDir,showFullPaths,flattenErrors,errorStyle,warn) os (err:PhasedError) =
let outputWhere (showFullPaths,errorStyle) os m =
if m = rangeStartup || m = rangeCmdArgs then ()
else
let file = m.FileName
let file = if showFullPaths then
Filename.fullpath implicitIncludeDir file
else
SanitizeFileName file implicitIncludeDir
match errorStyle with
| ErrorStyle.EmacsErrors -> Printf.bprintf os "File \"%s\", line %d, characters %d-%d: " (file.Replace("\\","/")) m.StartLine m.StartColumn m.EndColumn
// 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 -> Printf.bprintf os "%s(%d,%d): " (file.Replace('/',System.IO.Path.DirectorySeparatorChar)) m.StartLine (m.StartColumn + 1)
// We may also want to change TestErrors to be 1-based
| ErrorStyle.TestErrors -> Printf.bprintf os "%s(%d,%d-%d,%d): " (file.Replace("/","\\")) m.StartLine (m.StartColumn + 1) m.EndLine (m.EndColumn + 1)
// Here, we want the complete range information so Project Systems can generate proper squiggles
| ErrorStyle.VSErrors ->
// Show prefix only for real files. Otherise, we just want a truncated error like:
// parse error FS0031 : blah blah
if m<>range0 && m<>rangeStartup && m<>rangeCmdArgs then
Printf.bprintf os "%s(%d,%d,%d,%d): " (file.Replace("/","\\")) m.StartLine (m.StartColumn + 1) m.EndLine (m.EndColumn + 1)
match err.Exception with
| ReportedError _ ->
dprintf "Unexpected ReportedError" (* this should actually never happen *)
| StopProcessing ->
dprintf "Unexpected StopProcessing" (* this should actually never happen *)
| _ ->
let report err =
let OutputWhere(err) =
Printf.bprintf os "\n";
match RangeOfError err with
| Some m -> outputWhere (showFullPaths,errorStyle) os m
| None -> ()
let OutputCanonicalInformation(err:PhasedError,subcategory, errorNumber) =
match errorStyle with
// Show the subcategory for --vserrors so that we can fish it out in Visual Studio and use it to determine error stickiness.
| ErrorStyle.VSErrors -> Printf.bprintf os "%s %s FS%04d: " subcategory (if warn then "warning" else "error") errorNumber;
| _ -> Printf.bprintf os "%s FS%04d: " (if warn then "warning" else "error") (GetErrorNumber err);
let mainError,relatedErrors = SplitRelatedErrors err
OutputWhere(mainError)
OutputCanonicalInformation(mainError,err.Subcategory(),GetErrorNumber mainError)
OutputPhasedError os mainError flattenErrors;
let OutputRelatedError(err) =
match errorStyle with
// Give a canonical string when --vserror.
| ErrorStyle.VSErrors ->
OutputWhere(mainError) // mainError?
OutputCanonicalInformation(err, err.Subcategory(),GetErrorNumber mainError) // Use main error for code
OutputPhasedError os err flattenErrors
| _ -> Printf.bprintf os "\n"; OutputPhasedError os err flattenErrors
relatedErrors |> List.iter OutputRelatedError
match err with
#if EXTENSIONTYPING
| {Exception = (:? TypeProviderError as tpe)} ->
tpe.Iter (fun e ->
let newErr = {err with Exception = e}
report newErr
)
#endif
| x -> report x
let OutputErrorOrWarningContext prefix fileLineFn os err =
match RangeOfError err with
| None -> ()
| Some m ->
let filename = m.FileName
let lineA = m.StartLine
let lineB = m.EndLine
let line = fileLineFn filename lineA
if line<>"" then
let iA = m.StartColumn
let iB = m.EndColumn
let iLen = if lineA = lineB then max (iB - iA) 1 else 1
Printf.bprintf os "%s%s\n" prefix line;
Printf.bprintf os "%s%s%s\n" prefix (String.make iA '-') (String.make iLen '^')
//----------------------------------------------------------------------------
let GetFSharpCoreLibraryName () = "FSharp.Core"
#if SILVERLIGHT
let GetFsiLibraryName () = "FSharp.Compiler.Silverlight"
#else
let GetFsiLibraryName () = "FSharp.Compiler.Interactive.Settings"
#endif
// This list is the default set of references for "non-project" files.
//
// These DLLs are
// (a) included in the environment used for all .fsx files (see service.fs)
// (b) included in environment for files 'orphaned' from a project context
// -- for orphaned files (files in VS without a project context)
// -- for files given on a command line without --noframework set
let DefaultBasicReferencesForOutOfProjectSources =
[
#if SILVERLIGHT
yield "System.dll"
yield "System.Xml.dll"
yield "System.Core.dll"
yield "System.Net.dll"]
#else
yield "System"
yield "System.Xml"
yield "System.Runtime.Remoting"
yield "System.Runtime.Serialization.Formatters.Soap"
yield "System.Data"
yield "System.Drawing"
// Don't reference System.Core for .NET 2.0 compilations.
//
// We only use a default reference to System.Core if one exists which we can load it into the compiler process.
// Note: this is not a partiuclarly good technique as it relying on the environment the compiler is executing in
// to determine the default references. However, System.Core will only fail to load on machines with only .NET 2.0,
// in which case the compiler will also be running as a .NET 2.0 process.
if (try System.Reflection.Assembly.Load "System.Core, Version=3.5.0.0, Culture=neutral, PublicKeyToken=b77a5c561934e089" |> ignore; true with _ -> false) then
yield "System.Core"
yield "System.Web"
yield "System.Web.Services"
yield "System.Windows.Forms" ]
#endif
// Extra implicit references for .NET 4.0
let DefaultBasicReferencesForOutOfProjectSources40 =
[ "System.Numerics" ]
// A set of assemblies to always consider to be system assemblies
let SystemAssemblies (mscorlibAssemblyName, mscorlibVersion: System.Version, mscorlibIsSilverlight) =
ignore mscorlibVersion
#if SILVERLIGHT
[ yield mscorlibAssemblyName
yield GetFSharpCoreLibraryName()
yield "System"
yield "System.Xml"
yield "System.Core"
yield "System.Net"
yield "System.Observable" ]
#else
[ yield mscorlibAssemblyName
yield GetFSharpCoreLibraryName()
yield "System"
yield "System.Xml"
yield "System.Core"
yield "System.Net"
yield "System.Runtime.Remoting"
yield "System.Runtime.Serialization.Formatters.Soap"
yield "System.Data"
yield "System.Deployment"
yield "System.Design"
yield "System.Messaging"
yield "System.Drawing"
yield "System.Web"
yield "System.Web.Services"
yield "System.Windows.Forms"
// Include System.Observable in the potential-system-assembly set
// on WP7. Note that earlier versions of silverlight did not have this DLL, but
// it is OK to over-approximate the system assembly set.
if mscorlibIsSilverlight then
yield "System.Observable"
if mscorlibVersion.Major >= 4 then
yield "System.Numerics"]
#endif
// The set of references entered into the TcConfigBuilder for scripts prior to computing
// the load closure.
//
// REVIEW: it isn't clear if there is any negative effect
// of leaving an assembly off this list.
let BasicReferencesForScriptLoadClosure =
#if SILVERLIGHT
["mscorlib.dll"; GetFSharpCoreLibraryName()+".dll" ] @ // Need to resolve these explicitly so they will be found in the reference assemblies directory which is where the .xml files are.
DefaultBasicReferencesForOutOfProjectSources @
[ GetFsiLibraryName()+".dll" ]
#else
["mscorlib"; GetFSharpCoreLibraryName () ] @ // Need to resolve these explicitly so they will be found in the reference assemblies directory which is where the .xml files are.
DefaultBasicReferencesForOutOfProjectSources @
[ GetFsiLibraryName() ]
#endif
let (++) x s = x @ [s]
/// Determine the default "frameworkVersion" (which is passed into MSBuild resolve).
/// If this binary was built for v4, the return "v4.0" or "v4.5"
/// If this binary was built for v2, the return "v3.5", "v3.5" or "v2.0" depending on what is installed.
///
/// See: Detecting which versions of the .NET framework are installed.
/// http://blogs.msdn.com/aaronru/archive/2007/11/26/net-framework-3-5-rtm-detection-logic.aspx
/// See: bug 4409.
open Microsoft.Win32
let highestInstalledNetFrameworkVersionMajorMinor() =
#if SILVERLIGHT
#if FX_ATLEAST_SILVERLIGHT_50
System.Version(4,0,5,0),"v5.0"
#else
System.Version(2,0,5,0),"v2.0"
#endif
#else
try
let net45 = Registry.GetValue(@"HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\.NETFramework\v4.0.30319\SKUs\.NETFramework,Version=v4.5","",1) = box 1
if net45 then System.Version(4,0,0,0),"v4.5"
else System.Version(4,0,0,0),"v4.0" // version is 4.0 assumed since this code is running.
with e ->
System.Version(4,0,0,0),"v4.0"
#endif // SILVERLIGHT
//----------------------------------------------------------------------------
// General file name resolver
//--------------------------------------------------------------------------
/// Will return None if the filename is not found.
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))
if FileSystem.IsPathRootedShim(name) && FileSystem.SafeExists name
then Some name
else
let res = paths |> List.tryPick (fun path ->
let n = Path.Combine (path, name)
if FileSystem.SafeExists n then Some n
else None)
res
/// Will raise FileNameNotResolved if the filename was not found
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))
let GetWarningNumber(m,s:string) =
try
Some (int32 s)
with err ->
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("\"","")
if not (FileSystem.IsPathRootedShim(path))
then Path.Combine (implicitIncludeDir, path)
else path
with
:? System.ArgumentException -> path
//----------------------------------------------------------------------------
// Configuration
//--------------------------------------------------------------------------
type CompilerTarget =
| WinExe
| ConsoleExe
| Dll
| Module
member x.IsExe = (match x with ConsoleExe | WinExe -> true | _ -> false)
type ResolveAssemblyReferenceMode = Speculative | ReportErrors
type VersionFlag =
| VersionString of string
| VersionFile of string
| VersionNone
member x.GetVersionInfo(implicitIncludeDir) =
let vstr = x.GetVersionString(implicitIncludeDir)
try
IL.parseILVersion vstr
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)
if not(FileSystem.SafeExists(s)) then
errorR(Error(FSComp.SR.buildInvalidVersionFile(s),rangeStartup)) ; "0.0.0.0"
else
use is = System.IO.File.OpenText s
is.ReadLine()
| VersionNone -> "0.0.0.0"
type AssemblyReference =
| AssemblyReference of range * string
member x.Range = (let (AssemblyReference(m,_)) = x in m)
member x.Text = (let (AssemblyReference(_,text)) = x in text)
member x.SimpleAssemblyNameIs(name) =
(String.Compare(fileNameWithoutExtension x.Text, name, StringComparison.OrdinalIgnoreCase) = 0) ||
(let text = x.Text.ToLowerInvariant()
not (text.Contains "/") && not (text.Contains "\\") && not (text.Contains ".dll") && not (text.Contains ".exe") &&
try let aname = System.Reflection.AssemblyName(x.Text) in aname.Name = name
with _ -> false)
override x.ToString() = sprintf "AssemblyReference(%s)" x.Text
type UnresolvedAssemblyReference = UnresolvedAssemblyReference of string * AssemblyReference list
#if EXTENSIONTYPING
type ResolvedExtensionReference = ResolvedExtensionReference of string * AssemblyReference list * Tainted<ITypeProvider> list
#endif
type TcConfigBuilder =
{ mutable mscorlibAssemblyName : string;
mutable autoResolveOpenDirectivesToDlls: bool;
mutable noFeedback: bool;
mutable stackReserveSize: int32 option;
mutable implicitIncludeDir: string; (* normally "." *)
mutable openBinariesInMemory: bool; (* false for command line, true for VS *)
mutable openDebugInformationForLaterStaticLinking: bool; (* only for --standalone *)
defaultFSharpBinariesDir: string;
mutable compilingFslib: bool;
mutable compilingFslib20: string option;
mutable compilingFslib40: bool;
mutable useIncrementalBuilder: bool;
mutable includes: string list;
mutable implicitOpens: string list;
mutable useFsiAuxLib: bool;
mutable framework: bool;
mutable resolutionEnvironment : Microsoft.FSharp.Compiler.MSBuildResolver.ResolutionEnvironment
mutable implicitlyResolveAssemblies: bool;
mutable addVersionSpecificFrameworkReferences: bool;
mutable light: bool option;
mutable conditionalCompilationDefines: string list;
mutable loadedSources: (range * string) list;
mutable referencedDLLs : AssemblyReference list;
mutable knownUnresolvedReferences : UnresolvedAssemblyReference list;
optimizeForMemory: bool;
mutable subsystemVersion : int * int
mutable useHighEntropyVA : bool
mutable inputCodePage: int option;
mutable embedResources : string list;
mutable globalWarnAsError: bool;
mutable globalWarnLevel: int;
mutable specificWarnOff: int list;
mutable specificWarnOn: int list;
mutable specificWarnAsError: int list
mutable specificWarnAsWarn : int list
mutable mlCompatibility: bool;
mutable checkOverflow: bool;
mutable showReferenceResolutions:bool;
mutable outputFile : string option;
mutable resolutionFrameworkRegistryBase : string;
mutable resolutionAssemblyFoldersSuffix : string;
mutable resolutionAssemblyFoldersConditions : string;
mutable platform : ILPlatform option;
mutable prefer32Bit : bool;
mutable useMonoResolution : bool
mutable target : CompilerTarget
mutable debuginfo : bool
mutable testFlagEmitFeeFeeAs100001 : bool;
mutable dumpDebugInfo : bool
mutable debugSymbolFile : string option
(* Backend configuration *)
mutable typeCheckOnly : bool
mutable parseOnly : bool
mutable importAllReferencesOnly : bool
mutable simulateException : string option
mutable printAst : bool
mutable tokenizeOnly : bool
mutable testInteractionParser : bool
mutable reportNumDecls : bool
mutable printSignature : bool
mutable printSignatureFile : string
mutable xmlDocOutputFile : string option
mutable stats : bool
mutable generateFilterBlocks : bool (* don't generate filter blocks due to bugs on Mono *)
mutable signer : string option
mutable container : string option
mutable delaysign : bool
mutable version : VersionFlag
mutable metadataVersion : string option
mutable standalone : bool
mutable extraStaticLinkRoots : string list
mutable noSignatureData : bool
mutable onlyEssentialOptimizationData : bool
mutable useOptimizationDataFile : bool
mutable useSignatureDataFile : bool
mutable jitTracking : bool
mutable ignoreSymbolStoreSequencePoints : bool
mutable internConstantStrings : bool
mutable extraOptimizationIterations : int
mutable win32res : string
mutable win32manifest : string
mutable includewin32manifest : bool
mutable linkResources : string list
mutable showFullPaths : bool
mutable errorStyle : ErrorStyle
mutable validateTypeProviders: bool
mutable utf8output : bool
mutable flatErrors: bool
mutable maxErrors : int
mutable abortOnError : bool (* intended for fsi scripts that should exit on first error *)
mutable baseAddress : int32 option
#if DEBUG
mutable writeGeneratedILFiles : bool (* write il files? *)
mutable showOptimizationData : bool
#endif
mutable showTerms : bool (* show terms between passes? *)
mutable writeTermsToFiles : bool (* show terms to files? *)
mutable doDetuple : bool (* run detuple pass? *)
mutable doTLR : bool (* run TLR pass? *)
mutable doFinalSimplify : bool (* do final simplification pass *)
mutable optsOn : bool (* optimizations are turned on *)
mutable optSettings : Opt.OptimizationSettings
mutable emitTailcalls : bool
mutable lcid : int option
mutable productNameForBannerText : string
/// show the MS (c) notice, e.g. with help or fsi?
mutable showBanner : bool
/// show times between passes?
mutable showTimes : bool
mutable showLoadedAssemblies : bool
mutable continueAfterParseFailure : bool
#if EXTENSIONTYPING
/// show messages about extension type resolution?
mutable showExtensionTypeMessages : bool
#endif
/// pause between passes?
mutable pause : bool
/// use reflection and indirect calls to call methods taking multidimensional generic arrays
mutable indirectCallArrayMethods : bool
/// whenever possible, emit callvirt instead of call
mutable alwaysCallVirt : bool
/// if true, strip away data that would not be of use to end users, but is useful to us for debugging
// REVIEW: "stripDebugData"?
mutable noDebugData : bool
/// if true, indicates all type checking and code generation is in the context of fsi.exe
isInteractive : bool
isInvalidationSupported : bool
}
static member CreateNew (defaultFSharpBinariesDir,optimizeForMemory,implicitIncludeDir,isInteractive,isInvalidationSupported) =
#if SILVERLIGHT
#else
System.Diagnostics.Debug.Assert(FileSystem.IsPathRootedShim(implicitIncludeDir), sprintf "implicitIncludeDir should be absolute: '%s'" implicitIncludeDir)
if (String.IsNullOrEmpty(defaultFSharpBinariesDir)) then
failwith "Expected a valid defaultFSharpBinariesDir"
#endif
{ mscorlibAssemblyName = "mscorlib";
light = None;
noFeedback=false;
stackReserveSize=None;
conditionalCompilationDefines=[];
implicitIncludeDir = implicitIncludeDir;
autoResolveOpenDirectivesToDlls = false;
openBinariesInMemory = false;
openDebugInformationForLaterStaticLinking=false;
defaultFSharpBinariesDir=defaultFSharpBinariesDir;
compilingFslib=false;
compilingFslib20=None;
compilingFslib40=false;
useIncrementalBuilder=false;
useFsiAuxLib=false;
implicitOpens=[];
includes=[];
resolutionEnvironment=MSBuildResolver.CompileTimeLike
framework=true;
implicitlyResolveAssemblies=true;
addVersionSpecificFrameworkReferences=false;
referencedDLLs = [];
knownUnresolvedReferences = [];
loadedSources = [];
globalWarnAsError=false;
globalWarnLevel=3;
specificWarnOff=[];
specificWarnOn=[];
specificWarnAsError=[]
specificWarnAsWarn=[]
embedResources = [];
inputCodePage=None;
optimizeForMemory=optimizeForMemory;
subsystemVersion = 4,0 // per spec for 357994
useHighEntropyVA = false
mlCompatibility=false;
checkOverflow=false;
showReferenceResolutions=false;
outputFile=None;
resolutionFrameworkRegistryBase = "Software\Microsoft\.NetFramework";
resolutionAssemblyFoldersSuffix = "AssemblyFoldersEx";
resolutionAssemblyFoldersConditions = "";
platform = None;
prefer32Bit = false;
useMonoResolution = runningOnMono
target = ConsoleExe
debuginfo = false
testFlagEmitFeeFeeAs100001 = false
dumpDebugInfo = false
debugSymbolFile = None
(* Backend configuration *)
typeCheckOnly = false
parseOnly = false
importAllReferencesOnly = false
simulateException = None
printAst = false
tokenizeOnly = false
testInteractionParser = false
reportNumDecls = false
printSignature = false
printSignatureFile = ""
xmlDocOutputFile = None
stats = false
generateFilterBlocks = false (* don't generate filter blocks *)
signer = None
container = None
maxErrors = 100
abortOnError = false
baseAddress = None
delaysign = false
version = VersionNone
metadataVersion = None
standalone = false
extraStaticLinkRoots = []
noSignatureData = false
onlyEssentialOptimizationData = false
useOptimizationDataFile = false
useSignatureDataFile = false
jitTracking = true
ignoreSymbolStoreSequencePoints = false
internConstantStrings = true
extraOptimizationIterations = 0
win32res = ""
win32manifest = ""
includewin32manifest = true
linkResources = []
showFullPaths =false
errorStyle = ErrorStyle.DefaultErrors
#if COMPILED_AS_LANGUAGE_SERVICE_DLL
validateTypeProviders = true
#else
validateTypeProviders = false
#endif
utf8output = false
flatErrors = false
#if DEBUG
writeGeneratedILFiles = false (* write il files? *)
showOptimizationData = false
#endif
showTerms = false
writeTermsToFiles = false
doDetuple = false
doTLR = false
doFinalSimplify = false
optsOn = false
optSettings = Opt.OptimizationSettings.Defaults
emitTailcalls = true
lcid = None
productNameForBannerText = (FSComp.SR.buildProductName(FSharpEnvironment.DotNetBuildString))
showBanner = true
showTimes = false
showLoadedAssemblies = false
continueAfterParseFailure = false
#if EXTENSIONTYPING
showExtensionTypeMessages = false
#endif
pause = false
indirectCallArrayMethods = false
alwaysCallVirt = true
noDebugData = false
isInteractive = isInteractive
isInvalidationSupported = isInvalidationSupported
}
member tcConfigB.ResolveSourceFile(m,nm,pathLoadedFrom) =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
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));
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)) implSuffixes)
let outfile =
match tcConfigB.outputFile, List.rev implFiles with
| None,[] -> "out" + ext()
| None, h :: _ ->
let basic = fileNameOfPath h
let modname = try Filename.chopExtension basic with _ -> basic
modname+(ext())
| Some f,_ -> f
let assemblyName =
let baseName = fileNameOfPath outfile
if not (Filename.checkSuffix (String.lowercase baseName) (ext())) then
errorR(Error(FSComp.SR.buildMismatchOutputExtension(),rangeCmdArgs));
fileNameWithoutExtension baseName
let pdbfile : string option =
#if SILVERLIGHT
None
#else
if tcConfigB.debuginfo then
#if NO_PDB_WRITER
Some (match tcConfigB.debugSymbolFile with None -> (Filename.chopExtension outfile)+ (if runningOnMono then ".mdb" else ".pdb") | Some f -> f)
#else
Some (match tcConfigB.debugSymbolFile with
| None -> Microsoft.FSharp.Compiler.AbstractIL.Internal.Support.getDebugFileName outfile
| Some _ when runningOnMono ->
// On Mono, the name of the debug file has to be "<assemblyname>.mdb" so specifying it explicitly is an error
warning(Error(FSComp.SR.ilwriteMDBFileNameCannotBeChangedWarning(),rangeCmdArgs)) ; ()
Microsoft.FSharp.Compiler.AbstractIL.Internal.Support.getDebugFileName outfile
| Some f -> f)
#endif
elif (tcConfigB.debugSymbolFile <> None) && (not (tcConfigB.debuginfo)) then
error(Error(FSComp.SR.buildPdbRequiresDebug(),rangeStartup))
else None
#endif
tcConfigB.outputFile <- Some(outfile)
outfile,pdbfile,assemblyName
member tcConfigB.TurnWarningOff(m,s:string) =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
match GetWarningNumber(m,s) with
| None -> ()
| Some n ->
// nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus
if n = 62 then tcConfigB.mlCompatibility <- true;
tcConfigB.specificWarnOff <- ListSet.insert (=) n tcConfigB.specificWarnOff
member tcConfigB.TurnWarningOn(m, s:string) =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
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) =
let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path
let ok =
let existsOpt =
try Some(Directory.Exists(absolutePath))
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));
exists
| None -> false
if ok && not (List.mem absolutePath tcConfigB.includes) then
tcConfigB.includes <- tcConfigB.includes ++ absolutePath
member tcConfigB.AddLoadedSource(m,path,pathLoadedFrom) =
if Path.IsInvalidPath(path) then
warning(Error(FSComp.SR.buildInvalidFilename(path),m))
else
let path =
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.mem path (List.map snd tcConfigB.loadedSources)) then
tcConfigB.loadedSources <- tcConfigB.loadedSources ++ (m,path)
member tcConfigB.AddEmbeddedResource filename =
tcConfigB.embedResources <- tcConfigB.embedResources ++ filename
member tcConfigB.AddReferencedAssemblyByPath (m,path) =
if Path.IsInvalidPath(path) then
warning(Error(FSComp.SR.buildInvalidAssemblyName(path),m))
elif not (List.mem (AssemblyReference(m,path)) tcConfigB.referencedDLLs) then // NOTE: We keep same paths if range is different.
tcConfigB.referencedDLLs <- tcConfigB.referencedDLLs ++ AssemblyReference(m,path)
member tcConfigB.RemoveReferencedAssemblyByPath (m,path) =
tcConfigB.referencedDLLs <- List.filter (fun (ar : AssemblyReference) -> ar <> AssemblyReference(m,path)) tcConfigB.referencedDLLs
static member SplitCommandLineResourceInfo ri =
if String.contains ri ',' then
let p = String.index ri ','
let file = String.sub ri 0 p
let rest = String.sub ri (p+1) (String.length ri - p - 1)
if String.contains rest ',' then
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))
else
file,rest,ILResourceAccess.Public
else
ri,fileNameOfPath ri,ILResourceAccess.Public
let OpenILBinary(filename,optimizeForMemory,openBinariesInMemory,ilGlobalsOpt,pdbPathOption,mscorlibAssemblyName,noDebugData) =
let ilGlobals =
match ilGlobalsOpt with
| None -> mkILGlobals ILScopeRef.Local (Some mscorlibAssemblyName) (noDebugData, true)
| Some ilGlobals -> ilGlobals
let opts = { ILBinaryReader.defaults with
ILBinaryReader.ilGlobals=ilGlobals;
// fsc.exe does not uses optimizeForMemory (hence keeps MORE caches in AbstractIL)
// fsi.exe does use optimizeForMemory (hence keeps FEWER caches in AbstractIL), because its long running
// Visual Studio does use optimizeForMemory (hence keeps FEWER caches in AbstractIL), because its long running
ILBinaryReader.optimizeForMemory=optimizeForMemory;
ILBinaryReader.pdbPath = pdbPathOption; }
// Visual Studio uses OpenILModuleReaderAfterReadingAllBytes for all DLLs to avoid having to dispose of any readers explicitly
if openBinariesInMemory // && not syslib
then ILBinaryReader.OpenILModuleReaderAfterReadingAllBytes filename opts
else ILBinaryReader.OpenILModuleReader filename opts
#if DEBUG
[<System.Diagnostics.DebuggerDisplayAttribute("AssemblyResolution({resolvedPath})")>]
#endif
type AssemblyResolution =
{ originalReference : AssemblyReference
resolvedPath : string
resolvedFrom : ResolvedFrom
fusionName : string
redist : string
sysdir : bool
ilAssemblyRef : ILAssemblyRef option ref
}
member this.ILAssemblyRef =
match !this.ilAssemblyRef with
| Some(assref) -> assref
| None ->
let readerSettings : ILBinaryReader.ILReaderOptions = {pdbPath=None;ilGlobals=ecmaILGlobals;optimizeForMemory=false}
let reader = ILBinaryReader.OpenILModuleReader this.resolvedPath readerSettings
try
let assRef = mkRefToILAssembly reader.ILModuleDef.ManifestOfAssembly
this.ilAssemblyRef := Some(assRef)
assRef
finally
ILBinaryReader.CloseILModuleReader reader
//----------------------------------------------------------------------------
// Names to match up refs and defs for assemblies and modules
//--------------------------------------------------------------------------
let GetNameOfILModule (m: ILModuleDef) =
match m.Manifest with
| Some manifest -> manifest.Name
| None -> m.Name
let MakeScopeRefForIlModule (ilModule: ILModuleDef) =
match ilModule.Manifest with
| Some m -> ILScopeRef.Assembly (mkRefToILAssembly m)
| None -> ILScopeRef.Module (mkRefToILModule ilModule)
let GetCustomAttributesOfIlModule (ilModule:ILModuleDef) =
(match ilModule.Manifest with Some m -> m.CustomAttrs | None -> ilModule.CustomAttrs).AsList
let GetAutoOpenAttributes(ilModule) =
ilModule |> GetCustomAttributesOfIlModule |> List.choose TryFindAutoOpenAttr
let GetInternalsVisibleToAttributes ilModule =
ilModule |> GetCustomAttributesOfIlModule |> List.choose TryFindInternalsVisibleToAttr
//----------------------------------------------------------------------------
// TcConfig
//--------------------------------------------------------------------------
[<Sealed>]
/// 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) =
// 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
do if validate then try data.version.GetVersionInfo(data.implicitIncludeDir) |> ignore with e -> errorR(e)
// clone the input builder to ensure nobody messes with it.
let data = { data with pause = data.pause }
let computeKnownDllReference(libraryName) =
let defaultCoreLibraryReference = AssemblyReference(range0,libraryName+".dll")
let nameOfDll(AssemblyReference(m,filename) as r) =
let filename = ComputeMakePathAbsolute data.implicitIncludeDir filename
if FileSystem.SafeExists(filename) then
r,Some(filename)
else
// If the file doesn't exist, let reference resolution logic report the error later...
defaultCoreLibraryReference, if m=rangeStartup then Some(filename) else None
match data.referencedDLLs |> List.filter(fun assemblyReference -> assemblyReference.SimpleAssemblyNameIs libraryName) with
| [r] -> nameOfDll r
| [] ->
defaultCoreLibraryReference, None
| r:: _ ->
// Recover by picking the first one.
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 mscorlibReference,mscorlibExplicitFilenameOpt = computeKnownDllReference(data.mscorlibAssemblyName)
let fslibReference,fslibExplicitFilenameOpt = computeKnownDllReference(GetFSharpCoreLibraryName())
// If either mscorlib.dll or fsharp.core.dll are explicitly specified then we require the --noframework flag.
// 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 ((mscorlibExplicitFilenameOpt.IsSome || fslibExplicitFilenameOpt.IsSome) && data.framework) then
error(Error(FSComp.SR.buildExplicitCoreLibRequiresNoFramework("--noframework"),rangeStartup))
let clrRootValue,(mscorlibVersion,targetFrameworkVersionValue),mscorlibIsSilverlight =
match mscorlibExplicitFilenameOpt with
| Some(mscorlibFilename) ->
let filename = ComputeMakePathAbsolute data.implicitIncludeDir mscorlibFilename
try
let ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None,data.mscorlibAssemblyName,data.noDebugData)
try
let ilModule = ilReader.ILModuleDef
match ilModule.ManifestOfAssembly.Version with
| Some(v1,v2,v3,v4) ->
if v1 = 1us then
warning(Error(FSComp.SR.buildRequiresCLI2(filename),rangeStartup))
let clrRoot =
#if SILVERLIGHT
None
#else
Some(Path.GetDirectoryName(FileSystem.GetFullPathShim(filename)))
#endif
clrRoot, (System.Version(int v1, int v2, int v3, int v4), sprintf "v%d.%d" v1 v2), (v1=5us && v2=0us && v3=5us) // SL5 mscorlib is 5.0.5.0
| _ ->
failwith (FSComp.SR.buildCouldNotReadVersionInfoFromMscorlib())
finally
ILBinaryReader.CloseILModuleReader ilReader
with _ ->
error(Error(FSComp.SR.buildCannotReadAssembly(filename),rangeStartup))
| _ ->
None, highestInstalledNetFrameworkVersionMajorMinor(), false
// Note: anycpu32bitpreferred can only be used with .Net version 4.5 and above
// but now there is no way to discriminate between 4.0 and 4.5,
// so here we minimally validate if .Net version >= 4 or not.
do if data.prefer32Bit && mscorlibVersion.Major < 4 then
error(Error(FSComp.SR.invalidPlatformTargetForOldFramework(),rangeCmdArgs))
let systemAssemblies = SystemAssemblies (data.mscorlibAssemblyName, mscorlibVersion, mscorlibIsSilverlight)
// Check that the referenced version of FSharp.Core.dll matches the referenced version of mscorlib.dll
let checkFSharpBinaryCompatWithMscorlib filename (ilAssemblyRefs: ILAssemblyRef list) explicitFscoreVersionToCheckOpt m =
let isfslib = fileNameOfPath filename = GetFSharpCoreLibraryName() + ".dll"
match ilAssemblyRefs |> List.tryFind (fun aref -> aref.Name = data.mscorlibAssemblyName) with
| Some aref ->
match aref.Version with
| Some(v1,_,_,_) ->
if isfslib && ((v1 < 4us) <> (mscorlibVersion.Major < 4)) then
// the versions mismatch, however they are allowed to mismatch in one case:
if mscorlibIsSilverlight && mscorlibVersion.Major=5 // SL5
&& (match explicitFscoreVersionToCheckOpt with
| Some(v1,v2,v3,_) -> v1=2us && v2=3us && v3=5us // we build SL5 against portable FSCore 2.3.5.0
| None -> true) // the 'None' code path happens after explicit FSCore was already checked, from now on SL5 path is always excepted
then
()
else
error(Error(FSComp.SR.buildMscorLibAndFSharpCoreMismatch(filename),m))
// If you're building an assembly that references another assembly built for a more recent
// framework version, we want to raise a warning
elif not(isfslib) && ((v1 = 4us) && (mscorlibVersion.Major < 4)) then
warning(Error(FSComp.SR.buildMscorlibAndReferencedAssemblyMismatch(filename),m))
else
()
| _ -> ()
| _ -> ()
// Look for an explicit reference to FSharp.Core and use that to compute fsharpBinariesDir
let fsharpBinariesDirValue =
#if SILVERLIGHT
#else
match fslibExplicitFilenameOpt with
| Some(fslibFilename) ->
let filename = ComputeMakePathAbsolute data.implicitIncludeDir fslibFilename
try
let ilReader = OpenILBinary(filename,data.optimizeForMemory,data.openBinariesInMemory,None,None,data.mscorlibAssemblyName,data.noDebugData)
try
checkFSharpBinaryCompatWithMscorlib filename ilReader.ILAssemblyRefs ilReader.ILModuleDef.ManifestOfAssembly.Version rangeStartup;
let fslibRoot = Path.GetDirectoryName(FileSystem.GetFullPathShim(filename))
fslibRoot (* , sprintf "v%d.%d" v1 v2 *)
finally
ILBinaryReader.CloseILModuleReader ilReader
with _ ->
error(Error(FSComp.SR.buildCannotReadAssembly(filename),rangeStartup))
| _ ->
#endif
data.defaultFSharpBinariesDir
member x.TargetMscorlibVersion = mscorlibVersion
member x.TargetIsSilverlight = mscorlibIsSilverlight
member x.mscorlibAssemblyName = data.mscorlibAssemblyName
member x.autoResolveOpenDirectivesToDlls = data.autoResolveOpenDirectivesToDlls
member x.noFeedback = data.noFeedback
member x.stackReserveSize = data.stackReserveSize
member x.implicitIncludeDir = data.implicitIncludeDir
member x.openBinariesInMemory = data.openBinariesInMemory
member x.openDebugInformationForLaterStaticLinking = data.openDebugInformationForLaterStaticLinking
member x.fsharpBinariesDir = fsharpBinariesDirValue
member x.compilingFslib = data.compilingFslib
member x.compilingFslib20 = data.compilingFslib20
member x.compilingFslib40 = data.compilingFslib40
member x.useIncrementalBuilder = data.useIncrementalBuilder
member x.includes = data.includes
member x.implicitOpens = data.implicitOpens
member x.useFsiAuxLib = data.useFsiAuxLib
member x.framework = data.framework
member x.implicitlyResolveAssemblies = data.implicitlyResolveAssemblies
member x.addVersionSpecificFrameworkReferences = data.addVersionSpecificFrameworkReferences
member x.resolutionEnvironment = data.resolutionEnvironment
member x.light = data.light
member x.conditionalCompilationDefines = data.conditionalCompilationDefines
member x.loadedSources = data.loadedSources
member x.referencedDLLs = data.referencedDLLs
member x.knownUnresolvedReferences = data.knownUnresolvedReferences
member x.clrRoot = clrRootValue
member x.optimizeForMemory = data.optimizeForMemory
member x.subsystemVersion = data.subsystemVersion
member x.useHighEntropyVA = data.useHighEntropyVA
member x.inputCodePage = data.inputCodePage
member x.embedResources = data.embedResources
member x.globalWarnAsError = data.globalWarnAsError
member x.globalWarnLevel = data.globalWarnLevel
member x.specificWarnOff = data. specificWarnOff
member x.specificWarnOn = data. specificWarnOn
member x.specificWarnAsError = data.specificWarnAsError
member x.specificWarnAsWarn = data.specificWarnAsWarn
member x.mlCompatibility = data.mlCompatibility
member x.checkOverflow = data.checkOverflow
member x.showReferenceResolutions = data.showReferenceResolutions
member x.outputFile = data.outputFile
member x.resolutionFrameworkRegistryBase = data.resolutionFrameworkRegistryBase
member x.resolutionAssemblyFoldersSuffix = data. resolutionAssemblyFoldersSuffix
member x.resolutionAssemblyFoldersConditions = data. resolutionAssemblyFoldersConditions
member x.platform = data.platform
member x.prefer32Bit = data.prefer32Bit
member x.useMonoResolution = data.useMonoResolution
member x.target = data.target
member x.debuginfo = data.debuginfo
member x.testFlagEmitFeeFeeAs100001 = data.testFlagEmitFeeFeeAs100001
member x.dumpDebugInfo = data.dumpDebugInfo
member x.debugSymbolFile = data.debugSymbolFile
member x.typeCheckOnly = data.typeCheckOnly
member x.parseOnly = data.parseOnly
member x.importAllReferencesOnly = data.importAllReferencesOnly
member x.simulateException = data.simulateException
member x.printAst = data.printAst
member x.targetFrameworkVersionMajorMinor = targetFrameworkVersionValue
member x.tokenizeOnly = data.tokenizeOnly
member x.testInteractionParser = data.testInteractionParser
member x.reportNumDecls = data.reportNumDecls
member x.printSignature = data.printSignature
member x.printSignatureFile = data.printSignatureFile
member x.xmlDocOutputFile = data.xmlDocOutputFile
member x.stats = data.stats
member x.generateFilterBlocks = data.generateFilterBlocks
member x.signer = data.signer
member x.container = data.container
member x.delaysign = data.delaysign
member x.version = data.version
member x.metadataVersion = data.metadataVersion
member x.standalone = data.standalone
member x.extraStaticLinkRoots = data.extraStaticLinkRoots
member x.noSignatureData = data.noSignatureData
member x.onlyEssentialOptimizationData = data.onlyEssentialOptimizationData
member x.useOptimizationDataFile = data.useOptimizationDataFile
member x.useSignatureDataFile = data.useSignatureDataFile
member x.jitTracking = data.jitTracking
member x.ignoreSymbolStoreSequencePoints = data.ignoreSymbolStoreSequencePoints
member x.internConstantStrings = data.internConstantStrings
member x.extraOptimizationIterations = data.extraOptimizationIterations
member x.win32res = data.win32res
member x.win32manifest = data.win32manifest
member x.includewin32manifest = data.includewin32manifest
member x.linkResources = data.linkResources
member x.showFullPaths = data.showFullPaths
member x.errorStyle = data.errorStyle
member x.validateTypeProviders = data.validateTypeProviders
member x.utf8output = data.utf8output
member x.flatErrors = data.flatErrors
member x.maxErrors = data.maxErrors
member x.baseAddress = data.baseAddress
#if DEBUG
member x.writeGeneratedILFiles = data.writeGeneratedILFiles
member x.showOptimizationData = data.showOptimizationData
#endif
member x.showTerms = data.showTerms
member x.writeTermsToFiles = data.writeTermsToFiles
member x.doDetuple = data.doDetuple
member x.doTLR = data.doTLR
member x.doFinalSimplify = data.doFinalSimplify
member x.optSettings = data.optSettings
member x.emitTailcalls = data.emitTailcalls
member x.lcid = data.lcid
member x.optsOn = data.optsOn
member x.productNameForBannerText = data.productNameForBannerText
member x.showBanner = data.showBanner
member x.showTimes = data.showTimes
member x.showLoadedAssemblies = data.showLoadedAssemblies
member x.continueAfterParseFailure = data.continueAfterParseFailure
#if EXTENSIONTYPING
member x.showExtensionTypeMessages = data.showExtensionTypeMessages
#endif
member x.pause = data.pause
member x.indirectCallArrayMethods = data.indirectCallArrayMethods
member x.alwaysCallVirt = data.alwaysCallVirt
member x.noDebugData = data.noDebugData
member x.isInteractive = data.isInteractive
member x.isInvalidationSupported = data.isInvalidationSupported
static member Create(builder,validate) =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
TcConfig(builder,validate)
member tcConfig.CloneOfOriginalBuilder =
{ data with conditionalCompilationDefines=data.conditionalCompilationDefines }
member tcConfig.ComputeCanContainEntryPoint(sourceFiles:string list) =
let n = sourceFiles.Length in
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.ClrRoot =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
match tcConfig.clrRoot with
| Some x ->
[tcConfig.MakePathAbsolute x]
| None ->
#if SILVERLIGHT
[]
#else
// When running on Mono we lead everyone to believe we're doing .NET 4.0 compilation
// by default. Why? See https://github.com/fsharp/fsharp/issues/99
if runningOnMono then
[System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()]
else
try
match tcConfig.resolutionEnvironment with
| MSBuildResolver.RuntimeLike ->
[System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()]
| _ ->
let frameworkRoot = MSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory
let frameworkRootVersion = Path.Combine(frameworkRoot,tcConfig.targetFrameworkVersionMajorMinor)
[frameworkRootVersion]
with e ->
errorRecovery e range0; []
#endif
member tcConfig.ComputeLightSyntaxInitialStatus filename =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
let lower = String.lowercase filename
let lightOnByDefault = List.exists (Filename.checkSuffix lower) lightSyntaxDefaultExtensions
if lightOnByDefault then (tcConfig.light <> Some(false)) else (tcConfig.light = Some(true) )
member tcConfig.GetAvailableLoadedSources() =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
let resolveLoadedSource (m,path) =
try
if not(FileSystem.SafeExists(path)) then
error(LoadedSourceNotFoundIgnoring(path,m))
None
else Some(m,path)
with e -> errorRecovery e m; None
tcConfig.loadedSources
|> List.map resolveLoadedSource
|> List.filter Option.isSome
|> List.map Option.get
|> Seq.distinct
|> Seq.toList
/// A closed set of assemblies where, for any subset S:
/// - the TcImports object built for S (and thus the F# Compiler CCUs for the assemblies in S)
/// is a resource that can be shared between any two IncrementalBuild objects that reference
/// precisely S
///
/// Determined by looking at the set of assemblies in the framework assemblies directory, plus the
/// F# core library.
///
/// Returning true may mean that the file is locked and/or placed into the
/// 'framework' reference set that is potentially shared across multiple compilations.
member tcConfig.IsSystemAssembly (filename:string) =
try
FileSystem.SafeExists filename &&
((tcConfig.ClrRoot |> List.exists (fun clrRoot -> clrRoot = Path.GetDirectoryName filename)) ||
(systemAssemblies |> List.exists (fun sysFile -> sysFile = fileNameWithoutExtension filename)))
with _ ->
false
// This is not the complete set of search paths, it is just the set
// that is special to F# (as compared to MSBuild resolution)
member tcConfig.SearchPathsForLibraryFiles =
[ yield! tcConfig.ClrRoot
yield! List.map (tcConfig.MakePathAbsolute) tcConfig.includes
yield tcConfig.implicitIncludeDir
yield tcConfig.fsharpBinariesDir ]
member tcConfig.MakePathAbsolute path =
let result = ComputeMakePathAbsolute tcConfig.implicitIncludeDir path
#if TRACK_DOWN_EXTRA_BACKSLASHES
System.Diagnostics.Debug.Assert(not(result.Contains(@"\\")), "tcConfig.MakePathAbsolute results in a non-canonical filename with extra backslashes: "+result)
#endif
result
member tcConfig.TryResolveLibWithDirectories (AssemblyReference (m,nm) as r) =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
// Only want to resolve certain extensions (otherwise, 'System.Xml' is ambiguous).
// MSBuild resolution is limitted 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
if String.Compare(ext,".dll",StringComparison.OrdinalIgnoreCase)=0
|| String.Compare(ext,".exe",StringComparison.OrdinalIgnoreCase)=0
|| isNetModule then
let resolved = TryResolveFileUsingPaths(tcConfig.SearchPathsForLibraryFiles,m,nm)
match resolved with
| Some(resolved) ->
let sysdir = tcConfig.IsSystemAssembly resolved
let fusionName =
if isNetModule then ""
else
try
let readerSettings : ILBinaryReader.ILReaderOptions = {pdbPath=None;ilGlobals=ecmaILGlobals;optimizeForMemory=false}
let reader = ILBinaryReader.OpenILModuleReader resolved readerSettings
try
let assRef = mkRefToILAssembly reader.ILModuleDef.ManifestOfAssembly
assRef.QualifiedName
finally
ILBinaryReader.CloseILModuleReader reader
with e ->
""
Some
{ originalReference = r;
resolvedPath = resolved;
resolvedFrom = Unknown;
fusionName = fusionName;
redist = null;
sysdir = sysdir;
ilAssemblyRef = ref None }
| None -> None
else None
member tcConfig.ResolveLibWithDirectories (AssemblyReference (m,nm)) =
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 nms =
if isExe || isDLL || isNetModule then
[nm]
else
[nm+".dll";nm+".exe";nm+".netmodule"]
match (List.tryPick (fun nm -> tcConfig.TryResolveLibWithDirectories(AssemblyReference(m,nm))) nms) with
| Some(res) -> res
| None ->
let searchMessage = String.concat "\n " tcConfig.SearchPathsForLibraryFiles
raise (FileNameNotResolved(nm,searchMessage,m))
member tcConfig.ResolveSourceFile(m,nm,pathLoadedFrom) =
data.ResolveSourceFile(m,nm,pathLoadedFrom)
member tcConfig.CheckFSharpBinary (filename,ilAssemblyRefs,m) =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
checkFSharpBinaryCompatWithMscorlib filename ilAssemblyRefs None m
// NOTE!! if mode=Speculative then this method must not report ANY warnings or errors through 'warning' or 'error'. Instead
// 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
#if SILVERLIGHT
#else
static member TryResolveLibsUsingMSBuildRules (tcConfig:TcConfig,originalReferences:AssemblyReference list, errorAndWarningRange:range, mode:ResolveAssemblyReferenceMode) : AssemblyResolution list * UnresolvedAssemblyReference list =
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
if tcConfig.useMonoResolution then
failwith "MSBuild resolution is not supported."
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.
let groupedReferences =
originalReferences
|> List.mapi (fun index reference -> (index, reference))
|> Seq.groupBy(fun (_, reference) -> reference.Text)
|> Seq.map(fun (assemblyName,assemblyAndIndexGroup)->
let assemblyAndIndexGroup = assemblyAndIndexGroup |> List.ofSeq
let highestPosition = assemblyAndIndexGroup |> List.maxBy fst |> fst
let assemblyGroup = assemblyAndIndexGroup |> List.map snd
assemblyName, highestPosition, assemblyGroup)
|> Array.ofSeq
let logmessage showMessages =
if showMessages && tcConfig.showReferenceResolutions then (fun (message:string)->dprintf "%s\n" message)
else ignore
let logwarning showMessages =
(fun code message->
if showMessages && mode = ReportErrors then
match code with
// These are warnings that mean 'not resolved' for some assembly.
// Note that we don't get to know the name of the assembly that couldn't be resolved.
// Ignore these and rely on the logic below to emit an error for each unresolved reference.
| "MSB3246" // Resolved file has a bad image, no metadata, or is otherwise inaccessible.
| "MSB3106"
-> ()
| _ ->
(if code = "MSB3245" then errorR else warning)
(MSBuildReferenceResolutionWarning(code,message,errorAndWarningRange)))
let logerror showMessages =
(fun code message ->
if showMessages && mode = ReportErrors then
errorR(MSBuildReferenceResolutionError(code,message,errorAndWarningRange)))
let targetFrameworkMajorMinor = tcConfig.targetFrameworkVersionMajorMinor
#if DEBUG
assert( Set.contains targetFrameworkMajorMinor (set ["v2.0";"v3.0";"v3.5";"v4.0";"v4.5"; (*SL only*) "v5.0"]) ) // Resolve is flexible, but pinning down targetFrameworkMajorMinor.
#endif
let targetProcessorArchitecture =
match tcConfig.platform with
| None -> "MSIL"
| Some(X86) -> "x86"
| Some(AMD64) -> "amd64"
| Some(IA64) -> "ia64"
let outputDirectory =
match tcConfig.outputFile with
| Some(outputFile) -> tcConfig.MakePathAbsolute outputFile
| None -> tcConfig.implicitIncludeDir
let targetFrameworkDirectories =
match tcConfig.clrRoot with
| Some(clrRoot) -> [tcConfig.MakePathAbsolute clrRoot]
| None -> []
// First, try to resolve everything as a file using simple resolution
let resolvedAsFile =
groupedReferences
|>Array.map(fun (_filename,maxIndexOfReference,references)->
let assemblyResolution = references
|> List.map tcConfig.TryResolveLibWithDirectories
|> List.filter Option.isSome
|> List.map Option.get
(maxIndexOfReference, assemblyResolution))
|> Array.filter(fun (_,refs)->refs|>List.isEmpty|>not)
// Whatever is left, pass to MSBuild.
let Resolve(references,showMessages) =
try
MSBuildResolver.Resolve
(tcConfig.resolutionEnvironment,
references,
targetFrameworkMajorMinor, // TargetFrameworkVersionMajorMinor
targetFrameworkDirectories, // TargetFrameworkDirectories
targetProcessorArchitecture, // TargetProcessorArchitecture
Path.GetDirectoryName(outputDirectory), // Output directory
tcConfig.fsharpBinariesDir, // FSharp binaries directory
tcConfig.includes, // Explicit include directories
tcConfig.implicitIncludeDir, // Implicit include directory (likely the project directory)
tcConfig.resolutionFrameworkRegistryBase,
tcConfig.resolutionAssemblyFoldersSuffix,
tcConfig.resolutionAssemblyFoldersConditions,
logmessage showMessages, logwarning showMessages, logerror showMessages)
with
MSBuildResolver.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)
let resolutions = Resolve(toMsBuild,(*showMessages*)true)
// Map back to original assembly resolutions.
let resolvedByMsbuild =
resolutions.resolvedFiles
|> Array.map(fun resolvedFile ->
let i = int resolvedFile.baggage
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)
let canonicalItemSpec = FileSystem.GetFullPathShim(resolvedFile.itemSpec)
{originalReference=originalReference;
resolvedPath=canonicalItemSpec;
resolvedFrom=resolvedFile.resolvedFrom;
fusionName=resolvedFile.fusionName
redist=resolvedFile.redist;
sysdir=tcConfig.IsSystemAssembly canonicalItemSpec;
ilAssemblyRef = ref None})
(maxIndexOfReference, assemblyResolutions))
// When calculating the resulting resolutions, we're going to use the index of the reference
// in the original specification and resort it to match the ordering that we had.
let resultingResolutions =
[resolvedByMsbuild;resolvedAsFile]
|> Array.concat
|> Array.sortBy fst
|> Array.map snd
|> List.ofArray
|> List.concat
// O(N^2) here over a small set of referenced assemblies.
let IsResolved(originalName:string) =
if resultingResolutions |> List.exists(fun resolution -> resolution.originalReference.Text = originalName) then true
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).resolvedFiles.Length<>0
let unresolvedReferences =
groupedReferences
//|> Array.filter(p13 >> IsNotFileOrIsAssembly)
|> Array.filter(p13 >> IsResolved >> not)
|> List.ofArray
// 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
else
resultingResolutions,unresolvedReferences |> List.map (fun (name, _, r) -> (name, r)) |> List.map UnresolvedAssemblyReference
#endif // SILVERLIGHT
member tcConfig.MscorlibDllReference() = mscorlibReference
member tcConfig.CoreLibraryDllReference() = fslibReference
let warningMem n l = List.mem n l
let ReportWarning (globalWarnLevel : int) (specificWarnOff : int list) (specificWarnOn : int list) err =
let n = GetErrorNumber err
warningOn err globalWarnLevel specificWarnOn && not (warningMem n specificWarnOff)
let ReportWarningAsError (globalWarnLevel : int) (specificWarnOff : int list) (specificWarnOn : int list) (specificWarnAsError : int list) (specificWarnAsWarn : int list) (globalWarnAsError : bool) err =
(warningOn err globalWarnLevel specificWarnOn) &&
not(warningMem (GetErrorNumber err) specificWarnAsWarn) &&
((globalWarnAsError && not (warningMem (GetErrorNumber err) specificWarnOff)) ||
warningMem (GetErrorNumber err) specificWarnAsError)
//----------------------------------------------------------------------------
// Scoped #nowarn pragmas
let GetScopedPragmasForHashDirective hd =
[ match hd with
| ParsedHashDirective("nowarn",numbers,m) ->
for s in numbers do
match GetWarningNumber(m,s) with
| None -> ()
| Some n -> yield ScopedPragma.WarningOff(m,n)
| _ -> () ]
let GetScopedPragmasForInput input =
match input with
| ParsedInput.SigFile (ParsedSigFileInput(_,_,pragmas,_,_)) -> pragmas
| ParsedInput.ImplFile (ParsedImplFileInput(_,_,_,pragmas,_,_,_)) ->pragmas
/// Build an ErrorLogger that delegates to another ErrorLogger but filters warnings turned off by the given pragma declarations
//
// NOTE: we allow a flag to turn of strict file checking. This is because file names sometimes don't match due to use of
// #line directives, e.g. for pars.fs/pars.fsy. In this case we just test by line number - in most cases this is sufficent
// because we install a filtering error handler on a file-by-file basis for parsing and type-checking.
// However this is indicative of a more systematic problem where source-line
// sensitive operations (lexfilter and warning filtering) do not always
// interact well with #line directives.
type ErrorLoggerFilteringByScopedPragmas (checkFile,scopedPragmas,errorLogger:ErrorLogger) =
inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas")
let mutable scopedPragmas = scopedPragmas
member x.ScopedPragmas with set v = scopedPragmas <- v
override x.ErrorSinkImpl err = errorLogger.ErrorSink err
override x.ErrorCount = errorLogger.ErrorCount
override x.WarnSinkImpl err =
let report =
let warningNum = GetErrorNumber err
match RangeOfError err with
| Some m ->
not (scopedPragmas |> List.exists (fun pragma ->
match pragma with
| ScopedPragma.WarningOff(pragmaRange,warningNumFromPragma) ->
warningNum = warningNumFromPragma &&
(not checkFile || m.FileIndex = pragmaRange.FileIndex) &&
Range.posGeq m.Start pragmaRange.Start))
| None -> true
if report then errorLogger.WarnSink(err);
let GetErrorLoggerFilteringByScopedPragmas(checkFile,scopedPragmas,errorLogger) =
(ErrorLoggerFilteringByScopedPragmas(checkFile,scopedPragmas,errorLogger) :> ErrorLogger)
/// Build an ErrorLogger that delegates to another ErrorLogger but filters warnings turned off by the given pragma declarations
type DelayedErrorLogger(errorLogger:ErrorLogger) =
inherit ErrorLogger("DelayedErrorLogger")
let delayed = new ResizeArray<_>()
override x.ErrorSinkImpl err = delayed.Add (err,true)
override x.ErrorCount = delayed |> Seq.filter snd |> Seq.length
override x.WarnSinkImpl err = delayed.Add(err,false)
member x.CommitDelayedErrorsAndWarnings() =
// Eagerly grab all the errors and warnings from the mutable collection
let errors = delayed |> Seq.toList
// Now report them
for (err,isError) in errors do
if isError then errorLogger.ErrorSink err else errorLogger.WarnSink err
//----------------------------------------------------------------------------
// Parsing
//--------------------------------------------------------------------------
let CanonicalizeFilename filename =
let basic = fileNameOfPath filename
String.capitalize (try Filename.chopExtension basic with _ -> basic)
let IsScript filename =
let lower = String.lowercase filename
scriptSuffixes |> List.exists (Filename.checkSuffix lower)
// Give a unique name to the different kinds of inputs. Used to correlate signature and implementation files
// QualFileNameOfModuleName - files with a single module declaration or an anonymous module
let QualFileNameOfModuleName m filename modname = QualifiedNameOfFile(mkSynId m (textOfLid modname + (if IsScript filename then "$fsx" else "")))
let QualFileNameOfFilename m filename = QualifiedNameOfFile(mkSynId m (CanonicalizeFilename filename + (if IsScript filename then "$fsx" else "")))
// Interactive fragments
let QualFileNameOfUniquePath (m, p: string list) = QualifiedNameOfFile(mkSynId m (String.concat "_" p))
let QualFileNameOfSpecs filename specs =
match specs with
| [SynModuleOrNamespaceSig(modname,true,_,_,_,_,m)] -> QualFileNameOfModuleName m filename modname
| _ -> QualFileNameOfFilename (rangeN filename 1) filename
let QualFileNameOfImpls filename specs =
match specs with
| [SynModuleOrNamespace(modname,true,_,_,_,_,m)] -> QualFileNameOfModuleName m filename modname
| _ -> QualFileNameOfFilename (rangeN filename 1) filename
let PrepandPathToQualFileName x (QualifiedNameOfFile(q)) = QualFileNameOfUniquePath (q.idRange,pathOfLid x@[q.idText])
let PrepandPathToImpl x (SynModuleOrNamespace(p,c,d,e,f,g,h)) = SynModuleOrNamespace(x@p,c,d,e,f,g,h)
let PrepandPathToSpec x (SynModuleOrNamespaceSig(p,c,d,e,f,g,h)) = SynModuleOrNamespaceSig(x@p,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))
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))
let combined =
match defaultNamespace with
| None -> modname
| Some ns -> textOfPath [ns;modname]
let anonymousModuleNameRange =
let filename = m.FileName
mkRange filename pos0 pos0
pathToSynLid anonymousModuleNameRange (splitNamespace combined)
let PostParseModuleImpl (_i,defaultNamespace,isLastCompiland,filename,impl) =
match impl with
| ParsedImplFileFragment.NamedModule(SynModuleOrNamespace(lid,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 :: rest when id.idText = MangledGlobalName -> rest
| _ -> lid
SynModuleOrNamespace(lid,isModule,decls,xmlDoc,attribs,access,m)
| ParsedImplFileFragment.AnonModule (defs,m)->
if not isLastCompiland && not (doNotRequireNamespaceOrModuleSuffixes |> List.exists (Filename.checkSuffix (String.lowercase filename))) then
errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(),trimRangeToLine m))
let modname = ComputeAnonModuleName (nonNil defs) defaultNamespace filename (trimRangeToLine m)
SynModuleOrNamespace(modname,true,defs,PreXmlDoc.Empty,[],None,m)
| ParsedImplFileFragment.NamespaceFragment (lid,b,c,d,e,m)->
let lid =
match lid with
| id :: rest when id.idText = MangledGlobalName -> rest
| _ -> lid
SynModuleOrNamespace(lid,b,c,d,e,None,m)
let PostParseModuleSpec (_i,defaultNamespace,isLastCompiland,filename,intf) =
match intf with
| ParsedSigFileFragment.NamedModule(SynModuleOrNamespaceSig(lid,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 :: rest when id.idText = MangledGlobalName -> rest
| _ -> lid
SynModuleOrNamespaceSig(lid,isModule,decls,xmlDoc,attribs,access,m)
| ParsedSigFileFragment.AnonModule (defs,m) ->
if not isLastCompiland && not (doNotRequireNamespaceOrModuleSuffixes |> List.exists (Filename.checkSuffix (String.lowercase filename))) then
errorR(Error(FSComp.SR.buildMultiFileRequiresNamespaceOrModule(),m))
let modname = ComputeAnonModuleName (nonNil defs) defaultNamespace filename (trimRangeToLine m)
SynModuleOrNamespaceSig(modname,true,defs,PreXmlDoc.Empty,[],None,m)
| ParsedSigFileFragment.NamespaceFragment (lid,b,c,d,e,m)->
let lid =
match lid with
| id :: rest when id.idText = MangledGlobalName -> rest
| _ -> lid
SynModuleOrNamespaceSig(lid,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
| Some lid when impls.Length > 1 ->
errorR(Error(FSComp.SR.buildMultipleToplevelModules(),rangeOfLid lid))
| _ ->
()
let impls = impls |> List.mapi (fun i x -> PostParseModuleImpl (i, defaultNamespace, isLastCompiland, filename, x))
let qualName = QualFileNameOfImpls filename impls
let isScript = IsScript filename
let scopedPragmas =
[ for (SynModuleOrNamespace(_,_,decls,_,_,_,_)) in impls do
for d in decls do
match d with
| SynModuleDecl.HashDirective (hd,_) -> yield! GetScopedPragmasForHashDirective hd
| _ -> ()
for hd in hashDirectives