Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions azure-pipelines.yml
Original file line number Diff line number Diff line change
Expand Up @@ -12,6 +12,7 @@ trigger:
exclude:
- .github/*
- docs/
- tests/scripts/
- attributions.md
- CODE_OF_CONDUCT.md
- DEVGUIDE.md
Expand Down
8 changes: 4 additions & 4 deletions src/Compiler/AbstractIL/ilreflect.fs
Original file line number Diff line number Diff line change
Expand Up @@ -479,11 +479,11 @@ module Zmap =

let equalTypes (s: Type) (t: Type) = s.Equals t

let equalTypeLists ss tt =
List.lengthsEqAndForall2 equalTypes ss tt
let equalTypeLists (tys1: Type list) (tys2: Type list) =
List.lengthsEqAndForall2 equalTypes tys1 tys2

let equalTypeArrays ss tt =
Array.lengthsEqAndForall2 equalTypes ss tt
let equalTypeArrays (tys1: Type[]) (tys2: Type[]) =
Array.lengthsEqAndForall2 equalTypes tys1 tys2

let getGenericArgumentsOfType (typT: Type) =
if typT.IsGenericType then
Expand Down
2 changes: 1 addition & 1 deletion src/Compiler/AbstractIL/ilx.fs
Original file line number Diff line number Diff line change
Expand Up @@ -75,7 +75,7 @@ type IlxClosureApps =
let rec instAppsAux n inst apps =
match apps with
| Apps_tyapp (ty, rest) -> Apps_tyapp(instILTypeAux n inst ty, instAppsAux n inst rest)
| Apps_app (dty, rest) -> Apps_app(instILTypeAux n inst dty, instAppsAux n inst rest)
| Apps_app (domainTy, rest) -> Apps_app(instILTypeAux n inst domainTy, instAppsAux n inst rest)
| Apps_done retTy -> Apps_done(instILTypeAux n inst retTy)

let rec instLambdasAux n inst lambdas =
Expand Down
14 changes: 7 additions & 7 deletions src/Compiler/Checking/CheckComputationExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -224,10 +224,10 @@ let TcComputationExpression (cenv: cenv) env (overallTy: OverallTy) tpenv (mWhol
// Give bespoke error messages for the FSharp.Core "query" builder
let isQuery =
match stripDebugPoints interpExpr with
| Expr.Val (vf, _, m) ->
let item = Item.CustomBuilder (vf.DisplayName, vf)
| Expr.Val (vref, _, m) ->
let item = Item.CustomBuilder (vref.DisplayName, vref)
CallNameResolutionSink cenv.tcSink (m, env.NameEnv, item, emptyTyparInst, ItemOccurence.Use, env.eAccessRights)
valRefEq cenv.g vf cenv.g.query_value_vref
valRefEq cenv.g vref cenv.g.query_value_vref
| _ -> false

/// Make a builder.Method(...) call
Expand Down Expand Up @@ -1909,8 +1909,8 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =
// This transformation is visible in quotations and thus needs to remain.
| (TPat_as (TPat_wild _, PatternValBinding (v, _), _),
[_],
DebugPoints(Expr.App (Expr.Val (vf, _, _), _, [genEnumElemTy], [yieldExpr], _mYield), recreate))
when valRefEq cenv.g vf cenv.g.seq_singleton_vref ->
DebugPoints(Expr.App (Expr.Val (vref, _, _), _, [genEnumElemTy], [yieldExpr], _mYield), recreate))
when valRefEq cenv.g vref cenv.g.seq_singleton_vref ->

// The debug point mFor is attached to the 'map'
// The debug point mIn is attached to the lambda
Expand Down Expand Up @@ -2051,11 +2051,11 @@ let TcSequenceExpression (cenv: cenv) env tpenv comp (overallTy: OverallTy) m =
error(Error(FSComp.SR.tcUseForInSequenceExpression(), m))

| SynExpr.Match (spMatch, expr, clauses, _m, _trivia) ->
let inputExpr, matchty, tpenv = TcExprOfUnknownType cenv env tpenv expr
let inputExpr, inputTy, tpenv = TcExprOfUnknownType cenv env tpenv expr

let tclauses, tpenv =
(tpenv, clauses) ||> List.mapFold (fun tpenv (SynMatchClause(pat, cond, innerComp, _, sp, _)) ->
let patR, condR, vspecs, envinner, tpenv = TcMatchPattern cenv matchty env tpenv pat cond
let patR, condR, vspecs, envinner, tpenv = TcMatchPattern cenv inputTy env tpenv pat cond
let envinner =
match sp with
| DebugPointAtTarget.Yes -> { envinner with eIsControlFlow = true }
Expand Down
64 changes: 32 additions & 32 deletions src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -291,9 +291,9 @@ let OpenModuleOrNamespaceRefs tcSink g amap scopem root env mvvs openDeclaration
env

/// Adjust the TcEnv to account for opening a type implied by an `open type` declaration
let OpenTypeContent tcSink g amap scopem env (typ: TType) openDeclaration =
let OpenTypeContent tcSink g amap scopem env (ty: TType) openDeclaration =
let env =
{ env with eNameResEnv = AddTypeContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv typ }
{ env with eNameResEnv = AddTypeContentsToNameEnv g amap env.eAccessRights scopem env.eNameResEnv ty }
CallEnvSink tcSink (scopem, env.NameEnv, env.eAccessRights)
CallOpenDeclarationSink tcSink openDeclaration
env
Expand Down Expand Up @@ -658,16 +658,16 @@ let TcOpenTypeDecl (cenv: cenv) mOpenDecl scopem env (synType: SynType, m) =

checkLanguageFeatureError g.langVersion LanguageFeature.OpenTypeDeclaration mOpenDecl

let typ, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType
let ty, _tpenv = TcType cenv NoNewTypars CheckCxs ItemOccurence.Open env emptyUnscopedTyparEnv synType

if not (isAppTy g typ) then
if not (isAppTy g ty) then
error(Error(FSComp.SR.tcNamedTypeRequired("open type"), m))

if isByrefTy g typ then
if isByrefTy g ty then
error(Error(FSComp.SR.tcIllegalByrefsInOpenTypeDeclaration(), m))

let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [typ], scopem, false)
let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env typ openDecl
let openDecl = OpenDeclaration.Create (SynOpenDeclTarget.Type (synType, m), [], [ty], scopem, false)
let env = OpenTypeContent cenv.tcSink g cenv.amap scopem env ty openDecl
env, [openDecl]

let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target =
Expand Down Expand Up @@ -1060,7 +1060,7 @@ module MutRecBindingChecking =
Phase2BInherit (inheritsExpr, baseValOpt), innerState

// Phase2B: let and let rec value and function definitions
| Phase2AIncrClassBindings (tcref, binds, isStatic, isRec, bindsm) ->
| Phase2AIncrClassBindings (tcref, binds, isStatic, isRec, mBinds) ->
let envForBinding = if isStatic then envStatic else envInstance
let binds, bindRs, env, tpenv =
if isRec then
Expand All @@ -1073,12 +1073,12 @@ module MutRecBindingChecking =
else

// Type check local binding
let binds, env, tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding isStatic) tpenv (binds, bindsm, scopem)
let binds, env, tpenv = TcLetBindings cenv envForBinding ExprContainerInfo (ClassLetBinding isStatic) tpenv (binds, mBinds, scopem)
let binds, bindRs =
binds
|> List.map (function
| TMDefLet(bind, _) -> [bind], IncrClassBindingGroup([bind], isStatic, false)
| TMDefDo(e, _) -> [], IncrClassDo(e, isStatic, bindsm)
| TMDefDo(e, _) -> [], IncrClassDo(e, isStatic, mBinds)
| _ -> error(InternalError("unexpected definition kind", tcref.Range)))
|> List.unzip
List.concat binds, bindRs, env, tpenv
Expand Down Expand Up @@ -1473,7 +1473,7 @@ module MutRecBindingChecking =
envForDecls)

/// Phase 2: Check the members and 'let' definitions in a mutually recursive group of definitions.
let TcMutRecDefns_Phase2_Bindings (cenv: cenv) envInitial tpenv bindsm scopem mutRecNSInfo (envMutRecPrelimWithReprs: TcEnv) (mutRecDefns: MutRecDefnsPhase2Info) =
let TcMutRecDefns_Phase2_Bindings (cenv: cenv) envInitial tpenv mBinds scopem mutRecNSInfo (envMutRecPrelimWithReprs: TcEnv) (mutRecDefns: MutRecDefnsPhase2Info) =
let g = cenv.g
let denv = envMutRecPrelimWithReprs.DisplayEnv

Expand Down Expand Up @@ -1601,12 +1601,12 @@ module MutRecBindingChecking =
(fun morpher shape -> shape |> MutRecShapes.iterTyconsAndLets (p23 >> morpher) morpher)
MutRecShape.Lets
(fun morpher shape -> shape |> MutRecShapes.mapTyconsAndLets (fun (tyconOpt, fixupValueExprBinds, methodBinds) -> tyconOpt, (morpher fixupValueExprBinds @ methodBinds)) morpher)
bindsm
mBinds

defnsEs, envMutRec

/// Check and generalize the interface implementations, members, 'let' definitions in a mutually recursive group of definitions.
let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (envMutRec: TcEnv) (mutRecDefns: MutRecDefnsPhase2Data) =
let TcMutRecDefns_Phase2 (cenv: cenv) envInitial mBinds scopem mutRecNSInfo (envMutRec: TcEnv) (mutRecDefns: MutRecDefnsPhase2Data) =
let g = cenv.g
let interfacesFromTypeDefn envForTycon tyconMembersData =
let (MutRecDefnsPhase2DataForTycon(_, _, declKind, tcref, _, _, declaredTyconTypars, members, _, _, _)) = tyconMembersData
Expand Down Expand Up @@ -1720,7 +1720,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (env
(intfTypes, slotImplSets) ||> List.map2 (interfaceMembersFromTypeDefn tyconData) |> List.concat
MutRecDefnsPhase2InfoForTycon(tyconOpt, tcref, declaredTyconTypars, declKind, obinds @ ibinds, fixupFinalAttrs))

MutRecBindingChecking.TcMutRecDefns_Phase2_Bindings cenv envInitial tpenv bindsm scopem mutRecNSInfo envMutRec binds
MutRecBindingChecking.TcMutRecDefns_Phase2_Bindings cenv envInitial tpenv mBinds scopem mutRecNSInfo envMutRec binds

with exn -> errorRecovery exn scopem; [], envMutRec

Expand Down Expand Up @@ -3426,37 +3426,37 @@ module EstablishTypeDefinitionCores =
match stripTyparEqns ty with
| TType_anon (_,l)
| TType_tuple (_, l) -> accInAbbrevTypes l acc
| TType_ucase (UnionCaseRef(tc, _), tinst)
| TType_app (tc, tinst, _) ->
let tycon2 = tc.Deref
| TType_ucase (UnionCaseRef(tcref2, _), tinst)
| TType_app (tcref2, tinst, _) ->
let tycon2 = tcref2.Deref
let acc = accInAbbrevTypes tinst acc
// Record immediate recursive references
if ListSet.contains (===) tycon2 tycons then
(tycon, tycon2) :: acc
// Expand the representation of abbreviations
elif tc.IsTypeAbbrev then
accInAbbrevType (reduceTyconRefAbbrev tc tinst) acc
elif tcref2.IsTypeAbbrev then
accInAbbrevType (reduceTyconRefAbbrev tcref2 tinst) acc
// Otherwise H<inst> - explore the instantiation.
else
acc

| TType_fun (d, r, _) ->
accInAbbrevType d (accInAbbrevType r acc)
| TType_fun (domainTy, rangeTy, _) ->
accInAbbrevType domainTy (accInAbbrevType rangeTy acc)

| TType_var _ -> acc

| TType_forall (_, r) -> accInAbbrevType r acc
| TType_forall (_, bodyTy) -> accInAbbrevType bodyTy acc

| TType_measure ms -> accInMeasure ms acc

and accInMeasure ms acc =
match stripUnitEqns ms with
| Measure.Con tc when ListSet.contains (===) tc.Deref tycons ->
(tycon, tc.Deref) :: acc
| Measure.Con tc when tc.IsTypeAbbrev ->
accInMeasure (reduceTyconRefAbbrevMeasureable tc) acc
| TType_measure measureTy -> accInMeasure measureTy acc

and accInMeasure measureTy acc =
match stripUnitEqns measureTy with
| Measure.Const tcref when ListSet.contains (===) tcref.Deref tycons ->
(tycon, tcref.Deref) :: acc
| Measure.Const tcref when tcref.IsTypeAbbrev ->
accInMeasure (reduceTyconRefAbbrevMeasureable tcref) acc
| Measure.Prod (ms1, ms2) -> accInMeasure ms1 (accInMeasure ms2 acc)
| Measure.Inv ms -> accInMeasure ms acc
| Measure.Inv invTy -> accInMeasure invTy acc
| _ -> acc

and accInAbbrevTypes tys acc =
Expand All @@ -3467,7 +3467,7 @@ module EstablishTypeDefinitionCores =
| Some ty -> accInAbbrevType ty []

let edges = List.collect edgesFrom tycons
let graph = Graph<Tycon, Stamp> ((fun tc -> tc.Stamp), tycons, edges)
let graph = Graph<Tycon, Stamp> ((fun tycon -> tycon.Stamp), tycons, edges)
graph.IterateCycles (fun path ->
let tycon = path.Head
// The thing is cyclic. Set the abbreviation and representation to be "None" to stop later VS crashes
Expand Down
Loading