@@ -971,6 +971,43 @@ let TranslatePartialValReprInfo tps (PrelimValReprInfo (argsData, retData)) =
971971// Members
972972//-------------------------------------------------------------------------
973973
974+ let TcAddNullnessToType (warn: bool) (cenv: cenv) (env: TcEnv) nullness innerTyC m =
975+ let g = cenv.g
976+ if g.langFeatureNullness then
977+ if TypeNullNever g innerTyC then
978+ let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
979+ errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))
980+
981+ match tryAddNullnessToTy nullness innerTyC with
982+
983+ | None ->
984+ let tyString = NicePrint.minimalStringOfType env.DisplayEnv innerTyC
985+ errorR(Error(FSComp.SR.tcTypeDoesNotHaveAnyNull(tyString), m))
986+ innerTyC
987+
988+ | Some innerTyCWithNull ->
989+ // The inner type is not allowed to support null or use null as a representation value.
990+ // For example "int option?" is not allowed, nor "string??".
991+ //
992+ // For variable types in FSharp.Core we make an exception because we must allow
993+ // val toObj: value: 'T option -> 'T __withnull when 'T : not struct (* and 'T : __notnull *)
994+ // wihout implying 'T is not null. This is because it is legitimate to use this
995+ // function to "collapse" null and obj-null-coming-from-option using such a function.
996+
997+ if not g.compilingFSharpCore || not (isTyparTy g innerTyC) then
998+ AddCxTypeDefnNotSupportsNull env.DisplayEnv cenv.css m NoTrace innerTyC
999+
1000+ innerTyCWithNull
1001+
1002+ else
1003+ if warn then
1004+ warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m))
1005+ innerTyC
1006+
1007+ //-------------------------------------------------------------------------
1008+ // Members
1009+ //-------------------------------------------------------------------------
1010+
9741011let ComputeLogicalName (id: Ident) (memberFlags: SynMemberFlags) =
9751012 match memberFlags.MemberKind with
9761013 | SynMemberKind.ClassConstructor -> ".cctor"
@@ -2085,7 +2122,7 @@ module GeneralizationHelpers =
20852122 match tp.Constraints |> List.partition (function TyparConstraint.CoercesTo _ -> true | _ -> false) with
20862123 | [TyparConstraint.CoercesTo(tgtTy, _)], others ->
20872124 // Throw away null constraints if they are implied
2088- if others |> List.exists (function TyparConstraint.SupportsNull _ -> not (TypeSatisfiesNullConstraint g m tgtTy) | _ -> true)
2125+ if others |> List.exists (function TyparConstraint.SupportsNull _ -> not (TypeNullIsExtraValue g m tgtTy) | _ -> true)
20892126 then None
20902127 else Some tgtTy
20912128 | _ -> None
@@ -3963,7 +4000,14 @@ let rec TcTyparConstraint ridx (cenv: cenv) newOk checkConstraints occ (env: TcE
39634000 tpenv
39644001
39654002 | SynTypeConstraint.WhereTyparSupportsNull(tp, m) ->
3966- TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeUseSupportsNull
4003+ TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeDefnSupportsNull
4004+
4005+ | SynTypeConstraint.WhereTyparNotSupportsNull(tp, m) ->
4006+ if g.langFeatureNullness then
4007+ TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeDefnNotSupportsNull
4008+ else
4009+ warning(Error(FSComp.SR.tcNullnessCheckingNotEnabled(), m))
4010+ tpenv
39674011
39684012 | SynTypeConstraint.WhereTyparIsComparable(tp, m) ->
39694013 TcSimpleTyparConstraint cenv env newOk tpenv tp m AddCxTypeMustSupportComparison
@@ -4377,11 +4421,18 @@ and TcTypeOrMeasure kindOpt (cenv: cenv) newOk checkConstraints occ (iwsam: Warn
43774421 | SynType.StaticConstant (synConst, m) ->
43784422 TcTypeStaticConstant kindOpt tpenv synConst m
43794423
4424+ | SynType.StaticConstantNull m
43804425 | SynType.StaticConstantNamed (_, _, m)
43814426 | SynType.StaticConstantExpr (_, m) ->
43824427 errorR(Error(FSComp.SR.parsInvalidLiteralInType(), m))
43834428 NewErrorType (), tpenv
43844429
4430+ | SynType.WithNull(innerTy, ambivalent, m) ->
4431+ let innerTyC, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv innerTy
4432+ let nullness = if ambivalent then KnownAmbivalentToNull else KnownWithNull
4433+ let tyWithNull = TcAddNullnessToType false cenv env nullness innerTyC m
4434+ tyWithNull, tpenv
4435+
43854436 | SynType.MeasurePower(ty, exponent, m) ->
43864437 TcTypeMeasurePower kindOpt cenv newOk checkConstraints occ env tpenv ty exponent m
43874438
@@ -4531,7 +4582,7 @@ and TcFunctionType (cenv: cenv) newOk checkConstraints occ env tpenv domainTy re
45314582and TcArrayType (cenv: cenv) newOk checkConstraints occ env tpenv rank elemTy m =
45324583 let g = cenv.g
45334584 let elemTy, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.Yes env tpenv elemTy
4534- let tyR = mkArrayTy g rank elemTy m
4585+ let tyR = mkArrayTy g rank g.knownWithoutNull elemTy m
45354586 tyR, tpenv
45364587
45374588and TcTypeParameter kindOpt (cenv: cenv) env newOk tpenv tp =
@@ -4556,8 +4607,9 @@ and TcTypeWithConstraints (cenv: cenv) env newOk checkConstraints occ tpenv synT
45564607and TcTypeHashConstraint (cenv: cenv) env newOk checkConstraints occ tpenv synTy m =
45574608 let tp = TcAnonTypeOrMeasure (Some TyparKind.Type) cenv TyparRigidity.WarnIfNotRigid TyparDynamicReq.Yes newOk m
45584609 let ty, tpenv = TcTypeAndRecover cenv newOk checkConstraints occ WarnOnIWSAM.No env tpenv synTy
4559- AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty (mkTyparTy tp)
4560- tp.AsType, tpenv
4610+ let tpTy = mkTyparTy tp
4611+ AddCxTypeMustSubsumeType ContextInfo.NoContext env.DisplayEnv cenv.css m NoTrace ty tpTy
4612+ tpTy, tpenv
45614613
45624614and TcTypeStaticConstant kindOpt tpenv c m =
45634615 match c, kindOpt with
@@ -4711,7 +4763,7 @@ and TcStaticConstantParameter (cenv: cenv) (env: TcEnv) tpenv kind (StripParenTy
47114763 | SynConst.Double n when typeEquiv g g.float_ty kind -> record(g.float_ty); box (n: double)
47124764 | SynConst.Char n when typeEquiv g g.char_ty kind -> record(g.char_ty); box (n: char)
47134765 | SynConst.String (s, _, _)
4714- | SynConst.SourceIdentifier (_, s, _) when s <> null && typeEquiv g g.string_ty kind -> record(g.string_ty); box (s: string)
4766+ | SynConst.SourceIdentifier (_, s, _) when typeEquiv g g.string_ty kind -> record(g.string_ty); box (s: string)
47154767 | SynConst.Bool b when typeEquiv g g.bool_ty kind -> record(g.bool_ty); box (b: bool)
47164768 | _ -> fail()
47174769 v, tpenv
@@ -4740,7 +4792,6 @@ and TcStaticConstantParameter (cenv: cenv) (env: TcEnv) tpenv kind (StripParenTy
47404792 | Const.Single n -> record(g.float32_ty); box (n: single)
47414793 | Const.Double n -> record(g.float_ty); box (n: double)
47424794 | Const.Char n -> record(g.char_ty); box (n: char)
4743- | Const.String null -> fail()
47444795 | Const.String s -> record(g.string_ty); box (s: string)
47454796 | Const.Bool b -> record(g.bool_ty); box (b: bool)
47464797 | _ -> fail()
@@ -4909,7 +4960,7 @@ and TcTypeApp (cenv: cenv) newOk checkConstraints occ env tpenv m tcref pathType
49094960 List.iter2 (UnifyTypes cenv env m) tinst actualArgTys
49104961
49114962 // Try to decode System.Tuple --> F# tuple types etc.
4912- let ty = g.decompileType tcref actualArgTys
4963+ let ty = g.decompileType tcref actualArgTys g.knownWithoutNull
49134964
49144965 ty, tpenv
49154966
@@ -5564,8 +5615,11 @@ and TcExprUndelayed (cenv: cenv) (overallTy: OverallTy) env tpenv (synExpr: SynE
55645615
55655616 | SynExpr.Null m ->
55665617 TcNonControlFlowExpr env <| fun env ->
5618+ // Which?
55675619 AddCxTypeUseSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
5568- mkNull m overallTy.Commit, tpenv
5620+ //AddCxTypeDefnSupportsNull env.DisplayEnv cenv.css m NoTrace overallTy.Commit
5621+ let tyWithNull = addNullnessToTy KnownWithNull overallTy.Commit
5622+ mkNull m tyWithNull, tpenv
55695623
55705624 | SynExpr.Lazy (synInnerExpr, m) ->
55715625 TcNonControlFlowExpr env <| fun env ->
0 commit comments