From f80302c9555c3e08d9da381beecd68a032852bdd Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sat, 7 May 2022 16:30:43 +0100 Subject: [PATCH 01/19] cleanup --- src/fsharp/absil/il.fs | 359 +++++++++++++++++++++-------------------- 1 file changed, 180 insertions(+), 179 deletions(-) diff --git a/src/fsharp/absil/il.fs b/src/fsharp/absil/il.fs index 5d89c9b9bee..fc18d9bc215 100644 --- a/src/fsharp/absil/il.fs +++ b/src/fsharp/absil/il.fs @@ -2564,9 +2564,9 @@ let mkILSimpleTypar nm = CustomAttrsStored = storeILCustomAttrs emptyILCustomAttrs MetadataIndex = NoMetadataIdx } -let gparam_of_gactual (_ga: ILType) = mkILSimpleTypar "T" +let genericParamOfGenericActual (_ga: ILType) = mkILSimpleTypar "T" -let mkILFormalTypars (x: ILGenericArgsList) = List.map gparam_of_gactual x +let mkILFormalTypars (x: ILGenericArgsList) = List.map genericParamOfGenericActual x let mkILFormalGenericArgs numtypars (gparams: ILGenericParameterDefs) = List.mapi (fun n _gf -> mkILTyvarTy (uint16 (numtypars + n))) gparams @@ -3192,10 +3192,10 @@ let cdef_cctorCode2CodeOrCreate tag imports f (cd: ILTypeDef) = cd.With(methods = methods) -let code_of_mdef (md: ILMethodDef) = +let codeOfMethodDef (md: ILMethodDef) = match md.Code with | Some x -> x - | None -> failwith "code_of_mdef: not IL" + | None -> failwith "codeOfmdef: not IL" let mkRefToILMethod (tref, md: ILMethodDef) = mkILMethRef (tref, md.CallingConv, md.Name, md.GenericParams.Length, md.ParameterTypes, md.Return.Type) @@ -3244,19 +3244,19 @@ type ILLocalsAllocator (preAlloc: int) = member tmps.Close() = ResizeArray.toList newLocals -let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (f: ILFieldDef) -> f.Name), l)) +let mkILFieldsLazy l = ILFields (LazyOrderedMultiMap ((fun (fdef: ILFieldDef) -> fdef.Name), l)) let mkILFields l = mkILFieldsLazy (notlazy l) let emptyILFields = mkILFields [] -let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (e: ILEventDef) -> e.Name), l)) +let mkILEventsLazy l = ILEvents (LazyOrderedMultiMap ((fun (edef: ILEventDef) -> edef.Name), l)) let mkILEvents l = mkILEventsLazy (notlazy l) let emptyILEvents = mkILEvents [] -let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (p: ILPropertyDef) -> p.Name), l) ) +let mkILPropertiesLazy l = ILProperties (LazyOrderedMultiMap ((fun (pdef: ILPropertyDef) -> pdef.Name), l) ) let mkILProperties l = mkILPropertiesLazy (notlazy l) @@ -3486,9 +3486,9 @@ let computeILEnumInfo (mdName, mdFields: ILFieldDefs) = match (List.partition (fun (fd: ILFieldDef) -> fd.IsStatic) (mdFields.AsList())) with | staticFields, [vfd] -> { enumType = vfd.FieldType - enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": static field does not have an default value"))) } - | _, [] -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": no non-static field found") - | _, _ -> failwith ("info_of_enum_tdef: badly formed enum "+mdName+": more than one non-static field found") + enumValues = staticFields |> List.map (fun fd -> (fd.Name, match fd.LiteralValue with Some i -> i | None -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": static field does not have an default value"))) } + | _, [] -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": no non-static field found") + | _, _ -> failwith ("computeILEnumInfo: badly formed enum "+mdName+": more than one non-static field found") //--------------------------------------------------------------------- // Primitives to help read signatures. These do not use the file cursor, but @@ -3547,17 +3547,17 @@ let sigptr_get_u64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr uint64 u, sigptr -let float32_of_bits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) +let float32OfBits (x: int32) = BitConverter.ToSingle (BitConverter.GetBytes x, 0) -let float_of_bits (x: int64) = BitConverter.Int64BitsToDouble x +let floatOfBits (x: int64) = BitConverter.Int64BitsToDouble x let sigptr_get_ieee32 bytes sigptr = let u, sigptr = sigptr_get_i32 bytes sigptr - float32_of_bits u, sigptr + float32OfBits u, sigptr let sigptr_get_ieee64 bytes sigptr = let u, sigptr = sigptr_get_i64 bytes sigptr - float_of_bits u, sigptr + floatOfBits u, sigptr let sigptr_get_intarray n (bytes: byte[]) sigptr = let res = Bytes.zeroCreate n @@ -3651,13 +3651,13 @@ let u32AsBytes (i: uint32) = i32AsBytes (int32 i) let u64AsBytes (i: uint64) = i64AsBytes (int64 i) -let bits_of_float32 (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) +let bitsOfSingle (x: float32) = BitConverter.ToInt32 (BitConverter.GetBytes x, 0) -let bits_of_float (x: float) = BitConverter.DoubleToInt64Bits x +let bitsOfDouble (x: float) = BitConverter.DoubleToInt64Bits x -let ieee32AsBytes i = i32AsBytes (bits_of_float32 i) +let ieee32AsBytes i = i32AsBytes (bitsOfSingle i) -let ieee64AsBytes i = i64AsBytes (bits_of_float i) +let ieee64AsBytes i = i64AsBytes (bitsOfDouble i) let et_END = 0x00uy let et_VOID = 0x01uy @@ -3859,7 +3859,7 @@ let encodeCustomAttrNamedArg (nm, ty, prop, elem) = yield! encodeCustomAttrString nm yield! encodeCustomAttrValue ty elem |] -let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: list<_>) (namedArgs: list<_>) = +let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: _ list) (namedArgs: _ list) = let argTys = mspec.MethodRef.ArgTypes [| yield! [| 0x01uy; 0x00uy; |] for argTy, fixedArg in Seq.zip argTys fixedArgs do @@ -3868,11 +3868,11 @@ let encodeCustomAttrArgs (mspec: ILMethodSpec) (fixedArgs: list<_>) (namedArgs: for namedArg in namedArgs do yield! encodeCustomAttrNamedArg namedArg |] -let encodeCustomAttr (mspec: ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) = +let encodeCustomAttr (mspec: ILMethodSpec, fixedArgs, namedArgs) = let args = encodeCustomAttrArgs mspec fixedArgs namedArgs ILAttribute.Encoded (mspec, args, fixedArgs @ (namedArgs |> List.map (fun (_, _, _, e) -> e))) -let mkILCustomAttribMethRef (mspec: ILMethodSpec, fixedArgs: list<_>, namedArgs: list<_>) = +let mkILCustomAttribMethRef (mspec: ILMethodSpec, fixedArgs, namedArgs) = encodeCustomAttr (mspec, fixedArgs, namedArgs) let mkILCustomAttribute (tref, argTys, argvs, propvs) = @@ -4104,8 +4104,8 @@ let decodeILAttribData (ca: ILAttribute) = try let parser = ILTypeSigParser n parser.ParseTypeSpec(), sigptr - with e -> - failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" e.Message) + with exn -> + failwith (sprintf "decodeILAttribData: error parsing type in custom attribute blob: %s" exn.Message) | ILType.Boxed tspec when tspec.Name = "System.Object" -> let et, sigptr = sigptr_get_u8 bytes sigptr if et = 0xFFuy then @@ -4197,116 +4197,119 @@ let emptyILRefs = MethodReferences = [||] FieldReferences = [||] } -(* Now find references. *) -let refs_of_assemblyRef (s: ILReferencesAccumulator) x = s.refsA.Add x |> ignore +let refsOfILAssemblyRef (s: ILReferencesAccumulator) x = + s.refsA.Add x |> ignore -let refs_of_modref (s: ILReferencesAccumulator) x = s.refsM.Add x |> ignore +let refsOfILModuleRef (s: ILReferencesAccumulator) x = + s.refsM.Add x |> ignore -let refs_of_scoref s x = +let refsOfScopeRef s x = match x with | ILScopeRef.Local -> () - | ILScopeRef.Assembly assemblyRef -> refs_of_assemblyRef s assemblyRef - | ILScopeRef.Module modref -> refs_of_modref s modref - | ILScopeRef.PrimaryAssembly -> refs_of_assemblyRef s s.ilg.primaryAssemblyRef + | ILScopeRef.Assembly assemblyRef -> refsOfILAssemblyRef s assemblyRef + | ILScopeRef.Module modref -> refsOfILModuleRef s modref + | ILScopeRef.PrimaryAssembly -> refsOfILAssemblyRef s s.ilg.primaryAssemblyRef -let refs_of_tref s (x: ILTypeRef) = refs_of_scoref s x.Scope +let refsOfILTypeRef s (x: ILTypeRef) = refsOfScopeRef s x.Scope -let rec refs_of_typ s x = +let rec refsOfILType s x = match x with | ILType.Void | ILType.TypeVar _ -> () - | ILType.Modified (_, ty1, ty2) -> refs_of_tref s ty1; refs_of_typ s ty2 + | ILType.Modified (_, ty1, ty2) -> refsOfILTypeRef s ty1; refsOfILType s ty2 | ILType.Array (_, ty) - | ILType.Ptr ty | ILType.Byref ty -> refs_of_typ s ty - | ILType.Value tr | ILType.Boxed tr -> refs_of_tspec s tr - | ILType.FunctionPointer mref -> refs_of_callsig s mref + | ILType.Ptr ty | ILType.Byref ty -> refsOfILType s ty + | ILType.Value tr | ILType.Boxed tr -> refsOfILTypeSpec s tr + | ILType.FunctionPointer mref -> refsOfILCallsig s mref -and refs_of_inst s i = refs_of_tys s i +and refsOfILTypeSpec s (x: ILTypeSpec) = + refsOfILTypeRef s x.TypeRef + refsOfILTypes s x.GenericArgs -and refs_of_tspec s (x: ILTypeSpec) = refs_of_tref s x.TypeRef; refs_of_inst s x.GenericArgs +and refsOfILCallsig s csig = + refsOfILTypes s csig.ArgTypes + refsOfILType s csig.ReturnType -and refs_of_callsig s csig = refs_of_tys s csig.ArgTypes; refs_of_typ s csig.ReturnType +and refsOfILGenericParam s x = + refsOfILTypes s x.Constraints -and refs_of_genparam s x = refs_of_tys s x.Constraints +and refsOfILGenericParams s b = + List.iter (refsOfILGenericParam s) b -and refs_of_genparams s b = List.iter (refs_of_genparam s) b - -and refs_of_dloc s ts = refs_of_tref s ts - -and refs_of_mref s (x: ILMethodRef) = - refs_of_dloc s x.DeclaringTypeRef - refs_of_tys s x.mrefArgs - refs_of_typ s x.mrefReturn +and refsOfILMethodRef s (x: ILMethodRef) = + refsOfILTypeRef s x.DeclaringTypeRef + refsOfILTypes s x.mrefArgs + refsOfILType s x.mrefReturn s.refsMs.Add x |> ignore -and refs_of_fref s x = - refs_of_tref s x.DeclaringTypeRef - refs_of_typ s x.Type +and refsOfILFieldRef s x = + refsOfILTypeRef s x.DeclaringTypeRef + refsOfILType s x.Type s.refsFs.Add x |> ignore -and refs_of_ospec s (OverridesSpec (mref, ty)) = - refs_of_mref s mref - refs_of_typ s ty +and refsOfILOverridesSpec s (OverridesSpec (mref, ty)) = + refsOfILMethodRef s mref + refsOfILType s ty -and refs_of_mspec s (x: ILMethodSpec) = - refs_of_mref s x.MethodRef - refs_of_typ s x.DeclaringType - refs_of_inst s x.GenericArgs +and refsOfILMethodSpec s (x: ILMethodSpec) = + refsOfILMethodRef s x.MethodRef + refsOfILType s x.DeclaringType + refsOfILTypes s x.GenericArgs -and refs_of_fspec s x = - refs_of_fref s x.FieldRef - refs_of_typ s x.DeclaringType +and refsOfILFieldSpec s x = + refsOfILFieldRef s x.FieldRef + refsOfILType s x.DeclaringType -and refs_of_tys s l = List.iter (refs_of_typ s) l +and refsOfILTypes s l = List.iter (refsOfILType s) l -and refs_of_token s x = +and refsOfILToken s x = match x with - | ILToken.ILType ty -> refs_of_typ s ty - | ILToken.ILMethod mr -> refs_of_mspec s mr - | ILToken.ILField fr -> refs_of_fspec s fr - -and refs_of_attrib_elem s (e: ILAttribElem) = - match e with - | Type (Some ty) -> refs_of_typ s ty - | TypeRef (Some tref) -> refs_of_tref s tref + | ILToken.ILType ty -> refsOfILType s ty + | ILToken.ILMethod mr -> refsOfILMethodSpec s mr + | ILToken.ILField fr -> refsOfILFieldSpec s fr + +and refsOfILCustomAttrElem s (elem: ILAttribElem) = + match elem with + | Type (Some ty) -> refsOfILType s ty + | TypeRef (Some tref) -> refsOfILTypeRef s tref | Array (ty, els) -> - refs_of_typ s ty - refs_of_attrib_elems s els + refsOfILType s ty + refsOfILCustomAttrElems s els | _ -> () -and refs_of_attrib_elems s els = - els |> List.iter (refs_of_attrib_elem s) +and refsOfILCustomAttrElems s els = + els |> List.iter (refsOfILCustomAttrElem s) -and refs_of_custom_attr s (cattr: ILAttribute) = - refs_of_mspec s cattr.Method - refs_of_attrib_elems s cattr.Elements +and refsOfILCustomAttr s (cattr: ILAttribute) = + refsOfILMethodSpec s cattr.Method + refsOfILCustomAttrElems s cattr.Elements -and refs_of_custom_attrs s (cas : ILAttributes) = - cas.AsArray() |> Array.iter (refs_of_custom_attr s) +and refsOfILCustomAttrs s (cas : ILAttributes) = + cas.AsArray() |> Array.iter (refsOfILCustomAttr s) -and refs_of_varargs s tyso = - Option.iter (refs_of_tys s) tyso +and refsOfILVarArgs s tyso = + Option.iter (refsOfILTypes s) tyso -and refs_of_instr s x = +and refsOfILInstr s x = match x with | I_call (_, mr, varargs) | I_newobj (mr, varargs) | I_callvirt (_, mr, varargs) -> - refs_of_mspec s mr - refs_of_varargs s varargs + refsOfILMethodSpec s mr + refsOfILVarArgs s varargs | I_callconstraint (_, tr, mr, varargs) -> - refs_of_typ s tr - refs_of_mspec s mr - refs_of_varargs s varargs + refsOfILType s tr + refsOfILMethodSpec s mr + refsOfILVarArgs s varargs | I_calli (_, callsig, varargs) -> - refs_of_callsig s callsig; refs_of_varargs s varargs + refsOfILCallsig s callsig; refsOfILVarArgs s varargs | I_jmp mr | I_ldftn mr | I_ldvirtftn mr -> - refs_of_mspec s mr + refsOfILMethodSpec s mr | I_ldsfld (_, fr) | I_ldfld (_, _, fr) | I_ldsflda fr | I_ldflda fr | I_stsfld (_, fr) | I_stfld (_, _, fr) -> - refs_of_fspec s fr + refsOfILFieldSpec s fr | I_isinst ty | I_castclass ty | I_cpobj ty | I_initobj ty | I_ldobj (_, _, ty) | I_stobj (_, _, ty) | I_box ty |I_unbox ty | I_unbox_any ty | I_sizeof ty | I_ldelem_any (_, ty) | I_ldelema (_, _, _, ty) |I_stelem_any (_, ty) | I_newarr (_, ty) | I_mkrefany ty | I_refanyval ty - | EI_ilzero ty -> refs_of_typ s ty - | I_ldtoken token -> refs_of_token s token + | EI_ilzero ty -> refsOfILType s ty + | I_ldtoken token -> refsOfILToken s token | I_stelem _|I_ldelem _|I_ldstr _|I_switch _|I_stloc _|I_stind _ | I_starg _|I_ldloca _|I_ldloc _|I_ldind _ | I_ldarga _|I_ldarg _|I_leave _|I_br _ @@ -4319,119 +4322,117 @@ and refs_of_instr s x = | AI_ldnull | AI_dup | AI_pop | AI_ckfinite | AI_nop | AI_ldc _ | I_seqpoint _ | EI_ldlen_multi _ -> () -and refs_of_il_code s (c: ILCode) = - c.Instrs |> Array.iter (refs_of_instr s) - c.Exceptions |> List.iter (fun e -> e.Clause |> (function - | ILExceptionClause.TypeCatch (ilty, _) -> refs_of_typ s ilty - | _ -> ())) +and refsOfILCode s (c: ILCode) = + for i in c.Instrs do + refsOfILInstr s i + + for exnClause in c.Exceptions do + match exnClause.Clause with + | ILExceptionClause.TypeCatch (ilty, _) -> refsOfILType s ilty + | _ -> () -and refs_of_ilmbody s (il: ILMethodBody) = - List.iter (refs_of_local s) il.Locals - refs_of_il_code s il.Code +and refsOfILMethodBody s (il: ILMethodBody) = + List.iter (refsOfILLocal s) il.Locals + refsOfILCode s il.Code -and refs_of_local s loc = refs_of_typ s loc.Type +and refsOfILLocal s loc = refsOfILType s loc.Type -and refs_of_mbody s x = +and refsOfMethodBody s x = match x with - | MethodBody.IL il -> refs_of_ilmbody s il.Value - | MethodBody.PInvoke attr -> refs_of_modref s attr.Value.Where + | MethodBody.IL il -> refsOfILMethodBody s il.Value + | MethodBody.PInvoke attr -> refsOfILModuleRef s attr.Value.Where | _ -> () -and refs_of_mdef s (md: ILMethodDef) = - List.iter (refs_of_param s) md.Parameters - refs_of_return s md.Return - refs_of_mbody s md.Body - refs_of_custom_attrs s md.CustomAttrs - refs_of_genparams s md.GenericParams - -and refs_of_param s p = refs_of_typ s p.Type - -and refs_of_return s (rt: ILReturn) = refs_of_typ s rt.Type +and refsOfILMethodDef s (md: ILMethodDef) = + List.iter (refsOfILParam s) md.Parameters + refsOfILReturn s md.Return + refsOfMethodBody s md.Body + refsOfILCustomAttrs s md.CustomAttrs + refsOfILGenericParams s md.GenericParams -and refs_of_mdefs s x = Seq.iter (refs_of_mdef s) x +and refsOfILParam s p = refsOfILType s p.Type -and refs_of_event_def s (ed: ILEventDef) = - Option.iter (refs_of_typ s) ed.EventType - refs_of_mref s ed.AddMethod - refs_of_mref s ed.RemoveMethod - Option.iter (refs_of_mref s) ed.FireMethod - List.iter (refs_of_mref s) ed.OtherMethods - refs_of_custom_attrs s ed.CustomAttrs +and refsOfILReturn s (rt: ILReturn) = refsOfILType s rt.Type -and refs_of_events s (x: ILEventDefs) = - List.iter (refs_of_event_def s) (x.AsList()) +and refsOfILMethodDefs s x = Seq.iter (refsOfILMethodDef s) x -and refs_of_property_def s (pd: ILPropertyDef) = - Option.iter (refs_of_mref s) pd.SetMethod - Option.iter (refs_of_mref s) pd.GetMethod - refs_of_typ s pd.PropertyType - refs_of_tys s pd.Args - refs_of_custom_attrs s pd.CustomAttrs +and refsOfILEventDef s (ed: ILEventDef) = + Option.iter (refsOfILType s) ed.EventType + refsOfILMethodRef s ed.AddMethod + refsOfILMethodRef s ed.RemoveMethod + Option.iter (refsOfILMethodRef s) ed.FireMethod + List.iter (refsOfILMethodRef s) ed.OtherMethods + refsOfILCustomAttrs s ed.CustomAttrs -and refs_of_properties s (x: ILPropertyDefs) = - List.iter (refs_of_property_def s) (x.AsList()) +and refsOfILEventDefs s (x: ILEventDefs) = + List.iter (refsOfILEventDef s) (x.AsList()) -and refs_of_fdef s (fd: ILFieldDef) = - refs_of_typ s fd.FieldType - refs_of_custom_attrs s fd.CustomAttrs +and refsOfILPropertyDef s (pd: ILPropertyDef) = + Option.iter (refsOfILMethodRef s) pd.SetMethod + Option.iter (refsOfILMethodRef s) pd.GetMethod + refsOfILType s pd.PropertyType + refsOfILTypes s pd.Args + refsOfILCustomAttrs s pd.CustomAttrs -and refs_of_fields s fields = - List.iter (refs_of_fdef s) fields +and refsOfILPropertyDefs s (x: ILPropertyDefs) = + List.iter (refsOfILPropertyDef s) (x.AsList()) -and refs_of_method_impls s mimpls = - List.iter (refs_of_method_impl s) mimpls +and refsOfILFieldDef s (fd: ILFieldDef) = + refsOfILType s fd.FieldType + refsOfILCustomAttrs s fd.CustomAttrs -and refs_of_method_impl s m = - refs_of_ospec s m.Overrides - refs_of_mspec s m.OverrideBy +and refsOfILFieldDefs s fields = + List.iter (refsOfILFieldDef s) fields -and refs_of_tdef_kind _s _k = () +and refsOfILMethodImpls s mimpls = + List.iter (refsOfILMethodImpl s) mimpls -and refs_of_tdef s (td : ILTypeDef) = - refs_of_types s td.NestedTypes - refs_of_genparams s td.GenericParams - refs_of_tys s td.Implements - Option.iter (refs_of_typ s) td.Extends - refs_of_mdefs s td.Methods - refs_of_fields s (td.Fields.AsList()) - refs_of_method_impls s (td.MethodImpls.AsList()) - refs_of_events s td.Events - refs_of_tdef_kind s td - refs_of_custom_attrs s td.CustomAttrs - refs_of_properties s td.Properties +and refsOfILMethodImpl s m = + refsOfILOverridesSpec s m.Overrides + refsOfILMethodSpec s m.OverrideBy -and refs_of_string _s _ = () +and refsOfILTypeDef s (td : ILTypeDef) = + refsOfILTypeDefs s td.NestedTypes + refsOfILGenericParams s td.GenericParams + refsOfILTypes s td.Implements + Option.iter (refsOfILType s) td.Extends + refsOfILMethodDefs s td.Methods + refsOfILFieldDefs s (td.Fields.AsList()) + refsOfILMethodImpls s (td.MethodImpls.AsList()) + refsOfILEventDefs s td.Events + refsOfILCustomAttrs s td.CustomAttrs + refsOfILPropertyDefs s td.Properties -and refs_of_types s (types: ILTypeDefs) = Seq.iter (refs_of_tdef s) types +and refsOfILTypeDefs s (types: ILTypeDefs) = Seq.iter (refsOfILTypeDef s) types -and refs_of_exported_type s (c: ILExportedTypeOrForwarder) = - refs_of_custom_attrs s c.CustomAttrs +and refsOfILExportedType s (c: ILExportedTypeOrForwarder) = + refsOfILCustomAttrs s c.CustomAttrs -and refs_of_exported_types s (tab: ILExportedTypesAndForwarders) = - List.iter (refs_of_exported_type s) (tab.AsList()) +and refsOfILExportedTypes s (tab: ILExportedTypesAndForwarders) = + List.iter (refsOfILExportedType s) (tab.AsList()) -and refs_of_resource_where s x = +and refsOfILResourceLocation s x = match x with | ILResourceLocation.Local _ -> () - | ILResourceLocation.File (mref, _) -> refs_of_modref s mref - | ILResourceLocation.Assembly aref -> refs_of_assemblyRef s aref + | ILResourceLocation.File (mref, _) -> refsOfILModuleRef s mref + | ILResourceLocation.Assembly aref -> refsOfILAssemblyRef s aref -and refs_of_resource s x = - refs_of_resource_where s x.Location - refs_of_custom_attrs s x.CustomAttrs +and refsOfILResource s x = + refsOfILResourceLocation s x.Location + refsOfILCustomAttrs s x.CustomAttrs -and refs_of_resources s (tab: ILResources) = - List.iter (refs_of_resource s) (tab.AsList()) +and refsOfILResources s (tab: ILResources) = + List.iter (refsOfILResource s) (tab.AsList()) -and refs_of_modul s m = - refs_of_types s m.TypeDefs - refs_of_resources s m.Resources - refs_of_custom_attrs s m.CustomAttrs - Option.iter (refs_of_manifest s) m.Manifest +and refsOfILModule s m = + refsOfILTypeDefs s m.TypeDefs + refsOfILResources s m.Resources + refsOfILCustomAttrs s m.CustomAttrs + Option.iter (refsOfILManifest s) m.Manifest -and refs_of_manifest s (m: ILAssemblyManifest) = - refs_of_custom_attrs s m.CustomAttrs - refs_of_exported_types s m.ExportedTypes +and refsOfILManifest s (m: ILAssemblyManifest) = + refsOfILCustomAttrs s m.CustomAttrs + refsOfILExportedTypes s m.ExportedTypes let computeILRefs ilg modul = let s = @@ -4442,7 +4443,7 @@ let computeILRefs ilg modul = refsMs = HashSet<_>(HashIdentity.Structural) refsFs = HashSet<_>(HashIdentity.Structural) } - refs_of_modul s modul + refsOfILModule s modul { AssemblyReferences = s.refsA.ToArray() ModuleReferences = s.refsM.ToArray() TypeReferences = s.refsTs.ToArray() From 607a0199c0f5402e97801c624654a63ca731e0f5 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 16:16:57 +0100 Subject: [PATCH 02/19] split files --- .../FSharp.Compiler.Service.fsproj | 20 +- src/fsharp/IlxGen.fs | 5 +- src/fsharp/LowerCalls.fs | 53 +++ src/fsharp/LowerCalls.fsi | 11 + .../LowerComputedCollectionExpressions.fs | 277 +++++++++++++ .../LowerComputedCollectionExpressions.fsi | 10 + ...AndSeqs.fs => LowerSequenceExpressions.fs} | 390 +----------------- ...dSeqs.fsi => LowerSequenceExpressions.fsi} | 15 +- src/fsharp/LowerStateMachines.fs | 8 +- src/fsharp/OptimizeInputs.fs | 2 +- src/fsharp/TypedTreeOps.fs | 88 ++++ src/fsharp/TypedTreeOps.fsi | 27 ++ 12 files changed, 494 insertions(+), 412 deletions(-) create mode 100644 src/fsharp/LowerCalls.fs create mode 100644 src/fsharp/LowerCalls.fsi create mode 100644 src/fsharp/LowerComputedCollectionExpressions.fs create mode 100644 src/fsharp/LowerComputedCollectionExpressions.fsi rename src/fsharp/{LowerCallsAndSeqs.fs => LowerSequenceExpressions.fs} (68%) rename src/fsharp/{LowerCallsAndSeqs.fsi => LowerSequenceExpressions.fsi} (68%) diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 2cdae317460..02d664108ed 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -687,11 +687,23 @@ Optimize\InnerLambdasToTopLevelFuncs.fs - - Optimize\LowerCallsAndSeqs.fsi + + Optimize\LowerCalls.fsi - - Optimize\LowerCallsAndSeqs.fs + + Optimize\LowerCalls.fs + + + Optimize\LowerSequenceExpressions.fsi + + + Optimize\LowerSequenceExpressions.fs + + + Optimize\LowerComputedCollectionExpressions.fsi + + + Optimize\LowerComputedCollectionExpressions.fs Optimize\LowerStateMachines.fsi diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index effc65e80cd..dd0fb29e3cd 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -24,7 +24,6 @@ open FSharp.Compiler.ErrorLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Import -open FSharp.Compiler.LowerCallsAndSeqs open FSharp.Compiler.LowerStateMachines open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -2368,13 +2367,13 @@ and GenExprPreSteps (cenv: cenv) (cgbuf: CodeGenBuffer) eenv expr sequel = //ProcessDebugPointForExpr cenv cgbuf expr - match (if compileSequenceExpressions then LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else None) with + match (if compileSequenceExpressions then LowerComputedCollectionExpressions.LowerComputedListOrArrayExpr cenv.tcVal g cenv.amap expr else None) with | Some altExpr -> GenExpr cenv cgbuf eenv altExpr sequel true | None -> - match (if compileSequenceExpressions then ConvertSequenceExprToObject g cenv.amap expr else None) with + match (if compileSequenceExpressions then LowerSequenceExpressions.ConvertSequenceExprToObject g cenv.amap expr else None) with | Some info -> GenSequenceExpr cenv cgbuf eenv info sequel true diff --git a/src/fsharp/LowerCalls.fs b/src/fsharp/LowerCalls.fs new file mode 100644 index 00000000000..0264e72deb7 --- /dev/null +++ b/src/fsharp/LowerCalls.fs @@ -0,0 +1,53 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerCalls + +open Internal.Utilities.Library +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps + +let LowerCallsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsRewrite" + +//---------------------------------------------------------------------------- +// Expansion of calls to methods with statically known arity + +let InterceptExpr g cont expr = + + match expr with + | Expr.Val (vref, flags, m) -> + match vref.ValReprInfo with + | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) + | None -> None + + // App (Val v, tys, args) + | Expr.App (Expr.Val (vref, flags, _) as f0, f0ty, tyargsl, argsl, m) -> + // Only transform if necessary, i.e. there are not enough arguments + match vref.ValReprInfo with + | Some(topValInfo) -> + let argsl = List.map cont argsl + let f0 = + if topValInfo.AritiesOfArgs.Length > argsl.Length + then fst(AdjustValForExpectedArity g m vref flags topValInfo) + else f0 + + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) + | None -> None + + | Expr.App (f0, f0ty, tyargsl, argsl, m) -> + Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) + + | _ -> None + +/// An "expr -> expr" pass that eta-expands under-applied values of +/// known arity to lambda expressions and beta-var-reduces to bind +/// any known arguments. The results are later optimized by the peephole +/// optimizer in opt.fs +let LowerImplFile g assembly = + let rwenv = + { PreIntercept = Some(InterceptExpr g) + PreInterceptBinding=None + PostTransform= (fun _ -> None) + RewriteQuotations=false + StackGuard = StackGuard(LowerCallsRewriteStackGuardDepth) } + assembly |> RewriteImplFile rwenv diff --git a/src/fsharp/LowerCalls.fsi b/src/fsharp/LowerCalls.fsi new file mode 100644 index 00000000000..beca1348653 --- /dev/null +++ b/src/fsharp/LowerCalls.fsi @@ -0,0 +1,11 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerCalls + +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TypedTree + +/// Expands under-applied values of known arity to lambda expressions, and then reduce to bind +/// any known arguments. The results are later optimized by Optimizer.fs +val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile + diff --git a/src/fsharp/LowerComputedCollectionExpressions.fs b/src/fsharp/LowerComputedCollectionExpressions.fs new file mode 100644 index 00000000000..320762edbed --- /dev/null +++ b/src/fsharp/LowerComputedCollectionExpressions.fs @@ -0,0 +1,277 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerComputedCollectionExpressions + +open Internal.Utilities.Collections +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.InfoReader +open FSharp.Compiler.Infos +open FSharp.Compiler.LowerSequenceExpressions +open FSharp.Compiler.MethodCalls +open FSharp.Compiler.Syntax +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypeRelations +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps + +let LowerComputedCollectionsStackGuardDepth = StackGuard.GetDepthOption "LowerComputedCollections" + +/// Build the 'test and dispose' part of a 'use' statement +let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = + let disposeMethod = + match GetIntrinsicMethInfosOfType infoReader (Some "Dispose") AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m g.system_IDisposable_ty with + | [x] -> x + | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) + // For struct types the test is simpler + if isStructTy g v.Type then + assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) + // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive + // copy of it. + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] + //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] + + disposeExpr + else + let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty + let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] + let inpe = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) + mkIsInstConditional g m g.system_IDisposable_ty inpe disposeObjVar disposeExpr (mkUnit g m) + +let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = + let listCollectorTy = tyOfExpr g collExpr + let addMethod = + match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with + | [x] -> x + | _ -> error(InternalError("no " + name + " method found on Collector", m)) + let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args + expr + +let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "Add" collExpr [arg] + +let mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "AddMany" collExpr [arg] + +let mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arg = + mkCallCollectorMethod tcVal g infoReader m "AddManyAndClose" collExpr [arg] + +let mkCallCollectorClose tcVal (g: TcGlobals) infoReader m collExpr = + mkCallCollectorMethod tcVal g infoReader m "Close" collExpr [] + +let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = + let infoReader = InfoReader(g, amap) + let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy + //let collExpr = mkValAddr m false (mkLocalValRef collVal) + let rec ConvertSeqExprCode isUninteresting isTailcall expr = + match expr with + | SeqYield g (e, m) -> + let exprR = mkCallCollectorAdd tcVal g infoReader m collExpr e + Result.Ok (false, exprR) + + | SeqDelay g (delayedExpr, _elemTy) -> + ConvertSeqExprCode isUninteresting isTailcall delayedExpr + + | SeqAppend g (e1, e2, m) -> + let res1 = ConvertSeqExprCode false false e1 + let res2 = ConvertSeqExprCode false isTailcall e2 + match res1, res2 with + | Result.Ok (_, e1R), Result.Ok (closed2, e2R) -> + let exprR = mkSequential m e1R e2R + Result.Ok (closed2, exprR) + | Result.Error msg, _ | _, Result.Error msg -> Result.Error msg + + | SeqWhile g (guardExpr, bodyExpr, spWhile, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + let exprR = mkWhile g (spWhile, NoSpecialWhileLoopMarker, guardExpr, bodyExprR, m) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqUsing g (resource, v, bodyExpr, _elemTy, spBind, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + // printfn "found Seq.using" + let cleanupE = BuildDisposableCleanup tcVal g infoReader m v + let exprR = + mkLet spBind m v resource + (mkTryFinally g (bodyExprR, cleanupE, m, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqForEach g (inp, v, bodyExpr, _genElemTy, mFor, mIn, spIn) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + // printfn "found Seq.for" + let inpElemTy = v.Type + let inpEnumTy = mkIEnumeratorTy g inpElemTy + let enumv, enumve = mkCompGenLocal m "enum" inpEnumTy + let guardExpr = callNonOverloadedILMethod g amap m "MoveNext" inpEnumTy [enumve] + let cleanupE = BuildDisposableCleanup tcVal g infoReader m enumv + + // A debug point should get emitted prior to both the evaluation of 'inp' and the call to GetEnumerator + let addForDebugPoint e = Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, e) + + let spInAsWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No + + let exprR = + mkInvisibleLet mFor enumv (callNonOverloadedILMethod g amap mFor "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) + (mkTryFinally g + (mkWhile g (spInAsWhile, NoSpecialWhileLoopMarker, guardExpr, + (mkInvisibleLet mIn v + (callNonOverloadedILMethod g amap mIn "get_Current" inpEnumTy [enumve])) + bodyExprR, mIn), + cleanupE, + mFor, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) + |> addForDebugPoint + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqTryFinally g (bodyExpr, compensation, spTry, spFinally, m) -> + let resBody = ConvertSeqExprCode false false bodyExpr + match resBody with + | Result.Ok (_, bodyExprR) -> + let exprR = + mkTryFinally g (bodyExprR, compensation, m, tyOfExpr g bodyExpr, spTry, spFinally) + Result.Ok (false, exprR) + | Result.Error msg -> Result.Error msg + + | SeqEmpty g m -> + let exprR = mkUnit g m + Result.Ok(false, exprR) + + | Expr.Sequential (x1, bodyExpr, NormalSeq, m) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = Expr.Sequential (x1, bodyExprR, NormalSeq, m) + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.Let (bind, bodyExpr, m, _) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = mkLetBind m bind bodyExprR + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.LetRec (binds, bodyExpr, m, _) -> + let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr + match resBody with + | Result.Ok (closed, bodyExprR) -> + let exprR = mkLetRecBinds m binds bodyExprR + Result.Ok(closed, exprR) + | Result.Error msg -> Result.Error msg + + | Expr.Match (spBind, exprm, pt, targets, m, ty) -> + // lower all the targets. abandon if any fail to lower + let resTargets = + targets |> Array.map (fun (TTarget(vs, targetExpr, flags)) -> + match ConvertSeqExprCode false false targetExpr with + | Result.Ok (_, targetExprR) -> + Result.Ok (TTarget(vs, targetExprR, flags)) + | Result.Error msg -> Result.Error msg ) + + if resTargets |> Array.forall (function Result.Ok _ -> true | _ -> false) then + let tglArray = Array.map (function Result.Ok v -> v | _ -> failwith "unreachable") resTargets + + let exprR = primMkMatch (spBind, exprm, pt, tglArray, m, ty) + Result.Ok(false, exprR) + else + resTargets |> Array.pick (function Result.Error msg -> Some (Result.Error msg) | _ -> None) + + | Expr.DebugPoint(dp, innerExpr) -> + let resInnerExpr = ConvertSeqExprCode isUninteresting isTailcall innerExpr + match resInnerExpr with + | Result.Ok (flag, innerExprR) -> + let exprR = Expr.DebugPoint(dp, innerExprR) + Result.Ok (flag, exprR) + | Result.Error msg -> Result.Error msg + + // yield! e ---> (for x in e -> x) + + | arbitrarySeqExpr -> + let m = arbitrarySeqExpr.Range + if isUninteresting then + // printfn "FAILED - not worth compiling an unrecognized Seq.toList at %s " (stringOfRange m) + Result.Error () + else + // If we're the final in a sequential chain then we can AddMany, Close and return + if isTailcall then + let exprR = mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr + // Return 'true' to indicate the collector was closed and the overall result of the expression is the result + Result.Ok(true, exprR) + else + let exprR = mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr + Result.Ok(false, exprR) + + + // Perform conversion + match ConvertSeqExprCode true true overallSeqExpr with + | Result.Ok (closed, overallSeqExprR) -> + mkInvisibleLet m collVal (mkDefault (m, collectorTy)) + (if closed then + // If we ended with AddManyAndClose then we're done + overallSeqExprR + else + mkSequential m + overallSeqExprR + (mkCallCollectorClose tcVal g infoReader m collExpr)) + |> Some + | Result.Error () -> + None + +let (|OptionalCoerce|) expr = + match expr with + | Expr.Op (TOp.Coerce, _, [arg], _) -> arg + | _ -> expr + +// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression +// which only adds a 'seq' call outside of FSharp.Core +let (|OptionalSeq|_|) g amap expr = + match expr with + // use 'seq { ... }' as an indicator + | Seq g (e, elemTy) -> + Some (e, elemTy) + | _ -> + // search for the relevant element type + match tyOfExpr g expr with + | SeqElemTy g amap expr.Range elemTy -> + Some (expr, elemTy) + | _ -> None + +let (|SeqToList|_|) g expr = + match expr with + | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) + | _ -> None + +let (|SeqToArray|_|) g expr = + match expr with + | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) + | _ -> None + +let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = + // If ListCollector is in FSharp.Core then this optimization kicks in + if g.ListCollector_tcr.CanDeref then + + match overallExpr with + | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> + let collectorTy = g.mk_ListCollector_ty overallElemTy + LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr + + | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> + let collectorTy = g.mk_ArrayCollector_ty overallElemTy + LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr + + | _ -> None + else + None diff --git a/src/fsharp/LowerComputedCollectionExpressions.fsi b/src/fsharp/LowerComputedCollectionExpressions.fsi new file mode 100644 index 00000000000..a1656361776 --- /dev/null +++ b/src/fsharp/LowerComputedCollectionExpressions.fsi @@ -0,0 +1,10 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.LowerComputedCollectionExpressions + +open FSharp.Compiler.Import +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.TypedTree + +val LowerComputedListOrArrayExpr: + tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option diff --git a/src/fsharp/LowerCallsAndSeqs.fs b/src/fsharp/LowerSequenceExpressions.fs similarity index 68% rename from src/fsharp/LowerCallsAndSeqs.fs rename to src/fsharp/LowerSequenceExpressions.fs index 1d014f7d0b4..8fe22bba4bd 100644 --- a/src/fsharp/LowerCallsAndSeqs.fs +++ b/src/fsharp/LowerSequenceExpressions.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerCallsAndSeqs +module internal FSharp.Compiler.LowerSequenceExpressions open Internal.Utilities.Collections open Internal.Utilities.Library @@ -12,57 +12,12 @@ open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax -open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.TypeRelations open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -let LowerCallsAndSeqsRewriteStackGuardDepth = StackGuard.GetDepthOption "LowerCallsAndSeqsRewrite" - -//---------------------------------------------------------------------------- -// Eta-expansion of calls to top-level-methods - -let InterceptExpr g cont expr = - - match expr with - | Expr.Val (vref, flags, m) -> - match vref.ValReprInfo with - | Some arity -> Some (fst (AdjustValForExpectedArity g m vref flags arity)) - | None -> None - - // App (Val v, tys, args) - | Expr.App (Expr.Val (vref, flags, _) as f0, f0ty, tyargsl, argsl, m) -> - // Only transform if necessary, i.e. there are not enough arguments - match vref.ValReprInfo with - | Some(topValInfo) -> - let argsl = List.map cont argsl - let f0 = - if topValInfo.AritiesOfArgs.Length > argsl.Length - then fst(AdjustValForExpectedArity g m vref flags topValInfo) - else f0 - - Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m)) - | None -> None - - | Expr.App (f0, f0ty, tyargsl, argsl, m) -> - Some (MakeApplicationAndBetaReduce g (f0, f0ty, [tyargsl], argsl, m) ) - - | _ -> None - -/// An "expr -> expr" pass that eta-expands under-applied values of -/// known arity to lambda expressions and beta-var-reduces to bind -/// any known arguments. The results are later optimized by the peephole -/// optimizer in opt.fs -let LowerImplFile g assembly = - let rwenv = - { PreIntercept = Some(InterceptExpr g) - PreInterceptBinding=None - PostTransform= (fun _ -> None) - RewriteQuotations=false - StackGuard = StackGuard(LowerCallsAndSeqsRewriteStackGuardDepth) } - assembly |> RewriteImplFile rwenv +let LowerSequenceExpressionsStackGuardDepth = StackGuard.GetDepthOption "LowerSequenceExpressions" //---------------------------------------------------------------------------- // General helpers @@ -112,107 +67,9 @@ type LoweredSeqFirstPhaseResult = asyncVars: FreeVars } -let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals - -let (|Seq|_|) g expr = - match expr with - // use 'seq { ... }' as an indicator - | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) - | _ -> None - let IsPossibleSequenceExpr g overallExpr = match overallExpr with Seq g _ -> true | _ -> false -/// Detect a 'yield x' within a 'seq { ... }' -let (|SeqYield|_|) g expr = - match expr with - | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) - | _ -> None - -/// Detect a 'expr; expr' within a 'seq { ... }' -let (|SeqAppend|_|) g expr = - match expr with - | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) - | _ -> None - -/// Detect a 'while gd do expr' within a 'seq { ... }' -let (|SeqWhile|_|) g expr = - match expr with - | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) - when not (isVarFreeInExpr dummyv guardExpr) -> - - // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression - let mWhile = innerExpr.Range - let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No - Some (guardExpr, innerExpr, spWhile, m) - - | _ -> - None - -let (|SeqTryFinally|_|) g expr = - match expr with - | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) - when not (isVarFreeInExpr dummyv compensation) -> - - // The debug point for 'try' and 'finally' are attached to the first and second arguments - // respectively, see TcSequenceExpression - let mTry = arg1.Range - let mFinally = arg2.Range - let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No - let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No - - Some (arg1, compensation, spTry, spFinally, m) - - | _ -> - None - -let (|SeqUsing|_|) g expr = - match expr with - | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> - // The debug point mFor at the 'use x = ... ' gets attached to the lambda - let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible - Some (resource, v, body, elemTy, spBind, m) - | _ -> - None - -let (|SeqForEach|_|) g expr = - match expr with - // Nested for loops are represented by calls to Seq.collect - | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> - // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression - let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - Some (inp, v, body, genElemTy, mFor, mIn, spIn) - - // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. - | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> - let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No - // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression - Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) - - | _ -> None - -let (|SeqDelay|_|) g expr = - match expr with - | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) - when not (isVarFreeInExpr v e) -> - Some (e, elemTy) - | _ -> None - -let (|SeqEmpty|_|) g expr = - match expr with - | ValApp g g.seq_empty_vref (_, [], m) -> Some m - | _ -> None - -let (|SeqToList|_|) g expr = - match expr with - | ValApp g g.seq_to_list_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None - -let (|SeqToArray|_|) g expr = - match expr with - | ValApp g g.seq_to_array_vref (_, [seqExpr], m) -> Some (seqExpr, m) - | _ -> None - let tyConfirmsToSeq g ty = match tryTcrefOfAppTy g ty with | ValueSome tcref -> @@ -866,246 +723,3 @@ let ConvertSequenceExprToObject g amap overallExpr = None | _ -> None -/// Build the 'test and dispose' part of a 'use' statement -let BuildDisposableCleanup tcVal (g: TcGlobals) infoReader m (v: Val) = - let disposeMethod = - match GetIntrinsicMethInfosOfType infoReader (Some "Dispose") AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m g.system_IDisposable_ty with - | [x] -> x - | _ -> error(InternalError(FSComp.SR.tcCouldNotFindIDisposable(), m)) - // For struct types the test is simpler - if isStructTy g v.Type then - assert (TypeFeasiblySubsumesType 0 g infoReader.amap m g.system_IDisposable_ty CanCoerce v.Type) - // We can use NeverMutates here because the variable is going out of scope, there is no need to take a defensive - // copy of it. - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap NeverMutates m false disposeMethod NormalValUse [] [exprForVal v.Range v] [] - //callNonOverloadedILMethod g infoReader.amap m "Dispose" g.system_IDisposable_ty [exprForVal v.Range v] - - disposeExpr - else - let disposeObjVar, disposeObjExpr = mkCompGenLocal m "objectToDispose" g.system_IDisposable_ty - let disposeExpr, _ = BuildMethodCall tcVal g infoReader.amap PossiblyMutates m false disposeMethod NormalValUse [] [disposeObjExpr] [] - let inpe = mkCoerceExpr(exprForVal v.Range v, g.obj_ty, m, v.Type) - mkIsInstConditional g m g.system_IDisposable_ty inpe disposeObjVar disposeExpr (mkUnit g m) - -let mkCallCollectorMethod tcVal (g: TcGlobals) infoReader m name collExpr args = - let listCollectorTy = tyOfExpr g collExpr - let addMethod = - match GetIntrinsicMethInfosOfType infoReader (Some name) AccessibleFromSomewhere AllowMultiIntfInstantiations.Yes IgnoreOverrides m listCollectorTy with - | [x] -> x - | _ -> error(InternalError("no " + name + " method found on Collector", m)) - let expr, _ = BuildMethodCall tcVal g infoReader.amap DefinitelyMutates m false addMethod NormalValUse [] [collExpr] args - expr - -let mkCallCollectorAdd tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "Add" collExpr [arg] - -let mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "AddMany" collExpr [arg] - -let mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arg = - mkCallCollectorMethod tcVal g infoReader m "AddManyAndClose" collExpr [arg] - -let mkCallCollectorClose tcVal (g: TcGlobals) infoReader m collExpr = - mkCallCollectorMethod tcVal g infoReader m "Close" collExpr [] - -let LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr = - let infoReader = InfoReader(g, amap) - let collVal, collExpr = mkMutableCompGenLocal m "@collector" collectorTy - //let collExpr = mkValAddr m false (mkLocalValRef collVal) - let rec ConvertSeqExprCode isUninteresting isTailcall expr = - match expr with - | SeqYield g (e, m) -> - let exprR = mkCallCollectorAdd tcVal g infoReader m collExpr e - Result.Ok (false, exprR) - - | SeqDelay g (delayedExpr, _elemTy) -> - ConvertSeqExprCode isUninteresting isTailcall delayedExpr - - | SeqAppend g (e1, e2, m) -> - let res1 = ConvertSeqExprCode false false e1 - let res2 = ConvertSeqExprCode false isTailcall e2 - match res1, res2 with - | Result.Ok (_, e1R), Result.Ok (closed2, e2R) -> - let exprR = mkSequential m e1R e2R - Result.Ok (closed2, exprR) - | Result.Error msg, _ | _, Result.Error msg -> Result.Error msg - - | SeqWhile g (guardExpr, bodyExpr, spWhile, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - let exprR = mkWhile g (spWhile, NoSpecialWhileLoopMarker, guardExpr, bodyExprR, m) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqUsing g (resource, v, bodyExpr, _elemTy, spBind, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - // printfn "found Seq.using" - let cleanupE = BuildDisposableCleanup tcVal g infoReader m v - let exprR = - mkLet spBind m v resource - (mkTryFinally g (bodyExprR, cleanupE, m, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqForEach g (inp, v, bodyExpr, _genElemTy, mFor, mIn, spIn) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - // printfn "found Seq.for" - let inpElemTy = v.Type - let inpEnumTy = mkIEnumeratorTy g inpElemTy - let enumv, enumve = mkCompGenLocal m "enum" inpEnumTy - let guardExpr = callNonOverloadedILMethod g amap m "MoveNext" inpEnumTy [enumve] - let cleanupE = BuildDisposableCleanup tcVal g infoReader m enumv - - // A debug point should get emitted prior to both the evaluation of 'inp' and the call to GetEnumerator - let addForDebugPoint e = Expr.DebugPoint(DebugPointAtLeafExpr.Yes mFor, e) - - let spInAsWhile = match spIn with DebugPointAtInOrTo.Yes m -> DebugPointAtWhile.Yes m | DebugPointAtInOrTo.No -> DebugPointAtWhile.No - - let exprR = - mkInvisibleLet mFor enumv (callNonOverloadedILMethod g amap mFor "GetEnumerator" (mkSeqTy g inpElemTy) [inp]) - (mkTryFinally g - (mkWhile g (spInAsWhile, NoSpecialWhileLoopMarker, guardExpr, - (mkInvisibleLet mIn v - (callNonOverloadedILMethod g amap mIn "get_Current" inpEnumTy [enumve])) - bodyExprR, mIn), - cleanupE, - mFor, tyOfExpr g bodyExpr, DebugPointAtTry.No, DebugPointAtFinally.No)) - |> addForDebugPoint - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqTryFinally g (bodyExpr, compensation, spTry, spFinally, m) -> - let resBody = ConvertSeqExprCode false false bodyExpr - match resBody with - | Result.Ok (_, bodyExprR) -> - let exprR = - mkTryFinally g (bodyExprR, compensation, m, tyOfExpr g bodyExpr, spTry, spFinally) - Result.Ok (false, exprR) - | Result.Error msg -> Result.Error msg - - | SeqEmpty g m -> - let exprR = mkUnit g m - Result.Ok(false, exprR) - - | Expr.Sequential (x1, bodyExpr, NormalSeq, m) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = Expr.Sequential (x1, bodyExprR, NormalSeq, m) - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.Let (bind, bodyExpr, m, _) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = mkLetBind m bind bodyExprR - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.LetRec (binds, bodyExpr, m, _) -> - let resBody = ConvertSeqExprCode isUninteresting isTailcall bodyExpr - match resBody with - | Result.Ok (closed, bodyExprR) -> - let exprR = mkLetRecBinds m binds bodyExprR - Result.Ok(closed, exprR) - | Result.Error msg -> Result.Error msg - - | Expr.Match (spBind, exprm, pt, targets, m, ty) -> - // lower all the targets. abandon if any fail to lower - let resTargets = - targets |> Array.map (fun (TTarget(vs, targetExpr, flags)) -> - match ConvertSeqExprCode false false targetExpr with - | Result.Ok (_, targetExprR) -> - Result.Ok (TTarget(vs, targetExprR, flags)) - | Result.Error msg -> Result.Error msg ) - - if resTargets |> Array.forall (function Result.Ok _ -> true | _ -> false) then - let tglArray = Array.map (function Result.Ok v -> v | _ -> failwith "unreachable") resTargets - - let exprR = primMkMatch (spBind, exprm, pt, tglArray, m, ty) - Result.Ok(false, exprR) - else - resTargets |> Array.pick (function Result.Error msg -> Some (Result.Error msg) | _ -> None) - - | Expr.DebugPoint(dp, innerExpr) -> - let resInnerExpr = ConvertSeqExprCode isUninteresting isTailcall innerExpr - match resInnerExpr with - | Result.Ok (flag, innerExprR) -> - let exprR = Expr.DebugPoint(dp, innerExprR) - Result.Ok (flag, exprR) - | Result.Error msg -> Result.Error msg - - // yield! e ---> (for x in e -> x) - - | arbitrarySeqExpr -> - let m = arbitrarySeqExpr.Range - if isUninteresting then - // printfn "FAILED - not worth compiling an unrecognized Seq.toList at %s " (stringOfRange m) - Result.Error () - else - // If we're the final in a sequential chain then we can AddMany, Close and return - if isTailcall then - let exprR = mkCallCollectorAddManyAndClose tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr - // Return 'true' to indicate the collector was closed and the overall result of the expression is the result - Result.Ok(true, exprR) - else - let exprR = mkCallCollectorAddMany tcVal (g: TcGlobals) infoReader m collExpr arbitrarySeqExpr - Result.Ok(false, exprR) - - - // Perform conversion - match ConvertSeqExprCode true true overallSeqExpr with - | Result.Ok (closed, overallSeqExprR) -> - mkInvisibleLet m collVal (mkDefault (m, collectorTy)) - (if closed then - // If we ended with AddManyAndClose then we're done - overallSeqExprR - else - mkSequential m - overallSeqExprR - (mkCallCollectorClose tcVal g infoReader m collExpr)) - |> Some - | Result.Error () -> - None - -let (|OptionalCoerce|) expr = - match expr with - | Expr.Op (TOp.Coerce, _, [arg], _) -> arg - | _ -> expr - -// Making 'seq' optional means this kicks in for FSharp.Core, see TcArrayOrListComputedExpression -// which only adds a 'seq' call outside of FSharp.Core -let (|OptionalSeq|_|) g amap expr = - match expr with - // use 'seq { ... }' as an indicator - | Seq g (e, elemTy) -> - Some (e, elemTy) - | _ -> - // search for the relevant element type - match tyOfExpr g expr with - | SeqElemTy g amap expr.Range elemTy -> - Some (expr, elemTy) - | _ -> None - -let LowerComputedListOrArrayExpr tcVal (g: TcGlobals) amap overallExpr = - // If ListCollector is in FSharp.Core then this optimization kicks in - if g.ListCollector_tcr.CanDeref then - - match overallExpr with - | SeqToList g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> - let collectorTy = g.mk_ListCollector_ty overallElemTy - LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - - | SeqToArray g (OptionalCoerce (OptionalSeq g amap (overallSeqExpr, overallElemTy)), m) -> - let collectorTy = g.mk_ArrayCollector_ty overallElemTy - LowerComputedListOrArraySeqExpr tcVal g amap m collectorTy overallSeqExpr - - | _ -> None - else - None diff --git a/src/fsharp/LowerCallsAndSeqs.fsi b/src/fsharp/LowerSequenceExpressions.fsi similarity index 68% rename from src/fsharp/LowerCallsAndSeqs.fsi rename to src/fsharp/LowerSequenceExpressions.fsi index ae761a19700..05a5b81c599 100644 --- a/src/fsharp/LowerCallsAndSeqs.fsi +++ b/src/fsharp/LowerSequenceExpressions.fsi @@ -1,17 +1,17 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.LowerCallsAndSeqs +module internal FSharp.Compiler.LowerSequenceExpressions open FSharp.Compiler.Import +open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.Text -/// An "expr -> expr" pass that eta-expands under-applied values of -/// known arity to lambda expressions and beta-var-reduces to bind -/// any known arguments. The results are later optimized by the peephole -/// optimizer in opt.fs -val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile +/// Detect a 'seq' type +val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option + +val callNonOverloadedILMethod: g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr /// Analyze a TAST expression to detect the elaborated form of a sequence expression. /// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. @@ -26,6 +26,3 @@ val ConvertSequenceExprToObject: (ValRef * ValRef * ValRef * ValRef list * Expr * Expr * Expr * TType * range) option val IsPossibleSequenceExpr: g: TcGlobals -> overallExpr: Expr -> bool - -val LowerComputedListOrArrayExpr: - tcVal: ConstraintSolver.TcValF -> g: TcGlobals -> amap: ImportMap -> Expr -> Expr option diff --git a/src/fsharp/LowerStateMachines.fs b/src/fsharp/LowerStateMachines.fs index 65798f93ade..d1828a82b5f 100644 --- a/src/fsharp/LowerStateMachines.fs +++ b/src/fsharp/LowerStateMachines.fs @@ -2,7 +2,6 @@ module internal FSharp.Compiler.LowerStateMachines -open System.Collections.Generic open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras @@ -11,14 +10,11 @@ open FSharp.Compiler.ErrorLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming -open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -let LowerStateMachineStackGuardDepth = GetEnvInteger "FSHARP_LowerStateMachine" 50 - -let mkLabelled m l e = mkCompGenSequential m (Expr.Op (TOp.Label l, [], [], m)) e +let LowerStateMachineStackGuardDepth = StackGuard.GetDepthOption "LowerStateMachines" type StateMachineConversionFirstPhaseResult = { @@ -125,13 +121,11 @@ type env = { ResumableCodeDefns: ValMap TemplateStructTy: TType option - //MachineAddrExpr: Expr option } static member Empty = { ResumableCodeDefns = ValMap.Empty TemplateStructTy = None - //MachineAddrExpr = None } /// Detect prefix of expanded, optimized state machine expressions diff --git a/src/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index c40f7c3569f..6b7a898f579 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -118,7 +118,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM else implFile let implFile = - LowerCallsAndSeqs.LowerImplFile tcGlobals implFile + LowerCalls.LowerImplFile tcGlobals implFile let implFile, optEnvFinalSimplify = if tcConfig.doFinalSimplify then diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index deecf4724db..b824c352807 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -10085,3 +10085,91 @@ let ComputeUseMethodImpl g (v: Val) = (tcref.GeneratedHashAndEqualsWithComparerValues.IsSome && typeEquiv g oty g.mk_IStructuralEquatable_ty) not isStructural)) + +let (|Seq|_|) g expr = + match expr with + // use 'seq { ... }' as an indicator + | ValApp g g.seq_vref ([elemTy], [e], _m) -> Some (e, elemTy) + | _ -> None + +/// Detect a 'yield x' within a 'seq { ... }' +let (|SeqYield|_|) g expr = + match expr with + | ValApp g g.seq_singleton_vref (_, [arg], m) -> Some (arg, m) + | _ -> None + +/// Detect a 'expr; expr' within a 'seq { ... }' +let (|SeqAppend|_|) g expr = + match expr with + | ValApp g g.seq_append_vref (_, [arg1; arg2], m) -> Some (arg1, arg2, m) + | _ -> None + +let isVarFreeInExpr v e = Zset.contains v (freeInExpr CollectTyparsAndLocals e).FreeLocals + +/// Detect a 'while gd do expr' within a 'seq { ... }' +let (|SeqWhile|_|) g expr = + match expr with + | ValApp g g.seq_generated_vref (_, [Expr.Lambda (_, _, _, [dummyv], guardExpr, _, _);innerExpr], m) + when not (isVarFreeInExpr dummyv guardExpr) -> + + // The debug point for 'while' is attached to the innerExpr, see TcSequenceExpression + let mWhile = innerExpr.Range + let spWhile = match mWhile.NotedSourceConstruct with NotedSourceConstruct.While -> DebugPointAtWhile.Yes mWhile | _ -> DebugPointAtWhile.No + Some (guardExpr, innerExpr, spWhile, m) + + | _ -> + None + +let (|SeqTryFinally|_|) g expr = + match expr with + | ValApp g g.seq_finally_vref (_, [arg1;Expr.Lambda (_, _, _, [dummyv], compensation, _, _) as arg2], m) + when not (isVarFreeInExpr dummyv compensation) -> + + // The debug point for 'try' and 'finally' are attached to the first and second arguments + // respectively, see TcSequenceExpression + let mTry = arg1.Range + let mFinally = arg2.Range + let spTry = match mTry.NotedSourceConstruct with NotedSourceConstruct.Try -> DebugPointAtTry.Yes mTry | _ -> DebugPointAtTry.No + let spFinally = match mFinally.NotedSourceConstruct with NotedSourceConstruct.Finally -> DebugPointAtFinally.Yes mFinally | _ -> DebugPointAtFinally.No + + Some (arg1, compensation, spTry, spFinally, m) + + | _ -> + None + +let (|SeqUsing|_|) g expr = + match expr with + | ValApp g g.seq_using_vref ([_;_;elemTy], [resource;Expr.Lambda (_, _, _, [v], body, mBind, _)], m) -> + // The debug point mFor at the 'use x = ... ' gets attached to the lambda + let spBind = match mBind.NotedSourceConstruct with NotedSourceConstruct.Binding -> DebugPointAtBinding.Yes mBind | _ -> DebugPointAtBinding.NoneAtInvisible + Some (resource, v, body, elemTy, spBind, m) + | _ -> + None + +let (|SeqForEach|_|) g expr = + match expr with + // Nested for loops are represented by calls to Seq.collect + | ValApp g g.seq_collect_vref ([_inpElemTy;_enumty2;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> + // The debug point mIn at the 'in' gets attached to the first argument, see TcSequenceExpression + let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No + Some (inp, v, body, genElemTy, mFor, mIn, spIn) + + // "for x in e -> e2" is converted to a call to Seq.map by the F# type checker. This could be removed, except it is also visible in F# quotations. + | ValApp g g.seq_map_vref ([_inpElemTy;genElemTy], [Expr.Lambda (_, _, _, [v], body, mIn, _); inp], mFor) -> + let spIn = match mIn.NotedSourceConstruct with NotedSourceConstruct.InOrTo -> DebugPointAtInOrTo.Yes mIn | _ -> DebugPointAtInOrTo.No + // The debug point mFor at the 'for' gets attached to the first argument, see TcSequenceExpression + Some (inp, v, mkCallSeqSingleton g body.Range genElemTy body, genElemTy, mFor, mIn, spIn) + + | _ -> None + +let (|SeqDelay|_|) g expr = + match expr with + | ValApp g g.seq_delay_vref ([elemTy], [Expr.Lambda (_, _, _, [v], e, _, _)], _m) + when not (isVarFreeInExpr v e) -> + Some (e, elemTy) + | _ -> None + +let (|SeqEmpty|_|) g expr = + match expr with + | ValApp g g.seq_empty_vref (_, [], m) -> Some m + | _ -> None diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 76819d6d2fd..105f1ff56a9 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2609,3 +2609,30 @@ val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) option /// Determine if a value is a method implementing an interface dispatch slot using a private method impl val ComputeUseMethodImpl: g: TcGlobals -> v: Val -> bool + +/// Detect the de-sugared form of a 'yield x' within a 'seq { ... }' +val (|SeqYield|_|) : TcGlobals -> Expr -> (Expr * range) option + +/// Detect the de-sugared form of a 'expr; expr' within a 'seq { ... }' +val (|SeqAppend|_|) : TcGlobals -> Expr -> (Expr * Expr * range) option + +/// Detect the de-sugared form of a 'while gd do expr' within a 'seq { ... }' +val (|SeqWhile|_|) : TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) option + +/// Detect the de-sugared form of a 'try .. finally .. ' within a 'seq { ... }' +val (|SeqTryFinally|_|) : TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) option + +/// Detect the de-sugared form of a 'use x = ..' within a 'seq { ... }' +val (|SeqUsing|_|) : TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) option + +/// Detect the de-sugared form of a 'for x in collection do ..' within a 'seq { ... }' +val (|SeqForEach|_|) : TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) option + +/// Detect the outer 'Seq.delay' added for a construct 'seq { ... }' +val (|SeqDelay|_|) : TcGlobals -> Expr -> (Expr * TType) option + +/// Detect a 'Seq.empty' implicit in the implied 'else' branch of an 'if .. then' in a seq { ... } +val (|SeqEmpty|_|) : TcGlobals -> Expr -> range option + +/// Detect a 'seq { ... }' expression +val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option From 0d620c61b06982667858110cfabe6428d41bd03f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 16:19:13 +0100 Subject: [PATCH 03/19] rename --- .../FSharp.Compiler.Service.fsproj | 16 ++++++++-------- ...xpressions.fs => LowerComputedCollections.fs} | 0 ...ressions.fsi => LowerComputedCollections.fsi} | 0 ...rSequenceExpressions.fs => LowerSequences.fs} | 0 ...equenceExpressions.fsi => LowerSequences.fsi} | 0 5 files changed, 8 insertions(+), 8 deletions(-) rename src/fsharp/{LowerComputedCollectionExpressions.fs => LowerComputedCollections.fs} (100%) rename src/fsharp/{LowerComputedCollectionExpressions.fsi => LowerComputedCollections.fsi} (100%) rename src/fsharp/{LowerSequenceExpressions.fs => LowerSequences.fs} (100%) rename src/fsharp/{LowerSequenceExpressions.fsi => LowerSequences.fsi} (100%) diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 02d664108ed..15827fb01d9 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -693,17 +693,17 @@ Optimize\LowerCalls.fs - - Optimize\LowerSequenceExpressions.fsi + + Optimize\LowerSequences.fsi - - Optimize\LowerSequenceExpressions.fs + + Optimize\LowerSequences.fs - - Optimize\LowerComputedCollectionExpressions.fsi + + Optimize\LowerComputedCollections.fsi - - Optimize\LowerComputedCollectionExpressions.fs + + Optimize\LowerComputedCollections.fs Optimize\LowerStateMachines.fsi diff --git a/src/fsharp/LowerComputedCollectionExpressions.fs b/src/fsharp/LowerComputedCollections.fs similarity index 100% rename from src/fsharp/LowerComputedCollectionExpressions.fs rename to src/fsharp/LowerComputedCollections.fs diff --git a/src/fsharp/LowerComputedCollectionExpressions.fsi b/src/fsharp/LowerComputedCollections.fsi similarity index 100% rename from src/fsharp/LowerComputedCollectionExpressions.fsi rename to src/fsharp/LowerComputedCollections.fsi diff --git a/src/fsharp/LowerSequenceExpressions.fs b/src/fsharp/LowerSequences.fs similarity index 100% rename from src/fsharp/LowerSequenceExpressions.fs rename to src/fsharp/LowerSequences.fs diff --git a/src/fsharp/LowerSequenceExpressions.fsi b/src/fsharp/LowerSequences.fsi similarity index 100% rename from src/fsharp/LowerSequenceExpressions.fsi rename to src/fsharp/LowerSequences.fsi From eaab9dae5acc9d0a78ab3f727364d735adbf2777 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:02:34 +0100 Subject: [PATCH 04/19] split infos.fs and SymbolHelpres.fs --- src/fsharp/AccessibilityLogic.fs | 3 +- src/fsharp/AttributeChecking.fs | 10 +- src/fsharp/AttributeChecking.fsi | 2 +- src/fsharp/AugmentWithHashCompare.fs | 14 +- src/fsharp/BuildGraph.fs | 20 +- src/fsharp/BuildGraph.fsi | 2 +- src/fsharp/CheckComputationExpressions.fs | 2 +- src/fsharp/CheckDeclarations.fs | 17 +- src/fsharp/CheckExpressions.fs | 5 +- src/fsharp/CheckExpressions.fsi | 4 +- src/fsharp/CheckFormatStrings.fs | 2 +- src/fsharp/CompilerConfig.fs | 16 +- src/fsharp/CompilerConfig.fsi | 6 +- src/fsharp/CompilerDiagnostics.fs | 12 +- src/fsharp/CompilerDiagnostics.fsi | 6 +- src/fsharp/CompilerImports.fs | 6 +- src/fsharp/CompilerImports.fsi | 2 +- src/fsharp/CompilerOptions.fs | 14 +- src/fsharp/ConstraintSolver.fs | 3 +- src/fsharp/ConstraintSolver.fsi | 2 +- src/fsharp/CreateILModule.fs | 2 +- src/fsharp/DetupleArgs.fs | 2 +- src/fsharp/ErrorLogger.fs | 738 ------------------ src/fsharp/ErrorLogger.fsi | 393 ---------- .../FSharp.Compiler.Service.fsproj | 20 +- src/fsharp/FindUnsolved.fs | 2 +- src/fsharp/FxResolver.fs | 2 +- src/fsharp/IlxGen.fs | 5 +- src/fsharp/InfoReader.fs | 3 +- src/fsharp/InfoReader.fsi | 1 + src/fsharp/InnerLambdasToTopLevelFuncs.fs | 2 +- src/fsharp/LegacyHostedCompilerForTesting.fs | 4 +- src/fsharp/LexFilter.fs | 2 +- src/fsharp/LowerCalls.fs | 2 +- src/fsharp/LowerComputedCollections.fs | 9 +- src/fsharp/LowerSequences.fs | 4 +- src/fsharp/LowerStateMachines.fs | 2 +- src/fsharp/MethodCalls.fs | 3 +- src/fsharp/MethodCalls.fsi | 2 +- src/fsharp/MethodOverrides.fs | 3 +- src/fsharp/NameResolution.fs | 9 +- src/fsharp/NicePrint.fs | 11 +- src/fsharp/Optimizer.fs | 4 +- src/fsharp/ParseAndCheckInputs.fs | 32 +- src/fsharp/ParseAndCheckInputs.fsi | 16 +- src/fsharp/ParseHelpers.fs | 2 +- src/fsharp/PatternMatchCompilation.fs | 2 +- src/fsharp/PostInferenceChecks.fs | 3 +- src/fsharp/QuotationTranslator.fs | 2 +- src/fsharp/ScriptClosure.fs | 20 +- src/fsharp/ScriptClosure.fsi | 2 +- src/fsharp/SignatureConformance.fs | 5 +- src/fsharp/StaticLinking.fs | 2 +- src/fsharp/SyntaxTreeOps.fs | 2 +- src/fsharp/TypeHierarchy.fs | 409 ++++++++++ src/fsharp/TypeHierarchy.fsi | 174 +++++ src/fsharp/TypeProviders.fs | 2 +- src/fsharp/TypeRelations.fs | 4 +- src/fsharp/TypedTree.fs | 10 +- src/fsharp/TypedTreeOps.fs | 7 +- src/fsharp/TypedTreeOps.fsi | 5 +- src/fsharp/TypedTreePickle.fs | 2 +- src/fsharp/XmlDoc.fs | 2 +- src/fsharp/XmlDocFileWriter.fs | 2 +- src/fsharp/absil/ilread.fs | 2 +- src/fsharp/absil/ilreflect.fs | 2 +- src/fsharp/absil/ilwrite.fs | 2 +- src/fsharp/absil/ilwritepdb.fs | 2 +- src/fsharp/autobox.fs | 4 +- src/fsharp/fsc.fs | 82 +- src/fsharp/fsc.fsi | 22 +- src/fsharp/fscmain.fs | 2 +- src/fsharp/fsi/console.fs | 2 +- src/fsharp/fsi/fsi.fs | 64 +- src/fsharp/fsi/fsimain.fs | 4 +- src/fsharp/import.fs | 14 +- src/fsharp/import.fsi | 7 + src/fsharp/infos.fs | 473 +---------- src/fsharp/infos.fsi | 165 ---- src/fsharp/lex.fsl | 2 +- src/fsharp/lexhelp.fs | 4 +- src/fsharp/lexhelp.fsi | 6 +- src/fsharp/pars.fsy | 2 +- src/fsharp/pplex.fsl | 2 +- src/fsharp/pppars.fsy | 2 +- src/fsharp/service/FSharpCheckerResults.fs | 60 +- src/fsharp/service/FSharpCheckerResults.fsi | 2 +- src/fsharp/service/FSharpParseFileResults.fs | 4 +- src/fsharp/service/IncrementalBuild.fs | 32 +- src/fsharp/service/IncrementalBuild.fsi | 2 +- src/fsharp/service/SemanticClassification.fs | 7 +- src/fsharp/service/ServiceAssemblyContent.fs | 4 +- .../service/ServiceCompilerDiagnostics.fs | 2 +- src/fsharp/service/ServiceDeclarationLists.fs | 10 +- src/fsharp/service/ServiceLexing.fs | 12 +- src/fsharp/service/ServiceParsedInputOps.fs | 4 +- src/fsharp/service/service.fs | 22 +- src/fsharp/symbols/Exprs.fs | 3 +- src/fsharp/symbols/FSharpDiagnostic.fs | 207 +++++ src/fsharp/symbols/FSharpDiagnostic.fsi | 126 +++ src/fsharp/symbols/SymbolHelpers.fs | 212 +---- src/fsharp/symbols/SymbolHelpers.fsi | 116 --- src/fsharp/symbols/Symbols.fs | 19 +- src/fsharp/utils/prim-lexing.fs | 2 +- .../CompilerTestHelpers.fs | 2 +- .../HashIfExpression.fs | 8 +- vsintegration/tests/UnitTests/Tests.Watson.fs | 6 +- 107 files changed, 1379 insertions(+), 2426 deletions(-) delete mode 100644 src/fsharp/ErrorLogger.fs delete mode 100644 src/fsharp/ErrorLogger.fsi create mode 100644 src/fsharp/TypeHierarchy.fs create mode 100644 src/fsharp/TypeHierarchy.fsi create mode 100644 src/fsharp/symbols/FSharpDiagnostic.fs create mode 100644 src/fsharp/symbols/FSharpDiagnostic.fsi diff --git a/src/fsharp/AccessibilityLogic.fs b/src/fsharp/AccessibilityLogic.fs index e9d917016ed..4a70f268ddf 100644 --- a/src/fsharp/AccessibilityLogic.fs +++ b/src/fsharp/AccessibilityLogic.fs @@ -6,12 +6,13 @@ module internal FSharp.Compiler.AccessibilityLogic open Internal.Utilities.Library open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/fsharp/AttributeChecking.fs b/src/fsharp/AttributeChecking.fs index 14e92c80b43..9d1cc9ac5ca 100644 --- a/src/fsharp/AttributeChecking.fs +++ b/src/fsharp/AttributeChecking.fs @@ -9,12 +9,14 @@ open System.Collections.Generic open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders @@ -87,7 +89,7 @@ type AttribInfo = match x with | FSAttribInfo(_g, Attrib(tcref, _, _, _, _, _, _)) -> tcref | ILAttribInfo (g, amap, scoref, a, m) -> - let ty = ImportILType scoref amap m [] a.Method.DeclaringType + let ty = RescopeAndImportILType scoref amap m [] a.Method.DeclaringType tcrefOfAppTy g ty member x.ConstructorArguments = @@ -101,7 +103,7 @@ type AttribInfo = | ILAttribInfo (_g, amap, scoref, cattr, m) -> let parms, _args = decodeILAttribData cattr [ for argTy, arg in Seq.zip cattr.Method.FormalArgTypes parms -> - let ty = ImportILType scoref amap m [] argTy + let ty = RescopeAndImportILType scoref amap m [] argTy let obj = evalILAttribElem arg ty, obj ] @@ -116,7 +118,7 @@ type AttribInfo = | ILAttribInfo (_g, amap, scoref, cattr, m) -> let _parms, namedArgs = decodeILAttribData cattr [ for nm, argTy, isProp, arg in namedArgs -> - let ty = ImportILType scoref amap m [] argTy + let ty = RescopeAndImportILType scoref amap m [] argTy let obj = evalILAttribElem arg let isField = not isProp ty, nm, isField, obj ] diff --git a/src/fsharp/AttributeChecking.fsi b/src/fsharp/AttributeChecking.fsi index 25db0ca1679..430fe36f0db 100644 --- a/src/fsharp/AttributeChecking.fsi +++ b/src/fsharp/AttributeChecking.fsi @@ -7,7 +7,7 @@ module internal FSharp.Compiler.AttributeChecking open System.Collections.Generic open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text diff --git a/src/fsharp/AugmentWithHashCompare.fs b/src/fsharp/AugmentWithHashCompare.fs index 59869f2dfbe..8e2646ada99 100644 --- a/src/fsharp/AugmentWithHashCompare.fs +++ b/src/fsharp/AugmentWithHashCompare.fs @@ -5,8 +5,7 @@ module internal FSharp.Compiler.AugmentWithHashCompare open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Infos +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Xml @@ -14,6 +13,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy let mkIComparableCompareToSlotSig (g: TcGlobals) = TSlotSig("CompareTo", g.mk_IComparable_ty, [], [], [[TSlotParam(Some("obj"), g.obj_ty, false, false, false, [])]], Some g.int_ty) @@ -175,7 +175,7 @@ let mkEqualsTestConjuncts g m exprs = List.foldBack (fun e acc -> mkCond DebugPointAtBinding.NoneAtSticky m g.bool_ty e acc (mkFalse g m)) a b let mkMinimalTy (g: TcGlobals) (tcref: TyconRef) = - if tcref.Deref.IsExceptionDecl then [], g.exn_ty + if tcref.Deref.IsFSharpException then [], g.exn_ty else generalizeTyconRef g tcref // check for nulls @@ -679,7 +679,7 @@ let isTrueFSharpStructTycon _g (tycon: Tycon) = let canBeAugmentedWithEquals g (tycon: Tycon) = tycon.IsUnionTycon || tycon.IsRecordTycon || - (tycon.IsExceptionDecl && isNominalExnc tycon) || + (tycon.IsFSharpException && isNominalExnc tycon) || isTrueFSharpStructTycon g tycon let canBeAugmentedWithCompare g (tycon: Tycon) = @@ -918,7 +918,7 @@ let MakeValsForEqualsAugmentation g (tcref: TyconRef) = let tps = tcref.Typars m let objEqualsVal = mkValSpec g tcref ty vis (Some(mkEqualsSlotSig g)) "Equals" (tps +-> (mkEqualsObjTy g ty)) unaryArg - let nocEqualsVal = mkValSpec g tcref ty vis (if tcref.Deref.IsExceptionDecl then None else Some(mkGenericIEquatableEqualsSlotSig g ty)) "Equals" (tps +-> (mkEqualsTy g ty)) unaryArg + let nocEqualsVal = mkValSpec g tcref ty vis (if tcref.Deref.IsFSharpException then None else Some(mkGenericIEquatableEqualsSlotSig g ty)) "Equals" (tps +-> (mkEqualsTy g ty)) unaryArg objEqualsVal, nocEqualsVal let MakeValsForEqualityWithComparerAugmentation g (tcref: TyconRef) = @@ -1032,7 +1032,7 @@ let MakeBindingsForEqualityWithComparerAugmentation (g: TcGlobals) (tycon: Tycon (mkCompGenBind withcEqualsVal.Deref withcEqualsExpr)] if tycon.IsUnionTycon then mkStructuralEquatable mkUnionHashWithComparer mkUnionEqualityWithComparer elif (tycon.IsRecordTycon || tycon.IsStructOrEnumTycon) then mkStructuralEquatable mkRecdHashWithComparer mkRecdEqualityWithComparer - elif tycon.IsExceptionDecl then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer + elif tycon.IsFSharpException then mkStructuralEquatable mkExnHashWithComparer mkExnEqualityWithComparer else [] let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = @@ -1066,7 +1066,7 @@ let MakeBindingsForEqualsAugmentation (g: TcGlobals) (tycon: Tycon) = [ mkCompGenBind nocEqualsVal.Deref nocEqualsExpr mkCompGenBind objEqualsVal.Deref objEqualsExpr ] - if tycon.IsExceptionDecl then mkEquals mkExnEquality + if tycon.IsFSharpException then mkEquals mkExnEquality elif tycon.IsUnionTycon then mkEquals mkUnionEquality elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then mkEquals mkRecdEquality else [] diff --git a/src/fsharp/BuildGraph.fs b/src/fsharp/BuildGraph.fs index 5ca7d3a11ce..f75271c4d38 100644 --- a/src/fsharp/BuildGraph.fs +++ b/src/fsharp/BuildGraph.fs @@ -7,7 +7,7 @@ open System.Threading open System.Threading.Tasks open System.Diagnostics open System.Globalization -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library [] @@ -15,12 +15,12 @@ type NodeCode<'T> = Node of Async<'T> let wrapThreadStaticInfo computation = async { - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let phase = CompileThreadStatic.BuildPhase try return! computation finally - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase } @@ -72,7 +72,7 @@ type NodeCodeBuilder() = member _.Using(value: CompilationGlobalsScope, binder: CompilationGlobalsScope -> NodeCode<'U>) = Node( async { - CompileThreadStatic.ErrorLogger <- value.ErrorLogger + CompileThreadStatic.DiagnosticsLogger <- value.DiagnosticsLogger CompileThreadStatic.BuildPhase <- value.BuildPhase try return! binder value |> Async.AwaitNodeCode @@ -90,19 +90,19 @@ type NodeCode private () = Node(wrapThreadStaticInfo Async.CancellationToken) static member RunImmediate (computation: NodeCode<'T>, ct: CancellationToken) = - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let phase = CompileThreadStatic.BuildPhase try try let work = async { - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase return! computation |> Async.AwaitNodeCode } Async.StartImmediateAsTask(work, cancellationToken=ct).Result finally - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase with | :? AggregateException as ex when ex.InnerExceptions.Count = 1 -> @@ -112,18 +112,18 @@ type NodeCode private () = NodeCode.RunImmediate(computation, CancellationToken.None) static member StartAsTask_ForTesting (computation: NodeCode<'T>, ?ct: CancellationToken) = - let errorLogger = CompileThreadStatic.ErrorLogger + let errorLogger = CompileThreadStatic.DiagnosticsLogger let phase = CompileThreadStatic.BuildPhase try let work = async { - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase return! computation |> Async.AwaitNodeCode } Async.StartAsTask(work, cancellationToken=defaultArg ct CancellationToken.None) finally - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger CompileThreadStatic.BuildPhase <- phase static member CancellationToken = cancellationToken diff --git a/src/fsharp/BuildGraph.fsi b/src/fsharp/BuildGraph.fsi index 1a475c97225..169164d6ff5 100644 --- a/src/fsharp/BuildGraph.fsi +++ b/src/fsharp/BuildGraph.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.BuildGraph open System open System.Threading open System.Threading.Tasks -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open Internal.Utilities.Library /// Represents code that can be run as part of the build graph. diff --git a/src/fsharp/CheckComputationExpressions.fs b/src/fsharp/CheckComputationExpressions.fs index 64dde88c6d9..e27825992d9 100644 --- a/src/fsharp/CheckComputationExpressions.fs +++ b/src/fsharp/CheckComputationExpressions.fs @@ -9,7 +9,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CheckExpressions open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 9ce89d6306f..e9f17bbc23c 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.CheckExpressions open FSharp.Compiler.CheckComputationExpressions open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -35,6 +35,7 @@ open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS @@ -2290,7 +2291,7 @@ module MutRecBindingChecking = let moduleAbbrevs = decls |> List.choose (function MutRecShape.ModuleAbbrev (MutRecDataForModuleAbbrev (id, mp, m)) -> Some (id, mp, m) | _ -> None) let opens = decls |> List.choose (function MutRecShape.Open (MutRecDataForOpen (target, m, moduleRange, openDeclsRef)) -> Some (target, m, moduleRange, openDeclsRef) | _ -> None) let lets = decls |> List.collect (function MutRecShape.Lets binds -> getVals binds | _ -> []) - let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsExceptionDecl) + let exns = tycons |> List.filter (fun (tycon: Tycon) -> tycon.IsFSharpException) // Add the type definitions, exceptions, modules and "open" declarations. // The order here is sensitive. The things added first will be resolved in an environment @@ -2475,7 +2476,7 @@ let TcMutRecDefns_Phase2 (cenv: cenv) envInitial bindsm scopem mutRecNSInfo (env let overridesOK = DeclKind.CanOverrideOrImplement declKind members |> List.collect (function | SynMemberDefn.Interface(interfaceType=intfTy; members=defnOpt) -> - let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = intfTy.Range if tcref.IsTypeAbbrev then error(Error(FSComp.SR.tcTypeAbbreviationsCannotHaveInterfaceDeclaration(), m)) if tcref.IsEnumTycon then error(Error(FSComp.SR.tcEnumerationsCannotHaveInterfaceDeclaration(), m)) @@ -2600,7 +2601,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tycon && scSet.Contains tycon.Stamp then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range let genericIComparableTy = mkAppTy g.system_GenericIComparable_tcref [ty] @@ -2623,7 +2624,7 @@ module AddAugmentationDeclarations = PublishInterface cenv env.DisplayEnv tcref m true g.mk_IStructuralComparable_ty PublishInterface cenv env.DisplayEnv tcref m true g.mk_IComparable_ty - if not tycon.IsExceptionDecl && not hasExplicitGenericIComparable then + if not tycon.IsFSharpException && not hasExplicitGenericIComparable then PublishInterface cenv env.DisplayEnv tcref m true genericIComparableTy tcaug.SetCompare (mkLocalValRef cvspec1, mkLocalValRef cvspec2) tcaug.SetCompareWith (mkLocalValRef cvspec3) @@ -2684,7 +2685,7 @@ module AddAugmentationDeclarations = if AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tycon then let tcref = mkLocalTyconRef tycon let tcaug = tycon.TypeContents - let ty = if tcref.Deref.IsExceptionDecl then g.exn_ty else generalizedTyconRef g tcref + let ty = if tcref.Deref.IsFSharpException then g.exn_ty else generalizedTyconRef g tcref let m = tycon.Range // Note: tycon.HasOverride only gives correct results after we've done the type augmentation @@ -2701,7 +2702,7 @@ module AddAugmentationDeclarations = let vspec1, vspec2 = AugmentWithHashCompare.MakeValsForEqualsAugmentation g tcref tcaug.SetEquals (mkLocalValRef vspec1, mkLocalValRef vspec2) - if not tycon.IsExceptionDecl then + if not tycon.IsFSharpException then PublishInterface cenv env.DisplayEnv tcref m true (mkAppTy g.system_GenericIEquatable_tcref [ty]) PublishValueDefn cenv env ModuleOrMemberBinding vspec1 PublishValueDefn cenv env ModuleOrMemberBinding vspec2 @@ -4606,7 +4607,7 @@ module EstablishTypeDefinitionCores = (envMutRecPrelim, withAttrs) ||> MutRecShapes.extendEnvs (fun envForDecls decls -> let tycons = decls |> List.choose (function MutRecShape.Tycon (_, Some (tycon, _)) -> Some tycon | _ -> None) - let exns = tycons |> List.filter (fun tycon -> tycon.IsExceptionDecl) + let exns = tycons |> List.filter (fun tycon -> tycon.IsFSharpException) let envForDecls = (envForDecls, exns) ||> List.fold (AddLocalExnDefnAndReport cenv.tcSink scopem) envForDecls) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 12eb6f4ccd9..aae35b3f7e1 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -18,7 +18,7 @@ open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -38,6 +38,7 @@ open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS @@ -11308,7 +11309,7 @@ and AnalyzeRecursiveStaticMemberOrValDecl CheckMemberFlags None newslotsOK overridesOK memberFlags id.idRange CheckForNonAbstractInterface declKind tcref memberFlags id.idRange - if memberFlags.MemberKind = SynMemberKind.Constructor && tcref.Deref.IsExceptionDecl then + if memberFlags.MemberKind = SynMemberKind.Constructor && tcref.Deref.IsFSharpException then error(Error(FSComp.SR.tcConstructorsDisallowedInExceptionAugmentation(), id.idRange)) let isExtrinsic = (declKind = ExtrinsicExtensionBinding) diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index badd1b17da0..cedfbf5d2a5 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -11,7 +11,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.ConstraintSolver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -112,7 +112,7 @@ type TcEnv = //------------------------------------------------------------------------- // Some of the exceptions arising from type checking. These should be moved to -// use ErrorLogger. +// use DiagnosticsLogger. //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range diff --git a/src/fsharp/CheckFormatStrings.fs b/src/fsharp/CheckFormatStrings.fs index 10f91b62498..5d24e1050d9 100644 --- a/src/fsharp/CheckFormatStrings.fs +++ b/src/fsharp/CheckFormatStrings.fs @@ -367,7 +367,7 @@ let parseFormatStringInternal (m: range) (fragRanges: range list) (g: TcGlobals) parseLoop acc (i+1, fragLine, fragCol+1) fragments | 'd' | 'i' | 'u' | 'B' | 'o' | 'x' | 'X' -> - if ch = 'B' then ErrorLogger.checkLanguageFeatureError g.langVersion Features.LanguageFeature.PrintfBinaryFormat m + if ch = 'B' then DiagnosticsLogger.checkLanguageFeatureError g.langVersion Features.LanguageFeature.PrintfBinaryFormat m if info.precision then failwithf "%s" <| FSComp.SR.forFormatDoesntSupportPrecision(ch.ToString()) collectSpecifierLocation fragLine fragCol 1 let i = skipPossibleInterpolationHole (i+1) diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index 835cf68894d..c317cb026ee 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -368,7 +368,7 @@ type TcConfigBuilder = mutable useHighEntropyVA: bool mutable inputCodePage: int option mutable embedResources: string list - mutable errorSeverityOptions: FSharpDiagnosticOptions + mutable diagnosticsOptions: FSharpDiagnosticOptions mutable mlCompatibility: bool mutable checkOverflow: bool mutable showReferenceResolutions: bool @@ -579,7 +579,7 @@ type TcConfigBuilder = projectReferences = [] knownUnresolvedReferences = [] loadedSources = [] - errorSeverityOptions = FSharpDiagnosticOptions.Default + diagnosticsOptions = FSharpDiagnosticOptions.Default embedResources = [] inputCodePage = None subsystemVersion = 4, 0 // per spec for 357994 @@ -770,8 +770,8 @@ type TcConfigBuilder = | Some n -> // nowarn:62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- true - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with WarnOff = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOff } + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with WarnOff = ListSet.insert (=) n tcConfigB.diagnosticsOptions.WarnOff } member tcConfigB.TurnWarningOn(m, s: string) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parameter @@ -780,8 +780,8 @@ type TcConfigBuilder = | Some n -> // warnon 62 turns on mlCompatibility, e.g. shows ML compat items in intellisense menus if n = 62 then tcConfigB.mlCompatibility <- false - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with WarnOn = ListSet.insert (=) n tcConfigB.errorSeverityOptions.WarnOn } + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with WarnOn = ListSet.insert (=) n tcConfigB.diagnosticsOptions.WarnOn } member tcConfigB.AddIncludePath (m, path, pathIncludedFrom) = let absolutePath = ComputeMakePathAbsolute pathIncludedFrom path @@ -1062,7 +1062,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.useHighEntropyVA = data.useHighEntropyVA member _.inputCodePage = data.inputCodePage member _.embedResources = data.embedResources - member _.errorSeverityOptions = data.errorSeverityOptions + member _.diagnosticsOptions = data.diagnosticsOptions member _.mlCompatibility = data.mlCompatibility member _.checkOverflow = data.checkOverflow member _.showReferenceResolutions = data.showReferenceResolutions diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index 8caa6028a6a..ba09e77b8a0 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.AbstractIL.ILPdbWriter open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text @@ -256,7 +256,7 @@ type TcConfigBuilder = mutable embedResources: string list - mutable errorSeverityOptions: FSharpDiagnosticOptions + mutable diagnosticsOptions: FSharpDiagnosticOptions mutable mlCompatibility: bool @@ -566,7 +566,7 @@ type TcConfig = member embedResources: string list - member errorSeverityOptions: FSharpDiagnosticOptions + member diagnosticsOptions: FSharpDiagnosticOptions member mlCompatibility: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index a5b4bfc37a9..3c2adad42c5 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.ConstraintSolver open FSharp.Compiler.DiagnosticMessage open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp @@ -1960,7 +1960,7 @@ let ReportDiagnosticAsError options (diag, severity) = // Scoped #nowarn pragmas -/// Build an ErrorLogger that delegates to another ErrorLogger but filters warnings turned off by the given pragma declarations +/// Build an DiagnosticsLogger that delegates to another DiagnosticsLogger 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 sufficient @@ -1968,8 +1968,8 @@ let ReportDiagnosticAsError options (diag, severity) = // 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, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger) = - inherit ErrorLogger("ErrorLoggerFilteringByScopedPragmas") +type DiagnosticsLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: DiagnosticsLogger) = + inherit DiagnosticsLogger("DiagnosticsLoggerFilteringByScopedPragmas") override x.DiagnosticSink (phasedError, severity) = if severity = FSharpDiagnosticSeverity.Error then @@ -1998,5 +1998,5 @@ type ErrorLoggerFilteringByScopedPragmas (checkFile, scopedPragmas, diagnosticOp override _.ErrorCount = errorLogger.ErrorCount -let GetErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) = - ErrorLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) :> ErrorLogger +let GetDiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) = + DiagnosticsLoggerFilteringByScopedPragmas(checkFile, scopedPragmas, diagnosticOptions, errorLogger) :> DiagnosticsLogger diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 79f2de1ce4c..6ee7a2f56c4 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.CompilerDiagnostics open System.Text open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -114,8 +114,8 @@ val CollectDiagnostic: seq /// Get an error logger that filters the reporting of warnings based on scoped pragma information -val GetErrorLoggerFilteringByScopedPragmas: - checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * ErrorLogger -> ErrorLogger +val GetDiagnosticsLoggerFilteringByScopedPragmas: + checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 4353f5ec4ef..77d147c3aef 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -23,7 +23,7 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CompilerConfig open FSharp.Compiler.DependencyManager -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis @@ -1327,7 +1327,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse runtimeAssemblyAttributes: ILAttribute list, entityToInjectInto, invalidateCcu: Event<_>, m) = - let startingErrorCount = CompileThreadStatic.ErrorLogger.ErrorCount + let startingErrorCount = CompileThreadStatic.DiagnosticsLogger.ErrorCount // Find assembly level TypeProviderAssemblyAttributes. These will point to the assemblies that // have class which implement ITypeProvider and which have TypeProviderAttribute on them. @@ -1454,7 +1454,7 @@ and [] TcImports(tcConfigP: TcConfigProvider, initialResolutions: TcAsse with e -> errorRecovery e m - if startingErrorCount None [ CompilerOption("warnaserror", tagNone, OptionSwitch(fun switch -> - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with GlobalWarnAsError = switch <> OptionSwitch.Off }), None, Some (FSComp.SR.optsWarnaserrorPM())) CompilerOption("warnaserror", tagWarnList, OptionStringListSwitch (fun n switch -> match trimFStoInt n with | Some n -> - let options = tcConfigB.errorSeverityOptions - tcConfigB.errorSeverityOptions <- + let options = tcConfigB.diagnosticsOptions + tcConfigB.diagnosticsOptions <- if switch = OptionSwitch.Off then { options with WarnAsError = ListSet.remove (=) n options.WarnAsError @@ -633,8 +633,8 @@ let errorsAndWarningsFlags (tcConfigB: TcConfigBuilder) = | None -> ()), None, Some (FSComp.SR.optsWarnaserror())) CompilerOption("warn", tagInt, OptionInt (fun n -> - tcConfigB.errorSeverityOptions <- - { tcConfigB.errorSeverityOptions with + tcConfigB.diagnosticsOptions <- + { tcConfigB.diagnosticsOptions with WarnLevel = if (n >= 0 && n <= 5) then n else error(Error (FSComp.SR.optsInvalidWarningLevel n, rangeCmdArgs)) } ), None, Some (FSComp.SR.optsWarn())) diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 4a91626e7d3..2dbb006024b 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -51,7 +51,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Import open FSharp.Compiler.InfoReader @@ -66,6 +66,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //------------------------------------------------------------------------- diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 8a305067831..353f0aab107 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -4,7 +4,7 @@ module internal FSharp.Compiler.ConstraintSolver open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader diff --git a/src/fsharp/CreateILModule.fs b/src/fsharp/CreateILModule.fs index ea2bf785a11..c510fcca310 100644 --- a/src/fsharp/CreateILModule.fs +++ b/src/fsharp/CreateILModule.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.CheckDeclarations open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.IO open FSharp.Compiler.OptimizeInputs diff --git a/src/fsharp/DetupleArgs.fs b/src/fsharp/DetupleArgs.fs index e7aac1ac894..718cc21e87a 100644 --- a/src/fsharp/DetupleArgs.fs +++ b/src/fsharp/DetupleArgs.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.Detuple open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text diff --git a/src/fsharp/ErrorLogger.fs b/src/fsharp/ErrorLogger.fs deleted file mode 100644 index 776c91519bc..00000000000 --- a/src/fsharp/ErrorLogger.fs +++ /dev/null @@ -1,738 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module FSharp.Compiler.ErrorLogger - -open FSharp.Compiler.Diagnostics -open FSharp.Compiler.Features -open FSharp.Compiler.Text.Range -open FSharp.Compiler.Text -open System -open System.Diagnostics -open System.Threading -open Internal.Utilities.Library -open Internal.Utilities.Library.Extras - -/// Represents the style being used to format errors -[] -type ErrorStyle = - | DefaultErrors - | EmacsErrors - | TestErrors - | VSErrors - | GccErrors - -/// Thrown when we want to add some range information to a .NET exception -exception WrappedError of exn * range with - override this.Message = - match this :> exn with - | WrappedError (exn, _) -> "WrappedError(" + exn.Message + ")" - | _ -> "WrappedError" - -/// Thrown when immediate, local error recovery is not possible. This indicates -/// we've reported an error but need to make a non-local transfer of control. -/// Error recovery may catch this and continue (see 'errorRecovery') -/// -/// The exception that caused the report is carried as data because in some -/// situations (LazyWithContext) we may need to re-report the original error -/// when a lazy thunk is re-evaluated. -exception ReportedError of exn option with - override this.Message = - let msg = "The exception has been reported. This internal exception should now be caught at an error recovery point on the stack." - match this :> exn with - | ReportedError (Some exn) -> msg + " Original message: " + exn.Message + ")" - | _ -> msg - -let rec findOriginalException err = - match err with - | ReportedError (Some err) -> err - | WrappedError(err, _) -> findOriginalException err - | _ -> err - -type Suggestions = (string -> unit) -> unit - -let NoSuggestions : Suggestions = ignore - -/// Thrown when we stop processing the F# Interactive entry or #load. -exception StopProcessingExn of exn option with - override _.Message = "Processing of a script fragment has stopped because an exception has been raised" - - override this.ToString() = - match this :> exn with - | StopProcessingExn(Some exn) -> "StopProcessingExn, originally (" + exn.ToString() + ")" - | _ -> "StopProcessingExn" - - -let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ -> None - -let StopProcessing<'T> = StopProcessingExn None - -exception Error of (int * string) * range with // int is e.g. 191 in FS0191 - override this.Message = - match this :> exn with - | Error((_, msg), _) -> msg - | _ -> "impossible" - -exception InternalError of msg: string * range with - override this.Message = - match this :> exn with - | InternalError(msg, m) -> msg + m.ToString() - | _ -> "impossible" - -exception UserCompilerMessage of string * int * range - -exception LibraryUseOnly of range - -exception Deprecated of string * range - -exception Experimental of string * range - -exception PossibleUnverifiableCode of range - -exception UnresolvedReferenceNoRange of (*assemblyName*) string - -exception UnresolvedReferenceError of (*assemblyName*) string * range - -exception UnresolvedPathReferenceNoRange of (*assemblyName*) string * (*path*) string with - override this.Message = - match this :> exn with - | UnresolvedPathReferenceNoRange(assemblyName, path) -> sprintf "Assembly: %s, full path: %s" assemblyName path - | _ -> "impossible" - -exception UnresolvedPathReference of (*assemblyName*) string * (*path*) string * range - -exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 - override this.Message = - match this :> exn with - | ErrorWithSuggestions((_, msg), _, _, _) -> msg - | _ -> "impossible" - - -let inline protectAssemblyExploration dflt f = - try - f() - with - | UnresolvedPathReferenceNoRange _ -> dflt - | _ -> reraise() - -let inline protectAssemblyExplorationF dflt f = - try - f() - with - | UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName, path) - | _ -> reraise() - -let inline protectAssemblyExplorationNoReraise dflt1 dflt2 f = - try - f() - with - | UnresolvedPathReferenceNoRange _ -> dflt1 - | _ -> dflt2 - -// Attach a range if this is a range dual exception. -let rec AttachRange m (exn:exn) = - if equals m range0 then exn - else - match exn with - // Strip TargetInvocationException wrappers - | :? System.Reflection.TargetInvocationException -> AttachRange m exn.InnerException - | UnresolvedReferenceNoRange a -> UnresolvedReferenceError(a, m) - | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) - | Failure msg -> InternalError(msg + " (Failure)", m) - | :? ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) - | notARangeDual -> notARangeDual - -type Exiter = - abstract Exit : int -> 'T - -let QuitProcessExiter = - { new Exiter with - member _.Exit n = - try - Environment.Exit n - with _ -> - () - FSComp.SR.elSysEnvExitDidntExit() - |> failwith } - -/// Closed enumeration of build phases. -[] -type BuildPhase = - | DefaultPhase - | Compile - | Parameter | Parse | TypeCheck - | CodeGen - | Optimize | IlxGen | IlGen | Output - | Interactive // An error seen during interactive execution - -/// Literal build phase subcategory strings. -module BuildPhaseSubcategory = - [] - let DefaultPhase = "" - [] - let Compile = "compile" - [] - let Parameter = "parameter" - [] - let Parse = "parse" - [] - let TypeCheck = "typecheck" - [] - let CodeGen = "codegen" - [] - let Optimize = "optimize" - [] - let IlxGen = "ilxgen" - [] - let IlGen = "ilgen" - [] - let Output = "output" - [] - let Interactive = "interactive" - [] - let Internal = "internal" // Compiler ICE - -[] -type PhasedDiagnostic = - { Exception:exn; Phase:BuildPhase } - - /// Construct a phased error - static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = - // FUTURE: reenable this assert, which has historically triggered in some compiler service scenarios - // System.Diagnostics.Debug.Assert(phase<>BuildPhase.DefaultPhase, sprintf "Compile error seen with no phase to attribute it to.%A %s %s" phase exn.Message exn.StackTrace ) - {Exception = exn; Phase=phase} - - member this.DebugDisplay() = - sprintf "%s: %s" (this.Subcategory()) this.Exception.Message - - /// This is the textual subcategory to display in error and warning messages (shows only under --vserrors): - /// - /// file1.fs(72): subcategory warning FS0072: This is a warning message - /// - member pe.Subcategory() = - match pe.Phase with - | BuildPhase.DefaultPhase -> BuildPhaseSubcategory.DefaultPhase - | BuildPhase.Compile -> BuildPhaseSubcategory.Compile - | BuildPhase.Parameter -> BuildPhaseSubcategory.Parameter - | BuildPhase.Parse -> BuildPhaseSubcategory.Parse - | BuildPhase.TypeCheck -> BuildPhaseSubcategory.TypeCheck - | BuildPhase.CodeGen -> BuildPhaseSubcategory.CodeGen - | BuildPhase.Optimize -> BuildPhaseSubcategory.Optimize - | BuildPhase.IlxGen -> BuildPhaseSubcategory.IlxGen - | BuildPhase.IlGen -> BuildPhaseSubcategory.IlGen - | BuildPhase.Output -> BuildPhaseSubcategory.Output - | BuildPhase.Interactive -> BuildPhaseSubcategory.Interactive - - /// Return true if the textual phase given is from the compile part of the build process. - /// This set needs to be equal to the set of subcategories that the language service can produce. - static member IsSubcategoryOfCompile(subcategory:string) = - // This code logic is duplicated in DocumentTask.cs in the language service. - match subcategory with - | BuildPhaseSubcategory.Compile - | BuildPhaseSubcategory.Parameter - | BuildPhaseSubcategory.Parse - | BuildPhaseSubcategory.TypeCheck -> true - | BuildPhaseSubcategory.DefaultPhase - | BuildPhaseSubcategory.CodeGen - | BuildPhaseSubcategory.Optimize - | BuildPhaseSubcategory.IlxGen - | BuildPhaseSubcategory.IlGen - | BuildPhaseSubcategory.Output - | BuildPhaseSubcategory.Interactive -> false - | BuildPhaseSubcategory.Internal - // Getting here means the compiler has ICE-d. Let's not pile on by showing the unknownSubcategory assert below. - // Just treat as an unknown-to-LanguageService error. - -> false - | unknownSubcategory -> - Debug.Assert(false, sprintf "Subcategory '%s' could not be correlated with a build phase." unknownSubcategory) - // Recovery is to treat this as a 'build' error. Downstream, the project system and language service will treat this as - // if it came from the build and not the language service. - false - - /// Return true if this phase is one that's known to be part of the 'compile'. This is the initial phase of the entire compilation that - /// the language service knows about. - member pe.IsPhaseInCompile() = - let isPhaseInCompile = - match pe.Phase with - | BuildPhase.Compile | BuildPhase.Parameter | BuildPhase.Parse | BuildPhase.TypeCheck -> true - | _ -> false - // Sanity check ensures that Phase matches Subcategory -#if DEBUG - if isPhaseInCompile then - Debug.Assert(PhasedDiagnostic.IsSubcategoryOfCompile(pe.Subcategory()), "Subcategory did not match isPhaseInCompile=true") - else - Debug.Assert(not(PhasedDiagnostic.IsSubcategoryOfCompile(pe.Subcategory())), "Subcategory did not match isPhaseInCompile=false") -#endif - isPhaseInCompile - -[] -[] -type ErrorLogger(nameForDebugging:string) = - abstract ErrorCount: int - // The 'Impl' factoring enables a developer to place a breakpoint at the non-Impl - // code just below and get a breakpoint for all error logger implementations. - abstract DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - member _.DebugDisplay() = sprintf "ErrorLogger(%s)" nameForDebugging - -let DiscardErrorsLogger = - { new ErrorLogger("DiscardErrorsLogger") with - member x.DiagnosticSink(phasedError, severity) = () - member x.ErrorCount = 0 } - -let AssertFalseErrorLogger = - { new ErrorLogger("AssertFalseErrorLogger") with - // TODO: reenable these asserts in the compiler service - member x.DiagnosticSink(phasedError, severity) = (* assert false; *) () - member x.ErrorCount = (* assert false; *) 0 - } - -type CapturingErrorLogger(nm) = - inherit ErrorLogger(nm) - let mutable errorCount = 0 - let diagnostics = ResizeArray() - - override _.DiagnosticSink(phasedError, severity) = - if severity = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 - diagnostics.Add (phasedError, severity) - - override _.ErrorCount = errorCount - - member _.Diagnostics = diagnostics |> Seq.toList - - member _.CommitDelayedDiagnostics(errorLogger:ErrorLogger) = - // Eagerly grab all the errors and warnings from the mutable collection - let errors = diagnostics.ToArray() - errors |> Array.iter errorLogger.DiagnosticSink - -/// Type holds thread-static globals for use by the compile. -type internal CompileThreadStatic = - [] - static val mutable private buildPhase : BuildPhase - - [] - static val mutable private errorLogger : ErrorLogger - - static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase (* This can be a null value *) - - static member BuildPhase - with get() = - match box CompileThreadStatic.buildPhase with - | Null -> BuildPhase.DefaultPhase - | _ -> CompileThreadStatic.buildPhase - and set v = CompileThreadStatic.buildPhase <- v - - static member ErrorLogger - with get() = - match box CompileThreadStatic.errorLogger with - | Null -> AssertFalseErrorLogger - | _ -> CompileThreadStatic.errorLogger - and set v = CompileThreadStatic.errorLogger <- v - - -[] -module ErrorLoggerExtensions = - open System.Reflection - - // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV - // This uses a simple heuristic to detect it (the vsversion is < 16.0) - let tryAndDetectDev15 = - let vsVersion = Environment.GetEnvironmentVariable("VisualStudioVersion") - match Double.TryParse vsVersion with - | true, v -> v < 16.0 - | _ -> false - - /// Instruct the exception not to reset itself when thrown again. - let PreserveStackTrace exn = - try - if not tryAndDetectDev15 then - let preserveStackTrace = typeof.GetMethod("InternalPreserveStackTrace", BindingFlags.Instance ||| BindingFlags.NonPublic) - preserveStackTrace.Invoke(exn, null) |> ignore - with _ -> - // This is probably only the mono case. - Debug.Assert(false, "Could not preserve stack trace for watson exception.") - () - - /// Reraise an exception if it is one we want to report to Watson. - let ReraiseIfWatsonable(exn:exn) = - match exn with - // These few SystemExceptions which we don't report to Watson are because we handle these in some way in Build.fs - | :? TargetInvocationException -> () - | :? NotSupportedException -> () - | :? System.IO.IOException -> () // This covers FileNotFoundException and DirectoryNotFoundException - | :? UnauthorizedAccessException -> () - | Failure _ // This gives reports for compiler INTERNAL ERRORs - | :? SystemException -> - PreserveStackTrace exn - raise exn - | _ -> () - - type ErrorLogger with - - member x.EmitDiagnostic (exn, severity) = - match exn with - | InternalError (s, _) - | Failure s as exn -> Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) - | _ -> () - - match exn with - | StopProcessing - | ReportedError _ -> - PreserveStackTrace exn - raise exn - | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), severity) - - member x.ErrorR exn = - x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Error) - - member x.Warning exn = - x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Warning) - - member x.InformationalWarning exn = - x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Info) - - member x.Error exn = - x.ErrorR exn - raise (ReportedError (Some exn)) - - member x.SimulateError (ph: PhasedDiagnostic) = - x.DiagnosticSink (ph, FSharpDiagnosticSeverity.Error) - raise (ReportedError (Some ph.Exception)) - - member x.ErrorRecovery (exn: exn) (m: range) = - // Never throws ReportedError. - // Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler. - match exn with - (* Don't send ThreadAbortException down the error channel *) - | :? System.Threading.ThreadAbortException | WrappedError(:? System.Threading.ThreadAbortException, _) -> () - | ReportedError _ | WrappedError(ReportedError _, _) -> () - | StopProcessing | WrappedError(StopProcessing, _) -> - PreserveStackTrace exn - raise exn - | _ -> - try - x.ErrorR (AttachRange m exn) // may raise exceptions, e.g. an fsi error sink raises StopProcessing. - ReraiseIfWatsonable exn - with - | ReportedError _ | WrappedError(ReportedError _, _) -> () - - member x.StopProcessingRecovery (exn:exn) (m:range) = - // Do standard error recovery. - // Additionally ignore/catch StopProcessing. [This is the only catch handler for StopProcessing]. - // Additionally ignore/catch ReportedError. - // Can throw other exceptions raised by the DiagnosticSink(exn) handler. - match exn with - | StopProcessing | WrappedError(StopProcessing, _) -> () // suppress, so skip error recovery. - | _ -> - try - x.ErrorRecovery exn m - with - | StopProcessing | WrappedError(StopProcessing, _) -> () // catch, e.g. raised by DiagnosticSink. - | ReportedError _ | WrappedError(ReportedError _, _) -> () // catch, but not expected unless ErrorRecovery is changed. - - member x.ErrorRecoveryNoRange (exn:exn) = - x.ErrorRecovery exn range0 - -/// NOTE: The change will be undone when the returned "unwind" object disposes -let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = - let oldBuildPhase = CompileThreadStatic.BuildPhaseUnchecked - CompileThreadStatic.BuildPhase <- phase - { new IDisposable with - member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase } - -/// NOTE: The change will be undone when the returned "unwind" object disposes -let PushErrorLoggerPhaseUntilUnwind(errorLoggerTransformer: ErrorLogger -> #ErrorLogger) = - let oldErrorLogger = CompileThreadStatic.ErrorLogger - CompileThreadStatic.ErrorLogger <- errorLoggerTransformer oldErrorLogger - { new IDisposable with - member _.Dispose() = - CompileThreadStatic.ErrorLogger <- oldErrorLogger } - -let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase - -let SetThreadErrorLoggerNoUnwind errorLogger = CompileThreadStatic.ErrorLogger <- errorLogger - -/// This represents the thread-local state established as each task function runs as part of the build. -/// -/// Use to reset error and warning handlers. -type CompilationGlobalsScope(errorLogger: ErrorLogger, buildPhase: BuildPhase) = - let unwindEL = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) - let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase - - member _.ErrorLogger = errorLogger - member _.BuildPhase = buildPhase - - // Return the disposable object that cleans up - interface IDisposable with - member _.Dispose() = - unwindBP.Dispose() - unwindEL.Dispose() - -// Global functions are still used by parser and TAST ops. - -/// Raises an exception with error recovery and returns unit. -let errorR exn = CompileThreadStatic.ErrorLogger.ErrorR exn - -/// Raises a warning with error recovery and returns unit. -let warning exn = CompileThreadStatic.ErrorLogger.Warning exn - -/// Raises a warning with error recovery and returns unit. -let informationalWarning exn = CompileThreadStatic.ErrorLogger.InformationalWarning exn - -/// Raises a special exception and returns 'T - can be caught later at an errorRecovery point. -let error exn = CompileThreadStatic.ErrorLogger.Error exn - -/// Simulates an error. For test purposes only. -let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.ErrorLogger.SimulateError p - -let diagnosticSink (phasedError, severity) = CompileThreadStatic.ErrorLogger.DiagnosticSink (phasedError, severity) - -let errorSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Error) - -let warnSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Warning) - -let errorRecovery exn m = CompileThreadStatic.ErrorLogger.ErrorRecovery exn m - -let stopProcessingRecovery exn m = CompileThreadStatic.ErrorLogger.StopProcessingRecovery exn m - -let errorRecoveryNoRange exn = CompileThreadStatic.ErrorLogger.ErrorRecoveryNoRange exn - -let report f = - f() - -let deprecatedWithError s m = errorR(Deprecated(s, m)) - -let libraryOnlyError m = errorR(LibraryUseOnly m) - -let libraryOnlyWarning m = warning(LibraryUseOnly m) - -let deprecatedOperator m = deprecatedWithError (FSComp.SR.elDeprecatedOperator()) m - -let mlCompatWarning s m = warning(UserCompilerMessage(FSComp.SR.mlCompatMessage s, 62, m)) - -let mlCompatError s m = errorR(UserCompilerMessage(FSComp.SR.mlCompatError s, 62, m)) - -let suppressErrorReporting f = - let errorLogger = CompileThreadStatic.ErrorLogger - try - let errorLogger = - { new ErrorLogger("suppressErrorReporting") with - member _.DiagnosticSink(_phasedError, _isError) = () - member _.ErrorCount = 0 } - SetThreadErrorLoggerNoUnwind errorLogger - f() - finally - SetThreadErrorLoggerNoUnwind errorLogger - -let conditionallySuppressErrorReporting cond f = if cond then suppressErrorReporting f else f() - -//------------------------------------------------------------------------ -// Errors as data: Sometimes we have to reify errors as data, e.g. if backtracking - -/// The result type of a computational modality to colelct warnings and possibly fail -[] -type OperationResult<'T> = - | OkResult of warnings: exn list * 'T - | ErrorResult of warnings: exn list * exn - -type ImperativeOperationResult = OperationResult - -let ReportWarnings warns = - match warns with - | [] -> () // shortcut in common case - | _ -> List.iter warning warns - -let CommitOperationResult res = - match res with - | OkResult (warns, res) -> ReportWarnings warns; res - | ErrorResult (warns, err) -> ReportWarnings warns; error err - -let RaiseOperationResult res : unit = CommitOperationResult res - -let ErrorD err = ErrorResult([], err) - -let WarnD err = OkResult([err], ()) - -let CompleteD = OkResult([], ()) - -let ResultD x = OkResult([], x) - -let CheckNoErrorsAndGetWarnings res = - match res with - | OkResult (warns, res2) -> Some (warns, res2) - | ErrorResult _ -> None - -/// The bind in the monad. Stop on first error. Accumulate warnings and continue. -let (++) res f = - match res with - | OkResult([], res) -> (* tailcall *) f res - | OkResult(warns, res) -> - match f res with - | OkResult(warns2, res2) -> OkResult(warns@warns2, res2) - | ErrorResult(warns2, err) -> ErrorResult(warns@warns2, err) - | ErrorResult(warns, err) -> - ErrorResult(warns, err) - -/// Stop on first error. Accumulate warnings and continue. -let rec IterateD f xs = - match xs with - | [] -> CompleteD - | h :: t -> f h ++ (fun () -> IterateD f t) - -let rec WhileD gd body = if gd() then body() ++ (fun () -> WhileD gd body) else CompleteD - -let MapD f xs = - let rec loop acc xs = - match xs with - | [] -> ResultD (List.rev acc) - | h :: t -> f h ++ (fun x -> loop (x :: acc) t) - - loop [] xs - -type TrackErrorsBuilder() = - member x.Bind(res, k) = res ++ k - member x.Return res = ResultD res - member x.ReturnFrom res = res - member x.For(seq, k) = IterateD k seq - member x.Combine(expr1, expr2) = expr1 ++ expr2 - member x.While(gd, k) = WhileD gd k - member x.Zero() = CompleteD - member x.Delay fn = fun () -> fn () - member x.Run fn = fn () - -let trackErrors = TrackErrorsBuilder() - -/// Stop on first error. Accumulate warnings and continue. -let OptionD f xs = - match xs with - | None -> CompleteD - | Some h -> f h - -/// Stop on first error. Report index -let IterateIdxD f xs = - let rec loop xs i = match xs with [] -> CompleteD | h :: t -> f i h ++ (fun () -> loop t (i+1)) - loop xs 0 - -/// Stop on first error. Accumulate warnings and continue. -let rec Iterate2D f xs ys = - match xs, ys with - | [], [] -> CompleteD - | h1 :: t1, h2 :: t2 -> f h1 h2 ++ (fun () -> Iterate2D f t1 t2) - | _ -> failwith "Iterate2D" - -/// Keep the warnings, propagate the error to the exception continuation. -let TryD f g = - match f() with - | ErrorResult(warns, err) -> - trackErrors { - do! OkResult(warns, ()) - return! g err - } - | res -> res - -let rec RepeatWhileD nDeep body = body nDeep ++ (fun x -> if x then RepeatWhileD (nDeep+1) body else CompleteD) - -let inline AtLeastOneD f l = MapD f l ++ (fun res -> ResultD (List.exists id res)) - -let inline AtLeastOne2D f xs ys = List.zip xs ys |> AtLeastOneD (fun (x,y) -> f x y) - -let inline MapReduceD mapper zero reducer l = MapD mapper l ++ (fun res -> ResultD (match res with [] -> zero | _ -> List.reduce reducer res)) - -let inline MapReduce2D mapper zero reducer xs ys = List.zip xs ys |> MapReduceD (fun (x,y) -> mapper x y) zero reducer - -[] -module OperationResult = - let inline ignore (res: OperationResult<'a>) = - match res with - | OkResult(warnings, _) -> OkResult(warnings, ()) - | ErrorResult(warnings, err) -> ErrorResult(warnings, err) - -// Code below is for --flaterrors flag that is only used by the IDE -let stringThatIsAProxyForANewlineInFlatErrors = String [|char 29 |] - -let NewlineifyErrorString (message:string) = message.Replace(stringThatIsAProxyForANewlineInFlatErrors, Environment.NewLine) - -/// fixes given string by replacing all control chars with spaces. -/// NOTE: newlines are recognized and replaced with stringThatIsAProxyForANewlineInFlatErrors (ASCII 29, the 'group separator'), -/// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo -let NormalizeErrorString (text : string MaybeNull) = - let text = nullArgCheck "text" text - let text = text.Trim() - - let buf = System.Text.StringBuilder() - let mutable i = 0 - while i < text.Length do - let delta = - match text[i] with - | '\r' when i + 1 < text.Length && text[i + 1] = '\n' -> - // handle \r\n sequence - replace it with one single space - buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore - 2 - | '\n' | '\r' -> - buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore - 1 - | c -> - // handle remaining chars: control - replace with space, others - keep unchanged - let c = if Char.IsControl c then ' ' else c - buf.Append c |> ignore - 1 - i <- i + delta - buf.ToString() - -let private tryLanguageFeatureErrorAux (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) = - if not (langVersion.SupportsFeature langFeature) then - let featureStr = langVersion.GetFeatureString langFeature - let currentVersionStr = langVersion.SpecifiedVersionString - let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature - Some (Error(FSComp.SR.chkFeatureNotLanguageSupported(featureStr, currentVersionStr, suggestedVersionStr), m)) - else - None - -let internal checkLanguageFeatureError langVersion langFeature m = - match tryLanguageFeatureErrorAux langVersion langFeature m with - | Some e -> error e - | None -> () - -let internal checkLanguageFeatureErrorRecover langVersion langFeature m = - match tryLanguageFeatureErrorAux langVersion langFeature m with - | Some e -> errorR e - | None -> () - -let internal tryLanguageFeatureErrorOption langVersion langFeature m = - tryLanguageFeatureErrorAux langVersion langFeature m - -let internal languageFeatureNotSupportedInLibraryError (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) = - let featureStr = langVersion.GetFeatureString langFeature - let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature - error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary(featureStr, suggestedVersionStr), m)) - -/// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached -type StackGuard(maxDepth: int) = - - let mutable depth = 1 - - member _.Guard(f) = - depth <- depth + 1 - try - if depth % maxDepth = 0 then - let errorLogger = CompileThreadStatic.ErrorLogger - let buildPhase = CompileThreadStatic.BuildPhase - async { - do! Async.SwitchToNewThread() - Thread.CurrentThread.Name <- "F# Extra Compilation Thread" - use _scope = new CompilationGlobalsScope(errorLogger, buildPhase) - return f() - } |> Async.RunImmediate - else - f() - finally - depth <- depth - 1 - - static member val DefaultDepth = -#if DEBUG - GetEnvInteger "FSHARP_DefaultStackGuardDepth" 50 -#else - GetEnvInteger "FSHARP_DefaultStackGuardDepth" 100 -#endif - - static member GetDepthOption (name: string) = - GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth - diff --git a/src/fsharp/ErrorLogger.fsi b/src/fsharp/ErrorLogger.fsi deleted file mode 100644 index eb36563e984..00000000000 --- a/src/fsharp/ErrorLogger.fsi +++ /dev/null @@ -1,393 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module internal FSharp.Compiler.ErrorLogger - -open System -open FSharp.Compiler.Diagnostics -open FSharp.Compiler.Features -open FSharp.Compiler.Text - -/// Represents the style being used to format errors -[] -type ErrorStyle = - | DefaultErrors - | EmacsErrors - | TestErrors - | VSErrors - | GccErrors - -/// Thrown when we want to add some range information to a .NET exception -exception WrappedError of exn * range - -/// Thrown when immediate, local error recovery is not possible. This indicates -/// we've reported an error but need to make a non-local transfer of control. -/// Error recovery may catch this and continue (see 'errorRecovery') -/// -/// The exception that caused the report is carried as data because in some -/// situations (LazyWithContext) we may need to re-report the original error -/// when a lazy thunk is re-evaluated. -exception ReportedError of exn option - -val findOriginalException: err: exn -> exn - -type Suggestions = (string -> unit) -> unit - -val NoSuggestions: Suggestions - -/// Thrown when we stop processing the F# Interactive entry or #load. -exception StopProcessingExn of exn option - -val (|StopProcessing|_|): exn: exn -> unit option - -val StopProcessing<'T> : exn - -exception Error of (int * string) * range - -exception InternalError of msg: string * range - -exception UserCompilerMessage of string * int * range - -exception LibraryUseOnly of range - -exception Deprecated of string * range - -exception Experimental of string * range - -exception PossibleUnverifiableCode of range - -exception UnresolvedReferenceNoRange of string - -exception UnresolvedReferenceError of string * range - -exception UnresolvedPathReferenceNoRange of string * string - -exception UnresolvedPathReference of string * string * range - -exception ErrorWithSuggestions of (int * string) * range * string * Suggestions - -val inline protectAssemblyExploration: dflt: 'a -> f: (unit -> 'a) -> 'a - -val inline protectAssemblyExplorationF: dflt: (string * string -> 'a) -> f: (unit -> 'a) -> 'a - -val inline protectAssemblyExplorationNoReraise: dflt1: 'a -> dflt2: 'a -> f: (unit -> 'a) -> 'a - -val AttachRange: m: range -> exn: exn -> exn - -type Exiter = - abstract member Exit: int -> 'T - -val QuitProcessExiter: Exiter - -/// Closed enumeration of build phases. -[] -type BuildPhase = - | DefaultPhase - | Compile - | Parameter - | Parse - | TypeCheck - | CodeGen - | Optimize - | IlxGen - | IlGen - | Output - | Interactive - -/// Literal build phase subcategory strings. -module BuildPhaseSubcategory = - [] - val DefaultPhase: string = "" - - [] - val Compile: string = "compile" - - [] - val Parameter: string = "parameter" - - [] - val Parse: string = "parse" - - [] - val TypeCheck: string = "typecheck" - - [] - val CodeGen: string = "codegen" - - [] - val Optimize: string = "optimize" - - [] - val IlxGen: string = "ilxgen" - - [] - val IlGen: string = "ilgen" - - [] - val Output: string = "output" - - [] - val Interactive: string = "interactive" - - [] - val Internal: string = "internal" - -type PhasedDiagnostic = - { Exception: exn - Phase: BuildPhase } - - /// Construct a phased error - static member Create: exn: exn * phase: BuildPhase -> PhasedDiagnostic - - /// Return true if the textual phase given is from the compile part of the build process. - /// This set needs to be equal to the set of subcategories that the language service can produce. - static member IsSubcategoryOfCompile: subcategory: string -> bool - - member DebugDisplay: unit -> string - - /// Return true if this phase is one that's known to be part of the 'compile'. This is the initial phase of the entire compilation that - /// the language service knows about. - member IsPhaseInCompile: unit -> bool - - /// This is the textual subcategory to display in error and warning messages (shows only under --vserrors): - /// - /// file1.fs(72): subcategory warning FS0072: This is a warning message - /// - member Subcategory: unit -> string - -[] -type ErrorLogger = - - new: nameForDebugging: string -> ErrorLogger - - member DebugDisplay: unit -> string - - abstract member DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - - abstract member ErrorCount: int - -val DiscardErrorsLogger: ErrorLogger - -val AssertFalseErrorLogger: ErrorLogger - -type CapturingErrorLogger = - inherit ErrorLogger - - new: nm: string -> CapturingErrorLogger - - member CommitDelayedDiagnostics: errorLogger: ErrorLogger -> unit - - override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - - member Diagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list - - override ErrorCount: int - -[] -type CompileThreadStatic = - - static member BuildPhase: BuildPhase with get, set - - static member BuildPhaseUnchecked: BuildPhase - - static member ErrorLogger: ErrorLogger with get, set - -[] -module ErrorLoggerExtensions = - - val tryAndDetectDev15: bool - - /// Instruct the exception not to reset itself when thrown again. - val PreserveStackTrace: exn: 'a -> unit - - /// Reraise an exception if it is one we want to report to Watson. - val ReraiseIfWatsonable: exn: exn -> unit - - type ErrorLogger with - - member ErrorR: exn: exn -> unit - member Warning: exn: exn -> unit - member Error: exn: exn -> 'b - member SimulateError: ph: PhasedDiagnostic -> 'a - member ErrorRecovery: exn: exn -> m: range -> unit - member StopProcessingRecovery: exn: exn -> m: range -> unit - member ErrorRecoveryNoRange: exn: exn -> unit - -/// NOTE: The change will be undone when the returned "unwind" object disposes -val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable - -/// NOTE: The change will be undone when the returned "unwind" object disposes -val PushErrorLoggerPhaseUntilUnwind: errorLoggerTransformer: (ErrorLogger -> #ErrorLogger) -> IDisposable - -val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit - -val SetThreadErrorLoggerNoUnwind: errorLogger: ErrorLogger -> unit - -/// Reports an error diagnostic and continues -val errorR: exn: exn -> unit - -/// Reports a warning diagnostic -val warning: exn: exn -> unit - -/// Reports an error and raises a ReportedError exception -val error: exn: exn -> 'a - -/// Reports an informational diagnostic -val informationalWarning: exn: exn -> unit - -val simulateError: p: PhasedDiagnostic -> 'a - -val diagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit - -val errorSink: pe: PhasedDiagnostic -> unit - -val warnSink: pe: PhasedDiagnostic -> unit - -val errorRecovery: exn: exn -> m: range -> unit - -val stopProcessingRecovery: exn: exn -> m: range -> unit - -val errorRecoveryNoRange: exn: exn -> unit - -val report: f: (unit -> 'a) -> 'a - -val deprecatedWithError: s: string -> m: range -> unit - -val libraryOnlyError: m: range -> unit - -val libraryOnlyWarning: m: range -> unit - -val deprecatedOperator: m: range -> unit - -val mlCompatWarning: s: string -> m: range -> unit - -val mlCompatError: s: string -> m: range -> unit - -val suppressErrorReporting: f: (unit -> 'a) -> 'a - -val conditionallySuppressErrorReporting: cond: bool -> f: (unit -> 'a) -> 'a - -/// The result type of a computational modality to colelct warnings and possibly fail -[] -type OperationResult<'T> = - | OkResult of warnings: exn list * 'T - | ErrorResult of warnings: exn list * exn - -type ImperativeOperationResult = OperationResult - -val ReportWarnings: warns: #exn list -> unit - -val CommitOperationResult: res: OperationResult<'a> -> 'a - -val RaiseOperationResult: res: OperationResult -> unit - -val ErrorD: err: exn -> OperationResult<'a> - -val WarnD: err: exn -> OperationResult - -val CompleteD: OperationResult - -val ResultD: x: 'a -> OperationResult<'a> - -val CheckNoErrorsAndGetWarnings: res: OperationResult<'a> -> (exn list * 'a) option - -val (++): res: OperationResult<'a> -> f: ('a -> OperationResult<'b>) -> OperationResult<'b> - -/// Stop on first error. Accumulate warnings and continue. -val IterateD: f: ('a -> OperationResult) -> xs: 'a list -> OperationResult - -val WhileD: gd: (unit -> bool) -> body: (unit -> OperationResult) -> OperationResult - -val MapD: f: ('a -> OperationResult<'b>) -> xs: 'a list -> OperationResult<'b list> - -type TrackErrorsBuilder = - - new: unit -> TrackErrorsBuilder - - member Bind: res: OperationResult<'h> * k: ('h -> OperationResult<'i>) -> OperationResult<'i> - - member Combine: expr1: OperationResult<'c> * expr2: ('c -> OperationResult<'d>) -> OperationResult<'d> - - member Delay: fn: (unit -> 'b) -> (unit -> 'b) - - member For: seq: 'e list * k: ('e -> OperationResult) -> OperationResult - - member Return: res: 'g -> OperationResult<'g> - - member ReturnFrom: res: 'f -> 'f - - member Run: fn: (unit -> 'a) -> 'a - - member While: gd: (unit -> bool) * k: (unit -> OperationResult) -> OperationResult - - member Zero: unit -> OperationResult - -val trackErrors: TrackErrorsBuilder - -val OptionD: f: ('a -> OperationResult) -> xs: 'a option -> OperationResult - -val IterateIdxD: f: (int -> 'a -> OperationResult) -> xs: 'a list -> OperationResult - -/// Stop on first error. Accumulate warnings and continue. -val Iterate2D: f: ('a -> 'b -> OperationResult) -> xs: 'a list -> ys: 'b list -> OperationResult - -val TryD: f: (unit -> OperationResult<'a>) -> g: (exn -> OperationResult<'a>) -> OperationResult<'a> - -val RepeatWhileD: nDeep: int -> body: (int -> OperationResult) -> OperationResult - -val inline AtLeastOneD: f: ('a -> OperationResult) -> l: 'a list -> OperationResult - -val inline AtLeastOne2D: f: ('a -> 'b -> OperationResult) -> xs: 'a list -> ys: 'b list -> OperationResult - -val inline MapReduceD: - mapper: ('a -> OperationResult<'b>) -> zero: 'b -> reducer: ('b -> 'b -> 'b) -> l: 'a list -> OperationResult<'b> - -val inline MapReduce2D: - mapper: ('a -> 'b -> OperationResult<'c>) -> - zero: 'c -> - reducer: ('c -> 'c -> 'c) -> - xs: 'a list -> - ys: 'b list -> - OperationResult<'c> - -module OperationResult = - val inline ignore: res: OperationResult<'a> -> OperationResult - -// For --flaterrors flag that is only used by the IDE -val stringThatIsAProxyForANewlineInFlatErrors: String - -val NewlineifyErrorString: message: string -> string - -/// fixes given string by replacing all control chars with spaces. -/// NOTE: newlines are recognized and replaced with stringThatIsAProxyForANewlineInFlatErrors (ASCII 29, the 'group separator'), -/// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo -val NormalizeErrorString: text: string -> string - -val checkLanguageFeatureError: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit - -val checkLanguageFeatureErrorRecover: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit - -val tryLanguageFeatureErrorOption: - langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> exn option - -val languageFeatureNotSupportedInLibraryError: - langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> 'a - -type StackGuard = - new: maxDepth: int -> StackGuard - - /// Execute the new function, on a new thread if necessary - member Guard: f: (unit -> 'T) -> 'T - - static member GetDepthOption: string -> int - -/// This represents the global state established as each task function runs as part of the build. -/// -/// Use to reset error and warning handlers. -type CompilationGlobalsScope = - new: errorLogger: ErrorLogger * buildPhase: BuildPhase -> CompilationGlobalsScope - - interface IDisposable - - member ErrorLogger: ErrorLogger - - member BuildPhase: BuildPhase diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 15827fb01d9..4e2af33a519 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -241,11 +241,11 @@ ErrorLogging\TextLayoutRender.fs - - ErrorLogging\ErrorLogger.fsi + + ErrorLogging\DiagnosticsLogger.fsi - - ErrorLogging\ErrorLogger.fs + + ErrorLogging\DiagnosticsLogger.fs ErrorLogging\ErrorResolutionHints.fsi @@ -549,6 +549,12 @@ Logic\import.fs + + Logic\TypeHierarchy.fsi + + + Logic\TypeHierarchy.fs + Logic\infos.fsi @@ -824,6 +830,12 @@ + + Symbols/FSharpDiagnostic.fsi + + + Symbols/FSharpDiagnostic.fs + Symbols/SymbolHelpers.fsi diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index 725cb437ea1..508ef4d9e3f 100644 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -7,7 +7,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps diff --git a/src/fsharp/FxResolver.fs b/src/fsharp/FxResolver.fs index 79a37c5b486..ff75963c159 100644 --- a/src/fsharp/FxResolver.fs +++ b/src/fsharp/FxResolver.fs @@ -14,7 +14,7 @@ open System.Runtime.InteropServices open Internal.Utilities.FSharpEnvironment open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.ILBinaryReader -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Text open FSharp.Compiler.IO diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index dd0fb29e3cd..da750053eba 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -20,7 +20,7 @@ open FSharp.Compiler.AbstractIL.ILX open FSharp.Compiler.AbstractIL.ILX.Types open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Import @@ -37,6 +37,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations let IlxGenStackGuardDepth = StackGuard.GetDepthOption "IlxGen" @@ -7441,7 +7442,7 @@ and GenModuleDef cenv (cgbuf: CodeGenBuffer) qname lazyInitInfo eenv x = | TMDefRec(_isRec, opens, tycons, mbinds, m) -> let eenvinner = AddDebugImportsToEnv cenv eenv opens for tc in tycons do - if tc.IsExceptionDecl then + if tc.IsFSharpException then GenExnDef cenv cgbuf.mgbuf eenvinner m tc else GenTypeDef cenv cgbuf.mgbuf lazyInitInfo eenvinner m tc diff --git a/src/fsharp/InfoReader.fs b/src/fsharp/InfoReader.fs index 0cfdaa825e7..da69bbbbc0a 100644 --- a/src/fsharp/InfoReader.fs +++ b/src/fsharp/InfoReader.fs @@ -10,7 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.Syntax @@ -20,6 +20,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations /// Use the given function to select some of the member values from the members of an F# type diff --git a/src/fsharp/InfoReader.fsi b/src/fsharp/InfoReader.fsi index 487e0de771d..c7e375d5042 100644 --- a/src/fsharp/InfoReader.fsi +++ b/src/fsharp/InfoReader.fsi @@ -12,6 +12,7 @@ open FSharp.Compiler.Infos open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text open FSharp.Compiler.Xml +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypedTree /// Try to select an F# value when querying members, and if so return a MethInfo that wraps the F# value. diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index 578201a3601..edc81950c2f 100644 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -8,7 +8,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Detuple.GlobalUsageAnalysis -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Layout diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index 5408af60981..cc21e80c399 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -10,7 +10,7 @@ open System.IO open System.Text.RegularExpressions open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.AbstractIL.ILBinaryReader @@ -60,7 +60,7 @@ type internal InProcCompiler(legacyReferenceResolver) = // Explanation: Compilation happens on whichever thread calls this function. let ctok = AssumeCompilationThreadWithoutEvidence () - let loggerProvider = InProcErrorLoggerProvider() + let loggerProvider = InProcDiagnosticsLoggerProvider() let mutable exitCode = 0 let exiter = { new Exiter with diff --git a/src/fsharp/LexFilter.fs b/src/fsharp/LexFilter.fs index 323347b78eb..5396ffdaabd 100644 --- a/src/fsharp/LexFilter.fs +++ b/src/fsharp/LexFilter.fs @@ -9,7 +9,7 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.ParseHelpers diff --git a/src/fsharp/LowerCalls.fs b/src/fsharp/LowerCalls.fs index 0264e72deb7..5e58eea4911 100644 --- a/src/fsharp/LowerCalls.fs +++ b/src/fsharp/LowerCalls.fs @@ -3,7 +3,7 @@ module internal FSharp.Compiler.LowerCalls open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps diff --git a/src/fsharp/LowerComputedCollections.fs b/src/fsharp/LowerComputedCollections.fs index 320762edbed..054a6d9f559 100644 --- a/src/fsharp/LowerComputedCollections.fs +++ b/src/fsharp/LowerComputedCollections.fs @@ -2,23 +2,18 @@ module internal FSharp.Compiler.LowerComputedCollectionExpressions -open Internal.Utilities.Collections open Internal.Utilities.Library -open Internal.Utilities.Library.Extras -open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader -open FSharp.Compiler.Infos open FSharp.Compiler.LowerSequenceExpressions open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals -open FSharp.Compiler.Text open FSharp.Compiler.TypeRelations open FSharp.Compiler.TypedTree -open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy let LowerComputedCollectionsStackGuardDepth = StackGuard.GetDepthOption "LowerComputedCollections" diff --git a/src/fsharp/LowerSequences.fs b/src/fsharp/LowerSequences.fs index 8fe22bba4bd..b82947b11ff 100644 --- a/src/fsharp/LowerSequences.fs +++ b/src/fsharp/LowerSequences.fs @@ -2,12 +2,11 @@ module internal FSharp.Compiler.LowerSequenceExpressions -open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.MethodCalls @@ -16,6 +15,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy let LowerSequenceExpressionsStackGuardDepth = StackGuard.GetDepthOption "LowerSequenceExpressions" diff --git a/src/fsharp/LowerStateMachines.fs b/src/fsharp/LowerStateMachines.fs index d1828a82b5f..c0530768877 100644 --- a/src/fsharp/LowerStateMachines.fs +++ b/src/fsharp/LowerStateMachines.fs @@ -6,7 +6,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/MethodCalls.fs b/src/fsharp/MethodCalls.fs index 8ae36bc1d28..e4b4251178d 100644 --- a/src/fsharp/MethodCalls.fs +++ b/src/fsharp/MethodCalls.fs @@ -10,7 +10,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -26,6 +26,7 @@ open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations #if !NO_TYPEPROVIDERS diff --git a/src/fsharp/MethodCalls.fsi b/src/fsharp/MethodCalls.fsi index e6b94be5b3f..b8fe0a53560 100644 --- a/src/fsharp/MethodCalls.fsi +++ b/src/fsharp/MethodCalls.fsi @@ -5,7 +5,7 @@ module internal FSharp.Compiler.MethodCalls open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Import open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos diff --git a/src/fsharp/MethodOverrides.fs b/src/fsharp/MethodOverrides.fs index 5e5e040d76d..9da0e71f765 100644 --- a/src/fsharp/MethodOverrides.fs +++ b/src/fsharp/MethodOverrides.fs @@ -7,7 +7,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.Features @@ -20,6 +20,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //------------------------------------------------------------------------- diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 1ed0a835f9e..4ceaa99aff1 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -17,7 +17,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos @@ -32,6 +32,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders @@ -1315,7 +1316,7 @@ and AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap ad m root nenv tcrefs /// Add an F# exception definition to the name resolution environment let AddExceptionDeclsToNameEnv bulkAddMode nenv (ecref: TyconRef) = - assert ecref.IsExceptionDecl + assert ecref.IsFSharpException let item = Item.ExnCase ecref {nenv with eUnqualifiedItems = @@ -4347,7 +4348,7 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE nenv.TyconsByDemangledNameAndArity(fullyQualified).Values |> Seq.filter (fun tcref -> not (tcref.LogicalName.Contains ",") && - not tcref.IsExceptionDecl && + not tcref.IsFSharpException && not (IsTyconUnseen ad g ncenv.amap m tcref)) |> Seq.map (ItemOfTyconRef ncenv m) |> Seq.toList @@ -4945,7 +4946,7 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a | Item.Types _ -> for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do - if not tcref.IsExceptionDecl + if not tcref.IsFSharpException && not (tcref.LogicalName.Contains ",") && not (IsTyconUnseen ad g ncenv.amap m tcref) then yield ItemOfTyconRef ncenv m tcref diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index ac03dbc080c..5b71aaeed15 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -12,8 +12,9 @@ open Internal.Utilities.Library.Extras open Internal.Utilities.Rational open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.AttributeChecking -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax @@ -23,11 +24,11 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Layout open FSharp.Compiler.Text.LayoutRender open FSharp.Compiler.Text.TaggedText -open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.AccessibilityLogic +open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.Xml open FSharp.Core.Printf @@ -2063,7 +2064,7 @@ module TastDefinitionPrinting = let layoutTyconDefns denv infoReader ad m (tycons: Tycon list) = match tycons with | [] -> emptyL - | [h] when h.IsExceptionDecl -> layoutExnDefn denv infoReader (mkLocalEntityRef h) + | [h] when h.IsFSharpException -> layoutExnDefn denv infoReader (mkLocalEntityRef h) | h :: t -> let x = layoutTyconDefn denv infoReader ad m false WordL.keywordType (mkLocalEntityRef h) let xs = List.map (mkLocalEntityRef >> layoutTyconDefn denv infoReader ad m false (wordL (tagKeyword "and"))) t @@ -2174,7 +2175,7 @@ module TastDefinitionPrinting = if eref.IsModuleOrNamespace then layoutModuleOrNamespace denv infoReader ad m false eref.Deref |> layoutXmlDocOfEntity denv infoReader eref - elif eref.IsExceptionDecl then + elif eref.IsFSharpException then layoutExnDefn denv infoReader eref else layoutTyconDefn denv infoReader ad m true WordL.keywordType eref diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index e58d6d3a5ec..33721292577 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -13,8 +13,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AttributeChecking open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Infos +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.Syntax @@ -29,6 +28,7 @@ open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint open FSharp.Compiler.TypedTreePickle +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations open System.Collections.Generic diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index 2f533c7ff1c..b32fe20b8cd 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -20,7 +20,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp @@ -266,7 +266,7 @@ let DeduplicateParsedInputModuleName (moduleNamesDict: ModuleNamesDict) input = let inputT = ParsedInput.SigFile (ParsedSigFileInput.ParsedSigFileInput (fileName, qualNameOfFileT, scopedPragmas, hashDirectives, modules, trivia)) inputT, moduleNamesDictT -let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: ErrorLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, fileName, isLastCompiland) = +let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: DiagnosticsLogger, lexbuf: UnicodeLexing.Lexbuf, defaultNamespace, fileName, isLastCompiland) = // The assert below is almost ok, but it fires in two cases: // - fsi.exe sometimes passes "stdin" as a dummy file name // - if you have a #line directive, e.g. @@ -275,8 +275,8 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: E // Delay sending errors and warnings until after the file is parsed. This gives us a chance to scrape the // #nowarn declarations for the file - let delayLogger = CapturingErrorLogger("Parsing") - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayLogger) + let delayLogger = CapturingDiagnosticsLogger("Parsing") + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let mutable scopedPragmas = [] @@ -308,8 +308,8 @@ let ParseInput (lexer, diagnosticOptions:FSharpDiagnosticOptions, errorLogger: E input finally // OK, now commit the errors, since the ScopedPragmas will (hopefully) have been scraped - let filteringErrorLogger = GetErrorLoggerFilteringByScopedPragmas(false, scopedPragmas, diagnosticOptions, errorLogger) - delayLogger.CommitDelayedDiagnostics filteringErrorLogger + let filteringDiagnosticsLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, scopedPragmas, diagnosticOptions, errorLogger) + delayLogger.CommitDelayedDiagnostics filteringDiagnosticsLogger type Tokenizer = unit -> Parser.token @@ -412,7 +412,7 @@ let ParseOneInputLexbuf (tcConfig: TcConfig, lexResourceManager, lexbuf, fileNam TestInteractionParserAndExit (tokenizer, lexbuf) // Parse the input - let res = ParseInput((fun _ -> tokenizer ()), tcConfig.errorSeverityOptions, errorLogger, lexbuf, None, fileName, isLastCompiland) + let res = ParseInput((fun _ -> tokenizer ()), tcConfig.diagnosticsOptions, errorLogger, lexbuf, None, fileName, isLastCompiland) // Report the statistics for testing purposes if tcConfig.reportNumDecls then @@ -488,7 +488,7 @@ let ParseOneInputFile (tcConfig: TcConfig, lexResourceManager, fileName, isLastC EmptyParsedInput(fileName, isLastCompiland) /// Parse multiple input files from disk -let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorLogger: ErrorLogger, exiter: Exiter, createErrorLogger: Exiter -> CapturingErrorLogger, retryLocked) = +let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorLogger: DiagnosticsLogger, exiter: Exiter, createDiagnosticsLogger: Exiter -> CapturingDiagnosticsLogger, retryLocked) = try let isLastCompiland, isExe = sourceFiles |> tcConfig.ComputeCanContainEntryPoint let sourceFiles = isLastCompiland |> List.zip sourceFiles |> Array.ofList @@ -500,11 +500,11 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL member this.Exit n = exitCode <- n; raise StopProcessing } // Check input files and create delayed error loggers before we try to parallel parse. - let delayedErrorLoggers = + let delayedDiagnosticsLoggers = sourceFiles |> Array.map (fun (fileName, _) -> checkInputFile tcConfig fileName - createErrorLogger(delayedExiter) + createDiagnosticsLogger(delayedExiter) ) let results = @@ -512,16 +512,16 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL try sourceFiles |> ArrayParallel.mapi (fun i (fileName, isLastCompiland) -> - let delayedErrorLogger = delayedErrorLoggers[i] + let delayedDiagnosticsLogger = delayedDiagnosticsLoggers[i] let directoryName = Path.GetDirectoryName fileName - let input = parseInputFileAux(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayedErrorLogger, retryLocked) + let input = parseInputFileAux(tcConfig, lexResourceManager, fileName, (isLastCompiland, isExe), delayedDiagnosticsLogger, retryLocked) (input, directoryName) ) finally - delayedErrorLoggers - |> Array.iter (fun delayedErrorLogger -> - delayedErrorLogger.CommitDelayedDiagnostics errorLogger + delayedDiagnosticsLoggers + |> Array.iter (fun delayedDiagnosticsLogger -> + delayedDiagnosticsLogger.CommitDelayedDiagnostics errorLogger ) with | StopProcessing -> @@ -968,7 +968,7 @@ let CheckOneInput /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInputEntry (ctok, checkForErrors, tcConfig:TcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = // 'use' ensures that the warning handler is restored at the end - use unwindEL = PushErrorLoggerPhaseUntilUnwind(fun oldLogger -> GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.errorSeverityOptions, oldLogger) ) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun oldLogger -> GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput inp, tcConfig.diagnosticsOptions, oldLogger) ) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck RequireCompilationThread ctok diff --git a/src/fsharp/ParseAndCheckInputs.fsi b/src/fsharp/ParseAndCheckInputs.fsi index 2b438899ad7..95406e74a72 100644 --- a/src/fsharp/ParseAndCheckInputs.fsi +++ b/src/fsharp/ParseAndCheckInputs.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.DependencyManager -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text @@ -35,7 +35,7 @@ val DeduplicateParsedInputModuleName: ModuleNamesDict -> ParsedInput -> ParsedIn val ParseInput: lexer: (Lexbuf -> Parser.token) * diagnosticOptions: FSharpDiagnosticOptions * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * lexbuf: Lexbuf * defaultNamespace: string option * fileName: string * @@ -62,7 +62,7 @@ val ParseOneInputStream: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * retryLocked: bool * stream: Stream -> ParsedInput @@ -73,7 +73,7 @@ val ParseOneInputSourceText: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * sourceText: ISourceText -> ParsedInput @@ -83,7 +83,7 @@ val ParseOneInputFile: lexResourceManager: Lexhelp.LexResourceManager * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * retryLocked: bool -> ParsedInput @@ -93,7 +93,7 @@ val ParseOneInputLexbuf: lexbuf: Lexbuf * fileName: string * isLastCompiland: (bool * bool) * - errorLogger: ErrorLogger -> + errorLogger: DiagnosticsLogger -> ParsedInput val EmptyParsedInput: fileName: string * isLastCompiland: (bool * bool) -> ParsedInput @@ -103,9 +103,9 @@ val ParseInputFiles: tcConfig: TcConfig * lexResourceManager: Lexhelp.LexResourceManager * sourceFiles: string list * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * exiter: Exiter * - createErrorLogger: (Exiter -> CapturingErrorLogger) * + createDiagnosticsLogger: (Exiter -> CapturingDiagnosticsLogger) * retryLocked: bool -> (ParsedInput * string) list diff --git a/src/fsharp/ParseHelpers.fs b/src/fsharp/ParseHelpers.fs index 63b99d61a17..aafb8174345 100644 --- a/src/fsharp/ParseHelpers.fs +++ b/src/fsharp/ParseHelpers.fs @@ -3,7 +3,7 @@ module FSharp.Compiler.ParseHelpers open FSharp.Compiler.AbstractIL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 94d930751f6..1832034434f 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -10,7 +10,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.MethodCalls open FSharp.Compiler.Syntax diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index 1a053ff5334..5d2179339fc 100644 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -13,7 +13,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AccessibilityLogic -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -26,6 +26,7 @@ open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations //-------------------------------------------------------------------------- diff --git a/src/fsharp/QuotationTranslator.fs b/src/fsharp/QuotationTranslator.fs index 1c91fe606a0..050c7601157 100644 --- a/src/fsharp/QuotationTranslator.fs +++ b/src/fsharp/QuotationTranslator.fs @@ -9,7 +9,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.QuotationPickler open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/ScriptClosure.fs b/src/fsharp/ScriptClosure.fs index 56846ed8510..03e1910ecef 100644 --- a/src/fsharp/ScriptClosure.fs +++ b/src/fsharp/ScriptClosure.fs @@ -16,7 +16,7 @@ open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.ParseAndCheckInputs @@ -117,7 +117,7 @@ module ScriptPreprocessClosure = tcConfig: TcConfig, codeContext, lexResourceManager: Lexhelp.LexResourceManager, - errorLogger: ErrorLogger + errorLogger: DiagnosticsLogger ) = // fsc.exe -- COMPILED\!INTERACTIVE @@ -185,8 +185,8 @@ module ScriptPreprocessClosure = match basicReferences with | None -> - let errorLogger = CapturingErrorLogger("ScriptDefaultReferences") - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingDiagnosticsLogger("ScriptDefaultReferences") + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, useDotNetFramework = tcConfigB.FxResolver.GetDefaultReferences useFsiAuxLib // If the user requested .NET Core scripting but something went wrong and we reverted to @@ -357,13 +357,13 @@ module ScriptPreprocessClosure = //printfn "visiting %s" fileName if IsScript fileName || parseRequired then let parseResult, parseDiagnostics = - let errorLogger = CapturingErrorLogger("FindClosureParse") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingDiagnosticsLogger("FindClosureParse") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let result = ParseScriptClosureInput (fileName, sourceText, tcConfig, codeContext, lexResourceManager, errorLogger) result, errorLogger.Diagnostics - let errorLogger = CapturingErrorLogger("FindClosureMetaCommands") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let errorLogger = CapturingDiagnosticsLogger("FindClosureMetaCommands") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let pathOfMetaCommandSource = Path.GetDirectoryName fileName let preSources = tcConfig.GetAvailableLoadedSources() @@ -429,9 +429,9 @@ module ScriptPreprocessClosure = // Resolve all references. let references, unresolvedReferences, resolutionDiagnostics = - let errorLogger = CapturingErrorLogger("GetLoadClosure") + let errorLogger = CapturingDiagnosticsLogger("GetLoadClosure") - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let references, unresolvedReferences = TcAssemblyResolutions.GetAssemblyResolutionInformation(tcConfig) let references = references |> List.map (fun ar -> ar.resolvedPath, ar) references, unresolvedReferences, errorLogger.Diagnostics diff --git a/src/fsharp/ScriptClosure.fsi b/src/fsharp/ScriptClosure.fsi index b6b80c8b60f..dfdc34f9dcd 100644 --- a/src/fsharp/ScriptClosure.fsi +++ b/src/fsharp/ScriptClosure.fsi @@ -9,7 +9,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.Text diff --git a/src/fsharp/SignatureConformance.fs b/src/fsharp/SignatureConformance.fs index 22dea30b046..8e31f63b248 100644 --- a/src/fsharp/SignatureConformance.fs +++ b/src/fsharp/SignatureConformance.fs @@ -10,15 +10,16 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos +open FSharp.Compiler.InfoReader open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.InfoReader +open FSharp.Compiler.TypeHierarchy #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders diff --git a/src/fsharp/StaticLinking.fs b/src/fsharp/StaticLinking.fs index 09e48552ef0..f09ae579634 100644 --- a/src/fsharp/StaticLinking.fs +++ b/src/fsharp/StaticLinking.fs @@ -13,7 +13,7 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.CompilerOptions -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.OptimizeInputs open FSharp.Compiler.Text.Range diff --git a/src/fsharp/SyntaxTreeOps.fs b/src/fsharp/SyntaxTreeOps.fs index a27775a174d..81a59c3dc92 100644 --- a/src/fsharp/SyntaxTreeOps.fs +++ b/src/fsharp/SyntaxTreeOps.fs @@ -3,7 +3,7 @@ module FSharp.Compiler.SyntaxTreeOps open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTrivia open FSharp.Compiler.Syntax.PrettyNaming diff --git a/src/fsharp/TypeHierarchy.fs b/src/fsharp/TypeHierarchy.fs new file mode 100644 index 00000000000..2eec1c57ec6 --- /dev/null +++ b/src/fsharp/TypeHierarchy.fs @@ -0,0 +1,409 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.TypeHierarchy + +open System +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Import +open FSharp.Compiler.Syntax +open FSharp.Compiler.SyntaxTreeOps +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeBasics +open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.Xml + +#if !NO_TYPEPROVIDERS +open FSharp.Compiler.TypeProviders +#endif + +//------------------------------------------------------------------------- +// Fold the hierarchy. +// REVIEW: this code generalizes the iteration used below for member lookup. +//------------------------------------------------------------------------- + +/// Get the base type of a type, taking into account type instantiations. Return None if the +/// type has no base type. +let GetSuperTypeOfType g amap m ty = +#if !NO_TYPEPROVIDERS + let ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref when tcref.IsProvided -> stripTyEqns g ty + | _ -> stripTyEqnsAndMeasureEqns g ty +#else + let ty = stripTyEqnsAndMeasureEqns g ty +#endif + + match metadataOfTy g ty with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + let st = info.ProvidedType + let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) + match superOpt with + | None -> None + | Some super -> Some(ImportProvidedType amap m super) +#endif + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + let tinst = argsOfAppTy g ty + match tdef.Extends with + | None -> None + | Some ilty -> Some (RescopeAndImportILType scoref amap m tinst ilty) + + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + if isFSharpObjModelTy g ty || isFSharpExceptionTy g ty then + let tcref = tcrefOfAppTy g ty + Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) + elif isArrayTy g ty then + Some g.system_Array_ty + elif isRefTy g ty && not (isObjTy g ty) then + Some g.obj_ty + elif isStructTupleTy g ty then + Some g.system_Value_ty + elif isFSharpStructOrEnumTy g ty then + if isFSharpEnumTy g ty then + Some g.system_Enum_ty + else + Some g.system_Value_ty + elif isStructAnonRecdTy g ty then + Some g.system_Value_ty + elif isAnonRecdTy g ty then + Some g.obj_ty + elif isRecdTy g ty || isUnionTy g ty then + Some g.obj_ty + else + None + +/// Make a type for System.Collections.Generic.IList +let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = + TType_app(g.tcref_System_Collections_Generic_IList, [ty], g.knownWithoutNull) + +/// Indicates whether we can skip interface types that lie outside the reference set +[] +type SkipUnrefInterfaces = Yes | No + +let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef) tinst = + [ + match metadataOfTy g ty with +#if !NO_TYPEPROVIDERS + | ProvidedTypeMetadata info -> + for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do + ImportProvidedType amap m ity +#endif + | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> + // ImportILType may fail for an interface if the assembly load set is incomplete and the interface + // comes from another assembly. In this case we simply skip the interface: + // if we don't skip it, then compilation will just fail here, and if type checking + // succeeds with fewer non-dereferencable interfaces reported then it would have + // succeeded with more reported. There are pathological corner cases where this + // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always + // assume those are present. + for ity in tdef.Implements do + if skipUnref = SkipUnrefInterfaces.No || CanRescopeAndImportILType scoref amap m ity then + RescopeAndImportILType scoref amap m tinst ity + | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> + for ity in tcref.ImmediateInterfaceTypesOfFSharpTycon do + instType (mkInstForAppTy g ty) ity ] + +/// Collect the set of immediate declared interface types for an F# type, but do not +/// traverse the type hierarchy to collect further interfaces. +// +// NOTE: Anonymous record types are not directly considered to implement IComparable, +// IComparable or IEquatable. This is because whether they support these interfaces depend on their +// consitutent types, which may not yet be known in type inference. +let rec GetImmediateInterfacesOfType skipUnref g amap m ty = + [ + match tryAppTy g ty with + | ValueSome(tcref, tinst) -> + // Check if this is a measure-annotated type + match tcref.TypeReprInfo with + | TMeasureableRepr reprTy -> + yield! GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy + | _ -> + yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref ty tcref tinst + + | ValueNone -> + // For tuple types, func types, check if we can eliminate to a type with metadata. + let tyWithMetadata = convertToTypeWithMetadataIfPossible g ty + match tryAppTy g tyWithMetadata with + | ValueSome (tcref, tinst) -> + if isAnyTupleTy g ty then + yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref tyWithMetadata tcref tinst + | _ -> () + + // .NET array types are considered to implement IList + if isArray1DTy g ty then + mkSystemCollectionsGenericIListTy g (destArrayTy g ty) + ] + +// Report the interfaces supported by a measure-annotated type. +// +// For example, consider: +// +// [] +// type A<[] 'm> = A +// +// This measure-annotated type is considered to support the interfaces on its representation type A, +// with the exception that +// +// 1. we rewrite the IComparable and IEquatable interfaces, so that +// IComparable --> IComparable> +// IEquatable --> IEquatable> +// +// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces +// +// This rule is conservative and only applies to IComparable and IEquatable interfaces. +// +// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. +and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = + [ + // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> + for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do + if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && + not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then + ity + + // NOTE: we should really only report the IComparable> interface for measure-annotated types + // if the original type supports IComparable somewhere in the hierarchy, likeiwse IEquatable>. + // + // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. + + //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then + mkAppTy g.system_GenericIComparable_tcref [ty] + + //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then + mkAppTy g.system_GenericIEquatable_tcref [ty] + ] + +// Check for IComparable, IEquatable and interfaces that derive from these +and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = + ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity + +// Check for IComparable, IEquatable and interfaces that derive from these +and ExistsInInterfaceHierarchy p skipUnref g amap m ity = + match ity with + | AppTy g (tcref, tinst) -> + p ity || + (GetImmediateInterfacesOfMetadataType g amap m skipUnref ity tcref tinst + |> List.exists (ExistsInInterfaceHierarchy p skipUnref g amap m)) + | _ -> false + +/// Indicates whether we should visit multiple instantiations of the same generic interface or not +[] +type AllowMultiIntfInstantiations = Yes | No + +/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). +/// Visit base types and interfaces first. +let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = + let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = + + let seenThisTycon = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> Set.contains tcref.Stamp visitedTycon + | _ -> false + + // Do not visit the same type twice. Could only be doing this if we've seen this tycon + if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else + + // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this + if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else + + let state = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> + let visitedTycon = Set.add tcref.Stamp visitedTycon + visitedTycon, visited.Add (tcref, ty), acc + | _ -> + state + + if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else + let visitedTycon, visited, acc = + if isInterfaceTy g ty then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + (loop ndeep g.obj_ty state) + else + match tryDestTyparTy g ty with + | ValueSome tp -> + let state = loop (ndeep+1) g.obj_ty state + List.foldBack + (fun x vacc -> + match x with + | TyparConstraint.MayResolveMember _ + | TyparConstraint.DefaultsTo _ + | TyparConstraint.SupportsComparison _ + | TyparConstraint.SupportsEquality _ + | TyparConstraint.IsEnum _ + | TyparConstraint.IsDelegate _ + | TyparConstraint.SupportsNull _ + | TyparConstraint.IsNonNullableStruct _ + | TyparConstraint.IsUnmanaged _ + | TyparConstraint.IsReferenceType _ + | TyparConstraint.SimpleChoice _ + | TyparConstraint.RequiresDefaultConstructor _ -> vacc + | TyparConstraint.CoercesTo(cty, _) -> + loop (ndeep + 1) cty vacc) + tp.Constraints + state + | _ -> + let state = + if followInterfaces then + List.foldBack + (loop (ndeep+1)) + (GetImmediateInterfacesOfType skipUnref g amap m ty) + state + else + state + let state = + Option.foldBack + (loop (ndeep+1)) + (GetSuperTypeOfType g amap m ty) + state + state + let acc = visitor ty acc + (visitedTycon, visited, acc) + loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 + +/// Fold, do not follow interfaces (unless the type is itself an interface) +let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc + +/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc + +/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () + +/// Search for one element satisfying a predicate, following interfaces +let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false + +/// Search for one element where a function returns a 'Some' result, following interfaces +let SearchEntireHierarchyOfType f g amap m ty = + FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes + (fun ty acc -> + match acc with + | None -> if f ty then Some ty else None + | Some _ -> acc) + g amap m ty None + +/// Get all super types of the type, including the type itself +let AllSuperTypesOfType g amap m allowMultiIntfInst ty = + FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] + +/// Get all interfaces of a type, including the type itself if it is an interface +let AllInterfacesOfType g amap m allowMultiIntfInst ty = + AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) + +/// Check if two types have the same nominal head type +let HaveSameHeadType g ty1 ty2 = + match tryTcrefOfAppTy g ty1 with + | ValueSome tcref1 -> + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 + | _ -> false + | _ -> false + +/// Check if a type has a particular head type +let HasHeadType g tcref ty2 = + match tryTcrefOfAppTy g ty2 with + | ValueSome tcref2 -> tyconRefEq g tcref tcref2 + | ValueNone -> false + +/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) +let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = + ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom + +/// Check if a type exists somewhere in the hierarchy which has the given head type. +let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = + ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom + +/// Read an Abstract IL type from metadata and convert to an F# type. +let ImportILTypeFromMetadata amap m scoref tinst minst ilty = + RescopeAndImportILType scoref amap m (tinst@minst) ilty + +/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. +let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty getCattrs = + let ty = RescopeAndImportILType scoref amap m (tinst@minst) ilty + // If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref. + if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then + mkInByrefTy amap.g (destByrefTy amap.g ty) + else + ty + +/// Get the parameter type of an IL method. +let ImportParameterTypeFromMetadata amap m ilty getCattrs scoref tinst mist = + ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty getCattrs + +/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and +/// translating 'void' to 'None'. +let ImportReturnTypeFromMetadata amap m ilty getCattrs scoref tinst minst = + match ilty with + | ILType.Void -> None + | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) + + +/// Copy constraints. If the constraint comes from a type parameter associated +/// with a type constructor then we are simply renaming type variables. If it comes +/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the +/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// M and instantiating their constraints +/// +/// Note: this now looks identical to constraint instantiation. + +let CopyTyparConstraints m tprefInst (tporig: Typar) = + tporig.Constraints + |> List.map (fun tpc -> + match tpc with + | TyparConstraint.CoercesTo(ty, _) -> + TyparConstraint.CoercesTo (instType tprefInst ty, m) + | TyparConstraint.DefaultsTo(priority, ty, _) -> + TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) + | TyparConstraint.SupportsNull _ -> + TyparConstraint.SupportsNull m + | TyparConstraint.IsEnum (uty, _) -> + TyparConstraint.IsEnum (instType tprefInst uty, m) + | TyparConstraint.SupportsComparison _ -> + TyparConstraint.SupportsComparison m + | TyparConstraint.SupportsEquality _ -> + TyparConstraint.SupportsEquality m + | TyparConstraint.IsDelegate(aty, bty, _) -> + TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) + | TyparConstraint.IsNonNullableStruct _ -> + TyparConstraint.IsNonNullableStruct m + | TyparConstraint.IsUnmanaged _ -> + TyparConstraint.IsUnmanaged m + | TyparConstraint.IsReferenceType _ -> + TyparConstraint.IsReferenceType m + | TyparConstraint.SimpleChoice (tys, _) -> + TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) + | TyparConstraint.RequiresDefaultConstructor _ -> + TyparConstraint.RequiresDefaultConstructor m + | TyparConstraint.MayResolveMember(traitInfo, _) -> + TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) + +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... +let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = + // Checks.. These are defensive programming against early reported errors. + let n0 = formalEnclosingTypars.Length + let n1 = tinst.Length + let n2 = tpsorig.Length + let n3 = tps.Length + if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) + if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) + + // The real code.. + let renaming, tptys = mkTyparToTyparRenaming tpsorig tps + let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming + (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) + renaming, tptys + diff --git a/src/fsharp/TypeHierarchy.fsi b/src/fsharp/TypeHierarchy.fsi new file mode 100644 index 00000000000..4e840f765bb --- /dev/null +++ b/src/fsharp/TypeHierarchy.fsi @@ -0,0 +1,174 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.TypeHierarchy + +open FSharp.Compiler +open FSharp.Compiler.AbstractIL.IL +open FSharp.Compiler.Syntax +open FSharp.Compiler.Import +open FSharp.Compiler.TcGlobals +open FSharp.Compiler.Text +open FSharp.Compiler.Xml +open FSharp.Compiler.TypedTree +open FSharp.Compiler.TypedTreeOps + +#if !NO_TYPEPROVIDERS +open FSharp.Compiler.TypeProviders +#endif + +/// Get the base type of a type, taking into account type instantiations. Return None if the +/// type has no base type. +val GetSuperTypeOfType: g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option + +/// Indicates whether we can skip interface types that lie outside the reference set +[] +type SkipUnrefInterfaces = + | Yes + | No + +/// Collect the set of immediate declared interface types for an F# type, but do not +/// traverse the type hierarchy to collect further interfaces. +val GetImmediateInterfacesOfType: + skipUnref: SkipUnrefInterfaces -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType list + +/// Indicates whether we should visit multiple instantiations of the same generic interface or not +[] +type AllowMultiIntfInstantiations = + | Yes + | No + +/// Fold, do not follow interfaces (unless the type is itself an interface) +val FoldPrimaryHierarchyOfType: + f: (TType -> 'a -> 'a) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + acc: 'a -> + 'a + +/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +val FoldEntireHierarchyOfType: + f: (TType -> 'a -> 'a) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + acc: 'a -> + 'a + +/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. +val IterateEntireHierarchyOfType: + f: (TType -> unit) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + unit + +/// Search for one element satisfying a predicate, following interfaces +val ExistsInEntireHierarchyOfType: + f: (TType -> bool) -> + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + bool + +/// Search for one element where a function returns a 'Some' result, following interfaces +val SearchEntireHierarchyOfType: + f: (TType -> bool) -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option + +/// Get all super types of the type, including the type itself +val AllSuperTypesOfType: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + TType list + +/// Get all interfaces of a type, including the type itself if it is an interface +val AllInterfacesOfType: + g: TcGlobals -> + amap: ImportMap -> + m: range -> + allowMultiIntfInst: AllowMultiIntfInstantiations -> + ty: TType -> + TType list + +/// Check if two types have the same nominal head type +val HaveSameHeadType: g: TcGlobals -> ty1: TType -> ty2: TType -> bool + +/// Check if a type has a particular head type +val HasHeadType: g: TcGlobals -> tcref: TyconRef -> ty2: TType -> bool + +/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) +val ExistsSameHeadTypeInHierarchy: + g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> typeToLookFor: TType -> bool + +/// Check if a type exists somewhere in the hierarchy which has the given head type. +val ExistsHeadTypeInEntireHierarchy: + g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> tcrefToLookFor: TyconRef -> bool + +/// Read an Abstract IL type from metadata and convert to an F# type. +val ImportILTypeFromMetadata: + amap: ImportMap -> m: range -> scoref: ILScopeRef -> tinst: TType list -> minst: TType list -> ilty: ILType -> TType + +/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. +val ImportILTypeFromMetadataWithAttributes: + amap: ImportMap -> + m: range -> + scoref: ILScopeRef -> + tinst: TType list -> + minst: TType list -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + TType + +/// Get the parameter type of an IL method. +val ImportParameterTypeFromMetadata: + amap: ImportMap -> + m: range -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + scoref: ILScopeRef -> + tinst: TType list -> + mist: TType list -> + TType + +/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and +/// translating 'void' to 'None'. +val ImportReturnTypeFromMetadata: + amap: ImportMap -> + m: range -> + ilty: ILType -> + getCattrs: (unit -> ILAttributes) -> + scoref: ILScopeRef -> + tinst: TType list -> + minst: TType list -> + TType option + +/// Copy constraints. If the constraint comes from a type parameter associated +/// with a type constructor then we are simply renaming type variables. If it comes +/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the +/// instantiation associated with 'ty' as well as copying the type parameters associated with +/// M and instantiating their constraints +/// +/// Note: this now looks identical to constraint instantiation. + +val CopyTyparConstraints: m: range -> tprefInst: TyparInst -> tporig: Typar -> TyparConstraint list + +/// The constraints for each typar copied from another typar can only be fixed up once +/// we have generated all the new constraints, e.g. f List, B :> List> ... +val FixupNewTypars: + m: range -> + formalEnclosingTypars: Typars -> + tinst: TType list -> + tpsorig: Typars -> + tps: Typars -> + TyparInst * TTypes diff --git a/src/fsharp/TypeProviders.fs b/src/fsharp/TypeProviders.fs index f7c9e752ac6..dd29a44d36d 100644 --- a/src/fsharp/TypeProviders.fs +++ b/src/fsharp/TypeProviders.fs @@ -16,7 +16,7 @@ open Internal.Utilities.FSharpEnvironment open FSharp.Core.CompilerServices open FSharp.Quotations open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Text open FSharp.Compiler.Text.Range diff --git a/src/fsharp/TypeRelations.fs b/src/fsharp/TypeRelations.fs index ea8d5b5dd33..6cbb7547f30 100755 --- a/src/fsharp/TypeRelations.fs +++ b/src/fsharp/TypeRelations.fs @@ -6,12 +6,12 @@ module internal FSharp.Compiler.TypeRelations open Internal.Utilities.Collections open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Infos +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy /// Implements a :> b without coercion based on finalized (no type variable) types // Note: This relation is approximate and not part of the language specification. diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 42dddef98b8..07dcf3f0514 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -17,7 +17,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILX.Types open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.QuotationPickler @@ -812,7 +812,7 @@ type Entity = | _ -> x.entity_opt_data <- Some { Entity.NewEmptyEntityOptData() with entity_exn_info = exn_info } /// Indicates if the entity represents an F# exception declaration. - member x.IsExceptionDecl = match x.ExceptionInfo with TExnNone -> false | _ -> true + member x.IsFSharpException = match x.ExceptionInfo with TExnNone -> false | _ -> true /// Demangle the module name, if FSharpModuleWithSuffix is used member x.DemangledModuleOrNamespaceName = @@ -1933,10 +1933,10 @@ type ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, en member _.ActivePatternElemRefLookupTable = activePatternElemRefCache /// Get a list of types defined within this module, namespace or type. - member _.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList + member _.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsFSharpException && not x.IsModuleOrNamespace) |> Seq.toList /// Get a list of F# exception definitions defined within this module, namespace or type. - member _.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList + member _.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsFSharpException) |> Seq.toList /// Get a list of module and namespace definitions defined within this module, namespace or type. member _.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList @@ -3434,7 +3434,7 @@ type EntityRef = member x.ExceptionInfo = x.Deref.ExceptionInfo /// Indicates if the entity represents an F# exception declaration. - member x.IsExceptionDecl = x.Deref.IsExceptionDecl + member x.IsFSharpException = x.Deref.IsFSharpException /// Get the type parameters for an entity that is a type declaration, otherwise return the empty list. /// diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index b824c352807..b20a03b9efa 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -14,7 +14,7 @@ open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Syntax open FSharp.Compiler.Syntax.PrettyNaming @@ -10173,3 +10173,8 @@ let (|SeqEmpty|_|) g expr = match expr with | ValApp g g.seq_empty_vref (_, [], m) -> Some m | _ -> None + +let isFSharpExceptionTy g ty = + match tryTcrefOfAppTy g ty with + | ValueSome tcref -> tcref.IsFSharpException + | _ -> false diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 105f1ff56a9..6a7c4c6984f 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -9,7 +9,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open Internal.Utilities.Rational open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.Syntax open FSharp.Compiler.Text @@ -2636,3 +2636,6 @@ val (|SeqEmpty|_|) : TcGlobals -> Expr -> range option /// Detect a 'seq { ... }' expression val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option + +/// Indicates if an F# type is the type associated with an F# exception declaration +val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool \ No newline at end of file diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 34edb759454..53eff22c771 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -17,7 +17,7 @@ open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Text.Position open FSharp.Compiler.Text.Range open FSharp.Compiler.Syntax diff --git a/src/fsharp/XmlDoc.fs b/src/fsharp/XmlDoc.fs index 8f0618ba0a2..81caa767298 100644 --- a/src/fsharp/XmlDoc.fs +++ b/src/fsharp/XmlDoc.fs @@ -9,7 +9,7 @@ open System.Xml open System.Xml.Linq open Internal.Utilities.Library open Internal.Utilities.Collections -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Text.Range diff --git a/src/fsharp/XmlDocFileWriter.fs b/src/fsharp/XmlDocFileWriter.fs index 882b31c4000..813dad3163c 100644 --- a/src/fsharp/XmlDocFileWriter.fs +++ b/src/fsharp/XmlDocFileWriter.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.XmlDocFileWriter open System.IO open System.Reflection open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text open FSharp.Compiler.Xml diff --git a/src/fsharp/absil/ilread.fs b/src/fsharp/absil/ilread.fs index 6f2ff19cef2..32ad2e8ca88 100644 --- a/src/fsharp/absil/ilread.fs +++ b/src/fsharp/absil/ilread.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.BinaryConstants open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Support -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open System.Reflection diff --git a/src/fsharp/absil/ilreflect.fs b/src/fsharp/absil/ilreflect.fs index 0710fb71442..2fda2716936 100644 --- a/src/fsharp/absil/ilreflect.fs +++ b/src/fsharp/absil/ilreflect.fs @@ -13,7 +13,7 @@ open Internal.Utilities.Collections open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range open FSharp.Core.Printf diff --git a/src/fsharp/absil/ilwrite.fs b/src/fsharp/absil/ilwrite.fs index 8ea0727798f..b0e77e253f7 100644 --- a/src/fsharp/absil/ilwrite.fs +++ b/src/fsharp/absil/ilwrite.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.Support open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.StrongNameSign open FSharp.Compiler.AbstractIL.ILPdbWriter -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range diff --git a/src/fsharp/absil/ilwritepdb.fs b/src/fsharp/absil/ilwritepdb.fs index 5f809518f4f..a6a5bb8afb0 100644 --- a/src/fsharp/absil/ilwritepdb.fs +++ b/src/fsharp/absil/ilwritepdb.fs @@ -16,7 +16,7 @@ open Internal.Utilities open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.Support open Internal.Utilities.Library -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.Text.Range diff --git a/src/fsharp/autobox.fs b/src/fsharp/autobox.fs index 84a2756d6d5..5a225db54d4 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/autobox.fs @@ -5,7 +5,7 @@ module internal FSharp.Compiler.AutoBox open Internal.Utilities.Collections open Internal.Utilities.Library.Extras open FSharp.Compiler -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps @@ -21,7 +21,7 @@ type cenv = { g: TcGlobals amap: Import.ImportMap } - override x.ToString() = "" + override _.ToString() = "" /// Find all the mutable locals that escape a method, function or lambda expression let DecideEscapes syntacticArgs body = diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 719394dcd26..b9818430590 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -39,7 +39,7 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader open FSharp.Compiler.IO @@ -62,8 +62,8 @@ open FSharp.Compiler.BuildGraph /// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached [] -type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameForDebugging) = - inherit ErrorLogger(nameForDebugging) +type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameForDebugging) = + inherit DiagnosticsLogger(nameForDebugging) let mutable errors = 0 @@ -76,7 +76,7 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo override x.ErrorCount = errors override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.errorSeverityOptions (err, severity) then + if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 @@ -91,16 +91,16 @@ type ErrorLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, nameFo | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (err.Exception.ToString())) | _ -> () - elif ReportDiagnosticAsWarning tcConfigB.errorSeverityOptions (err, severity) then + elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo tcConfigB.errorSeverityOptions (err, severity) then + elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then x.HandleIssue(tcConfigB, err, severity) /// Create an error logger that counts and prints errors -let ConsoleErrorLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter) = - { new ErrorLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleErrorLoggerUpToMaxErrors") with +let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter) = + { new DiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter, "ConsoleDiagnosticsLoggerUpToMaxErrors") with member _.HandleTooManyErrors(text : string) = DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> Printf.eprintfn "%s" text) @@ -110,38 +110,38 @@ let ConsoleErrorLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : Exiter let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.errorStyle, severity) writeViaBuffer stderr diag err stderr.WriteLine()) - } :> ErrorLogger + } :> DiagnosticsLogger /// This error logger delays the messages it receives. At the end, call ForwardDelayedDiagnostics /// to send the held messages. -type DelayAndForwardErrorLogger(exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider) = - inherit CapturingErrorLogger("DelayAndForwardErrorLogger") +type DelayAndForwardDiagnosticsLogger(exiter: Exiter, errorLoggerProvider: DiagnosticsLoggerProvider) = + inherit CapturingDiagnosticsLogger("DelayAndForwardDiagnosticsLogger") member x.ForwardDelayedDiagnostics(tcConfigB: TcConfigBuilder) = - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) x.CommitDelayedDiagnostics errorLogger and [] - ErrorLoggerProvider() = + DiagnosticsLoggerProvider() = - member this.CreateDelayAndForwardLogger exiter = DelayAndForwardErrorLogger(exiter, this) + member this.CreateDelayAndForwardLogger exiter = DelayAndForwardDiagnosticsLogger(exiter, this) - abstract CreateErrorLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> ErrorLogger + abstract CreateDiagnosticsLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> DiagnosticsLogger /// Part of LegacyHostedCompilerForTesting /// -/// Yet another ErrorLogger implementation, capturing the messages but only up to the maxerrors maximum -type InProcErrorLoggerProvider() = +/// Yet another DiagnosticsLogger implementation, capturing the messages but only up to the maxerrors maximum +type InProcDiagnosticsLoggerProvider() = let errors = ResizeArray() let warnings = ResizeArray() member _.Provider = - { new ErrorLoggerProvider() with + { new DiagnosticsLoggerProvider() with - member log.CreateErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + member log.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - { new ErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerErrorLoggerUpToMaxErrors") with + { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with member this.HandleTooManyErrors text = warnings.Add(Diagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) @@ -158,25 +158,25 @@ type InProcErrorLoggerProvider() = | FSharpDiagnosticSeverity.Warning -> warnings.AddRange(diagnostics) | _ -> ()} - :> ErrorLogger } + :> DiagnosticsLogger } member _.CapturedErrors = errors.ToArray() member _.CapturedWarnings = warnings.ToArray() -/// The default ErrorLogger implementation, reporting messages to the Console up to the maxerrors maximum +/// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = - inherit ErrorLoggerProvider() + inherit DiagnosticsLoggerProvider() - override this.CreateErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) = ConsoleErrorLoggerUpToMaxErrors(tcConfigBuilder, exiter) + override this.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) /// Notify the exiter if any error has occurred -let AbortOnError (errorLogger: ErrorLogger, exiter : Exiter) = +let AbortOnError (errorLogger: DiagnosticsLogger, exiter : Exiter) = if errorLogger.ErrorCount > 0 then exiter.Exit 1 -let TypeCheck (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, assemblyName, niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter) = +let TypeCheck (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLogger, assemblyName, niceNameGen, tcEnv0, openDecls0, inputs, exiter: Exiter) = try if isNil inputs then error(Error(FSComp.SR.fscNoImplementationFiles(), rangeStartup)) let ccuName = assemblyName @@ -416,7 +416,7 @@ type Args<'T> = Args of 'T /// - Check the inputs let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, reduceMemoryUsage: ReduceMemoryFlag, defaultCopyFSharpCore: CopyFSharpCoreFlag, - exiter: Exiter, errorLoggerProvider: ErrorLoggerProvider, disposables: DisposablesTracker) = + exiter: Exiter, errorLoggerProvider: DiagnosticsLoggerProvider, disposables: DisposablesTracker) = // See Bug 735819 let lcidFromCodePage = @@ -454,7 +454,7 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) + let _unwindEL_1 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) // Share intern'd strings across all lexing/parsing let lexResourceManager = Lexhelp.LexResourceManager() @@ -503,10 +503,10 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, delayForFlagsLogger.ForwardDelayedDiagnostics tcConfigB exiter.Exit 1 - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics errorLogger @@ -532,9 +532,9 @@ let main1(ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, ReportTime tcConfig "Parse inputs" use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - let createErrorLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingErrorLogger) + let createDiagnosticsLogger = (fun exiter -> errorLoggerProvider.CreateDelayAndForwardLogger(exiter) :> CapturingDiagnosticsLogger) - let inputs = ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, errorLogger, exiter, createErrorLogger, (*retryLocked*)false) + let inputs = ParseInputFiles(tcConfig, lexResourceManager, sourceFiles, errorLogger, exiter, createDiagnosticsLogger, (*retryLocked*)false) let inputs, _ = (Map.empty, inputs) ||> List.mapFold (fun state (input, x) -> @@ -600,7 +600,7 @@ let main1OfAst (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, outfile, pdbFile, dllReferences, noframework, exiter: Exiter, - errorLoggerProvider: ErrorLoggerProvider, + errorLoggerProvider: DiagnosticsLoggerProvider, disposables: DisposablesTracker, inputs: ParsedInput list) = @@ -646,7 +646,7 @@ let main1OfAst // Now install a delayed logger to hold all errors from flags until after all flags have been parsed (for example, --vserrors) let delayForFlagsLogger = errorLoggerProvider.CreateDelayAndForwardLogger exiter - let _unwindEL_1 = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) + let _unwindEL_1 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayForFlagsLogger) tcConfigB.conditionalDefines <- "COMPILED" :: tcConfigB.conditionalDefines @@ -662,10 +662,10 @@ let main1OfAst exiter.Exit 1 let dependencyProvider = new DependencyProvider() - let errorLogger = errorLoggerProvider.CreateErrorLoggerUpToMaxErrors(tcConfigB, exiter) + let errorLogger = errorLoggerProvider.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigB, exiter) // Install the global error logger and never remove it. This logger does have all command-line flags considered. - let _unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + let _unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) // Forward all errors from flags delayForFlagsLogger.CommitDelayedDiagnostics errorLogger @@ -731,9 +731,9 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener let oldLogger = errorLogger let errorLogger = let scopedPragmas = [ for TImplFile (pragmas=pragmas) in typedImplFiles do yield! pragmas ] - GetErrorLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.errorSeverityOptions, oldLogger) + GetDiagnosticsLoggerFilteringByScopedPragmas(true, scopedPragmas, tcConfig.diagnosticsOptions, oldLogger) - let _unwindEL_3 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + let _unwindEL_3 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) // Try to find an AssemblyVersion attribute let assemVerFromAttrib = @@ -770,7 +770,7 @@ let main2(Args (ctok, tcGlobals, tcImports: TcImports, frameworkTcImports, gener /// - optimize /// - encode optimization data let main3(Args (ctok, tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, - errorLogger: ErrorLogger, generatedCcu: CcuThunk, outfile, typedImplFiles, + errorLogger: DiagnosticsLogger, generatedCcu: CcuThunk, outfile, typedImplFiles, topAttrs, pdbfile, assemblyName, assemVerFromAttrib, signingInfo, exiter: Exiter)) = // Encode the signature data @@ -869,7 +869,7 @@ let main4 /// Fifth phase of compilation. /// - static linking -let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, staticLinker, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = +let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: DiagnosticsLogger, staticLinker, outfile, pdbfile, ilxMainModule, signingInfo, exiter: Exiter)) = use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Output @@ -888,7 +888,7 @@ let main5(Args (ctok, tcConfig, tcImports, tcGlobals, errorLogger: ErrorLogger, /// Sixth phase of compilation. /// - write the binaries let main6 dynamicAssemblyCreator (Args (ctok, tcConfig, tcImports: TcImports, tcGlobals: TcGlobals, - errorLogger: ErrorLogger, ilxMainModule, outfile, pdbfile, + errorLogger: DiagnosticsLogger, ilxMainModule, outfile, pdbfile, signingInfo, exiter: Exiter)) = ReportTime tcConfig "Write .NET Binary" diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 51593c20689..11ac0485ba6 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -8,20 +8,20 @@ open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.CompilerImports -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Syntax open FSharp.Compiler.TcGlobals [] -type ErrorLoggerProvider = - new: unit -> ErrorLoggerProvider - abstract CreateErrorLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> ErrorLogger +type DiagnosticsLoggerProvider = + new: unit -> DiagnosticsLoggerProvider + abstract CreateDiagnosticsLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger -/// The default ErrorLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum +/// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider - inherit ErrorLoggerProvider + inherit DiagnosticsLoggerProvider /// The main (non-incremental) compilation entry point used by fsc.exe val mainCompile: @@ -32,7 +32,7 @@ val mainCompile: reduceMemoryUsage: ReduceMemoryFlag * defaultCopyFSharpCore: CopyFSharpCoreFlag * exiter: Exiter * - loggerProvider: ErrorLoggerProvider * + loggerProvider: DiagnosticsLoggerProvider * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit @@ -49,15 +49,15 @@ val compileOfAst: dependencies: string list * noframework: bool * exiter: Exiter * - loggerProvider: ErrorLoggerProvider * + loggerProvider: DiagnosticsLoggerProvider * inputs: ParsedInput list * tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit /// Part of LegacyHostedCompilerForTesting -type InProcErrorLoggerProvider = - new: unit -> InProcErrorLoggerProvider - member Provider: ErrorLoggerProvider +type InProcDiagnosticsLoggerProvider = + new: unit -> InProcDiagnosticsLoggerProvider + member Provider: DiagnosticsLoggerProvider member CapturedWarnings: Diagnostic [] member CapturedErrors: Diagnostic [] diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 42458640fd6..fbad507cf02 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.Text diff --git a/src/fsharp/fsi/console.fs b/src/fsharp/fsi/console.fs index a828326910f..d49807d944e 100644 --- a/src/fsharp/fsi/console.fs +++ b/src/fsharp/fsi/console.fs @@ -59,7 +59,7 @@ module internal Utils = let guard(f) = try f() with e -> - FSharp.Compiler.ErrorLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) + FSharp.Compiler.DiagnosticsLogger.warning(Failure(sprintf "Note: an unexpected exception in fsi.exe readline console support. Consider starting fsi.exe with the --no-readline option and report the stack trace below to the .NET or Mono implementors\n%s\n%s\n" e.Message e.StackTrace)) let rec previousWordFromIdx (line: string) (idx, isInWord) = if idx < 0 then 0 else diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index b3b8c160be8..0e9190d4fbf 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -44,7 +44,7 @@ open FSharp.Compiler.CompilerGlobalState open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IlxGen open FSharp.Compiler.InfoReader @@ -762,9 +762,9 @@ type internal FsiConsoleOutput(tcConfigB, outWriter:TextWriter, errorWriter:Text member _.Error = errorWriter -/// This ErrorLogger reports all warnings, but raises StopProcessing on first error or early exit -type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStdinSyphon:FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) = - inherit ErrorLogger("ErrorLoggerThatStopsOnFirstError") +/// This DiagnosticsLogger reports all warnings, but raises StopProcessing on first error or early exit +type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStdinSyphon:FsiStdinSyphon, fsiConsoleOutput: FsiConsoleOutput) = + inherit DiagnosticsLogger("DiagnosticsLoggerThatStopsOnFirstError") let mutable errorCount = 0 member _.SetError() = @@ -773,13 +773,13 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd member _.ResetErrorCount() = errorCount <- 0 override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.errorSeverityOptions (err, severity) then + if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then fsiStdinSyphon.PrintError(tcConfigB,err) errorCount <- errorCount + 1 if tcConfigB.abortOnError then exit 1 (* non-zero exit code *) // STOP ON FIRST ERROR (AVOIDS PARSER ERROR RECOVERY) raise StopProcessing - elif ReportDiagnosticAsWarning tcConfigB.errorSeverityOptions (err, severity) then + elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err @@ -787,7 +787,7 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) - elif ReportDiagnosticAsInfo tcConfigB.errorSeverityOptions (err, severity) then + elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err @@ -798,7 +798,7 @@ type internal ErrorLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, fsiStd override x.ErrorCount = errorCount -type ErrorLogger with +type DiagnosticsLogger with member x.CheckForErrors() = (x.ErrorCount > 0) /// A helper function to check if its time to abort member x.AbortOnError(fsiConsoleOutput:FsiConsoleOutput) = @@ -1091,7 +1091,7 @@ let internal SetCurrentUICultureForThread (lcid : int option) = let internal InstallErrorLoggingOnThisThread errorLogger = if progress then dprintfn "Installing logger on id=%d name=%s" Thread.CurrentThread.ManagedThreadId Thread.CurrentThread.Name - SetThreadErrorLoggerNoUnwind(errorLogger) + SetThreadDiagnosticsLoggerNoUnwind(errorLogger) SetThreadBuildPhaseNoUnwind(BuildPhase.Interactive) /// Set the input/output encoding. The use of a thread is due to a known bug on @@ -1496,7 +1496,7 @@ type internal FsiDynamicCompiler( execs // Emit the codegen results using the assembly writer - let ProcessCodegenResults (ctok, errorLogger: ErrorLogger, istate, optEnv, tcState: TcState, tcConfig, prefixPath, showTypes: bool, isIncrementalFragment, fragName, declaredImpls, ilxGenerator: IlxAssemblyGenerator, codegenResults, m) = + let ProcessCodegenResults (ctok, errorLogger: DiagnosticsLogger, istate, optEnv, tcState: TcState, tcConfig, prefixPath, showTypes: bool, isIncrementalFragment, fragName, declaredImpls, ilxGenerator: IlxAssemblyGenerator, codegenResults, m) = let emEnv = istate.emEnv // Each input is like a small separately compiled extension to a single source file. @@ -1576,7 +1576,7 @@ type internal FsiDynamicCompiler( match exec() with | Some err -> match errorLogger with - | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> + | :? DiagnosticsLoggerThatStopsOnFirstError as errorLogger -> fprintfn fsiConsoleOutput.Error "%s" (err.ToString()) errorLogger.SetError() errorLogger.AbortOnError(fsiConsoleOutput) @@ -1621,7 +1621,7 @@ type internal FsiDynamicCompiler( // Return the new state and the environment at the end of the last input, ready for further inputs. (istate,declaredImpls) - let ProcessTypedImpl (errorLogger: ErrorLogger, optEnv, tcState: TcState, tcConfig: TcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator: IlxAssemblyGenerator) = + let ProcessTypedImpl (errorLogger: DiagnosticsLogger, optEnv, tcState: TcState, tcConfig: TcConfig, isInteractiveItExpr, topCustomAttrs, prefixPath, isIncrementalFragment, declaredImpls, ilxGenerator: IlxAssemblyGenerator) = #if DEBUG // Logging/debugging if tcConfig.printAst then @@ -1643,7 +1643,7 @@ type internal FsiDynamicCompiler( errorLogger.AbortOnError(fsiConsoleOutput) codegenResults, optEnv, fragName - let ProcessInputs (ctok, errorLogger: ErrorLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent, m) = + let ProcessInputs (ctok, errorLogger: DiagnosticsLogger, istate: FsiDynamicCompilerState, inputs: ParsedInput list, showTypes: bool, isIncrementalFragment: bool, isInteractiveItExpr: bool, prefixPath: LongIdent, m) = let optEnv = istate.optEnv let tcState = istate.tcState let ilxGenerator = istate.ilxGenerator @@ -1801,7 +1801,7 @@ type internal FsiDynamicCompiler( istate /// Evaluate the given definitions and produce a new interactive state. - member _.EvalParsedDefinitions (ctok, errorLogger: ErrorLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecl list) = + member _.EvalParsedDefinitions (ctok, errorLogger: DiagnosticsLogger, istate, showTypes, isInteractiveItExpr, defs: SynModuleDecl list) = let fileName = stdinMockFileName let i = nextFragmentId() let m = match defs with [] -> rangeStdin0 | _ -> List.reduce unionRanges [for d in defs -> d.Range] @@ -1818,7 +1818,7 @@ type internal FsiDynamicCompiler( processContents newState declaredImpls /// Evaluate the given expression and produce a new interactive state. - member fsiDynamicCompiler.EvalParsedExpression (ctok, errorLogger: ErrorLogger, istate, expr: SynExpr) = + member fsiDynamicCompiler.EvalParsedExpression (ctok, errorLogger: DiagnosticsLogger, istate, expr: SynExpr) = let tcConfig = TcConfig.Create (tcConfigB, validate=false) let itName = "it" @@ -1986,7 +1986,7 @@ type internal FsiDynamicCompiler( (fun _ _ -> ())) (tcConfigB, inp, Path.GetDirectoryName sourceFile, istate)) - member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, errorLogger: ErrorLogger) = + member fsiDynamicCompiler.EvalSourceFiles(ctok, istate, m, sourceFiles, lexResourceManager, errorLogger: DiagnosticsLogger) = let tcConfig = TcConfig.Create(tcConfigB,validate=false) match sourceFiles with | [] -> istate @@ -2058,7 +2058,7 @@ type internal FsiDynamicCompiler( | _ -> None - member _.AddBoundValue (ctok, errorLogger: ErrorLogger, istate, name: string, value: obj) = + member _.AddBoundValue (ctok, errorLogger: DiagnosticsLogger, istate, name: string, value: obj) = try match value with | null -> nullArg "value" @@ -2552,11 +2552,11 @@ type FsiInteractionProcessor with _ -> (istate,Completed None) - let InteractiveCatch (errorLogger: ErrorLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = + let InteractiveCatch (errorLogger: DiagnosticsLogger) (f:_ -> _ * FsiInteractionStepStatus) istate = try // reset error count match errorLogger with - | :? ErrorLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() + | :? DiagnosticsLoggerThatStopsOnFirstError as errorLogger -> errorLogger.ResetErrorCount() | _ -> () f istate @@ -2603,7 +2603,7 @@ type FsiInteractionProcessor None /// Execute a single parsed interaction. Called on the GUI/execute/main thread. - let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, errorLogger: ErrorLogger) = + let ExecInteraction (ctok, tcConfig:TcConfig, istate, action:ParsedScriptInteraction, errorLogger: DiagnosticsLogger) = let packageManagerDirective directive path m = let dm = fsiOptions.DependencyProvider.TryFindDependencyManagerInPath(tcConfigB.compilerToolPaths, getOutputDir tcConfigB, reportError m, path) match dm with @@ -2743,7 +2743,7 @@ type FsiInteractionProcessor /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = + let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult:option, cancellationToken: CancellationToken) = cancellationToken.ThrowIfCancellationRequested() let action,nextAction,istate = match action with @@ -2806,7 +2806,7 @@ type FsiInteractionProcessor /// Execute a single parsed interaction which may contain multiple items to be executed /// independently - let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: ErrorLogger, lastResult:option, cancellationToken: CancellationToken) = + let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult:option, cancellationToken: CancellationToken) = let istate, completed = execParsedInteractions (ctok, tcConfig, istate, action, errorLogger, lastResult, cancellationToken) match completed with | Completed _ -> @@ -2977,7 +2977,7 @@ type FsiInteractionProcessor member _.EvalInteraction(ctok, sourceText, scriptFileName, errorLogger, ?cancellationToken) = let cancellationToken = defaultArg cancellationToken CancellationToken.None use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) @@ -2994,7 +2994,7 @@ type FsiInteractionProcessor member _.EvalExpression (ctok, sourceText, scriptFileName, errorLogger) = use _unwind1 = PushThreadBuildPhaseUntilUnwind(BuildPhase.Interactive) - use _unwind2 = PushErrorLoggerPhaseUntilUnwind(fun _ -> errorLogger) + use _unwind2 = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) use _scope = SetCurrentUICultureForThread fsiOptions.FsiLCID let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, sourceText) let tokenizer = fsiStdinLexerProvider.CreateBufferLexer(scriptFileName, lexbuf, errorLogger) @@ -3253,7 +3253,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let fsiStdinSyphon = FsiStdinSyphon(errorWriter) let fsiConsoleOutput = FsiConsoleOutput(tcConfigB, outWriter, errorWriter) - let errorLogger = ErrorLoggerThatStopsOnFirstError(tcConfigB, fsiStdinSyphon, fsiConsoleOutput) + let errorLogger = DiagnosticsLoggerThatStopsOnFirstError(tcConfigB, fsiStdinSyphon, fsiConsoleOutput) do InstallErrorLoggingOnThisThread errorLogger // FSI error logging on main thread. @@ -3368,7 +3368,7 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i | Choice2Of2 None -> raise (FsiCompilationException(FSIstrings.SR.fsiOperationFailed(), None)) | Choice2Of2 (Some userExn) -> raise (makeNestedException userExn) - let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationErrorLogger) res = + let commitResultNonThrowing errorOptions scriptFile (errorLogger: CompilationDiagnosticLogger) res = let errs = errorLogger.GetDiagnostics() let errorInfos = DiagnosticHelpers.CreateDiagnostics (errorOptions, true, scriptFile, errs, true) let userRes = @@ -3504,8 +3504,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions - let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalExpression(ctok, code, dummyScriptFileName, errorLogger) |> commitResultNonThrowing errorOptions dummyScriptFileName errorLogger @@ -3526,8 +3526,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i let ctok = AssumeCompilationThreadWithoutEvidence() let cancellationToken = defaultArg cancellationToken CancellationToken.None - let errorOptions = TcConfig.Create(tcConfigB,validate = false).errorSeverityOptions - let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB,validate = false).diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalInteraction(ctok, code, dummyScriptFileName, errorLogger, cancellationToken) |> commitResultNonThrowing errorOptions "input.fsx" errorLogger @@ -3547,8 +3547,8 @@ type FsiEvaluationSession (fsi: FsiEvaluationSessionHostConfig, argv:string[], i // is not safe to call concurrently. let ctok = AssumeCompilationThreadWithoutEvidence() - let errorOptions = TcConfig.Create(tcConfigB, validate = false).errorSeverityOptions - let errorLogger = CompilationErrorLogger("EvalInteraction", errorOptions) + let errorOptions = TcConfig.Create(tcConfigB, validate = false).diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("EvalInteraction", errorOptions) fsiInteractionProcessor.EvalScript(ctok, filePath, errorLogger) |> commitResultNonThrowing errorOptions filePath errorLogger |> function Choice1Of2 _, errs -> Choice1Of2 (), errs | Choice2Of2 exn, errs -> Choice2Of2 exn, errs diff --git a/src/fsharp/fsi/fsimain.fs b/src/fsharp/fsi/fsimain.fs index 142c5b8561c..9a94dfeaabb 100644 --- a/src/fsharp/fsi/fsimain.fs +++ b/src/fsharp/fsi/fsimain.fs @@ -298,8 +298,8 @@ let evaluateSession(argv: string[]) = fsiSession.Run() 0 with - | FSharp.Compiler.ErrorLogger.StopProcessingExn _ -> 1 - | FSharp.Compiler.ErrorLogger.ReportedError _ -> 1 + | FSharp.Compiler.DiagnosticsLogger.StopProcessingExn _ -> 1 + | FSharp.Compiler.DiagnosticsLogger.ReportedError _ -> 1 | e -> eprintf "Exception by fsi.exe:\n%+A\n" e; 1 // Mark the main thread as STAThread since it is a GUI thread diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index 157cdc918fd..f16629472d2 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -10,7 +10,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.CompilerGlobalState -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Xml @@ -640,3 +640,15 @@ let ImportILAssembly(amap: unit -> ImportMap, m, auxModuleLoader, xmlDocInfoLoad } CcuThunk.Create(nm, ccuData) + +//------------------------------------------------------------------------- +// From IL types to F# types +//------------------------------------------------------------------------- + +/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. +let RescopeAndImportILType scoref amap m importInst ilty = + ilty |> rescopeILType scoref |> ImportILType amap m importInst + +let CanRescopeAndImportILType scoref amap m ilty = + ilty |> rescopeILType scoref |> CanImportILType amap m + diff --git a/src/fsharp/import.fsi b/src/fsharp/import.fsi index 975a9d56a56..e573870de6b 100644 --- a/src/fsharp/import.fsi +++ b/src/fsharp/import.fsi @@ -97,3 +97,10 @@ val internal ImportILAssembly: /// Import the type forwarder table for an IL assembly val internal ImportILAssemblyTypeForwarders: (unit -> ImportMap) * range * ILExportedTypesAndForwarders -> Map> + +/// Import an IL type as an F# type, first rescoping to view the metadata from the current assembly +/// being compiled. importInst gives the context for interpreting type variables. +val RescopeAndImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType + +val CanRescopeAndImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool + diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index c8ba00a3875..ef000fdcaa6 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -7,423 +7,23 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Import open FSharp.Compiler.Syntax open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.TcGlobals open FSharp.Compiler.Text -open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypedTreeOps.DebugPrint +open FSharp.Compiler.TypeHierarchy +open FSharp.Compiler.Xml #if !NO_TYPEPROVIDERS open FSharp.Compiler.TypeProviders #endif -//------------------------------------------------------------------------- -// From IL types to F# types -//------------------------------------------------------------------------- - -/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. -let ImportILType scoref amap m importInst ilty = - ilty |> rescopeILType scoref |> Import.ImportILType amap m importInst - -let CanImportILType scoref amap m ilty = - ilty |> rescopeILType scoref |> Import.CanImportILType amap m - -//------------------------------------------------------------------------- -// Fold the hierarchy. -// REVIEW: this code generalizes the iteration used below for member lookup. -//------------------------------------------------------------------------- - -/// Indicates if an F# type is the type associated with an F# exception declaration -let isExnDeclTy g ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> tcref.IsExceptionDecl - | _ -> false - -/// Get the base type of a type, taking into account type instantiations. Return None if the -/// type has no base type. -let GetSuperTypeOfType g amap m ty = -#if !NO_TYPEPROVIDERS - let ty = - match tryTcrefOfAppTy g ty with - | ValueSome tcref when tcref.IsProvided -> stripTyEqns g ty - | _ -> stripTyEqnsAndMeasureEqns g ty -#else - let ty = stripTyEqnsAndMeasureEqns g ty -#endif - - match metadataOfTy g ty with -#if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - let st = info.ProvidedType - let superOpt = st.PApplyOption((fun st -> match st.BaseType with null -> None | t -> Some t), m) - match superOpt with - | None -> None - | Some super -> Some(Import.ImportProvidedType amap m super) -#endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - let tinst = argsOfAppTy g ty - match tdef.Extends with - | None -> None - | Some ilty -> Some (ImportILType scoref amap m tinst ilty) - - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - if isFSharpObjModelTy g ty || isExnDeclTy g ty then - let tcref = tcrefOfAppTy g ty - Some (instType (mkInstForAppTy g ty) (superOfTycon g tcref.Deref)) - elif isArrayTy g ty then - Some g.system_Array_ty - elif isRefTy g ty && not (isObjTy g ty) then - Some g.obj_ty - elif isStructTupleTy g ty then - Some g.system_Value_ty - elif isFSharpStructOrEnumTy g ty then - if isFSharpEnumTy g ty then - Some g.system_Enum_ty - else - Some g.system_Value_ty - elif isStructAnonRecdTy g ty then - Some g.system_Value_ty - elif isAnonRecdTy g ty then - Some g.obj_ty - elif isRecdTy g ty || isUnionTy g ty then - Some g.obj_ty - else - None - -/// Make a type for System.Collections.Generic.IList -let mkSystemCollectionsGenericIListTy (g: TcGlobals) ty = - TType_app(g.tcref_System_Collections_Generic_IList, [ty], g.knownWithoutNull) - -/// Indicates whether we can skip interface types that lie outside the reference set -[] -type SkipUnrefInterfaces = Yes | No - -let GetImmediateInterfacesOfMetadataType g amap m skipUnref ty (tcref: TyconRef) tinst = - [ - match metadataOfTy g ty with -#if !NO_TYPEPROVIDERS - | ProvidedTypeMetadata info -> - for ity in info.ProvidedType.PApplyArray((fun st -> st.GetInterfaces()), "GetInterfaces", m) do - Import.ImportProvidedType amap m ity -#endif - | ILTypeMetadata (TILObjectReprData(scoref, _, tdef)) -> - // ImportILType may fail for an interface if the assembly load set is incomplete and the interface - // comes from another assembly. In this case we simply skip the interface: - // if we don't skip it, then compilation will just fail here, and if type checking - // succeeds with fewer non-dereferencable interfaces reported then it would have - // succeeded with more reported. There are pathological corner cases where this - // doesn't apply: e.g. for mscorlib interfaces like IComparable, but we can always - // assume those are present. - for ity in tdef.Implements do - if skipUnref = SkipUnrefInterfaces.No || CanImportILType scoref amap m ity then - ImportILType scoref amap m tinst ity - | FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata -> - for ity in tcref.ImmediateInterfaceTypesOfFSharpTycon do - instType (mkInstForAppTy g ty) ity ] - -/// Collect the set of immediate declared interface types for an F# type, but do not -/// traverse the type hierarchy to collect further interfaces. -// -// NOTE: Anonymous record types are not directly considered to implement IComparable, -// IComparable or IEquatable. This is because whether they support these interfaces depend on their -// consitutent types, which may not yet be known in type inference. -let rec GetImmediateInterfacesOfType skipUnref g amap m ty = - [ - match tryAppTy g ty with - | ValueSome(tcref, tinst) -> - // Check if this is a measure-annotated type - match tcref.TypeReprInfo with - | TMeasureableRepr reprTy -> - yield! GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy - | _ -> - yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref ty tcref tinst - - | ValueNone -> - // For tuple types, func types, check if we can eliminate to a type with metadata. - let tyWithMetadata = convertToTypeWithMetadataIfPossible g ty - match tryAppTy g tyWithMetadata with - | ValueSome (tcref, tinst) -> - if isAnyTupleTy g ty then - yield! GetImmediateInterfacesOfMetadataType g amap m skipUnref tyWithMetadata tcref tinst - | _ -> () - - // .NET array types are considered to implement IList - if isArray1DTy g ty then - mkSystemCollectionsGenericIListTy g (destArrayTy g ty) - ] - -// Report the interfaces supported by a measure-annotated type. -// -// For example, consider: -// -// [] -// type A<[] 'm> = A -// -// This measure-annotated type is considered to support the interfaces on its representation type A, -// with the exception that -// -// 1. we rewrite the IComparable and IEquatable interfaces, so that -// IComparable --> IComparable> -// IEquatable --> IEquatable> -// -// 2. we emit any other interfaces that derive from IComparable and IEquatable interfaces -// -// This rule is conservative and only applies to IComparable and IEquatable interfaces. -// -// This rule may in future be extended to rewrite the "trait" interfaces associated with .NET 7. -and GetImmediateInterfacesOfMeasureAnnotatedType skipUnref g amap m ty reprTy = - [ - // Report any interfaces that don't derive from IComparable<_> or IEquatable<_> - for ity in GetImmediateInterfacesOfType skipUnref g amap m reprTy do - if not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIComparable_tcref skipUnref g amap m ity) && - not (ExistsHeadTypeInInterfaceHierarchy g.system_GenericIEquatable_tcref skipUnref g amap m ity) then - ity - - // NOTE: we should really only report the IComparable> interface for measure-annotated types - // if the original type supports IComparable somewhere in the hierarchy, likeiwse IEquatable>. - // - // However since F# 2.0 we have always reported these interfaces for all measure-annotated types. - - //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIComparable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIComparable_tcref [ty] - - //if ExistsInInterfaceHierarchy (typeEquiv g (mkAppTy g.system_GenericIEquatable_tcref [reprTy])) skipUnref g amap m ty then - mkAppTy g.system_GenericIEquatable_tcref [ty] - ] - -// Check for IComparable, IEquatable and interfaces that derive from these -and ExistsHeadTypeInInterfaceHierarchy target skipUnref g amap m ity = - ExistsInInterfaceHierarchy (function AppTy g (tcref,_) -> tyconRefEq g tcref target | _ -> false) skipUnref g amap m ity - -// Check for IComparable, IEquatable and interfaces that derive from these -and ExistsInInterfaceHierarchy p skipUnref g amap m ity = - match ity with - | AppTy g (tcref, tinst) -> - p ity || - (GetImmediateInterfacesOfMetadataType g amap m skipUnref ity tcref tinst - |> List.exists (ExistsInInterfaceHierarchy p skipUnref g amap m)) - | _ -> false - -/// Indicates whether we should visit multiple instantiations of the same generic interface or not -[] -type AllowMultiIntfInstantiations = Yes | No - -/// Traverse the type hierarchy, e.g. f D (f C (f System.Object acc)). -/// Visit base types and interfaces first. -let private FoldHierarchyOfTypeAux followInterfaces allowMultiIntfInst skipUnref visitor g amap m ty acc = - let rec loop ndeep ty (visitedTycon, visited: TyconRefMultiMap<_>, acc as state) = - - let seenThisTycon = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> Set.contains tcref.Stamp visitedTycon - | _ -> false - - // Do not visit the same type twice. Could only be doing this if we've seen this tycon - if seenThisTycon && List.exists (typeEquiv g ty) (visited.Find (tcrefOfAppTy g ty)) then state else - - // Do not visit the same tycon twice, e.g. I and I, collect I only, unless directed to allow this - if seenThisTycon && allowMultiIntfInst = AllowMultiIntfInstantiations.No then state else - - let state = - match tryTcrefOfAppTy g ty with - | ValueSome tcref -> - let visitedTycon = Set.add tcref.Stamp visitedTycon - visitedTycon, visited.Add (tcref, ty), acc - | _ -> - state - - if ndeep > 100 then (errorR(Error((FSComp.SR.recursiveClassHierarchy (showType ty)), m)); (visitedTycon, visited, acc)) else - let visitedTycon, visited, acc = - if isInterfaceTy g ty then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - (loop ndeep g.obj_ty state) - else - match tryDestTyparTy g ty with - | ValueSome tp -> - let state = loop (ndeep+1) g.obj_ty state - List.foldBack - (fun x vacc -> - match x with - | TyparConstraint.MayResolveMember _ - | TyparConstraint.DefaultsTo _ - | TyparConstraint.SupportsComparison _ - | TyparConstraint.SupportsEquality _ - | TyparConstraint.IsEnum _ - | TyparConstraint.IsDelegate _ - | TyparConstraint.SupportsNull _ - | TyparConstraint.IsNonNullableStruct _ - | TyparConstraint.IsUnmanaged _ - | TyparConstraint.IsReferenceType _ - | TyparConstraint.SimpleChoice _ - | TyparConstraint.RequiresDefaultConstructor _ -> vacc - | TyparConstraint.CoercesTo(cty, _) -> - loop (ndeep + 1) cty vacc) - tp.Constraints - state - | _ -> - let state = - if followInterfaces then - List.foldBack - (loop (ndeep+1)) - (GetImmediateInterfacesOfType skipUnref g amap m ty) - state - else - state - let state = - Option.foldBack - (loop (ndeep+1)) - (GetSuperTypeOfType g amap m ty) - state - state - let acc = visitor ty acc - (visitedTycon, visited, acc) - loop 0 ty (Set.empty, TyconRefMultiMap<_>.Empty, acc) |> p33 - -/// Fold, do not follow interfaces (unless the type is itself an interface) -let FoldPrimaryHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux false allowMultiIntfInst SkipUnrefInterfaces.No f g amap m ty acc - -/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let FoldEntireHierarchyOfType f g amap m allowMultiIntfInst ty acc = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes f g amap m ty acc - -/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -let IterateEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty () -> f ty) g amap m ty () - -/// Search for one element satisfying a predicate, following interfaces -let ExistsInEntireHierarchyOfType f g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.Yes (fun ty acc -> acc || f ty ) g amap m ty false - -/// Search for one element where a function returns a 'Some' result, following interfaces -let SearchEntireHierarchyOfType f g amap m ty = - FoldHierarchyOfTypeAux true AllowMultiIntfInstantiations.Yes SkipUnrefInterfaces.Yes - (fun ty acc -> - match acc with - | None -> if f ty then Some ty else None - | Some _ -> acc) - g amap m ty None - -/// Get all super types of the type, including the type itself -let AllSuperTypesOfType g amap m allowMultiIntfInst ty = - FoldHierarchyOfTypeAux true allowMultiIntfInst SkipUnrefInterfaces.No (ListSet.insert (typeEquiv g)) g amap m ty [] - -/// Get all interfaces of a type, including the type itself if it is an interface -let AllInterfacesOfType g amap m allowMultiIntfInst ty = - AllSuperTypesOfType g amap m allowMultiIntfInst ty |> List.filter (isInterfaceTy g) - -/// Check if two types have the same nominal head type -let HaveSameHeadType g ty1 ty2 = - match tryTcrefOfAppTy g ty1 with - | ValueSome tcref1 -> - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref1 tcref2 - | _ -> false - | _ -> false - -/// Check if a type has a particular head type -let HasHeadType g tcref ty2 = - match tryTcrefOfAppTy g ty2 with - | ValueSome tcref2 -> tyconRefEq g tcref tcref2 - | ValueNone -> false - -/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -let ExistsSameHeadTypeInHierarchy g amap m typeToSearchFrom typeToLookFor = - ExistsInEntireHierarchyOfType (HaveSameHeadType g typeToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - -/// Check if a type exists somewhere in the hierarchy which has the given head type. -let ExistsHeadTypeInEntireHierarchy g amap m typeToSearchFrom tcrefToLookFor = - ExistsInEntireHierarchyOfType (HasHeadType g tcrefToLookFor) g amap m AllowMultiIntfInstantiations.Yes typeToSearchFrom - -/// Read an Abstract IL type from metadata and convert to an F# type. -let ImportILTypeFromMetadata amap m scoref tinst minst ilty = - ImportILType scoref amap m (tinst@minst) ilty - -/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. -let ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst ilty getCattrs = - let ty = ImportILType scoref amap m (tinst@minst) ilty - // If the type is a byref and one of attributes from a return or parameter has IsReadOnly, then it's a inref. - if isByrefTy amap.g ty && TryFindILAttribute amap.g.attrib_IsReadOnlyAttribute (getCattrs ()) then - mkInByrefTy amap.g (destByrefTy amap.g ty) - else - ty - -/// Get the parameter type of an IL method. -let ImportParameterTypeFromMetadata amap m ilty getCattrs scoref tinst mist = - ImportILTypeFromMetadataWithAttributes amap m scoref tinst mist ilty getCattrs - -/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and -/// translating 'void' to 'None'. -let ImportReturnTypeFromMetadata amap m ilty getCattrs scoref tinst minst = - match ilty with - | ILType.Void -> None - | retTy -> Some(ImportILTypeFromMetadataWithAttributes amap m scoref tinst minst retTy getCattrs) - - -/// Copy constraints. If the constraint comes from a type parameter associated -/// with a type constructor then we are simply renaming type variables. If it comes -/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with -/// M and instantiating their constraints -/// -/// Note: this now looks identical to constraint instantiation. - -let CopyTyparConstraints m tprefInst (tporig: Typar) = - tporig.Constraints - |> List.map (fun tpc -> - match tpc with - | TyparConstraint.CoercesTo(ty, _) -> - TyparConstraint.CoercesTo (instType tprefInst ty, m) - | TyparConstraint.DefaultsTo(priority, ty, _) -> - TyparConstraint.DefaultsTo (priority, instType tprefInst ty, m) - | TyparConstraint.SupportsNull _ -> - TyparConstraint.SupportsNull m - | TyparConstraint.IsEnum (uty, _) -> - TyparConstraint.IsEnum (instType tprefInst uty, m) - | TyparConstraint.SupportsComparison _ -> - TyparConstraint.SupportsComparison m - | TyparConstraint.SupportsEquality _ -> - TyparConstraint.SupportsEquality m - | TyparConstraint.IsDelegate(aty, bty, _) -> - TyparConstraint.IsDelegate (instType tprefInst aty, instType tprefInst bty, m) - | TyparConstraint.IsNonNullableStruct _ -> - TyparConstraint.IsNonNullableStruct m - | TyparConstraint.IsUnmanaged _ -> - TyparConstraint.IsUnmanaged m - | TyparConstraint.IsReferenceType _ -> - TyparConstraint.IsReferenceType m - | TyparConstraint.SimpleChoice (tys, _) -> - TyparConstraint.SimpleChoice (List.map (instType tprefInst) tys, m) - | TyparConstraint.RequiresDefaultConstructor _ -> - TyparConstraint.RequiresDefaultConstructor m - | TyparConstraint.MayResolveMember(traitInfo, _) -> - TyparConstraint.MayResolveMember (instTrait tprefInst traitInfo, m)) - -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... -let FixupNewTypars m (formalEnclosingTypars: Typars) (tinst: TType list) (tpsorig: Typars) (tps: Typars) = - // Checks.. These are defensive programming against early reported errors. - let n0 = formalEnclosingTypars.Length - let n1 = tinst.Length - let n2 = tpsorig.Length - let n3 = tps.Length - if n0 <> n1 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n0, n1)), m)) - if n2 <> n3 then error(Error((FSComp.SR.tcInvalidTypeArgumentCount(n2, n3)), m)) - - // The real code.. - let renaming, tptys = mkTyparToTyparRenaming tpsorig tps - let tprefInst = mkTyparInst formalEnclosingTypars tinst @ renaming - (tpsorig, tps) ||> List.iter2 (fun tporig tp -> tp.SetConstraints (CopyTyparConstraints m tprefInst tporig)) - renaming, tptys - - //------------------------------------------------------------------------- // Predicates and properties on values and members @@ -475,7 +75,7 @@ let GetCompiledReturnTyOfProvidedMethodInfo amap m (mi: Tainted mi.IsConstructor), m) then mi.PApply((fun mi -> mi.DeclaringType), m) else mi.Coerce(m).PApply((fun mi -> mi.ReturnType), m) - let ty = Import.ImportProvidedType amap m returnType + let ty = ImportProvidedType amap m returnType if isVoidTy amap.g ty then None else Some ty #endif @@ -492,10 +92,12 @@ let ReparentSlotSigToUseMethodTypars g m ovByMethValRef slotsig = slotsig /// Construct the data representing a parameter in the signature of an abstract method slot -let MakeSlotParam (ty, argInfo: ArgReprInfo) = TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) +let MakeSlotParam (ty, argInfo: ArgReprInfo) = + TSlotParam(Option.map textOfId argInfo.Name, ty, false, false, false, argInfo.Attribs) /// Construct the data representing the signature of an abstract method slot -let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) +let MakeSlotSig (nm, ty, ctps, mtps, paraml, retTy) = + copySlotSig (TSlotSig(nm, ty, ctps, mtps, paraml, retTy)) /// Split the type of an F# member value into /// - the type parameters associated with method but matching those of the enclosing type @@ -578,7 +180,11 @@ type OptionalArgInfo = /// Note this is correctly termed caller side, even though the default value is optically specified on the callee: /// in fact the default value is read from the metadata and passed explicitly to the callee on the caller side. | CallerSide of OptionalArgCallerSideValue - member x.IsOptional = match x with CalleeSide | CallerSide _ -> true | NotOptional -> false + + member x.IsOptional = + match x with + | CalleeSide | CallerSide _ -> true + | NotOptional -> false /// Compute the OptionalArgInfo for an IL parameter /// @@ -663,6 +269,7 @@ type ParamData = #if !NO_TYPEPROVIDERS type ILFieldInit with + /// Compute the ILFieldInit for the given provided constant value for a provided enum type. static member FromProvidedObj m (v: obj) = match v with @@ -692,7 +299,7 @@ type ILFieldInit with /// This is the same logic as OptionalArgInfoOfILParameter except we do not apply the /// Visual Basic rules for IDispatchConstant and IUnknownConstant to optional /// provided parameters. -let OptionalArgInfoOfProvidedParameter (amap: Import.ImportMap) m (provParam : Tainted) = +let OptionalArgInfoOfProvidedParameter (amap: ImportMap) m (provParam : Tainted) = let g = amap.g if provParam.PUntaint((fun p -> p.IsOptional), m) then match provParam.PUntaint((fun p -> p.HasDefaultValue), m) with @@ -705,7 +312,7 @@ let OptionalArgInfoOfProvidedParameter (amap: Import.ImportMap) m (provParam : T elif isObjTy g ty then MissingValue else DefaultValue - let pty = Import.ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) + let pty = ImportProvidedType amap m (provParam.PApply((fun p -> p.ParameterType), m)) CallerSide (analyze pty) | _ -> let v = provParam.PUntaint((fun p -> p.RawDefaultValue), m) @@ -952,7 +559,7 @@ type MethInfo = #if !NO_TYPEPROVIDERS /// Describes a use of a method backed by provided metadata - | ProvidedMeth of amap: Import.ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range + | ProvidedMeth of amap: ImportMap * methodBase: Tainted * extensionMethodPriority: ExtensionMethodPriority option * m: range #endif /// Get the enclosing type of the method info. @@ -966,7 +573,7 @@ type MethInfo = | DefaultStructCtor(_, ty) -> ty #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) + ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -1265,7 +872,7 @@ type MethInfo = | _ -> false /// Indicates if this is an extension member (e.g. on a struct) that takes a byref arg - member x.ObjArgNeedsAddress (amap: Import.ImportMap, m) = + member x.ObjArgNeedsAddress (amap: ImportMap, m) = (x.IsStruct && not x.IsExtensionMember) || match x.GetObjArgTypes (amap, m, x.FormalMethodInst) with | [h] -> isByrefTy amap.g h @@ -1328,21 +935,21 @@ type MethInfo = /// Indicates if this method is an extension member that is read-only. /// An extension member is considered read-only if the first argument is a read-only byref (inref) type. - member x.IsReadOnlyExtensionMember (amap: Import.ImportMap, m) = + member x.IsReadOnlyExtensionMember (amap: ImportMap, m) = x.IsExtensionMember && x.TryObjArgByrefType(amap, m, x.FormalMethodInst) |> Option.exists (isInByrefTy amap.g) /// Build IL method infos. - static member CreateILMeth (amap: Import.ImportMap, m, ty: TType, md: ILMethodDef) = + static member CreateILMeth (amap: ImportMap, m, ty: TType, md: ILMethodDef) = let tinfo = ILTypeInfo.FromType amap.g ty - let mtps = Import.ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams + let mtps = ImportILGenericParameters (fun () -> amap) m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata md.GenericParams ILMeth (amap.g, ILMethInfo(amap.g, ty, None, md, mtps), None) /// Build IL method infos for a C#-style extension method static member CreateILExtensionMeth (amap, m, apparentTy: TType, declaringTyconRef: TyconRef, extMethPri, md: ILMethodDef) = let scoref = declaringTyconRef.CompiledRepresentationForNamedType.Scope - let mtps = Import.ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams + let mtps = ImportILGenericParameters (fun () -> amap) m scoref [] md.GenericParams ILMeth (amap.g, ILMethInfo(amap.g, apparentTy, Some declaringTyconRef, md, mtps), extMethPri) /// Tests whether two method infos have the same underlying definition. @@ -1420,7 +1027,7 @@ type MethInfo = | ProvidedMeth(amap, mi, _, m) -> // A single group of tupled arguments [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do - yield Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] + yield ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) ] ] #endif /// Get the (zero or one) 'self'/'this'/'object' arguments associated with a method. @@ -1442,7 +1049,7 @@ type MethInfo = | DefaultStructCtor _ -> [] #if !NO_TYPEPROVIDERS | ProvidedMeth(amap, mi, _, m) -> - if x.IsInstance then [ Import.ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument + if x.IsInstance then [ ImportProvidedType amap m (mi.PApply((fun mi -> mi.DeclaringType), m)) ] // find the type of the 'this' argument else [] #endif @@ -1623,7 +1230,7 @@ type MethInfo = let formalParams = [ [ for p in mi.PApplyArray((fun mi -> mi.GetParameters()), "GetParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some s), m) - let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let paramType = ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) let isIn, isOut, isOptional = p.PUntaint((fun p -> p.IsIn, p.IsOut, p.IsOptional), m) yield TSlotParam(paramName, paramType, isIn, isOut, isOptional, []) ] ] formalRetTy, formalParams @@ -1656,7 +1263,7 @@ type MethInfo = let pty = match p.PApply((fun p -> p.ParameterType), m) with | Tainted.Null -> amap.g.unit_ty - | parameterType -> Import.ImportProvidedType amap m parameterType + | parameterType -> ImportProvidedType amap m parameterType yield ParamNameAndType(pname, pty) ] ] #endif @@ -1700,7 +1307,7 @@ type ILFieldInfo = | ILFieldInfo of ilTypeInfo: ILTypeInfo * ilFieldDef: ILFieldDef #if !NO_TYPEPROVIDERS /// Represents a single use of a field backed by provided metadata - | ProvidedField of amap: Import.ImportMap * providedField: Tainted * range: range + | ProvidedField of amap: ImportMap * providedField: Tainted * range: range #endif /// Get the enclosing ("parent"/"declaring") type of the field. @@ -1708,7 +1315,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ToType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) + | ProvidedField(amap, fi, m) -> (ImportProvidedType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))) #endif member x.ApparentEnclosingAppType = x.ApparentEnclosingType @@ -1729,7 +1336,7 @@ type ILFieldInfo = match x with | ILFieldInfo(tinfo, _) -> tinfo.ILTypeRef #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> (Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef + | ProvidedField(amap, fi, m) -> (ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.DeclaringType), m))).TypeRef #endif /// Get the scope used to interpret IL metadata @@ -1800,7 +1407,7 @@ type ILFieldInfo = match x with | ILFieldInfo (_, fdef) -> fdef.FieldType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> Import.ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) + | ProvidedField(amap, fi, m) -> ImportProvidedTypeAsILType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Get the type of the field as an F# type @@ -1808,7 +1415,7 @@ type ILFieldInfo = match x with | ILFieldInfo (tinfo, fdef) -> ImportILTypeFromMetadata amap m tinfo.ILScopeRef tinfo.TypeInstOfRawMetadata [] fdef.FieldType #if !NO_TYPEPROVIDERS - | ProvidedField(amap, fi, m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) + | ProvidedField(amap, fi, m) -> ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType), m)) #endif /// Tests whether two infos have the same underlying definition. @@ -2002,7 +1609,7 @@ type PropInfo = #if !NO_TYPEPROVIDERS /// An F# use of a property backed by provided metadata - | ProvidedProp of amap: Import.ImportMap * providedProp: Tainted * range: range + | ProvidedProp of amap: ImportMap * providedProp: Tainted * range: range #endif /// Get the enclosing type of the property. @@ -2014,7 +1621,7 @@ type PropInfo = | FSProp(_, ty, _, _) -> ty #if !NO_TYPEPROVIDERS | ProvidedProp(amap, pi, m) -> - Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) + ImportProvidedType amap m (pi.PApply((fun pi -> pi.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types @@ -2241,7 +1848,7 @@ type PropInfo = | FSProp _ -> failwith "unreachable" #if !NO_TYPEPROVIDERS | ProvidedProp(_, pi, m) -> - Import.ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) + ImportProvidedType amap m (pi.PApply((fun pi -> pi.PropertyType), m)) #endif /// Get the names and types of the indexer parameters associated with the property @@ -2259,7 +1866,7 @@ type PropInfo = | ProvidedProp (_, pi, m) -> [ for p in pi.PApplyArray((fun pi -> pi.GetIndexParameters()), "GetIndexParameters", m) do let paramName = p.PUntaint((fun p -> match p.Name with null -> None | s -> Some (mkSynId m s)), m) - let paramType = Import.ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) + let paramType = ImportProvidedType amap m (p.PApply((fun p -> p.ParameterType), m)) yield ParamNameAndType(paramName, paramType) ] #endif @@ -2419,7 +2026,7 @@ type EventInfo = #if !NO_TYPEPROVIDERS /// An F# use of an event backed by provided metadata - | ProvidedEvent of amap: Import.ImportMap * providedEvent: Tainted * range: range + | ProvidedEvent of amap: ImportMap * providedEvent: Tainted * range: range #endif /// Get the enclosing type of the event. @@ -2430,7 +2037,7 @@ type EventInfo = | ILEvent ileinfo -> ileinfo.ApparentEnclosingType | FSEvent (_, p, _, _) -> p.ApparentEnclosingType #if !NO_TYPEPROVIDERS - | ProvidedEvent (amap, ei, m) -> Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) + | ProvidedEvent (amap, ei, m) -> ImportProvidedType amap m (ei.PApply((fun ei -> ei.DeclaringType), m)) #endif /// Get the enclosing type of the method info, using a nominal type for tuple types member x.ApparentEnclosingAppType = @@ -2553,7 +2160,7 @@ type EventInfo = FindDelegateTypeOfPropertyEvent g amap x.EventName m (p.GetPropertyType(amap, m)) #if !NO_TYPEPROVIDERS | ProvidedEvent (_, ei, _) -> - Import.ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) + ImportProvidedType amap m (ei.PApply((fun ei -> ei.EventHandlerType), m)) #endif /// Test whether two event infos have the same underlying definition. diff --git a/src/fsharp/infos.fsi b/src/fsharp/infos.fsi index 183f8ccd199..b0af49e2f60 100644 --- a/src/fsharp/infos.fsi +++ b/src/fsharp/infos.fsi @@ -16,171 +16,6 @@ open FSharp.Compiler.TypedTreeOps open FSharp.Compiler.TypeProviders #endif -/// Import an IL type as an F# type. importInst gives the context for interpreting type variables. -val ImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType - -val CanImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool - -/// Indicates if an F# type is the type associated with an F# exception declaration -val isExnDeclTy: g: TcGlobals -> ty: TType -> bool - -/// Get the base type of a type, taking into account type instantiations. Return None if the -/// type has no base type. -val GetSuperTypeOfType: g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option - -/// Indicates whether we can skip interface types that lie outside the reference set -[] -type SkipUnrefInterfaces = - | Yes - | No - -/// Collect the set of immediate declared interface types for an F# type, but do not -/// traverse the type hierarchy to collect further interfaces. -val GetImmediateInterfacesOfType: - skipUnref: SkipUnrefInterfaces -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType list - -/// Indicates whether we should visit multiple instantiations of the same generic interface or not -[] -type AllowMultiIntfInstantiations = - | Yes - | No - -/// Fold, do not follow interfaces (unless the type is itself an interface) -val FoldPrimaryHierarchyOfType: - f: (TType -> 'a -> 'a) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - acc: 'a -> - 'a - -/// Fold, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -val FoldEntireHierarchyOfType: - f: (TType -> 'a -> 'a) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - acc: 'a -> - 'a - -/// Iterate, following interfaces. Skipping interfaces that lie outside the referenced assembly set is allowed. -val IterateEntireHierarchyOfType: - f: (TType -> unit) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - unit - -/// Search for one element satisfying a predicate, following interfaces -val ExistsInEntireHierarchyOfType: - f: (TType -> bool) -> - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - bool - -/// Search for one element where a function returns a 'Some' result, following interfaces -val SearchEntireHierarchyOfType: - f: (TType -> bool) -> g: TcGlobals -> amap: ImportMap -> m: range -> ty: TType -> TType option - -/// Get all super types of the type, including the type itself -val AllSuperTypesOfType: - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - TType list - -/// Get all interfaces of a type, including the type itself if it is an interface -val AllInterfacesOfType: - g: TcGlobals -> - amap: ImportMap -> - m: range -> - allowMultiIntfInst: AllowMultiIntfInstantiations -> - ty: TType -> - TType list - -/// Check if two types have the same nominal head type -val HaveSameHeadType: g: TcGlobals -> ty1: TType -> ty2: TType -> bool - -/// Check if a type has a particular head type -val HasHeadType: g: TcGlobals -> tcref: TyconRef -> ty2: TType -> bool - -/// Check if a type exists somewhere in the hierarchy which has the same head type as the given type (note, the given type need not have a head type at all) -val ExistsSameHeadTypeInHierarchy: - g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> typeToLookFor: TType -> bool - -/// Check if a type exists somewhere in the hierarchy which has the given head type. -val ExistsHeadTypeInEntireHierarchy: - g: TcGlobals -> amap: ImportMap -> m: range -> typeToSearchFrom: TType -> tcrefToLookFor: TyconRef -> bool - -/// Read an Abstract IL type from metadata and convert to an F# type. -val ImportILTypeFromMetadata: - amap: ImportMap -> m: range -> scoref: ILScopeRef -> tinst: TType list -> minst: TType list -> ilty: ILType -> TType - -/// Read an Abstract IL type from metadata, including any attributes that may affect the type itself, and convert to an F# type. -val ImportILTypeFromMetadataWithAttributes: - amap: ImportMap -> - m: range -> - scoref: ILScopeRef -> - tinst: TType list -> - minst: TType list -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - TType - -/// Get the parameter type of an IL method. -val ImportParameterTypeFromMetadata: - amap: ImportMap -> - m: range -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - scoref: ILScopeRef -> - tinst: TType list -> - mist: TType list -> - TType - -/// Get the return type of an IL method, taking into account instantiations for type, return attributes and method generic parameters, and -/// translating 'void' to 'None'. -val ImportReturnTypeFromMetadata: - amap: ImportMap -> - m: range -> - ilty: ILType -> - getCattrs: (unit -> ILAttributes) -> - scoref: ILScopeRef -> - tinst: TType list -> - minst: TType list -> - TType option - -/// Copy constraints. If the constraint comes from a type parameter associated -/// with a type constructor then we are simply renaming type variables. If it comes -/// from a generic method in a generic class (e.g. ty.M<_>) then we may be both substituting the -/// instantiation associated with 'ty' as well as copying the type parameters associated with -/// M and instantiating their constraints -/// -/// Note: this now looks identical to constraint instantiation. - -val CopyTyparConstraints: m: range -> tprefInst: TyparInst -> tporig: Typar -> TyparConstraint list - -/// The constraints for each typar copied from another typar can only be fixed up once -/// we have generated all the new constraints, e.g. f List, B :> List> ... -val FixupNewTypars: - m: range -> - formalEnclosingTypars: Typars -> - tinst: TType list -> - tpsorig: Typars -> - tps: Typars -> - TyparInst * TTypes - type ValRef with /// Indicates if an F#-declared function or member value is a CLIEvent property compiled as a .NET event diff --git a/src/fsharp/lex.fsl b/src/fsharp/lex.fsl index be194d99cc2..bc06a67f684 100644 --- a/src/fsharp/lex.fsl +++ b/src/fsharp/lex.fsl @@ -21,7 +21,7 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open FSharp.Compiler.AbstractIL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.IO open FSharp.Compiler.Lexhelp diff --git a/src/fsharp/lexhelp.fs b/src/fsharp/lexhelp.fs index ac67680eef2..698ada21335 100644 --- a/src/fsharp/lexhelp.fs +++ b/src/fsharp/lexhelp.fs @@ -10,7 +10,7 @@ open Internal.Utilities.Library open Internal.Utilities.Text.Lexing open FSharp.Compiler.IO -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.UnicodeLexing @@ -52,7 +52,7 @@ type LexArgs = { conditionalDefines: string list resourceManager: LexResourceManager - errorLogger: ErrorLogger + errorLogger: DiagnosticsLogger applyLineDirectives: bool pathMap: PathMap mutable ifdefStack: LexerIfdefStack diff --git a/src/fsharp/lexhelp.fsi b/src/fsharp/lexhelp.fsi index 7c17152fa8e..246da511506 100644 --- a/src/fsharp/lexhelp.fsi +++ b/src/fsharp/lexhelp.fsi @@ -6,7 +6,7 @@ open FSharp.Compiler.IO open Internal.Utilities open Internal.Utilities.Text -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.ParseHelpers open FSharp.Compiler.UnicodeLexing open FSharp.Compiler.Parser @@ -32,7 +32,7 @@ type LexResourceManager = type LexArgs = { conditionalDefines: string list resourceManager: LexResourceManager - errorLogger: ErrorLogger + errorLogger: DiagnosticsLogger applyLineDirectives: bool pathMap: PathMap mutable ifdefStack: LexerIfdefStack @@ -51,7 +51,7 @@ val mkLexargs: lightStatus: IndentationAwareSyntaxStatus * resourceManager: LexResourceManager * ifdefStack: LexerIfdefStack * - errorLogger: ErrorLogger * + errorLogger: DiagnosticsLogger * pathMap: PathMap -> LexArgs diff --git a/src/fsharp/pars.fsy b/src/fsharp/pars.fsy index 3bf8597b5ce..17765843400 100644 --- a/src/fsharp/pars.fsy +++ b/src/fsharp/pars.fsy @@ -14,7 +14,7 @@ open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.AbstractIL open FSharp.Compiler.AbstractIL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/pplex.fsl b/src/fsharp/pplex.fsl index fdd59bc6f81..4b6da64ff55 100644 --- a/src/fsharp/pplex.fsl +++ b/src/fsharp/pplex.fsl @@ -6,7 +6,7 @@ module internal FSharp.Compiler.PPLexer open System -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Lexhelp open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/pppars.fsy b/src/fsharp/pppars.fsy index 5775c898670..53616c481e6 100644 --- a/src/fsharp/pppars.fsy +++ b/src/fsharp/pppars.fsy @@ -1,7 +1,7 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. %{ -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax diff --git a/src/fsharp/service/FSharpCheckerResults.fs b/src/fsharp/service/FSharpCheckerResults.fs index 5e04d0cc569..7398e1d00ea 100644 --- a/src/fsharp/service/FSharpCheckerResults.fs +++ b/src/fsharp/service/FSharpCheckerResults.fs @@ -26,7 +26,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices open FSharp.Compiler.EditorServices.DeclarationListHelpers -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader @@ -1115,7 +1115,7 @@ type internal TypeCheckInfo /// Determines if a long ident is resolvable at a specific point. member _.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = - ErrorScope.Protect + DiagnosticsScope.Protect range0 (fun () -> /// Find items in the best naming environment. @@ -1132,7 +1132,7 @@ type internal TypeCheckInfo /// Get the auto-complete items at a location member _.GetDeclarations (parseResultsOpt, line, lineStr, partialName, completionContextAtPos, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1159,7 +1159,7 @@ type internal TypeCheckInfo /// Get the symbols for auto-complete items at a location member _.GetDeclarationListSymbols (parseResultsOpt, line, lineStr, partialName, getAllEntities) = let isInterfaceFile = SourceFileImpl.IsInterfaceFile mainInputFileName - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1282,7 +1282,7 @@ type internal TypeCheckInfo let tip = LayoutRender.toArray tip ToolTipElement.Single(tip, FSharpXmlDoc.None)] - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 dataTipOfReferences (fun err -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetReferenceResolutionStructuredToolTipText: '%s'" err) @@ -1302,7 +1302,7 @@ type internal TypeCheckInfo // GetToolTipText: return the "pop up" (or "Quick Info") text given a certain context. member _.GetStructuredToolTipText(line, lineStr, colAtEndOfNames, names) = let Compute() = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition(None, Some names, None, None, @@ -1328,7 +1328,7 @@ type internal TypeCheckInfo res member _.GetF1Keyword (line, lineStr, colAtEndOfNames, names) : string option = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1366,7 +1366,7 @@ type internal TypeCheckInfo None) member _.GetMethods (line, lineStr, colAtEndOfNames, namesOpt) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1390,7 +1390,7 @@ type internal TypeCheckInfo MethodGroup(msg,[| |])) member _.GetMethodsAsSymbols (line, lineStr, colAtEndOfNames, names) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition (None, Some names, None, @@ -1410,7 +1410,7 @@ type internal TypeCheckInfo None) member _.GetDeclarationLocation (line, lineStr, colAtEndOfNames, names, preferFlag) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = @@ -1519,7 +1519,7 @@ type internal TypeCheckInfo FindDeclResult.DeclNotFound (FindDeclFailureReason.Unknown msg)) member _.GetSymbolUseAtLocation (line, lineStr, colAtEndOfNames, names) = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let declItemsOpt = GetDeclItemsForNamesAtPosition (None, Some names, None, None, @@ -1605,7 +1605,7 @@ type FSharpParsingOptions = static member FromTcConfig(tcConfig: TcConfig, sourceFiles, isInteractive: bool) = { SourceFiles = sourceFiles ConditionalDefines = tcConfig.conditionalDefines - ErrorSeverityOptions = tcConfig.errorSeverityOptions + ErrorSeverityOptions = tcConfig.diagnosticsOptions LangVersionText = tcConfig.langVersion.VersionText IsInteractive = isInteractive IndentationAwareSyntax = tcConfig.indentationAwareSyntax @@ -1616,7 +1616,7 @@ type FSharpParsingOptions = { SourceFiles = sourceFiles ConditionalDefines = tcConfigB.conditionalDefines - ErrorSeverityOptions = tcConfigB.errorSeverityOptions + ErrorSeverityOptions = tcConfigB.diagnosticsOptions LangVersionText = tcConfigB.langVersion.VersionText IsInteractive = isInteractive IndentationAwareSyntax = tcConfigB.indentationAwareSyntax @@ -1627,8 +1627,8 @@ type FSharpParsingOptions = module internal ParseAndCheckFile = /// Error handler for parsing & type checking while processing a single file - type ErrorHandler(reportErrors, mainInputFileName, errorSeverityOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = - let mutable options = errorSeverityOptions + type ErrorHandler(reportErrors, mainInputFileName, diagnosticsOptions: FSharpDiagnosticOptions, sourceText: ISourceText, suggestNamesForErrors: bool) = + let mutable options = diagnosticsOptions let errorsAndWarningsCollector = ResizeArray<_>() let mutable errorCount = 0 @@ -1659,12 +1659,12 @@ module internal ParseAndCheckFile = | e -> report e let errorLogger = - { new ErrorLogger("ErrorHandler") with + { new DiagnosticsLogger("ErrorHandler") with member x.DiagnosticSink (exn, severity) = diagnosticSink severity exn member x.ErrorCount = errorCount } // Public members - member _.ErrorLogger = errorLogger + member _.DiagnosticsLogger = errorLogger member _.CollectedDiagnostics = errorsAndWarningsCollector.ToArray() @@ -1693,7 +1693,7 @@ module internal ParseAndCheckFile = // When analyzing files using ParseOneFile, i.e. for the use of editing clients, we do not apply line directives. // TODO(pathmap): expose PathMap on the service API, and thread it through here - let lexargs = mkLexargs(conditionalDefines, lightStatus, lexResourceManager, [], errHandler.ErrorLogger, PathMap.empty) + let lexargs = mkLexargs(conditionalDefines, lightStatus, lexResourceManager, [], errHandler.DiagnosticsLogger, PathMap.empty) let lexargs = { lexargs with applyLineDirectives = false } let tokenizer = LexFilter.LexFilter(lightStatus, options.CompilingFsLib, Lexer.token lexargs true, lexbuf) @@ -1703,15 +1703,15 @@ module internal ParseAndCheckFile = UnicodeLexing.SourceTextAsLexbuf(true, LanguageVersion(langVersion), sourceText) let matchBraces(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = - let delayedLogger = CapturingErrorLogger("matchBraces") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + let delayedLogger = CapturingDiagnosticsLogger("matchBraces") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "matchBraces", fileName) - // Make sure there is an ErrorLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors - let delayedLogger = CapturingErrorLogger("matchBraces") - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> delayedLogger) + // Make sure there is an DiagnosticsLogger installed whenever we do stuff that might record errors, even if we ultimately ignore the errors + let delayedLogger = CapturingDiagnosticsLogger("matchBraces") + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> delayedLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let matchingBraces = ResizeArray<_>() @@ -1788,7 +1788,7 @@ module internal ParseAndCheckFile = let parseFile(sourceText: ISourceText, fileName, options: FSharpParsingOptions, userOpName: string, suggestNamesForErrors: bool) = Trace.TraceInformation("FCS: {0}.{1} ({2})", userOpName, "parseFile", fileName) let errHandler = ErrorHandler(true, fileName, options.ErrorSeverityOptions, sourceText, suggestNamesForErrors) - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse let parseResult = @@ -1801,9 +1801,9 @@ module internal ParseAndCheckFile = let isExe = options.IsExe try - ParseInput(lexfun, options.ErrorSeverityOptions, errHandler.ErrorLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) + ParseInput(lexfun, options.ErrorSeverityOptions, errHandler.DiagnosticsLogger, lexbuf, None, fileName, (isLastCompiland, isExe)) with e -> - errHandler.ErrorLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. + errHandler.DiagnosticsLogger.StopProcessingRecovery e range0 // don't re-raise any exceptions, we must return None. EmptyParsedInput(fileName, (isLastCompiland, isExe))) errHandler.CollectedDiagnostics, parseResult, errHandler.AnyErrors @@ -1903,16 +1903,16 @@ module internal ParseAndCheckFile = let parsedMainInput = parseResults.ParseTree // Initialize the error handler - let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.errorSeverityOptions, sourceText, suggestNamesForErrors) + let errHandler = ErrorHandler(true, mainInputFileName, tcConfig.diagnosticsOptions, sourceText, suggestNamesForErrors) - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.ErrorLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> errHandler.DiagnosticsLogger) use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck // Apply nowarns to tcConfig (may generate errors, so ensure errorLogger is installed) let tcConfig = ApplyNoWarnsToTcConfig (tcConfig, parsedMainInput,Path.GetDirectoryName mainInputFileName) // update the error handler with the modified tcConfig - errHandler.ErrorSeverityOptions <- tcConfig.errorSeverityOptions + errHandler.ErrorSeverityOptions <- tcConfig.diagnosticsOptions // Play background errors and warnings for this file. do for err, severity in backgroundDiagnostics do @@ -1939,7 +1939,7 @@ module internal ParseAndCheckFile = // Typecheck is potentially a long running operation. We chop it up here with an Eventually continuation and, at each slice, give a chance // for the client to claim the result as obsolete and have the typecheck abort. - use _unwind = new CompilationGlobalsScope (errHandler.ErrorLogger, BuildPhase.TypeCheck) + use _unwind = new CompilationGlobalsScope (errHandler.DiagnosticsLogger, BuildPhase.TypeCheck) let! result = CheckOneInputAndFinish(checkForErrors, tcConfig, tcImports, tcGlobals, None, TcResultsSink.WithSink sink, tcState, parsedMainInput) diff --git a/src/fsharp/service/FSharpCheckerResults.fsi b/src/fsharp/service/FSharpCheckerResults.fsi index a8e65487a28..c7fea4e9b61 100644 --- a/src/fsharp/service/FSharpCheckerResults.fsi +++ b/src/fsharp/service/FSharpCheckerResults.fsi @@ -15,7 +15,7 @@ open FSharp.Compiler.CompilerConfig open FSharp.Compiler.CompilerImports open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Symbols open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs diff --git a/src/fsharp/service/FSharpParseFileResults.fs b/src/fsharp/service/FSharpParseFileResults.fs index d67044ea10d..9ee0e816b52 100644 --- a/src/fsharp/service/FSharpParseFileResults.fs +++ b/src/fsharp/service/FSharpParseFileResults.fs @@ -456,7 +456,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, /// Get declared items and the selected item at the specified location member _.GetNavigationItemsImpl() = - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> match input with | ParsedInput.ImplFile _ as p -> @@ -808,7 +808,7 @@ type FSharpParseFileResults(diagnostics: FSharpDiagnostic[], input: ParsedInput, | ParsedInput.ImplFile (ParsedImplFileInput (modules = modules)) -> walkImplFile modules | _ -> [] - ErrorScope.Protect range0 + DiagnosticsScope.Protect range0 (fun () -> let locations = findBreakPoints() diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 2ea43ba718e..52f827079a7 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -4,6 +4,7 @@ namespace FSharp.Compiler.CodeAnalysis open System open System.Collections.Generic +open System.Diagnostics open System.IO open System.Threading open Internal.Utilities.Library @@ -22,7 +23,7 @@ open FSharp.Compiler.CreateILModule open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.NameResolution @@ -109,7 +110,7 @@ module IncrementalBuildSyntaxTree = let mutable weakCache: WeakReference<_> option = None let parse(sigNameOpt: QualifiedNameOfFile option) = - let errorLogger = CompilationErrorLogger("Parse", tcConfig.errorSeverityOptions) + let errorLogger = CompilationDiagnosticLogger("Parse", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parse) @@ -467,8 +468,8 @@ type BoundModel private (tcConfig: TcConfig, | input, _sourceRange, fileName, parseErrors -> IncrementalBuilderEventTesting.MRU.Add(IncrementalBuilderEventTesting.IBETypechecked fileName) - let capturingErrorLogger = CapturingErrorLogger("TypeCheck") - let errorLogger = GetErrorLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.errorSeverityOptions, capturingErrorLogger) + let capturingDiagnosticsLogger = CapturingDiagnosticsLogger("TypeCheck") + let errorLogger = GetDiagnosticsLoggerFilteringByScopedPragmas(false, GetScopedPragmasForInput input, tcConfig.diagnosticsOptions, capturingDiagnosticsLogger) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) beforeFileChecked.Trigger fileName @@ -498,7 +499,7 @@ type BoundModel private (tcConfig: TcConfig, Logger.LogBlockMessageStop fileName LogCompilerFunctionId.IncrementalBuild_TypeCheck fileChecked.Trigger fileName - let newErrors = Array.append parseErrors (capturingErrorLogger.Diagnostics |> List.toArray) + let newErrors = Array.append parseErrors (capturingDiagnosticsLogger.Diagnostics |> List.toArray) let tcEnvAtEndOfFile = if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls let tcInfo = @@ -746,7 +747,7 @@ module IncrementalBuilderHelpers = fileChecked, importsInvalidatedByTypeProvider: Event) : NodeCode = node { - let errorLogger = CompilationErrorLogger("CombineImportedAssembliesTask", tcConfig.errorSeverityOptions) + let errorLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) let! tcImports = @@ -777,7 +778,7 @@ module IncrementalBuilderHelpers = #endif return tcImports with exn -> - System.Diagnostics.Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" exn) + Debug.Assert(false, sprintf "Could not BuildAllReferencedDllTcImports %A" exn) errorLogger.Warning exn return frameworkTcImports } @@ -839,7 +840,7 @@ module IncrementalBuilderHelpers = /// Finish up the typechecking to produce outputs for the rest of the compilation process let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: block) = node { - let errorLogger = CompilationErrorLogger("FinalizeTypeCheckTask", tcConfig.errorSeverityOptions) + let errorLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) let! results = @@ -1402,7 +1403,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc node { // Trap and report warnings and errors from creation. - let delayedLogger = CapturingErrorLogger("IncrementalBuilderCreation") + let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) let! builderOpt = @@ -1513,8 +1514,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorOptions = tcConfig.errorSeverityOptions - let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) + let errorLogger = CompilationDiagnosticLogger("nonFrameworkAssemblyInputs", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) // Get the names and time stamps of all the non-framework referenced assemblies, which will act @@ -1524,7 +1524,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let nonFrameworkAssemblyInputs = // Note we are not calling errorLogger.GetDiagnostics() anywhere for this task. // This is ok because not much can actually go wrong here. - let errorLogger = CompilationErrorLogger("nonFrameworkAssemblyInputs", errorOptions) + let errorLogger = CompilationDiagnosticLogger("nonFrameworkAssemblyInputs", tcConfig.diagnosticsOptions) // Return the disposable object that cleans up use _holder = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -1535,10 +1535,6 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc for pr in projectReferences do yield Choice2Of2 pr, (fun (cache: TimeStampCache) -> cache.GetProjectReferenceTimeStamp pr) ] - // - // - // - // // Start importing let tcConfigP = TcConfigProvider.Constant tcConfig @@ -1639,8 +1635,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc let diagnostics = match builderOpt with | Some builder -> - let errorSeverityOptions = builder.TcConfig.errorSeverityOptions - let errorLogger = CompilationErrorLogger("IncrementalBuilderCreation", errorSeverityOptions) + let diagnosticsOptions = builder.TcConfig.diagnosticsOptions + let errorLogger = CompilationDiagnosticLogger("IncrementalBuilderCreation", diagnosticsOptions) delayedLogger.CommitDelayedDiagnostics errorLogger errorLogger.GetDiagnostics() | _ -> diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index ac4b206eb54..28945e789e0 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -12,7 +12,7 @@ open FSharp.Compiler.CompilerImports open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure diff --git a/src/fsharp/service/SemanticClassification.fs b/src/fsharp/service/SemanticClassification.fs index 1f55a0e5c70..0cb7f19ba78 100644 --- a/src/fsharp/service/SemanticClassification.fs +++ b/src/fsharp/service/SemanticClassification.fs @@ -9,7 +9,7 @@ open Internal.Utilities.Library open FSharp.Compiler.Diagnostics open FSharp.Compiler.Import open FSharp.Compiler.Infos -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.TcGlobals @@ -17,6 +17,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy type SemanticClassificationType = | ReferenceType = 0 @@ -71,7 +72,7 @@ module TcResolutionsExtensions = type TcResolutions with member sResolutions.GetSemanticClassification(g: TcGlobals, amap: ImportMap, formatSpecifierLocations: (range * int) [], range: range option) : SemanticClassificationItem [] = - ErrorScope.Protect range0 (fun () -> + DiagnosticsScope.Protect range0 (fun () -> let (|LegitTypeOccurence|_|) = function | ItemOccurence.UseInType | ItemOccurence.UseInAttribute @@ -341,7 +342,7 @@ module TcResolutionsExtensions = | Item.UnqualifiedType (tcref :: _), LegitTypeOccurence, _, _, _, m -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then add m SemanticClassificationType.Enumeration - elif tcref.IsExceptionDecl then + elif tcref.IsFSharpException then add m SemanticClassificationType.Exception elif tcref.IsFSharpDelegateTycon then add m SemanticClassificationType.Delegate diff --git a/src/fsharp/service/ServiceAssemblyContent.fs b/src/fsharp/service/ServiceAssemblyContent.fs index e65d12b8fa4..0a89eb646d2 100644 --- a/src/fsharp/service/ServiceAssemblyContent.fs +++ b/src/fsharp/service/ServiceAssemblyContent.fs @@ -247,7 +247,7 @@ module AssemblyContent = // are not triggered (see "if not entity.IsProvided") and the other data accessed is immutable or computed safely // on-demand. However a more compete review may be warranted. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() signature.TryGetEntities() |> Seq.collect (traverseEntity contentType Parent.Empty) @@ -265,7 +265,7 @@ module AssemblyContent = // concurrently with other threads. On an initial review this is not a problem since type provider computations // are not triggered (see "if not entity.IsProvided") and the other data accessed is immutable or computed safely // on-demand. However a more compete review may be warranted. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() #if !NO_TYPEPROVIDERS match assemblies |> List.filter (fun x -> not x.IsProviderGenerated), fileName with diff --git a/src/fsharp/service/ServiceCompilerDiagnostics.fs b/src/fsharp/service/ServiceCompilerDiagnostics.fs index abbedea37d2..f61b8ad9b6f 100644 --- a/src/fsharp/service/ServiceCompilerDiagnostics.fs +++ b/src/fsharp/service/ServiceCompilerDiagnostics.fs @@ -17,7 +17,7 @@ module CompilerDiagnostics = | FSharpDiagnosticKind.AddIndexerDot -> FSComp.SR.addIndexerDot() | FSharpDiagnosticKind.ReplaceWithSuggestion s -> FSComp.SR.replaceWithSuggestion(s) - let GetSuggestedNames (suggestionsF: FSharp.Compiler.ErrorLogger.Suggestions) (unresolvedIdentifier: string) = + let GetSuggestedNames (suggestionsF: FSharp.Compiler.DiagnosticsLogger.Suggestions) (unresolvedIdentifier: string) = let buffer = SuggestionBuffer(unresolvedIdentifier) if buffer.Disabled then Seq.empty diff --git a/src/fsharp/service/ServiceDeclarationLists.fs b/src/fsharp/service/ServiceDeclarationLists.fs index e0ec1e81016..cae7ebfe708 100644 --- a/src/fsharp/service/ServiceDeclarationLists.fs +++ b/src/fsharp/service/ServiceDeclarationLists.fs @@ -14,7 +14,7 @@ open FSharp.Compiler.AbstractIL.Diagnostics open FSharp.Compiler.AccessibilityLogic open FSharp.Compiler.Diagnostics open FSharp.Compiler.EditorServices -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution @@ -222,7 +222,7 @@ module DeclarationListHelpers = let remarks = toArray remarks ToolTipElement.Single (layout, xml, remarks=remarks) - | Item.RecdField rfinfo when rfinfo.TyconRef.IsExceptionDecl -> + | Item.RecdField rfinfo when rfinfo.TyconRef.IsFSharpException -> let ty, _ = PrettyTypes.PrettifyType g rfinfo.FieldType let id = rfinfo.RecdField.Id let layout = @@ -459,7 +459,7 @@ module DeclarationListHelpers = /// Format the structured version of a tooltip for an item let FormatStructuredDescriptionOfItem isDecl infoReader ad m denv item = - ErrorScope.Protect m + DiagnosticsScope.Protect m (fun () -> FormatItemDescriptionToToolTipElement isDecl infoReader ad m denv item) (fun err -> ToolTipElement.CompositionError err) @@ -857,7 +857,7 @@ module internal DescriptionListsImpl = | Item.Types _ -> FSharpGlyph.Class | Item.UnqualifiedType (tcref :: _) -> if tcref.IsEnumTycon || tcref.IsILEnumTycon then FSharpGlyph.Enum - elif tcref.IsExceptionDecl then FSharpGlyph.Exception + elif tcref.IsFSharpException then FSharpGlyph.Exception elif tcref.IsFSharpDelegateTycon then FSharpGlyph.Delegate elif tcref.IsFSharpInterfaceTycon then FSharpGlyph.Interface elif tcref.IsFSharpStructOrEnumTycon then FSharpGlyph.Struct @@ -1183,7 +1183,7 @@ type MethodGroup( name: string, unsortedMethods: MethodGroupItem[] ) = let methods = flatItems |> Array.ofList |> Array.map (fun flatItem -> let prettyParams, prettyRetTyL = - ErrorScope.Protect m + DiagnosticsScope.Protect m (fun () -> PrettyParamsAndReturnTypeOfItem infoReader m denv { item with Item = flatItem }) (fun err -> [], wordL (tagText err)) diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 8996aa276ee..8d06ddfac77 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -11,7 +11,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.Lexhelp open FSharp.Compiler.Parser @@ -822,7 +822,7 @@ type FSharpLineTokenizer(lexbuf: UnicodeLexing.Lexbuf, member x.ScanToken (lexState: FSharpTokenizerLexState) : FSharpTokenInfo option * FSharpTokenizerLexState = use unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) let lightStatus, lexcont = LexerStateEncoding.decodeLexInt lexState let lightStatus = IndentationAwareSyntaxStatus(lightStatus, false) @@ -1511,7 +1511,7 @@ type FSharpToken = [] module FSharpLexerImpl = - let lexWithErrorLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion errorLogger onToken pathMap (ct: CancellationToken) = + let lexWithDiagnosticsLogger (text: ISourceText) conditionalDefines (flags: FSharpLexerFlags) reportLibraryOnlyFeatures langVersion errorLogger onToken pathMap (ct: CancellationToken) = let canSkipTrivia = (flags &&& FSharpLexerFlags.SkipTrivia) = FSharpLexerFlags.SkipTrivia let isLightSyntaxOn = (flags &&& FSharpLexerFlags.LightSyntaxOn) = FSharpLexerFlags.LightSyntaxOn let isCompiling = (flags &&& FSharpLexerFlags.Compiling) = FSharpLexerFlags.Compiling @@ -1533,7 +1533,7 @@ module FSharpLexerImpl = lexer use _unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use _unwindEL = PushErrorLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) + use _unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> DiscardErrorsLogger) resetLexbufPos "" lexbuf while not lexbuf.IsPastEndOfStream do @@ -1541,8 +1541,8 @@ module FSharpLexerImpl = onToken (getNextToken lexbuf) lexbuf.LexemeRange let lex text conditionalDefines flags reportLibraryOnlyFeatures langVersion lexCallback pathMap ct = - let errorLogger = CompilationErrorLogger("Lexer", FSharpDiagnosticOptions.Default) - lexWithErrorLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion errorLogger lexCallback pathMap ct + let errorLogger = CompilationDiagnosticLogger("Lexer", FSharpDiagnosticOptions.Default) + lexWithDiagnosticsLogger text conditionalDefines flags reportLibraryOnlyFeatures langVersion errorLogger lexCallback pathMap ct [] type FSharpLexer = diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index 0ef54b9058e..d48c16a49d7 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -1610,7 +1610,7 @@ module ParsedInput = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() let mutable result = None let mutable ns = None @@ -1742,7 +1742,7 @@ module ParsedInput = // We ignore all diagnostics during this operation // // Based on an initial review, no diagnostics should be generated. However the code should be checked more closely. - use _ignoreAllDiagnostics = new ErrorScope() + use _ignoreAllDiagnostics = new DiagnosticsScope() match res with | None -> [||] | Some (scope, ns, pos) -> diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 33138220c4c..7895de1ffe1 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -22,7 +22,7 @@ open FSharp.Compiler.CompilerOptions open FSharp.Compiler.DependencyManager open FSharp.Compiler.Diagnostics open FSharp.Compiler.Driver -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.IO open FSharp.Compiler.ParseAndCheckInputs open FSharp.Compiler.ScriptClosure @@ -95,18 +95,18 @@ module CompileHelpers = List.iter oneError relatedErrors let errorLogger = - { new ErrorLogger("CompileAPI") with + { new DiagnosticsLogger("CompileAPI") with member x.DiagnosticSink(exn, isError) = errorSink isError exn member x.ErrorCount = errors |> Seq.filter (fun e -> e.Severity = FSharpDiagnosticSeverity.Error) |> Seq.length } let loggerProvider = - { new ErrorLoggerProvider() with - member x.CreateErrorLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } + { new DiagnosticsLoggerProvider() with + member x.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } errors, errorLogger, loggerProvider let tryCompile errorLogger f = use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse - use unwindEL_2 = PushErrorLoggerPhaseUntilUnwind (fun _ -> errorLogger) + use unwindEL_2 = PushDiagnosticsLoggerPhaseUntilUnwind (fun _ -> errorLogger) let exiter = { new Exiter with member x.Exit n = raise StopProcessing } try f exiter @@ -517,7 +517,7 @@ type BackgroundCompiler( return FSharpParseFileResults(creationDiags, parseTree, true, [| |]) | Some builder -> let parseTree,_,_,parseDiags = builder.GetParseResultsForFile fileName - let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.errorSeverityOptions, false, fileName, parseDiags, suggestNamesForErrors) |] + let diagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (builder.TcConfig.diagnosticsOptions, false, fileName, parseDiags, suggestNamesForErrors) |] return FSharpParseFileResults(diagnostics = diagnostics, input = parseTree, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) } @@ -726,7 +726,7 @@ type BackgroundCompiler( let latestImplementationFile = tcInfoExtras.latestImplFile let tcDependencyFiles = tcInfo.tcDependencyFiles let tcErrors = tcInfo.TcErrors - let errorOptions = builder.TcConfig.errorSeverityOptions + let errorOptions = builder.TcConfig.diagnosticsOptions let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, parseDiags, suggestNamesForErrors) |] let tcErrors = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, tcErrors, suggestNamesForErrors) |] let parseResults = FSharpParseFileResults(diagnostics=parseDiags, input=parseTree, parseHadErrors=false, dependencyFiles=builder.AllDependenciesDeprecated) @@ -815,7 +815,7 @@ type BackgroundCompiler( return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) | Some builder -> let! tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = builder.GetFullCheckResultsAndImplementationsForProject() - let errorOptions = tcProj.TcConfig.errorSeverityOptions + let errorOptions = tcProj.TcConfig.diagnosticsOptions let fileName = DummyFileNameForRangesWithoutASpecificLocation // Although we do not use 'tcInfoExtras', computing it will make sure we get an extra info. @@ -878,7 +878,7 @@ type BackgroundCompiler( member _.GetProjectOptionsFromScript(fileName, sourceText, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, sdkDirOverride: string option, assumeDotNetFramework: bool option, optionsStamp: int64 option, _userOpName) = cancellable { - use errors = new ErrorScope() + use errors = new DiagnosticsScope() // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true @@ -1295,7 +1295,7 @@ type FSharpChecker(legacyReferenceResolver, member _.GetParsingOptionsFromCommandLineArgs(sourceFiles, argv, ?isInteractive, ?isEditing) = let isEditing = defaultArg isEditing false let isInteractive = defaultArg isInteractive false - use errorScope = new ErrorScope() + use errorScope = new DiagnosticsScope() let tcConfigB = TcConfigBuilder.CreateNew(legacyReferenceResolver, defaultFSharpBinariesDir=FSharpCheckerResultsSettings.defaultFSharpBinariesDir, @@ -1368,7 +1368,7 @@ open FSharp.Compiler.CodeAnalysis open FSharp.Compiler.CompilerConfig open FSharp.Compiler.EditorServices open FSharp.Compiler.Text.Range -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger type CompilerEnvironment() = /// Source file extensions diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index b479ec8a47e..e9ccc85ddc8 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -6,7 +6,7 @@ open FSharp.Compiler open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler.AbstractIL.IL -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Infos open FSharp.Compiler.QuotationTranslator open FSharp.Compiler.Syntax @@ -14,6 +14,7 @@ open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TypeRelations [] diff --git a/src/fsharp/symbols/FSharpDiagnostic.fs b/src/fsharp/symbols/FSharpDiagnostic.fs new file mode 100644 index 00000000000..5f9bb7060b6 --- /dev/null +++ b/src/fsharp/symbols/FSharpDiagnostic.fs @@ -0,0 +1,207 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +//---------------------------------------------------------------------------- +// Open up the compiler as an incremental service for parsing, +// type checking and intellisense-like environment-reporting. +//-------------------------------------------------------------------------- + +namespace FSharp.Compiler.Diagnostics + +open System + +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +open FSharp.Core.Printf +open FSharp.Compiler +open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Text +open FSharp.Compiler.Text.Position +open FSharp.Compiler.Text.Range + +type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = + member _.Range = m + + member _.Severity = severity + + member _.Message = message + + member _.Subcategory = subcategory + + member _.ErrorNumber = errorNum + + member _.ErrorNumberPrefix = numberPrefix + + member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") + + member _.Start = m.Start + + member _.End = m.End + + member _.StartLine = m.Start.Line + + member _.EndLine = m.End.Line + + member _.StartColumn = m.Start.Column + + member _.EndColumn = m.End.Column + + member _.FileName = m.FileName + + member _.WithStart newStart = + let m = mkFileIndexRange m.FileIndex newStart m.End + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) + + member _.WithEnd newEnd = + let m = mkFileIndexRange m.FileIndex m.Start newEnd + FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) + + override _.ToString() = + let fileName = m.FileName + let s = m.Start + let e = m.End + let severity = + match severity with + | FSharpDiagnosticSeverity.Warning -> "warning" + | FSharpDiagnosticSeverity.Error -> "error" + | FSharpDiagnosticSeverity.Info -> "info" + | FSharpDiagnosticSeverity.Hidden -> "hidden" + sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message + + /// Decompose a warning or error into parts: position, severity, message, error number + static member CreateFromException(exn, severity, fallbackRange: range, suggestNames: bool) = + let m = match GetRangeOfDiagnostic exn with Some m -> m | None -> fallbackRange + let msg = bufs (fun buf -> OutputPhasedDiagnostic buf exn false suggestNames) + let errorNum = GetDiagnosticNumber exn + FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum, "FS") + + /// Decompose a warning or error into parts: position, severity, message, error number + static member CreateFromExceptionAndAdjustEof(exn, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = + let r = FSharpDiagnostic.CreateFromException(exn, severity, fallbackRange, suggestNames) + + // Adjust to make sure that errors reported at Eof are shown at the linesCount + let startline, schange = min (Line.toZ r.Range.StartLine, false) (linesCount, true) + let endline, echange = min (Line.toZ r.Range.EndLine, false) (linesCount, true) + + if not (schange || echange) then r + else + let r = if schange then r.WithStart(mkPos startline lastLength) else r + if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r + + static member NewlineifyErrorString(message) = NewlineifyErrorString(message) + + static member NormalizeErrorString(text) = NormalizeErrorString(text) + + static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = + let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck + let numberPrefix = defaultArg numberPrefix "FS" + FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) + +/// Use to reset error and warning handlers +[] +type DiagnosticsScope() = + let mutable diags = [] + let mutable firstError = None + let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck + let unwindEL = + PushDiagnosticsLoggerPhaseUntilUnwind (fun _oldLogger -> + { new DiagnosticsLogger("DiagnosticsScope") with + member x.DiagnosticSink(exn, severity) = + let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) + diags <- err :: diags + if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then + firstError <- Some err.Message + member x.ErrorCount = diags.Length }) + + member _.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) + + member _.Diagnostics = diags + + member x.TryGetFirstErrorText() = + match x.Errors with + | error :: _ -> Some error.Message + | [] -> None + + interface IDisposable with + member _.Dispose() = + unwindEL.Dispose() (* unwind pushes when DiagnosticsScope disposes *) + unwindBP.Dispose() + + member _.FirstError with get() = firstError and set v = firstError <- v + + /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and + /// perform other operations which might expose us to either bona-fide F# error messages such + /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, + /// may hit internal compiler failures. + /// + /// In some calling cases, we get a chance to report the error as part of user text. For example + /// if there is a "missing assembly" error while formatting the text of the description of an + /// autocomplete, then the error message is shown in replacement of the text (rather than crashing Visual + /// Studio, or swallowing the exception completely) + static member Protect<'a> (m: range) (f: unit->'a) (err: string->'a): 'a = + use errorScope = new DiagnosticsScope() + let res = + try + Some (f()) + with e -> + // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. + try + errorRecovery e m + with _ -> + // If error recovery fails, then we have an internal compiler error. In this case, we show the whole stack + // in the extra message, should the extra message be used. + errorScope.FirstError <- Some (e.ToString()) + None + match res with + | Some res -> res + | None -> + match errorScope.TryGetFirstErrorText() with + | Some text -> err text + | None -> err "" + +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationDiagnosticLogger (debugName: string, options: FSharpDiagnosticOptions) = + inherit DiagnosticsLogger("CompilationDiagnosticLogger("+debugName+")") + + let mutable errorCount = 0 + let diagnostics = ResizeArray<_>() + + override _.DiagnosticSink(err, severity) = + if ReportDiagnosticAsError options (err, severity) then + diagnostics.Add(err, FSharpDiagnosticSeverity.Error) + errorCount <- errorCount + 1 + elif ReportDiagnosticAsWarning options (err, severity) then + diagnostics.Add(err, FSharpDiagnosticSeverity.Warning) + elif ReportDiagnosticAsInfo options (err, severity) then + diagnostics.Add(err, severity) + override x.ErrorCount = errorCount + + member x.GetDiagnostics() = diagnostics.ToArray() + +module DiagnosticHelpers = + + let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = + [ let severity = + if ReportDiagnosticAsError options (exn, severity) then FSharpDiagnosticSeverity.Error + else severity + if (severity = FSharpDiagnosticSeverity.Error || ReportDiagnosticAsWarning options (exn, severity) || ReportDiagnosticAsInfo options (exn, severity)) then + let oneError exn = + [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. + // Not ideal, but it's hard to see what else to do. + let fallbackRange = rangeN mainInputFileName 1 + let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) + let fileName = ei.Range.FileName + if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then + yield ei ] + + let mainError, relatedErrors = SplitRelatedDiagnostics exn + yield! oneError mainError + for e in relatedErrors do + yield! oneError e ] + + let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = + let fileInfo = (Int32.MaxValue, Int32.MaxValue) + [| for exn, severity in errors do + yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] diff --git a/src/fsharp/symbols/FSharpDiagnostic.fsi b/src/fsharp/symbols/FSharpDiagnostic.fsi new file mode 100644 index 00000000000..6555d013464 --- /dev/null +++ b/src/fsharp/symbols/FSharpDiagnostic.fsi @@ -0,0 +1,126 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +//---------------------------------------------------------------------------- +// Helpers for quick info and information about items +//---------------------------------------------------------------------------- + +namespace FSharp.Compiler.Diagnostics + +open System +open FSharp.Compiler.Text +open FSharp.Compiler.DiagnosticsLogger + +/// Represents a diagnostic produced by the F# compiler +[] +type public FSharpDiagnostic = + + /// Gets the file name for the diagnostic + member FileName: string + + /// Gets the start position for the diagnostic + member Start: Position + + /// Gets the end position for the diagnostic + member End: Position + + /// Gets the start column for the diagnostic + member StartColumn: int + + /// Gets the end column for the diagnostic + member EndColumn: int + + /// Gets the start line for the diagnostic + member StartLine: int + + /// Gets the end line for the diagnostic + member EndLine: int + + /// Gets the range for the diagnostic + member Range: range + + /// Gets the severity for the diagnostic + member Severity: FSharpDiagnosticSeverity + + /// Gets the message for the diagnostic + member Message: string + + /// Gets the sub-category for the diagnostic + member Subcategory: string + + /// Gets the number for the diagnostic + member ErrorNumber: int + + /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers + member ErrorNumberPrefix: string + + /// Gets the full error number text e.g "FS0031" + member ErrorNumberText: string + + /// Creates a diagnostic, e.g. for reporting from an analyzer + static member Create: + severity: FSharpDiagnosticSeverity * + message: string * + number: int * + range: range * + ?numberPrefix: string * + ?subcategory: string -> + FSharpDiagnostic + + static member internal CreateFromExceptionAndAdjustEof: + PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> + FSharpDiagnostic + + static member internal CreateFromException: + PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic + + /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), + /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo + static member NewlineifyErrorString: message: string -> string + + /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), + /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo + static member NormalizeErrorString: text: string -> string + +//---------------------------------------------------------------------------- +// Internal only + +// Implementation details used by other code in the compiler +[] +type internal DiagnosticsScope = + + interface IDisposable + + new: unit -> DiagnosticsScope + + member Diagnostics: FSharpDiagnostic list + + static member Protect<'T> : range -> (unit -> 'T) -> (string -> 'T) -> 'T + +/// An error logger that capture errors, filtering them according to warning levels etc. +type internal CompilationDiagnosticLogger = + inherit DiagnosticsLogger + + /// Create the diagnostics logger + new: debugName: string * options: FSharpDiagnosticOptions -> CompilationDiagnosticLogger + + /// Get the captured diagnostics + member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + +module internal DiagnosticHelpers = + + val ReportDiagnostic: + FSharpDiagnosticOptions * + allErrors: bool * + mainInputFileName: string * + fileInfo: (int * int) * + (PhasedDiagnostic * FSharpDiagnosticSeverity) * + suggestNames: bool -> + FSharpDiagnostic list + + val CreateDiagnostics: + FSharpDiagnosticOptions * + allErrors: bool * + mainInputFileName: string * + seq * + suggestNames: bool -> + FSharpDiagnostic [] diff --git a/src/fsharp/symbols/SymbolHelpers.fs b/src/fsharp/symbols/SymbolHelpers.fs index 8f7962d8862..5def8ebe7be 100644 --- a/src/fsharp/symbols/SymbolHelpers.fs +++ b/src/fsharp/symbols/SymbolHelpers.fs @@ -1,212 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -//---------------------------------------------------------------------------- -// Open up the compiler as an incremental service for parsing, -// type checking and intellisense-like environment-reporting. -//-------------------------------------------------------------------------- - -namespace FSharp.Compiler.Diagnostics - -open System - -open Internal.Utilities.Library -open Internal.Utilities.Library.Extras - -open FSharp.Core.Printf -open FSharp.Compiler -open FSharp.Compiler.CompilerDiagnostics -open FSharp.Compiler.Diagnostics -open FSharp.Compiler.ErrorLogger -open FSharp.Compiler.Text -open FSharp.Compiler.Text.Position -open FSharp.Compiler.Text.Range - -type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: string, subcategory: string, errorNum: int, numberPrefix: string) = - member _.Range = m - - member _.Severity = severity - - member _.Message = message - - member _.Subcategory = subcategory - - member _.ErrorNumber = errorNum - - member _.ErrorNumberPrefix = numberPrefix - - member _.ErrorNumberText = numberPrefix + errorNum.ToString("0000") - - member _.Start = m.Start - - member _.End = m.End - - member _.StartLine = m.Start.Line - - member _.EndLine = m.End.Line - - member _.StartColumn = m.Start.Column - - member _.EndColumn = m.End.Column - - member _.FileName = m.FileName - - member _.WithStart newStart = - let m = mkFileIndexRange m.FileIndex newStart m.End - FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) - - member _.WithEnd newEnd = - let m = mkFileIndexRange m.FileIndex m.Start newEnd - FSharpDiagnostic(m, severity, message, subcategory, errorNum, numberPrefix) - - override _.ToString() = - let fileName = m.FileName - let s = m.Start - let e = m.End - let severity = - match severity with - | FSharpDiagnosticSeverity.Warning -> "warning" - | FSharpDiagnosticSeverity.Error -> "error" - | FSharpDiagnosticSeverity.Info -> "info" - | FSharpDiagnosticSeverity.Hidden -> "hidden" - sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message - - /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromException(exn, severity, fallbackRange: range, suggestNames: bool) = - let m = match GetRangeOfDiagnostic exn with Some m -> m | None -> fallbackRange - let msg = bufs (fun buf -> OutputPhasedDiagnostic buf exn false suggestNames) - let errorNum = GetDiagnosticNumber exn - FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum, "FS") - - /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromExceptionAndAdjustEof(exn, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = - let r = FSharpDiagnostic.CreateFromException(exn, severity, fallbackRange, suggestNames) - - // Adjust to make sure that errors reported at Eof are shown at the linesCount - let startline, schange = min (Line.toZ r.Range.StartLine, false) (linesCount, true) - let endline, echange = min (Line.toZ r.Range.EndLine, false) (linesCount, true) - - if not (schange || echange) then r - else - let r = if schange then r.WithStart(mkPos startline lastLength) else r - if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r - - static member NewlineifyErrorString(message) = NewlineifyErrorString(message) - - static member NormalizeErrorString(text) = NormalizeErrorString(text) - - static member Create(severity: FSharpDiagnosticSeverity, message: string, number: int, range: range, ?numberPrefix: string, ?subcategory: string) = - let subcategory = defaultArg subcategory BuildPhaseSubcategory.TypeCheck - let numberPrefix = defaultArg numberPrefix "FS" - FSharpDiagnostic(range, severity, message, subcategory, number, numberPrefix) - -/// Use to reset error and warning handlers -[] -type ErrorScope() = - let mutable diags = [] - let mutable firstError = None - let unwindBP = PushThreadBuildPhaseUntilUnwind BuildPhase.TypeCheck - let unwindEL = - PushErrorLoggerPhaseUntilUnwind (fun _oldLogger -> - { new ErrorLogger("ErrorScope") with - member x.DiagnosticSink(exn, severity) = - let err = FSharpDiagnostic.CreateFromException(exn, severity, range.Zero, false) - diags <- err :: diags - if severity = FSharpDiagnosticSeverity.Error && firstError.IsNone then - firstError <- Some err.Message - member x.ErrorCount = diags.Length }) - - member x.Errors = diags |> List.filter (fun error -> error.Severity = FSharpDiagnosticSeverity.Error) - - member x.Diagnostics = diags - - member x.TryGetFirstErrorText() = - match x.Errors with - | error :: _ -> Some error.Message - | [] -> None - - interface IDisposable with - member d.Dispose() = - unwindEL.Dispose() (* unwind pushes when ErrorScope disposes *) - unwindBP.Dispose() - - member x.FirstError with get() = firstError and set v = firstError <- v - - /// Used at entry points to FSharp.Compiler.Service (service.fsi) which manipulate symbols and - /// perform other operations which might expose us to either bona-fide F# error messages such - /// "missing assembly" (for incomplete assembly reference sets), or, if there is a compiler bug, - /// may hit internal compiler failures. - /// - /// In some calling cases, we get a chance to report the error as part of user text. For example - /// if there is a "missing assembly" error while formatting the text of the description of an - /// autocomplete, then the error message is shown in replacement of the text (rather than crashing Visual - /// Studio, or swallowing the exception completely) - static member Protect<'a> (m: range) (f: unit->'a) (err: string->'a): 'a = - use errorScope = new ErrorScope() - let res = - try - Some (f()) - with e -> - // Here we only call errorRecovery to save the error message for later use by TryGetFirstErrorText. - try - errorRecovery e m - with _ -> - // If error recovery fails, then we have an internal compiler error. In this case, we show the whole stack - // in the extra message, should the extra message be used. - errorScope.FirstError <- Some (e.ToString()) - None - match res with - | Some res -> res - | None -> - match errorScope.TryGetFirstErrorText() with - | Some text -> err text - | None -> err "" - -/// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationErrorLogger (debugName: string, options: FSharpDiagnosticOptions) = - inherit ErrorLogger("CompilationErrorLogger("+debugName+")") - - let mutable errorCount = 0 - let diagnostics = ResizeArray<_>() - - override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError options (err, severity) then - diagnostics.Add(err, FSharpDiagnosticSeverity.Error) - errorCount <- errorCount + 1 - elif ReportDiagnosticAsWarning options (err, severity) then - diagnostics.Add(err, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo options (err, severity) then - diagnostics.Add(err, severity) - override x.ErrorCount = errorCount - - member x.GetDiagnostics() = diagnostics.ToArray() - -module DiagnosticHelpers = - - let ReportDiagnostic (options: FSharpDiagnosticOptions, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) = - [ let severity = - if ReportDiagnosticAsError options (exn, severity) then FSharpDiagnosticSeverity.Error - else severity - if (severity = FSharpDiagnosticSeverity.Error || ReportDiagnosticAsWarning options (exn, severity) || ReportDiagnosticAsInfo options (exn, severity)) then - let oneError exn = - [ // We use the first line of the file as a fallbackRange for reporting unexpected errors. - // Not ideal, but it's hard to see what else to do. - let fallbackRange = rangeN mainInputFileName 1 - let ei = FSharpDiagnostic.CreateFromExceptionAndAdjustEof (exn, severity, fallbackRange, fileInfo, suggestNames) - let fileName = ei.Range.FileName - if allErrors || fileName = mainInputFileName || fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation then - yield ei ] - - let mainError, relatedErrors = SplitRelatedDiagnostics exn - yield! oneError mainError - for e in relatedErrors do - yield! oneError e ] - - let CreateDiagnostics (options, allErrors, mainInputFileName, errors, suggestNames) = - let fileInfo = (Int32.MaxValue, Int32.MaxValue) - [| for exn, severity in errors do - yield! ReportDiagnostic (options, allErrors, mainInputFileName, fileInfo, (exn, severity), suggestNames) |] - - namespace FSharp.Compiler.Symbols open System.IO @@ -216,7 +9,7 @@ open Internal.Utilities.Library.Extras open FSharp.Core.Printf open FSharp.Compiler open FSharp.Compiler.AbstractIL.Diagnostics -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.InfoReader open FSharp.Compiler.Infos open FSharp.Compiler.IO @@ -230,6 +23,7 @@ open FSharp.Compiler.Xml open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps +open FSharp.Compiler.TypeHierarchy open FSharp.Compiler.TcGlobals /// Describe a comment as either a block of text or a file+signature reference into an intellidoc file. @@ -759,7 +553,7 @@ module internal SymbolHelpers = let tcref = rfinfo.TyconRef let xmldoc = if tyconRefUsesLocalXmlDoc g.compilingFSharpCore tcref || tcref.XmlDoc.NonEmpty then - if tcref.IsExceptionDecl then + if tcref.IsFSharpException then Some tcref.XmlDoc else Some rfinfo.RecdField.XmlDoc diff --git a/src/fsharp/symbols/SymbolHelpers.fsi b/src/fsharp/symbols/SymbolHelpers.fsi index 8cb781565db..d0057c47496 100755 --- a/src/fsharp/symbols/SymbolHelpers.fsi +++ b/src/fsharp/symbols/SymbolHelpers.fsi @@ -4,122 +4,6 @@ // Helpers for quick info and information about items //---------------------------------------------------------------------------- -namespace FSharp.Compiler.Diagnostics - -open System -open FSharp.Compiler.Text -open FSharp.Compiler.ErrorLogger - -/// Represents a diagnostic produced by the F# compiler -[] -type public FSharpDiagnostic = - - /// Gets the file name for the diagnostic - member FileName: string - - /// Gets the start position for the diagnostic - member Start: Position - - /// Gets the end position for the diagnostic - member End: Position - - /// Gets the start column for the diagnostic - member StartColumn: int - - /// Gets the end column for the diagnostic - member EndColumn: int - - /// Gets the start line for the diagnostic - member StartLine: int - - /// Gets the end line for the diagnostic - member EndLine: int - - /// Gets the range for the diagnostic - member Range: range - - /// Gets the severity for the diagnostic - member Severity: FSharpDiagnosticSeverity - - /// Gets the message for the diagnostic - member Message: string - - /// Gets the sub-category for the diagnostic - member Subcategory: string - - /// Gets the number for the diagnostic - member ErrorNumber: int - - /// Gets the number prefix for the diagnostic, usually "FS" but may differ for analyzers - member ErrorNumberPrefix: string - - /// Gets the full error number text e.g "FS0031" - member ErrorNumberText: string - - /// Creates a diagnostic, e.g. for reporting from an analyzer - static member Create: - severity: FSharpDiagnosticSeverity * - message: string * - number: int * - range: range * - ?numberPrefix: string * - ?subcategory: string -> - FSharpDiagnostic - - static member internal CreateFromExceptionAndAdjustEof: - PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> - FSharpDiagnostic - - static member internal CreateFromException: - PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic - - /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), - /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo - static member NewlineifyErrorString: message: string -> string - - /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), - /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo - static member NormalizeErrorString: text: string -> string - -//---------------------------------------------------------------------------- -// Internal only - -// Implementation details used by other code in the compiler -[] -type internal ErrorScope = - interface IDisposable - new: unit -> ErrorScope - member Diagnostics: FSharpDiagnostic list - static member Protect<'a> : range -> (unit -> 'a) -> (string -> 'a) -> 'a - -/// An error logger that capture errors, filtering them according to warning levels etc. -type internal CompilationErrorLogger = - inherit ErrorLogger - - /// Create the diagnostics logger - new: debugName: string * options: FSharpDiagnosticOptions -> CompilationErrorLogger - - /// Get the captured diagnostics - member GetDiagnostics: unit -> (PhasedDiagnostic * FSharpDiagnosticSeverity) [] - -module internal DiagnosticHelpers = - val ReportDiagnostic: - FSharpDiagnosticOptions * - allErrors: bool * - mainInputFileName: string * - fileInfo: (int * int) * - (PhasedDiagnostic * FSharpDiagnosticSeverity) * - suggestNames: bool -> - FSharpDiagnostic list - - val CreateDiagnostics: - FSharpDiagnosticOptions * - allErrors: bool * - mainInputFileName: string * - seq * - suggestNames: bool -> - FSharpDiagnostic [] - namespace FSharp.Compiler.Symbols open Internal.Utilities.Library diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index 25183fd4652..292457e6e67 100644 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -16,15 +16,16 @@ open FSharp.Compiler.Infos open FSharp.Compiler.InfoReader open FSharp.Compiler.NameResolution open FSharp.Compiler.Syntax +open FSharp.Compiler.Syntax.PrettyNaming open FSharp.Compiler.SyntaxTreeOps open FSharp.Compiler.Text open FSharp.Compiler.Text.Range open FSharp.Compiler.Xml +open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics -open FSharp.Compiler.TcGlobals open FSharp.Compiler.TypedTreeOps -open FSharp.Compiler.Syntax.PrettyNaming +open FSharp.Compiler.TypeHierarchy type FSharpAccessibility(a:Accessibility, ?isProtected) = let isProtected = defaultArg isProtected false @@ -75,7 +76,7 @@ type SymbolEnv(g: TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceTyp [] module Impl = let protect f = - ErrorLogger.protectAssemblyExplorationF + DiagnosticsLogger.protectAssemblyExplorationF (fun (asmName, path) -> invalidOp (sprintf "The entity or value '%s' does not exist or is in an unresolved assembly. You may need to add a reference to assembly '%s'" path asmName)) f @@ -546,7 +547,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = entity.IsEnumTycon member _.IsFSharpExceptionDeclaration = - isResolvedAndFSharp() && entity.IsExceptionDecl + isResolvedAndFSharp() && entity.IsFSharpException member _.IsUnresolved = isUnresolved() @@ -586,7 +587,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.DeclaredInterfaces = if isUnresolved() then makeReadOnlyCollection [] else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration [] (fun () -> + DiagnosticsLogger.protectAssemblyExploration [] (fun () -> [ for ity in GetImmediateInterfacesOfType SkipUnrefInterfaces.Yes cenv.g cenv.amap range0 ty do yield FSharpType(cenv, ity) ]) |> makeReadOnlyCollection @@ -594,7 +595,7 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.AllInterfaces = if isUnresolved() then makeReadOnlyCollection [] else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration [] (fun () -> + DiagnosticsLogger.protectAssemblyExploration [] (fun () -> [ for ity in AllInterfacesOfType cenv.g cenv.amap range0 AllowMultiIntfInstantiations.Yes ty do yield FSharpType(cenv, ity) ]) |> makeReadOnlyCollection @@ -602,13 +603,13 @@ type FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = member _.IsAttributeType = if isUnresolved() then false else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration false <| fun () -> + DiagnosticsLogger.protectAssemblyExploration false <| fun () -> ExistsHeadTypeInEntireHierarchy cenv.g cenv.amap range0 ty cenv.g.tcref_System_Attribute member _.IsDisposableType = if isUnresolved() then false else let ty = generalizedTyconRef cenv.g entity - ErrorLogger.protectAssemblyExploration false <| fun () -> + DiagnosticsLogger.protectAssemblyExploration false <| fun () -> ExistsHeadTypeInEntireHierarchy cenv.g cenv.amap range0 ty cenv.g.tcref_System_IDisposable member _.BaseType = @@ -2322,7 +2323,7 @@ type FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = type FSharpType(cenv, ty:TType) = let isUnresolved() = - ErrorLogger.protectAssemblyExploration true <| fun () -> + DiagnosticsLogger.protectAssemblyExploration true <| fun () -> match stripTyparEqns ty with | TType_app (tcref, _, _) -> FSharpEntity(cenv, tcref).IsUnresolved | TType_measure (Measure.Con tcref) -> FSharpEntity(cenv, tcref).IsUnresolved diff --git a/src/fsharp/utils/prim-lexing.fs b/src/fsharp/utils/prim-lexing.fs index 4e33ef35c65..be5740f14d2 100644 --- a/src/fsharp/utils/prim-lexing.fs +++ b/src/fsharp/utils/prim-lexing.fs @@ -255,7 +255,7 @@ namespace Internal.Utilities.Text.Lexing member _.SupportsFeature featureId = langVersion.SupportsFeature featureId member _.CheckLanguageFeatureErrorRecover featureId range = - FSharp.Compiler.ErrorLogger.checkLanguageFeatureErrorRecover langVersion featureId range + FSharp.Compiler.DiagnosticsLogger.checkLanguageFeatureErrorRecover langVersion featureId range static member FromFunction (reportLibraryOnlyFeatures, langVersion, f : 'Char[] * int * int -> int) : LexBuffer<'Char> = let extension= Array.zeroCreate 4096 diff --git a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs index bc4b3f9f0bc..b2d2166d1a0 100644 --- a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs +++ b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs @@ -5,5 +5,5 @@ module CompilerTestHelpers = let (|Warning|_|) (exn: System.Exception) = match exn with - | :? FSharp.Compiler.ErrorLogger.Error as e -> let n,d = e.Data0 in Some (n,d) + | :? FSharp.Compiler.DiagnosticsLogger.Error as e -> let n,d = e.Data0 in Some (n,d) | _ -> None diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs index b3442017bc4..84d4a1dc9ff 100644 --- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs +++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs @@ -15,7 +15,7 @@ open FSharp.Compiler open FSharp.Compiler.Diagnostics open FSharp.Compiler.Lexer open FSharp.Compiler.Lexhelp -open FSharp.Compiler.ErrorLogger +open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers open FSharp.Compiler.Syntax @@ -55,7 +55,7 @@ type public HashIfExpression() = let errorLogger = { - new ErrorLogger("TestErrorLogger") with + new DiagnosticsLogger("TestDiagnosticsLogger") with member x.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e member x.ErrorCount = errors.Count } @@ -66,7 +66,7 @@ type public HashIfExpression() = let startPos = Position.Empty let args = mkLexargs (defines, lightSyntax, resourceManager, [], errorLogger, PathMap.empty) - CompileThreadStatic.ErrorLogger <- errorLogger + CompileThreadStatic.DiagnosticsLogger <- errorLogger let parser (s : string) = let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) @@ -83,7 +83,7 @@ type public HashIfExpression() = interface IDisposable with // Teardown member _.Dispose() = CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase - CompileThreadStatic.ErrorLogger <- CompileThreadStatic.ErrorLogger + CompileThreadStatic.DiagnosticsLogger <- CompileThreadStatic.DiagnosticsLogger [] member this.PositiveParserTestCases()= diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index e0e44503b47..24dc100a18a 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -31,7 +31,7 @@ type Check = |] let ctok = AssumeCompilationThreadWithoutEvidence () - let _code = mainCompile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.ErrorLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) + let _code = mainCompile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) () with | :? 'TException as e -> @@ -40,8 +40,8 @@ type Check = else printfn "%s" msg Assert.Fail("The correct callstack was not reported to watson.") - | (FSharp.Compiler.ErrorLogger.ReportedError (Some (FSharp.Compiler.ErrorLogger.InternalError (msg, range) as e))) - | (FSharp.Compiler.ErrorLogger.InternalError (msg, range) as e) -> + | (FSharp.Compiler.DiagnosticsLogger.ReportedError (Some (FSharp.Compiler.DiagnosticsLogger.InternalError (msg, range) as e))) + | (FSharp.Compiler.DiagnosticsLogger.InternalError (msg, range) as e) -> printfn "InternalError Exception: %s, range = %A, stack = %s" msg range (e.ToString()) Assert.Fail("An InternalError exception occurred.") finally From 0cfaa22275e3edd280b3ac16427694a032f4a5d9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:03:05 +0100 Subject: [PATCH 05/19] split infos.fs and SymbolHelpres.fs --- src/fsharp/DiagnosticsLogger.fs | 741 +++++++++++++++++++++++++++++++ src/fsharp/DiagnosticsLogger.fsi | 393 ++++++++++++++++ 2 files changed, 1134 insertions(+) create mode 100644 src/fsharp/DiagnosticsLogger.fs create mode 100644 src/fsharp/DiagnosticsLogger.fsi diff --git a/src/fsharp/DiagnosticsLogger.fs b/src/fsharp/DiagnosticsLogger.fs new file mode 100644 index 00000000000..dad41adff9e --- /dev/null +++ b/src/fsharp/DiagnosticsLogger.fs @@ -0,0 +1,741 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module FSharp.Compiler.DiagnosticsLogger + +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Features +open FSharp.Compiler.Text.Range +open FSharp.Compiler.Text +open System +open System.Diagnostics +open System.Threading +open Internal.Utilities.Library +open Internal.Utilities.Library.Extras + +/// Represents the style being used to format errors +[] +type ErrorStyle = + | DefaultErrors + | EmacsErrors + | TestErrors + | VSErrors + | GccErrors + +/// Thrown when we want to add some range information to a .NET exception +exception WrappedError of exn * range with + override this.Message = + match this :> exn with + | WrappedError (exn, _) -> "WrappedError(" + exn.Message + ")" + | _ -> "WrappedError" + +/// Thrown when immediate, local error recovery is not possible. This indicates +/// we've reported an error but need to make a non-local transfer of control. +/// Error recovery may catch this and continue (see 'errorRecovery') +/// +/// The exception that caused the report is carried as data because in some +/// situations (LazyWithContext) we may need to re-report the original error +/// when a lazy thunk is re-evaluated. +exception ReportedError of exn option with + override this.Message = + let msg = "The exception has been reported. This internal exception should now be caught at an error recovery point on the stack." + match this :> exn with + | ReportedError (Some exn) -> msg + " Original message: " + exn.Message + ")" + | _ -> msg + +let rec findOriginalException err = + match err with + | ReportedError (Some err) -> err + | WrappedError(err, _) -> findOriginalException err + | _ -> err + +type Suggestions = (string -> unit) -> unit + +let NoSuggestions : Suggestions = ignore + +/// Thrown when we stop processing the F# Interactive entry or #load. +exception StopProcessingExn of exn option with + override _.Message = "Processing of a script fragment has stopped because an exception has been raised" + + override this.ToString() = + match this :> exn with + | StopProcessingExn(Some exn) -> "StopProcessingExn, originally (" + exn.ToString() + ")" + | _ -> "StopProcessingExn" + + +let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ -> None + +let StopProcessing<'T> = StopProcessingExn None + +exception Error of (int * string) * range with // int is e.g. 191 in FS0191 + override this.Message = + match this :> exn with + | Error((_, msg), _) -> msg + | _ -> "impossible" + +exception InternalError of msg: string * range with + override this.Message = + match this :> exn with + | InternalError(msg, m) -> msg + m.ToString() + | _ -> "impossible" + +exception UserCompilerMessage of string * int * range + +exception LibraryUseOnly of range + +exception Deprecated of string * range + +exception Experimental of string * range + +exception PossibleUnverifiableCode of range + +exception UnresolvedReferenceNoRange of (*assemblyName*) string + +exception UnresolvedReferenceError of (*assemblyName*) string * range + +exception UnresolvedPathReferenceNoRange of (*assemblyName*) string * (*path*) string with + override this.Message = + match this :> exn with + | UnresolvedPathReferenceNoRange(assemblyName, path) -> sprintf "Assembly: %s, full path: %s" assemblyName path + | _ -> "impossible" + +exception UnresolvedPathReference of (*assemblyName*) string * (*path*) string * range + +exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 + override this.Message = + match this :> exn with + | ErrorWithSuggestions((_, msg), _, _, _) -> msg + | _ -> "impossible" + + +let inline protectAssemblyExploration dflt f = + try + f() + with + | UnresolvedPathReferenceNoRange _ -> dflt + | _ -> reraise() + +let inline protectAssemblyExplorationF dflt f = + try + f() + with + | UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName, path) + | _ -> reraise() + +let inline protectAssemblyExplorationNoReraise dflt1 dflt2 f = + try + f() + with + | UnresolvedPathReferenceNoRange _ -> dflt1 + | _ -> dflt2 + +// Attach a range if this is a range dual exception. +let rec AttachRange m (exn:exn) = + if equals m range0 then exn + else + match exn with + // Strip TargetInvocationException wrappers + | :? System.Reflection.TargetInvocationException -> AttachRange m exn.InnerException + | UnresolvedReferenceNoRange a -> UnresolvedReferenceError(a, m) + | UnresolvedPathReferenceNoRange(a, p) -> UnresolvedPathReference(a, p, m) + | Failure msg -> InternalError(msg + " (Failure)", m) + | :? ArgumentException as exn -> InternalError(exn.Message + " (ArgumentException)", m) + | notARangeDual -> notARangeDual + +type Exiter = + abstract Exit : int -> 'T + +let QuitProcessExiter = + { new Exiter with + member _.Exit n = + try + Environment.Exit n + with _ -> + () + FSComp.SR.elSysEnvExitDidntExit() + |> failwith } + +/// Closed enumeration of build phases. +[] +type BuildPhase = + | DefaultPhase + | Compile + | Parameter | Parse | TypeCheck + | CodeGen + | Optimize | IlxGen | IlGen | Output + | Interactive // An error seen during interactive execution + +/// Literal build phase subcategory strings. +module BuildPhaseSubcategory = + [] + let DefaultPhase = "" + [] + let Compile = "compile" + [] + let Parameter = "parameter" + [] + let Parse = "parse" + [] + let TypeCheck = "typecheck" + [] + let CodeGen = "codegen" + [] + let Optimize = "optimize" + [] + let IlxGen = "ilxgen" + [] + let IlGen = "ilgen" + [] + let Output = "output" + [] + let Interactive = "interactive" + [] + let Internal = "internal" // Compiler ICE + +[] +type PhasedDiagnostic = + { Exception:exn; Phase:BuildPhase } + + /// Construct a phased error + static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = + // FUTURE: reenable this assert, which has historically triggered in some compiler service scenarios + // System.Diagnostics.Debug.Assert(phase<>BuildPhase.DefaultPhase, sprintf "Compile error seen with no phase to attribute it to.%A %s %s" phase exn.Message exn.StackTrace ) + {Exception = exn; Phase=phase} + + member this.DebugDisplay() = + sprintf "%s: %s" (this.Subcategory()) this.Exception.Message + + /// This is the textual subcategory to display in error and warning messages (shows only under --vserrors): + /// + /// file1.fs(72): subcategory warning FS0072: This is a warning message + /// + member pe.Subcategory() = + match pe.Phase with + | BuildPhase.DefaultPhase -> BuildPhaseSubcategory.DefaultPhase + | BuildPhase.Compile -> BuildPhaseSubcategory.Compile + | BuildPhase.Parameter -> BuildPhaseSubcategory.Parameter + | BuildPhase.Parse -> BuildPhaseSubcategory.Parse + | BuildPhase.TypeCheck -> BuildPhaseSubcategory.TypeCheck + | BuildPhase.CodeGen -> BuildPhaseSubcategory.CodeGen + | BuildPhase.Optimize -> BuildPhaseSubcategory.Optimize + | BuildPhase.IlxGen -> BuildPhaseSubcategory.IlxGen + | BuildPhase.IlGen -> BuildPhaseSubcategory.IlGen + | BuildPhase.Output -> BuildPhaseSubcategory.Output + | BuildPhase.Interactive -> BuildPhaseSubcategory.Interactive + + /// Return true if the textual phase given is from the compile part of the build process. + /// This set needs to be equal to the set of subcategories that the language service can produce. + static member IsSubcategoryOfCompile(subcategory:string) = + // This code logic is duplicated in DocumentTask.cs in the language service. + match subcategory with + | BuildPhaseSubcategory.Compile + | BuildPhaseSubcategory.Parameter + | BuildPhaseSubcategory.Parse + | BuildPhaseSubcategory.TypeCheck -> true + | BuildPhaseSubcategory.DefaultPhase + | BuildPhaseSubcategory.CodeGen + | BuildPhaseSubcategory.Optimize + | BuildPhaseSubcategory.IlxGen + | BuildPhaseSubcategory.IlGen + | BuildPhaseSubcategory.Output + | BuildPhaseSubcategory.Interactive -> false + | BuildPhaseSubcategory.Internal + // Getting here means the compiler has ICE-d. Let's not pile on by showing the unknownSubcategory assert below. + // Just treat as an unknown-to-LanguageService error. + -> false + | unknownSubcategory -> + Debug.Assert(false, sprintf "Subcategory '%s' could not be correlated with a build phase." unknownSubcategory) + // Recovery is to treat this as a 'build' error. Downstream, the project system and language service will treat this as + // if it came from the build and not the language service. + false + + /// Return true if this phase is one that's known to be part of the 'compile'. This is the initial phase of the entire compilation that + /// the language service knows about. + member pe.IsPhaseInCompile() = + let isPhaseInCompile = + match pe.Phase with + | BuildPhase.Compile | BuildPhase.Parameter | BuildPhase.Parse | BuildPhase.TypeCheck -> true + | _ -> false + // Sanity check ensures that Phase matches Subcategory +#if DEBUG + if isPhaseInCompile then + Debug.Assert(PhasedDiagnostic.IsSubcategoryOfCompile(pe.Subcategory()), "Subcategory did not match isPhaseInCompile=true") + else + Debug.Assert(not(PhasedDiagnostic.IsSubcategoryOfCompile(pe.Subcategory())), "Subcategory did not match isPhaseInCompile=false") +#endif + isPhaseInCompile + +[] +[] +type DiagnosticsLogger(nameForDebugging:string) = + abstract ErrorCount: int + + // The 'Impl' factoring enables a developer to place a breakpoint at the non-Impl + // code just below and get a breakpoint for all error logger implementations. + abstract DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + + member _.DebugDisplay() = sprintf "DiagnosticsLogger(%s)" nameForDebugging + +let DiscardErrorsLogger = + { new DiagnosticsLogger("DiscardErrorsLogger") with + member _.DiagnosticSink(phasedError, severity) = () + member _.ErrorCount = 0 + } + +let AssertFalseDiagnosticsLogger = + { new DiagnosticsLogger("AssertFalseDiagnosticsLogger") with + // TODO: reenable these asserts in the compiler service + member _.DiagnosticSink(phasedError, severity) = (* assert false; *) () + member _.ErrorCount = (* assert false; *) 0 + } + +type CapturingDiagnosticsLogger(nm) = + inherit DiagnosticsLogger(nm) + let mutable errorCount = 0 + let diagnostics = ResizeArray() + + override _.DiagnosticSink(phasedError, severity) = + if severity = FSharpDiagnosticSeverity.Error then errorCount <- errorCount + 1 + diagnostics.Add (phasedError, severity) + + override _.ErrorCount = errorCount + + member _.Diagnostics = diagnostics |> Seq.toList + + member _.CommitDelayedDiagnostics(errorLogger:DiagnosticsLogger) = + // Eagerly grab all the errors and warnings from the mutable collection + let errors = diagnostics.ToArray() + errors |> Array.iter errorLogger.DiagnosticSink + +/// Type holds thread-static globals for use by the compile. +type internal CompileThreadStatic = + [] + static val mutable private buildPhase: BuildPhase + + [] + static val mutable private errorLogger: DiagnosticsLogger + + static member BuildPhaseUnchecked = CompileThreadStatic.buildPhase + + static member BuildPhase + with get() = + match box CompileThreadStatic.buildPhase with + | Null -> BuildPhase.DefaultPhase + | _ -> CompileThreadStatic.buildPhase + and set v = CompileThreadStatic.buildPhase <- v + + static member DiagnosticsLogger + with get() = + match box CompileThreadStatic.errorLogger with + | Null -> AssertFalseDiagnosticsLogger + | _ -> CompileThreadStatic.errorLogger + and set v = CompileThreadStatic.errorLogger <- v + + +[] +module DiagnosticsLoggerExtensions = + open System.Reflection + + // Dev15.0 shipped with a bug in diasymreader in the portable pdb symbol reader which causes an AV + // This uses a simple heuristic to detect it (the vsversion is < 16.0) + let tryAndDetectDev15 = + let vsVersion = Environment.GetEnvironmentVariable("VisualStudioVersion") + match Double.TryParse vsVersion with + | true, v -> v < 16.0 + | _ -> false + + /// Instruct the exception not to reset itself when thrown again. + let PreserveStackTrace exn = + try + if not tryAndDetectDev15 then + let preserveStackTrace = typeof.GetMethod("InternalPreserveStackTrace", BindingFlags.Instance ||| BindingFlags.NonPublic) + preserveStackTrace.Invoke(exn, null) |> ignore + with _ -> + // This is probably only the mono case. + Debug.Assert(false, "Could not preserve stack trace for watson exception.") + () + + /// Reraise an exception if it is one we want to report to Watson. + let ReraiseIfWatsonable(exn:exn) = + match exn with + // These few SystemExceptions which we don't report to Watson are because we handle these in some way in Build.fs + | :? TargetInvocationException -> () + | :? NotSupportedException -> () + | :? System.IO.IOException -> () // This covers FileNotFoundException and DirectoryNotFoundException + | :? UnauthorizedAccessException -> () + | Failure _ // This gives reports for compiler INTERNAL ERRORs + | :? SystemException -> + PreserveStackTrace exn + raise exn + | _ -> () + + type DiagnosticsLogger with + + member x.EmitDiagnostic (exn, severity) = + match exn with + | InternalError (s, _) + | Failure s as exn -> Debug.Assert(false, sprintf "Unexpected exception raised in compiler: %s\n%s" s (exn.ToString())) + | _ -> () + + match exn with + | StopProcessing + | ReportedError _ -> + PreserveStackTrace exn + raise exn + | _ -> x.DiagnosticSink(PhasedDiagnostic.Create(exn, CompileThreadStatic.BuildPhase), severity) + + member x.ErrorR exn = + x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Error) + + member x.Warning exn = + x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Warning) + + member x.InformationalWarning exn = + x.EmitDiagnostic (exn, FSharpDiagnosticSeverity.Info) + + member x.Error exn = + x.ErrorR exn + raise (ReportedError (Some exn)) + + member x.SimulateError (ph: PhasedDiagnostic) = + x.DiagnosticSink (ph, FSharpDiagnosticSeverity.Error) + raise (ReportedError (Some ph.Exception)) + + member x.ErrorRecovery (exn: exn) (m: range) = + // Never throws ReportedError. + // Throws StopProcessing and exceptions raised by the DiagnosticSink(exn) handler. + match exn with + (* Don't send ThreadAbortException down the error channel *) + | :? System.Threading.ThreadAbortException | WrappedError(:? System.Threading.ThreadAbortException, _) -> () + | ReportedError _ | WrappedError(ReportedError _, _) -> () + | StopProcessing | WrappedError(StopProcessing, _) -> + PreserveStackTrace exn + raise exn + | _ -> + try + x.ErrorR (AttachRange m exn) // may raise exceptions, e.g. an fsi error sink raises StopProcessing. + ReraiseIfWatsonable exn + with + | ReportedError _ | WrappedError(ReportedError _, _) -> () + + member x.StopProcessingRecovery (exn:exn) (m:range) = + // Do standard error recovery. + // Additionally ignore/catch StopProcessing. [This is the only catch handler for StopProcessing]. + // Additionally ignore/catch ReportedError. + // Can throw other exceptions raised by the DiagnosticSink(exn) handler. + match exn with + | StopProcessing | WrappedError(StopProcessing, _) -> () // suppress, so skip error recovery. + | _ -> + try + x.ErrorRecovery exn m + with + | StopProcessing | WrappedError(StopProcessing, _) -> () // catch, e.g. raised by DiagnosticSink. + | ReportedError _ | WrappedError(ReportedError _, _) -> () // catch, but not expected unless ErrorRecovery is changed. + + member x.ErrorRecoveryNoRange (exn:exn) = + x.ErrorRecovery exn range0 + +/// NOTE: The change will be undone when the returned "unwind" object disposes +let PushThreadBuildPhaseUntilUnwind (phase:BuildPhase) = + let oldBuildPhase = CompileThreadStatic.BuildPhaseUnchecked + CompileThreadStatic.BuildPhase <- phase + { new IDisposable with + member x.Dispose() = CompileThreadStatic.BuildPhase <- oldBuildPhase } + +/// NOTE: The change will be undone when the returned "unwind" object disposes +let PushDiagnosticsLoggerPhaseUntilUnwind(errorLoggerTransformer: DiagnosticsLogger -> #DiagnosticsLogger) = + let oldDiagnosticsLogger = CompileThreadStatic.DiagnosticsLogger + CompileThreadStatic.DiagnosticsLogger <- errorLoggerTransformer oldDiagnosticsLogger + { new IDisposable with + member _.Dispose() = + CompileThreadStatic.DiagnosticsLogger <- oldDiagnosticsLogger } + +let SetThreadBuildPhaseNoUnwind(phase:BuildPhase) = CompileThreadStatic.BuildPhase <- phase + +let SetThreadDiagnosticsLoggerNoUnwind errorLogger = CompileThreadStatic.DiagnosticsLogger <- errorLogger + +/// This represents the thread-local state established as each task function runs as part of the build. +/// +/// Use to reset error and warning handlers. +type CompilationGlobalsScope(errorLogger: DiagnosticsLogger, buildPhase: BuildPhase) = + let unwindEL = PushDiagnosticsLoggerPhaseUntilUnwind(fun _ -> errorLogger) + let unwindBP = PushThreadBuildPhaseUntilUnwind buildPhase + + member _.DiagnosticsLogger = errorLogger + member _.BuildPhase = buildPhase + + // Return the disposable object that cleans up + interface IDisposable with + member _.Dispose() = + unwindBP.Dispose() + unwindEL.Dispose() + +// Global functions are still used by parser and TAST ops. + +/// Raises an exception with error recovery and returns unit. +let errorR exn = CompileThreadStatic.DiagnosticsLogger.ErrorR exn + +/// Raises a warning with error recovery and returns unit. +let warning exn = CompileThreadStatic.DiagnosticsLogger.Warning exn + +/// Raises a warning with error recovery and returns unit. +let informationalWarning exn = CompileThreadStatic.DiagnosticsLogger.InformationalWarning exn + +/// Raises a special exception and returns 'T - can be caught later at an errorRecovery point. +let error exn = CompileThreadStatic.DiagnosticsLogger.Error exn + +/// Simulates an error. For test purposes only. +let simulateError (p : PhasedDiagnostic) = CompileThreadStatic.DiagnosticsLogger.SimulateError p + +let diagnosticSink (phasedError, severity) = CompileThreadStatic.DiagnosticsLogger.DiagnosticSink (phasedError, severity) + +let errorSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Error) + +let warnSink pe = diagnosticSink (pe, FSharpDiagnosticSeverity.Warning) + +let errorRecovery exn m = CompileThreadStatic.DiagnosticsLogger.ErrorRecovery exn m + +let stopProcessingRecovery exn m = CompileThreadStatic.DiagnosticsLogger.StopProcessingRecovery exn m + +let errorRecoveryNoRange exn = CompileThreadStatic.DiagnosticsLogger.ErrorRecoveryNoRange exn + +let report f = + f() + +let deprecatedWithError s m = errorR(Deprecated(s, m)) + +let libraryOnlyError m = errorR(LibraryUseOnly m) + +let libraryOnlyWarning m = warning(LibraryUseOnly m) + +let deprecatedOperator m = deprecatedWithError (FSComp.SR.elDeprecatedOperator()) m + +let mlCompatWarning s m = warning(UserCompilerMessage(FSComp.SR.mlCompatMessage s, 62, m)) + +let mlCompatError s m = errorR(UserCompilerMessage(FSComp.SR.mlCompatError s, 62, m)) + +let suppressErrorReporting f = + let errorLogger = CompileThreadStatic.DiagnosticsLogger + try + let errorLogger = + { new DiagnosticsLogger("suppressErrorReporting") with + member _.DiagnosticSink(_phasedError, _isError) = () + member _.ErrorCount = 0 } + SetThreadDiagnosticsLoggerNoUnwind errorLogger + f() + finally + SetThreadDiagnosticsLoggerNoUnwind errorLogger + +let conditionallySuppressErrorReporting cond f = if cond then suppressErrorReporting f else f() + +//------------------------------------------------------------------------ +// Errors as data: Sometimes we have to reify errors as data, e.g. if backtracking + +/// The result type of a computational modality to colelct warnings and possibly fail +[] +type OperationResult<'T> = + | OkResult of warnings: exn list * 'T + | ErrorResult of warnings: exn list * exn + +type ImperativeOperationResult = OperationResult + +let ReportWarnings warns = + match warns with + | [] -> () // shortcut in common case + | _ -> List.iter warning warns + +let CommitOperationResult res = + match res with + | OkResult (warns, res) -> ReportWarnings warns; res + | ErrorResult (warns, err) -> ReportWarnings warns; error err + +let RaiseOperationResult res : unit = CommitOperationResult res + +let ErrorD err = ErrorResult([], err) + +let WarnD err = OkResult([err], ()) + +let CompleteD = OkResult([], ()) + +let ResultD x = OkResult([], x) + +let CheckNoErrorsAndGetWarnings res = + match res with + | OkResult (warns, res2) -> Some (warns, res2) + | ErrorResult _ -> None + +/// The bind in the monad. Stop on first error. Accumulate warnings and continue. +let (++) res f = + match res with + | OkResult([], res) -> (* tailcall *) f res + | OkResult(warns, res) -> + match f res with + | OkResult(warns2, res2) -> OkResult(warns@warns2, res2) + | ErrorResult(warns2, err) -> ErrorResult(warns@warns2, err) + | ErrorResult(warns, err) -> + ErrorResult(warns, err) + +/// Stop on first error. Accumulate warnings and continue. +let rec IterateD f xs = + match xs with + | [] -> CompleteD + | h :: t -> f h ++ (fun () -> IterateD f t) + +let rec WhileD gd body = if gd() then body() ++ (fun () -> WhileD gd body) else CompleteD + +let MapD f xs = + let rec loop acc xs = + match xs with + | [] -> ResultD (List.rev acc) + | h :: t -> f h ++ (fun x -> loop (x :: acc) t) + + loop [] xs + +type TrackErrorsBuilder() = + member x.Bind(res, k) = res ++ k + member x.Return res = ResultD res + member x.ReturnFrom res = res + member x.For(seq, k) = IterateD k seq + member x.Combine(expr1, expr2) = expr1 ++ expr2 + member x.While(gd, k) = WhileD gd k + member x.Zero() = CompleteD + member x.Delay fn = fun () -> fn () + member x.Run fn = fn () + +let trackErrors = TrackErrorsBuilder() + +/// Stop on first error. Accumulate warnings and continue. +let OptionD f xs = + match xs with + | None -> CompleteD + | Some h -> f h + +/// Stop on first error. Report index +let IterateIdxD f xs = + let rec loop xs i = match xs with [] -> CompleteD | h :: t -> f i h ++ (fun () -> loop t (i+1)) + loop xs 0 + +/// Stop on first error. Accumulate warnings and continue. +let rec Iterate2D f xs ys = + match xs, ys with + | [], [] -> CompleteD + | h1 :: t1, h2 :: t2 -> f h1 h2 ++ (fun () -> Iterate2D f t1 t2) + | _ -> failwith "Iterate2D" + +/// Keep the warnings, propagate the error to the exception continuation. +let TryD f g = + match f() with + | ErrorResult(warns, err) -> + trackErrors { + do! OkResult(warns, ()) + return! g err + } + | res -> res + +let rec RepeatWhileD nDeep body = body nDeep ++ (fun x -> if x then RepeatWhileD (nDeep+1) body else CompleteD) + +let inline AtLeastOneD f l = MapD f l ++ (fun res -> ResultD (List.exists id res)) + +let inline AtLeastOne2D f xs ys = List.zip xs ys |> AtLeastOneD (fun (x,y) -> f x y) + +let inline MapReduceD mapper zero reducer l = MapD mapper l ++ (fun res -> ResultD (match res with [] -> zero | _ -> List.reduce reducer res)) + +let inline MapReduce2D mapper zero reducer xs ys = List.zip xs ys |> MapReduceD (fun (x,y) -> mapper x y) zero reducer + +[] +module OperationResult = + let inline ignore (res: OperationResult<'a>) = + match res with + | OkResult(warnings, _) -> OkResult(warnings, ()) + | ErrorResult(warnings, err) -> ErrorResult(warnings, err) + +// Code below is for --flaterrors flag that is only used by the IDE +let stringThatIsAProxyForANewlineInFlatErrors = String [|char 29 |] + +let NewlineifyErrorString (message:string) = message.Replace(stringThatIsAProxyForANewlineInFlatErrors, Environment.NewLine) + +/// fixes given string by replacing all control chars with spaces. +/// NOTE: newlines are recognized and replaced with stringThatIsAProxyForANewlineInFlatErrors (ASCII 29, the 'group separator'), +/// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo +let NormalizeErrorString (text : string MaybeNull) = + let text = nullArgCheck "text" text + let text = text.Trim() + + let buf = System.Text.StringBuilder() + let mutable i = 0 + while i < text.Length do + let delta = + match text[i] with + | '\r' when i + 1 < text.Length && text[i + 1] = '\n' -> + // handle \r\n sequence - replace it with one single space + buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore + 2 + | '\n' | '\r' -> + buf.Append stringThatIsAProxyForANewlineInFlatErrors |> ignore + 1 + | c -> + // handle remaining chars: control - replace with space, others - keep unchanged + let c = if Char.IsControl c then ' ' else c + buf.Append c |> ignore + 1 + i <- i + delta + buf.ToString() + +let private tryLanguageFeatureErrorAux (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) = + if not (langVersion.SupportsFeature langFeature) then + let featureStr = langVersion.GetFeatureString langFeature + let currentVersionStr = langVersion.SpecifiedVersionString + let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature + Some (Error(FSComp.SR.chkFeatureNotLanguageSupported(featureStr, currentVersionStr, suggestedVersionStr), m)) + else + None + +let internal checkLanguageFeatureError langVersion langFeature m = + match tryLanguageFeatureErrorAux langVersion langFeature m with + | Some e -> error e + | None -> () + +let internal checkLanguageFeatureErrorRecover langVersion langFeature m = + match tryLanguageFeatureErrorAux langVersion langFeature m with + | Some e -> errorR e + | None -> () + +let internal tryLanguageFeatureErrorOption langVersion langFeature m = + tryLanguageFeatureErrorAux langVersion langFeature m + +let internal languageFeatureNotSupportedInLibraryError (langVersion: LanguageVersion) (langFeature: LanguageFeature) (m: range) = + let featureStr = langVersion.GetFeatureString langFeature + let suggestedVersionStr = langVersion.GetFeatureVersionString langFeature + error (Error(FSComp.SR.chkFeatureNotSupportedInLibrary(featureStr, suggestedVersionStr), m)) + +/// Guard against depth of expression nesting, by moving to new stack when a maximum depth is reached +type StackGuard(maxDepth: int) = + + let mutable depth = 1 + + member _.Guard(f) = + depth <- depth + 1 + try + if depth % maxDepth = 0 then + let errorLogger = CompileThreadStatic.DiagnosticsLogger + let buildPhase = CompileThreadStatic.BuildPhase + async { + do! Async.SwitchToNewThread() + Thread.CurrentThread.Name <- "F# Extra Compilation Thread" + use _scope = new CompilationGlobalsScope(errorLogger, buildPhase) + return f() + } |> Async.RunImmediate + else + f() + finally + depth <- depth - 1 + + static member val DefaultDepth = +#if DEBUG + GetEnvInteger "FSHARP_DefaultStackGuardDepth" 50 +#else + GetEnvInteger "FSHARP_DefaultStackGuardDepth" 100 +#endif + + static member GetDepthOption (name: string) = + GetEnvInteger ("FSHARP_" + name + "StackGuardDepth") StackGuard.DefaultDepth + diff --git a/src/fsharp/DiagnosticsLogger.fsi b/src/fsharp/DiagnosticsLogger.fsi new file mode 100644 index 00000000000..18c57bc81f3 --- /dev/null +++ b/src/fsharp/DiagnosticsLogger.fsi @@ -0,0 +1,393 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module internal FSharp.Compiler.DiagnosticsLogger + +open System +open FSharp.Compiler.Diagnostics +open FSharp.Compiler.Features +open FSharp.Compiler.Text + +/// Represents the style being used to format errors +[] +type ErrorStyle = + | DefaultErrors + | EmacsErrors + | TestErrors + | VSErrors + | GccErrors + +/// Thrown when we want to add some range information to a .NET exception +exception WrappedError of exn * range + +/// Thrown when immediate, local error recovery is not possible. This indicates +/// we've reported an error but need to make a non-local transfer of control. +/// Error recovery may catch this and continue (see 'errorRecovery') +/// +/// The exception that caused the report is carried as data because in some +/// situations (LazyWithContext) we may need to re-report the original error +/// when a lazy thunk is re-evaluated. +exception ReportedError of exn option + +val findOriginalException: err: exn -> exn + +type Suggestions = (string -> unit) -> unit + +val NoSuggestions: Suggestions + +/// Thrown when we stop processing the F# Interactive entry or #load. +exception StopProcessingExn of exn option + +val (|StopProcessing|_|): exn: exn -> unit option + +val StopProcessing<'T> : exn + +exception Error of (int * string) * range + +exception InternalError of msg: string * range + +exception UserCompilerMessage of string * int * range + +exception LibraryUseOnly of range + +exception Deprecated of string * range + +exception Experimental of string * range + +exception PossibleUnverifiableCode of range + +exception UnresolvedReferenceNoRange of string + +exception UnresolvedReferenceError of string * range + +exception UnresolvedPathReferenceNoRange of string * string + +exception UnresolvedPathReference of string * string * range + +exception ErrorWithSuggestions of (int * string) * range * string * Suggestions + +val inline protectAssemblyExploration: dflt: 'a -> f: (unit -> 'a) -> 'a + +val inline protectAssemblyExplorationF: dflt: (string * string -> 'a) -> f: (unit -> 'a) -> 'a + +val inline protectAssemblyExplorationNoReraise: dflt1: 'a -> dflt2: 'a -> f: (unit -> 'a) -> 'a + +val AttachRange: m: range -> exn: exn -> exn + +type Exiter = + abstract member Exit: int -> 'T + +val QuitProcessExiter: Exiter + +/// Closed enumeration of build phases. +[] +type BuildPhase = + | DefaultPhase + | Compile + | Parameter + | Parse + | TypeCheck + | CodeGen + | Optimize + | IlxGen + | IlGen + | Output + | Interactive + +/// Literal build phase subcategory strings. +module BuildPhaseSubcategory = + [] + val DefaultPhase: string = "" + + [] + val Compile: string = "compile" + + [] + val Parameter: string = "parameter" + + [] + val Parse: string = "parse" + + [] + val TypeCheck: string = "typecheck" + + [] + val CodeGen: string = "codegen" + + [] + val Optimize: string = "optimize" + + [] + val IlxGen: string = "ilxgen" + + [] + val IlGen: string = "ilgen" + + [] + val Output: string = "output" + + [] + val Interactive: string = "interactive" + + [] + val Internal: string = "internal" + +type PhasedDiagnostic = + { Exception: exn + Phase: BuildPhase } + + /// Construct a phased error + static member Create: exn: exn * phase: BuildPhase -> PhasedDiagnostic + + /// Return true if the textual phase given is from the compile part of the build process. + /// This set needs to be equal to the set of subcategories that the language service can produce. + static member IsSubcategoryOfCompile: subcategory: string -> bool + + member DebugDisplay: unit -> string + + /// Return true if this phase is one that's known to be part of the 'compile'. This is the initial phase of the entire compilation that + /// the language service knows about. + member IsPhaseInCompile: unit -> bool + + /// This is the textual subcategory to display in error and warning messages (shows only under --vserrors): + /// + /// file1.fs(72): subcategory warning FS0072: This is a warning message + /// + member Subcategory: unit -> string + +[] +type DiagnosticsLogger = + + new: nameForDebugging: string -> DiagnosticsLogger + + member DebugDisplay: unit -> string + + abstract member DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + + abstract member ErrorCount: int + +val DiscardErrorsLogger: DiagnosticsLogger + +val AssertFalseDiagnosticsLogger: DiagnosticsLogger + +type CapturingDiagnosticsLogger = + inherit DiagnosticsLogger + + new: nm: string -> CapturingDiagnosticsLogger + + member CommitDelayedDiagnostics: errorLogger: DiagnosticsLogger -> unit + + override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + + member Diagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) list + + override ErrorCount: int + +[] +type CompileThreadStatic = + + static member BuildPhase: BuildPhase with get, set + + static member BuildPhaseUnchecked: BuildPhase + + static member DiagnosticsLogger: DiagnosticsLogger with get, set + +[] +module DiagnosticsLoggerExtensions = + + val tryAndDetectDev15: bool + + /// Instruct the exception not to reset itself when thrown again. + val PreserveStackTrace: exn: 'a -> unit + + /// Reraise an exception if it is one we want to report to Watson. + val ReraiseIfWatsonable: exn: exn -> unit + + type DiagnosticsLogger with + + member ErrorR: exn: exn -> unit + member Warning: exn: exn -> unit + member Error: exn: exn -> 'b + member SimulateError: ph: PhasedDiagnostic -> 'a + member ErrorRecovery: exn: exn -> m: range -> unit + member StopProcessingRecovery: exn: exn -> m: range -> unit + member ErrorRecoveryNoRange: exn: exn -> unit + +/// NOTE: The change will be undone when the returned "unwind" object disposes +val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable + +/// NOTE: The change will be undone when the returned "unwind" object disposes +val PushDiagnosticsLoggerPhaseUntilUnwind: errorLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable + +val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit + +val SetThreadDiagnosticsLoggerNoUnwind: errorLogger: DiagnosticsLogger -> unit + +/// Reports an error diagnostic and continues +val errorR: exn: exn -> unit + +/// Reports a warning diagnostic +val warning: exn: exn -> unit + +/// Reports an error and raises a ReportedError exception +val error: exn: exn -> 'a + +/// Reports an informational diagnostic +val informationalWarning: exn: exn -> unit + +val simulateError: p: PhasedDiagnostic -> 'a + +val diagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + +val errorSink: pe: PhasedDiagnostic -> unit + +val warnSink: pe: PhasedDiagnostic -> unit + +val errorRecovery: exn: exn -> m: range -> unit + +val stopProcessingRecovery: exn: exn -> m: range -> unit + +val errorRecoveryNoRange: exn: exn -> unit + +val report: f: (unit -> 'a) -> 'a + +val deprecatedWithError: s: string -> m: range -> unit + +val libraryOnlyError: m: range -> unit + +val libraryOnlyWarning: m: range -> unit + +val deprecatedOperator: m: range -> unit + +val mlCompatWarning: s: string -> m: range -> unit + +val mlCompatError: s: string -> m: range -> unit + +val suppressErrorReporting: f: (unit -> 'a) -> 'a + +val conditionallySuppressErrorReporting: cond: bool -> f: (unit -> 'a) -> 'a + +/// The result type of a computational modality to colelct warnings and possibly fail +[] +type OperationResult<'T> = + | OkResult of warnings: exn list * 'T + | ErrorResult of warnings: exn list * exn + +type ImperativeOperationResult = OperationResult + +val ReportWarnings: warns: #exn list -> unit + +val CommitOperationResult: res: OperationResult<'a> -> 'a + +val RaiseOperationResult: res: OperationResult -> unit + +val ErrorD: err: exn -> OperationResult<'a> + +val WarnD: err: exn -> OperationResult + +val CompleteD: OperationResult + +val ResultD: x: 'a -> OperationResult<'a> + +val CheckNoErrorsAndGetWarnings: res: OperationResult<'a> -> (exn list * 'a) option + +val (++): res: OperationResult<'a> -> f: ('a -> OperationResult<'b>) -> OperationResult<'b> + +/// Stop on first error. Accumulate warnings and continue. +val IterateD: f: ('a -> OperationResult) -> xs: 'a list -> OperationResult + +val WhileD: gd: (unit -> bool) -> body: (unit -> OperationResult) -> OperationResult + +val MapD: f: ('a -> OperationResult<'b>) -> xs: 'a list -> OperationResult<'b list> + +type TrackErrorsBuilder = + + new: unit -> TrackErrorsBuilder + + member Bind: res: OperationResult<'h> * k: ('h -> OperationResult<'i>) -> OperationResult<'i> + + member Combine: expr1: OperationResult<'c> * expr2: ('c -> OperationResult<'d>) -> OperationResult<'d> + + member Delay: fn: (unit -> 'b) -> (unit -> 'b) + + member For: seq: 'e list * k: ('e -> OperationResult) -> OperationResult + + member Return: res: 'g -> OperationResult<'g> + + member ReturnFrom: res: 'f -> 'f + + member Run: fn: (unit -> 'a) -> 'a + + member While: gd: (unit -> bool) * k: (unit -> OperationResult) -> OperationResult + + member Zero: unit -> OperationResult + +val trackErrors: TrackErrorsBuilder + +val OptionD: f: ('a -> OperationResult) -> xs: 'a option -> OperationResult + +val IterateIdxD: f: (int -> 'a -> OperationResult) -> xs: 'a list -> OperationResult + +/// Stop on first error. Accumulate warnings and continue. +val Iterate2D: f: ('a -> 'b -> OperationResult) -> xs: 'a list -> ys: 'b list -> OperationResult + +val TryD: f: (unit -> OperationResult<'a>) -> g: (exn -> OperationResult<'a>) -> OperationResult<'a> + +val RepeatWhileD: nDeep: int -> body: (int -> OperationResult) -> OperationResult + +val inline AtLeastOneD: f: ('a -> OperationResult) -> l: 'a list -> OperationResult + +val inline AtLeastOne2D: f: ('a -> 'b -> OperationResult) -> xs: 'a list -> ys: 'b list -> OperationResult + +val inline MapReduceD: + mapper: ('a -> OperationResult<'b>) -> zero: 'b -> reducer: ('b -> 'b -> 'b) -> l: 'a list -> OperationResult<'b> + +val inline MapReduce2D: + mapper: ('a -> 'b -> OperationResult<'c>) -> + zero: 'c -> + reducer: ('c -> 'c -> 'c) -> + xs: 'a list -> + ys: 'b list -> + OperationResult<'c> + +module OperationResult = + val inline ignore: res: OperationResult<'a> -> OperationResult + +// For --flaterrors flag that is only used by the IDE +val stringThatIsAProxyForANewlineInFlatErrors: String + +val NewlineifyErrorString: message: string -> string + +/// fixes given string by replacing all control chars with spaces. +/// NOTE: newlines are recognized and replaced with stringThatIsAProxyForANewlineInFlatErrors (ASCII 29, the 'group separator'), +/// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo +val NormalizeErrorString: text: string -> string + +val checkLanguageFeatureError: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit + +val checkLanguageFeatureErrorRecover: langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> unit + +val tryLanguageFeatureErrorOption: + langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> exn option + +val languageFeatureNotSupportedInLibraryError: + langVersion: LanguageVersion -> langFeature: LanguageFeature -> m: range -> 'a + +type StackGuard = + new: maxDepth: int -> StackGuard + + /// Execute the new function, on a new thread if necessary + member Guard: f: (unit -> 'T) -> 'T + + static member GetDepthOption: string -> int + +/// This represents the global state established as each task function runs as part of the build. +/// +/// Use to reset error and warning handlers. +type CompilationGlobalsScope = + new: errorLogger: DiagnosticsLogger * buildPhase: BuildPhase -> CompilationGlobalsScope + + interface IDisposable + + member DiagnosticsLogger: DiagnosticsLogger + + member BuildPhase: BuildPhase From 5b7b058b30905df7c863cd59f0ddd40494ea9616 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:10:13 +0100 Subject: [PATCH 06/19] fix code formating --- src/fsharp/DiagnosticsLogger.fsi | 3 ++- src/fsharp/LowerCalls.fsi | 1 - src/fsharp/LowerSequences.fsi | 3 ++- src/fsharp/TypedTreeOps.fsi | 18 +++++++++--------- src/fsharp/fsc.fsi | 3 ++- src/fsharp/import.fsi | 4 ++-- src/fsharp/service/ServiceLexing.fsi | 1 + 7 files changed, 18 insertions(+), 15 deletions(-) diff --git a/src/fsharp/DiagnosticsLogger.fsi b/src/fsharp/DiagnosticsLogger.fsi index 18c57bc81f3..1ea8fae6366 100644 --- a/src/fsharp/DiagnosticsLogger.fsi +++ b/src/fsharp/DiagnosticsLogger.fsi @@ -216,7 +216,8 @@ module DiagnosticsLoggerExtensions = val PushThreadBuildPhaseUntilUnwind: phase: BuildPhase -> IDisposable /// NOTE: The change will be undone when the returned "unwind" object disposes -val PushDiagnosticsLoggerPhaseUntilUnwind: errorLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable +val PushDiagnosticsLoggerPhaseUntilUnwind: + errorLoggerTransformer: (DiagnosticsLogger -> #DiagnosticsLogger) -> IDisposable val SetThreadBuildPhaseNoUnwind: phase: BuildPhase -> unit diff --git a/src/fsharp/LowerCalls.fsi b/src/fsharp/LowerCalls.fsi index beca1348653..aecb0ff3f9e 100644 --- a/src/fsharp/LowerCalls.fsi +++ b/src/fsharp/LowerCalls.fsi @@ -8,4 +8,3 @@ open FSharp.Compiler.TypedTree /// Expands under-applied values of known arity to lambda expressions, and then reduce to bind /// any known arguments. The results are later optimized by Optimizer.fs val LowerImplFile: g: TcGlobals -> assembly: TypedImplFile -> TypedImplFile - diff --git a/src/fsharp/LowerSequences.fsi b/src/fsharp/LowerSequences.fsi index 05a5b81c599..aa675cda5c0 100644 --- a/src/fsharp/LowerSequences.fsi +++ b/src/fsharp/LowerSequences.fsi @@ -11,7 +11,8 @@ open FSharp.Compiler.Text /// Detect a 'seq' type val (|SeqElemTy|_|): TcGlobals -> ImportMap -> range -> TType -> TType option -val callNonOverloadedILMethod: g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr +val callNonOverloadedILMethod: + g: TcGlobals -> amap: ImportMap -> m: range -> methName: string -> ty: TType -> args: Exprs -> Expr /// Analyze a TAST expression to detect the elaborated form of a sequence expression. /// Then compile it to a state machine represented as a TAST containing goto, return and label nodes. diff --git a/src/fsharp/TypedTreeOps.fsi b/src/fsharp/TypedTreeOps.fsi index 6a7c4c6984f..045425f3513 100755 --- a/src/fsharp/TypedTreeOps.fsi +++ b/src/fsharp/TypedTreeOps.fsi @@ -2611,31 +2611,31 @@ val (|IfThenElseExpr|_|): expr: Expr -> (Expr * Expr * Expr) option val ComputeUseMethodImpl: g: TcGlobals -> v: Val -> bool /// Detect the de-sugared form of a 'yield x' within a 'seq { ... }' -val (|SeqYield|_|) : TcGlobals -> Expr -> (Expr * range) option +val (|SeqYield|_|): TcGlobals -> Expr -> (Expr * range) option /// Detect the de-sugared form of a 'expr; expr' within a 'seq { ... }' -val (|SeqAppend|_|) : TcGlobals -> Expr -> (Expr * Expr * range) option +val (|SeqAppend|_|): TcGlobals -> Expr -> (Expr * Expr * range) option /// Detect the de-sugared form of a 'while gd do expr' within a 'seq { ... }' -val (|SeqWhile|_|) : TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) option +val (|SeqWhile|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtWhile * range) option /// Detect the de-sugared form of a 'try .. finally .. ' within a 'seq { ... }' -val (|SeqTryFinally|_|) : TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) option +val (|SeqTryFinally|_|): TcGlobals -> Expr -> (Expr * Expr * DebugPointAtTry * DebugPointAtFinally * range) option /// Detect the de-sugared form of a 'use x = ..' within a 'seq { ... }' -val (|SeqUsing|_|) : TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) option +val (|SeqUsing|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * DebugPointAtBinding * range) option /// Detect the de-sugared form of a 'for x in collection do ..' within a 'seq { ... }' -val (|SeqForEach|_|) : TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) option +val (|SeqForEach|_|): TcGlobals -> Expr -> (Expr * Val * Expr * TType * range * range * DebugPointAtInOrTo) option /// Detect the outer 'Seq.delay' added for a construct 'seq { ... }' -val (|SeqDelay|_|) : TcGlobals -> Expr -> (Expr * TType) option +val (|SeqDelay|_|): TcGlobals -> Expr -> (Expr * TType) option /// Detect a 'Seq.empty' implicit in the implied 'else' branch of an 'if .. then' in a seq { ... } -val (|SeqEmpty|_|) : TcGlobals -> Expr -> range option +val (|SeqEmpty|_|): TcGlobals -> Expr -> range option /// Detect a 'seq { ... }' expression val (|Seq|_|): TcGlobals -> Expr -> (Expr * TType) option /// Indicates if an F# type is the type associated with an F# exception declaration -val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool \ No newline at end of file +val isFSharpExceptionTy: g: TcGlobals -> ty: TType -> bool diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 11ac0485ba6..6558572b3c1 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -16,7 +16,8 @@ open FSharp.Compiler.TcGlobals [] type DiagnosticsLoggerProvider = new: unit -> DiagnosticsLoggerProvider - abstract CreateDiagnosticsLoggerUpToMaxErrors: tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger + abstract CreateDiagnosticsLoggerUpToMaxErrors: + tcConfigBuilder: TcConfigBuilder * exiter: Exiter -> DiagnosticsLogger /// The default DiagnosticsLoggerProvider implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider = diff --git a/src/fsharp/import.fsi b/src/fsharp/import.fsi index e573870de6b..b9dceb386ae 100644 --- a/src/fsharp/import.fsi +++ b/src/fsharp/import.fsi @@ -100,7 +100,7 @@ val internal ImportILAssemblyTypeForwarders: /// Import an IL type as an F# type, first rescoping to view the metadata from the current assembly /// being compiled. importInst gives the context for interpreting type variables. -val RescopeAndImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType +val RescopeAndImportILType: + scoref: ILScopeRef -> amap: ImportMap -> m: range -> importInst: TType list -> ilty: ILType -> TType val CanRescopeAndImportILType: scoref: ILScopeRef -> amap: ImportMap -> m: range -> ilty: ILType -> bool - diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index 7f882ee3d62..0822067267b 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -6,6 +6,7 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text + #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing From 8aa08b5d17d3eff03b1f60f2759f2c096b877332 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:14:51 +0100 Subject: [PATCH 07/19] rename autobox --> LowerLocalMutables --- .../FSharp.Compiler.Service.fsproj | 8 ++++---- src/fsharp/{autobox.fs => LowerLocalMutables.fs} | 2 +- src/fsharp/{autobox.fsi => LowerLocalMutables.fsi} | 2 +- src/fsharp/OptimizeInputs.fs | 2 +- src/fsharp/import.fsi | 4 ++-- src/fsharp/service/ServiceLexing.fsi | 1 - 6 files changed, 9 insertions(+), 10 deletions(-) rename src/fsharp/{autobox.fs => LowerLocalMutables.fs} (99%) rename src/fsharp/{autobox.fsi => LowerLocalMutables.fsi} (88%) diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 4e2af33a519..9932d69ea63 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -717,11 +717,11 @@ Optimize\LowerStateMachines.fs - - Optimize\autobox.fsi + + Optimize\LowerLocalMutables.fsi - - Optimize\autobox.fs + + Optimize\LowerLocalMutables.fs CodeGen\IlxGen.fsi diff --git a/src/fsharp/autobox.fs b/src/fsharp/LowerLocalMutables.fs similarity index 99% rename from src/fsharp/autobox.fs rename to src/fsharp/LowerLocalMutables.fs index 5a225db54d4..08b46d70727 100644 --- a/src/fsharp/autobox.fs +++ b/src/fsharp/LowerLocalMutables.fs @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.AutoBox +module internal FSharp.Compiler.LowerLocalMutables open Internal.Utilities.Collections open Internal.Utilities.Library.Extras diff --git a/src/fsharp/autobox.fsi b/src/fsharp/LowerLocalMutables.fsi similarity index 88% rename from src/fsharp/autobox.fsi rename to src/fsharp/LowerLocalMutables.fsi index 1c2f32b13a6..614bdda7164 100644 --- a/src/fsharp/autobox.fsi +++ b/src/fsharp/LowerLocalMutables.fsi @@ -1,6 +1,6 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -module internal FSharp.Compiler.AutoBox +module internal FSharp.Compiler.LowerLocalMutables open FSharp.Compiler.Import open FSharp.Compiler.TcGlobals diff --git a/src/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index 6b7a898f579..4ba358d7172 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -80,7 +80,7 @@ let ApplyAllOptimizations (tcConfig:TcConfig, tcGlobals, tcVal, outfile, importM optEnvFirstLoop, isIncrementalFragment, tcConfig.fsiMultiAssemblyEmit, tcConfig.emitTailcalls, hidden, implFile) - let implFile = AutoBox.TransformImplFile tcGlobals importMap implFile + let implFile = LowerLocalMutables.TransformImplFile tcGlobals importMap implFile // Only do this on the first pass! let optSettings = { optSettings with abstractBigTargets = false; reportingPhase = false } diff --git a/src/fsharp/import.fsi b/src/fsharp/import.fsi index b9dceb386ae..acc5869615c 100644 --- a/src/fsharp/import.fsi +++ b/src/fsharp/import.fsi @@ -65,10 +65,10 @@ val internal CanImportILType: ImportMap -> range -> ILType -> bool #if !NO_TYPEPROVIDERS /// Import a provided type as an F# type. -val internal ImportProvidedType: ImportMap -> range (* TType list -> *) -> Tainted -> TType +val internal ImportProvidedType: ImportMap -> range -> Tainted -> TType /// Import a provided type reference as an F# type TyconRef -val internal ImportProvidedNamedType: ImportMap -> range (* TType list -> *) -> Tainted -> TyconRef +val internal ImportProvidedNamedType: ImportMap -> range -> Tainted -> TyconRef /// Import a provided type as an AbstractIL type val internal ImportProvidedTypeAsILType: ImportMap -> range -> Tainted -> ILType diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index 0822067267b..7f882ee3d62 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -6,7 +6,6 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text - #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing From 6e99f00cc73d1910a00a3a0c63b3c869050e4e08 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:27:35 +0100 Subject: [PATCH 08/19] adjust names --- src/fsharp/service/IncrementalBuild.fs | 25 ++++---- src/fsharp/service/IncrementalBuild.fsi | 5 +- src/fsharp/service/service.fs | 85 ++++++++++++++----------- src/fsharp/symbols/FSharpDiagnostic.fs | 22 +++---- src/fsharp/symbols/FSharpDiagnostic.fsi | 4 +- 5 files changed, 76 insertions(+), 65 deletions(-) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 52f827079a7..785cc86d7c8 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -181,16 +181,16 @@ type TcInfo = latestCcuSigForFile: ModuleOrNamespaceType option - /// Accumulated errors, last file first - tcErrorsRev:(PhasedDiagnostic * FSharpDiagnosticSeverity)[] list + /// Accumulated diagnostics, last file first + tcDiagnosticsRev:(PhasedDiagnostic * FSharpDiagnosticSeverity)[] list tcDependencyFiles: string list sigNameOpt: (string * QualifiedNameOfFile) option } - member x.TcErrors = - Array.concat (List.rev x.tcErrorsRev) + member x.TcDiagnostics = + Array.concat (List.rev x.tcDiagnosticsRev) /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] @@ -375,10 +375,10 @@ type BoundModel private (tcConfig: TcConfig, Some syntaxTree, None) - member this.Finish(finalTcErrorsRev, finalTopAttribs) = + member this.Finish(finalTcDiagnosticsRev, finalTopAttribs) = node { let createFinish tcInfo = - { tcInfo with tcErrorsRev = finalTcErrorsRev; topAttribs = finalTopAttribs } + { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } let! finishState = node { @@ -475,7 +475,7 @@ type BoundModel private (tcConfig: TcConfig, beforeFileChecked.Trigger fileName let prevModuleNamesDict = prevTcInfo.moduleNamesDict let prevTcState = prevTcInfo.tcState - let prevTcErrorsRev = prevTcInfo.tcErrorsRev + let prevTcDiagnosticsRev = prevTcInfo.tcDiagnosticsRev let prevTcDependencyFiles = prevTcInfo.tcDependencyFiles ApplyMetaCommandsFromInputToTcConfig (tcConfig, input, Path.GetDirectoryName fileName, tcImports.DependencyProvider) |> ignore @@ -508,7 +508,7 @@ type BoundModel private (tcConfig: TcConfig, tcEnvAtEndOfFile = tcEnvAtEndOfFile moduleNamesDict = moduleNamesDict latestCcuSigForFile = Some ccuSigForFile - tcErrorsRev = newErrors :: prevTcErrorsRev + tcDiagnosticsRev = newErrors :: prevTcDiagnosticsRev topAttribs = Some topAttribs tcDependencyFiles = fileName :: prevTcDependencyFiles sigNameOpt = @@ -799,7 +799,7 @@ module IncrementalBuilderHelpers = tcEnvAtEndOfFile=tcInitial topAttribs=None latestCcuSigForFile=None - tcErrorsRev = [ initialErrors ] + tcDiagnosticsRev = [ initialErrors ] moduleNamesDict = Map.empty tcDependencyFiles = basicDependencies sigNameOpt = None @@ -921,7 +921,7 @@ module IncrementalBuilderHelpers = errorRecoveryNoRange exn mkSimpleAssemblyRef assemblyName, ProjectAssemblyDataResult.Unavailable true, None - let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcErrorsRev + let diagnostics = errorLogger.GetDiagnostics() :: finalInfo.tcDiagnosticsRev let! finalBoundModelWithErrors = finalBoundModel.Finish(diagnostics, Some topAttrs) return ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt, finalBoundModelWithErrors } @@ -1402,7 +1402,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc node { - // Trap and report warnings and errors from creation. + // Trap and report diagnostics from creation. let delayedLogger = CapturingDiagnosticsLogger("IncrementalBuilderCreation") use _ = new CompilationGlobalsScope(delayedLogger, BuildPhase.Parameter) @@ -1641,7 +1641,8 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc errorLogger.GetDiagnostics() | _ -> Array.ofList delayedLogger.Diagnostics - |> Array.map (fun (d, severity) -> FSharpDiagnostic.CreateFromException(d, severity, range.Zero, suggestNamesForErrors)) + |> Array.map (fun (diag, severity) -> + FSharpDiagnostic.CreateFromException(diag, severity, range.Zero, suggestNamesForErrors)) return builderOpt, diagnostics } diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 28945e789e0..d55e1dcf7f9 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -57,13 +57,14 @@ type internal TcInfo = latestCcuSigForFile: ModuleOrNamespaceType option /// Accumulated errors, last file first - tcErrorsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list + tcDiagnosticsRev: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] list tcDependencyFiles: string list sigNameOpt: (string * QualifiedNameOfFile) option } - member TcErrors: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] + /// Accumulated diagnostics + member TcDiagnostics: (PhasedDiagnostic * FSharpDiagnosticSeverity) [] /// Accumulated results of type checking. Optional data that isn't needed to type-check a file, but needed for more information for in tooling. [] diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 7895de1ffe1..97d5202c05a 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -85,24 +85,29 @@ module Helpers = && FSharpProjectOptions.UseSameProject(o1,o2) module CompileHelpers = - let mkCompilationErrorHandlers() = - let errors = ResizeArray<_>() + let mkCompilationDiagnosticsHandlers() = + let diagnostics = ResizeArray<_>() - let errorSink isError exn = - let mainError, relatedErrors = SplitRelatedDiagnostics exn - let oneError e = errors.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors - oneError mainError - List.iter oneError relatedErrors + let diagnosticSink isError exn = + let main, related = SplitRelatedDiagnostics exn + let oneDiagnostic e = diagnostics.Add(FSharpDiagnostic.CreateFromException (e, isError, range0, true)) // Suggest names for errors + oneDiagnostic main + List.iter oneDiagnostic related let errorLogger = { new DiagnosticsLogger("CompileAPI") with - member x.DiagnosticSink(exn, isError) = errorSink isError exn - member x.ErrorCount = errors |> Seq.filter (fun e -> e.Severity = FSharpDiagnosticSeverity.Error) |> Seq.length } + + member _.DiagnosticSink(exn, isError) = diagnosticSink isError exn + + member _.ErrorCount = + diagnostics + |> Seq.filter (fun diag -> diag.Severity = FSharpDiagnosticSeverity.Error) + |> Seq.length } let loggerProvider = { new DiagnosticsLoggerProvider() with - member x.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } - errors, errorLogger, loggerProvider + member _.CreateDiagnosticsLoggerUpToMaxErrors(_tcConfigBuilder, _exiter) = errorLogger } + diagnostics, errorLogger, loggerProvider let tryCompile errorLogger f = use unwindParsePhase = PushThreadBuildPhaseUntilUnwind BuildPhase.Parse @@ -118,16 +123,16 @@ module CompileHelpers = /// Compile using the given flags. Source files names are resolved via the FileSystem API. The output file must be given by a -o flag. let compileFromArgs (ctok, argv: string[], legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) = - let errors, errorLogger, loggerProvider = mkCompilationErrorHandlers() + let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() let result = tryCompile errorLogger (fun exiter -> mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) - errors.ToArray(), result + diagnostics.ToArray(), result let compileFromAsts (ctok, legacyReferenceResolver, asts, assemblyName, outFile, dependencies, noframework, pdbFile, executable, tcImportsCapture, dynamicAssemblyCreator) = - let errors, errorLogger, loggerProvider = mkCompilationErrorHandlers() + let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() let executable = defaultArg executable true let target = if executable then CompilerTarget.ConsoleExe else CompilerTarget.Dll @@ -136,7 +141,7 @@ module CompileHelpers = tryCompile errorLogger (fun exiter -> compileOfAst (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) - errors.ToArray(), result + diagnostics.ToArray(), result let createDynamicAssembly (debugInfo: bool, tcImportsRef: TcImports option ref, execute: bool, assemblyBuilderRef: _ option ref) (tcConfig: TcConfig, tcGlobals:TcGlobals, outfile, ilxMainModule) = @@ -573,7 +578,7 @@ type BackgroundCompiler( tcInfo.tcState, tcInfo.moduleNamesDict, loadClosure, - tcInfo.TcErrors, + tcInfo.TcDiagnostics, options.IsIncompleteTypeCheckEnvironment, options, builder, @@ -725,10 +730,10 @@ type BackgroundCompiler( let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile let latestImplementationFile = tcInfoExtras.latestImplFile let tcDependencyFiles = tcInfo.tcDependencyFiles - let tcErrors = tcInfo.TcErrors - let errorOptions = builder.TcConfig.diagnosticsOptions - let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, parseDiags, suggestNamesForErrors) |] - let tcErrors = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, false, fileName, tcErrors, suggestNamesForErrors) |] + let tcDiagnostics = tcInfo.TcDiagnostics + let diagnosticsOptions = builder.TcConfig.diagnosticsOptions + let parseDiags = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, parseDiags, suggestNamesForErrors) |] + let tcDiagnostics = [| yield! creationDiags; yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, false, fileName, tcDiagnostics, suggestNamesForErrors) |] let parseResults = FSharpParseFileResults(diagnostics=parseDiags, input=parseTree, parseHadErrors=false, dependencyFiles=builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCache.TryGet(AnyCallerThread, options) let typedResults = @@ -743,7 +748,7 @@ type BackgroundCompiler( Array.ofList tcDependencyFiles, creationDiags, parseResults.Diagnostics, - tcErrors, + tcDiagnostics, keepAssemblyContents, Option.get latestCcuSigForFile, tcState.Ccu, @@ -815,7 +820,7 @@ type BackgroundCompiler( return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationDiags, None) | Some builder -> let! tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = builder.GetFullCheckResultsAndImplementationsForProject() - let errorOptions = tcProj.TcConfig.diagnosticsOptions + let diagnosticsOptions = tcProj.TcConfig.diagnosticsOptions let fileName = DummyFileNameForRangesWithoutASpecificLocation // Although we do not use 'tcInfoExtras', computing it will make sure we get an extra info. @@ -824,28 +829,32 @@ type BackgroundCompiler( let topAttribs = tcInfo.topAttribs let tcState = tcInfo.tcState let tcEnvAtEnd = tcInfo.tcEnvAtEndOfFile - let tcErrors = tcInfo.TcErrors + let tcDiagnostics = tcInfo.TcDiagnostics let tcDependencyFiles = tcInfo.tcDependencyFiles let diagnostics = [| yield! creationDiags; - yield! DiagnosticHelpers.CreateDiagnostics (errorOptions, true, fileName, tcErrors, suggestNamesForErrors) |] + yield! DiagnosticHelpers.CreateDiagnostics (diagnosticsOptions, true, fileName, tcDiagnostics, suggestNamesForErrors) |] let getAssemblyData() = match tcAssemblyDataOpt with | ProjectAssemblyDataResult.Available data -> Some data | _ -> None + let details = + (tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, + Choice1Of2 builder, topAttribs, getAssemblyData, ilAssemRef, + tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, + Array.ofList tcDependencyFiles, + options) + let results = - FSharpCheckProjectResults - (options.ProjectFileName, + FSharpCheckProjectResults( + options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, - diagnostics, - Some(tcProj.TcGlobals, tcProj.TcImports, tcState.Ccu, tcState.CcuSig, - (Choice1Of2 builder), topAttribs, getAssemblyData, ilAssemRef, - tcEnvAtEnd.AccessRights, tcAssemblyExprOpt, - Array.ofList tcDependencyFiles, - options)) + diagnostics, + Some details + ) return results } @@ -878,7 +887,7 @@ type BackgroundCompiler( member _.GetProjectOptionsFromScript(fileName, sourceText, previewEnabled, loadedTimeStamp, otherFlags, useFsiAuxLib: bool option, useSdkRefs: bool option, sdkDirOverride: string option, assumeDotNetFramework: bool option, optionsStamp: int64 option, _userOpName) = cancellable { - use errors = new DiagnosticsScope() + use diagnostics = new DiagnosticsScope() // Do we add a reference to FSharp.Compiler.Interactive.Settings by default? let useFsiAuxLib = defaultArg useFsiAuxLib true @@ -935,7 +944,7 @@ type BackgroundCompiler( } scriptClosureCache.Set(AnyCallerThread, options, loadClosure) // Save the full load closure for later correlation. let diags = loadClosure.LoadClosureRootFileDiagnostics |> List.map (fun (exn, isError) -> FSharpDiagnostic.CreateFromException(exn, isError, range.Zero, false)) - return options, (diags @ errors.Diagnostics) + return options, (diags @ diagnostics.Diagnostics) } |> Cancellable.toAsync @@ -1150,7 +1159,7 @@ type FSharpChecker(legacyReferenceResolver, let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) // Perform the compilation, given the above capturing function. - let errorsAndWarnings, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) + let diagnostics, result = CompileHelpers.compileFromArgs (ctok, otherFlags, legacyReferenceResolver, tcImportsCapture, dynamicAssemblyCreator) // Retrieve and return the results let assemblyOpt = @@ -1158,7 +1167,7 @@ type FSharpChecker(legacyReferenceResolver, | None -> None | Some a -> Some (a :> Assembly) - return errorsAndWarnings, result, assemblyOpt + return diagnostics, result, assemblyOpt } member _.CompileToDynamicAssembly (ast:ParsedInput list, assemblyName:string, dependencies:string list, execute: (TextWriter * TextWriter) option, ?debug:bool, ?noframework:bool, ?userOpName: string) = @@ -1183,7 +1192,7 @@ type FSharpChecker(legacyReferenceResolver, let dynamicAssemblyCreator = Some (CompileHelpers.createDynamicAssembly (debugInfo, tcImportsRef, execute.IsSome, assemblyBuilderRef)) // Perform the compilation, given the above capturing function. - let errorsAndWarnings, result = + let diagnostics, result = CompileHelpers.compileFromAsts (ctok, legacyReferenceResolver, ast, assemblyName, outFile, dependencies, noframework, None, Some execute.IsSome, tcImportsCapture, dynamicAssemblyCreator) // Retrieve and return the results @@ -1192,7 +1201,7 @@ type FSharpChecker(legacyReferenceResolver, | None -> None | Some a -> Some (a :> Assembly) - return errorsAndWarnings, result, assemblyOpt + return diagnostics, result, assemblyOpt } /// This function is called when the entire environment is known to have changed for reasons not encoded in the ProjectOptions of any project/compilation. diff --git a/src/fsharp/symbols/FSharpDiagnostic.fs b/src/fsharp/symbols/FSharpDiagnostic.fs index 5f9bb7060b6..09e118a3ea4 100644 --- a/src/fsharp/symbols/FSharpDiagnostic.fs +++ b/src/fsharp/symbols/FSharpDiagnostic.fs @@ -71,23 +71,23 @@ type FSharpDiagnostic(m: range, severity: FSharpDiagnosticSeverity, message: str sprintf "%s (%d,%d)-(%d,%d) %s %s %s" fileName s.Line (s.Column + 1) e.Line (e.Column + 1) subcategory severity message /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromException(exn, severity, fallbackRange: range, suggestNames: bool) = - let m = match GetRangeOfDiagnostic exn with Some m -> m | None -> fallbackRange - let msg = bufs (fun buf -> OutputPhasedDiagnostic buf exn false suggestNames) - let errorNum = GetDiagnosticNumber exn - FSharpDiagnostic(m, severity, msg, exn.Subcategory(), errorNum, "FS") + static member CreateFromException(diag, severity, fallbackRange: range, suggestNames: bool) = + let m = match GetRangeOfDiagnostic diag with Some m -> m | None -> fallbackRange + let msg = bufs (fun buf -> OutputPhasedDiagnostic buf diag false suggestNames) + let errorNum = GetDiagnosticNumber diag + FSharpDiagnostic(m, severity, msg, diag.Subcategory(), errorNum, "FS") /// Decompose a warning or error into parts: position, severity, message, error number - static member CreateFromExceptionAndAdjustEof(exn, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = - let r = FSharpDiagnostic.CreateFromException(exn, severity, fallbackRange, suggestNames) + static member CreateFromExceptionAndAdjustEof(diag, severity, fallbackRange: range, (linesCount: int, lastLength: int), suggestNames: bool) = + let diag = FSharpDiagnostic.CreateFromException(diag, severity, fallbackRange, suggestNames) // Adjust to make sure that errors reported at Eof are shown at the linesCount - let startline, schange = min (Line.toZ r.Range.StartLine, false) (linesCount, true) - let endline, echange = min (Line.toZ r.Range.EndLine, false) (linesCount, true) + let startline, schange = min (Line.toZ diag.Range.StartLine, false) (linesCount, true) + let endline, echange = min (Line.toZ diag.Range.EndLine, false) (linesCount, true) - if not (schange || echange) then r + if not (schange || echange) then diag else - let r = if schange then r.WithStart(mkPos startline lastLength) else r + let r = if schange then diag.WithStart(mkPos startline lastLength) else diag if echange then r.WithEnd(mkPos endline (1 + lastLength)) else r static member NewlineifyErrorString(message) = NewlineifyErrorString(message) diff --git a/src/fsharp/symbols/FSharpDiagnostic.fsi b/src/fsharp/symbols/FSharpDiagnostic.fsi index 6555d013464..4b6027e9dce 100644 --- a/src/fsharp/symbols/FSharpDiagnostic.fsi +++ b/src/fsharp/symbols/FSharpDiagnostic.fsi @@ -67,11 +67,11 @@ type public FSharpDiagnostic = FSharpDiagnostic static member internal CreateFromExceptionAndAdjustEof: - PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> + diag: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> FSharpDiagnostic static member internal CreateFromException: - PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic + diag: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * suggestNames: bool -> FSharpDiagnostic /// Newlines are recognized and replaced with (ASCII 29, the 'group separator'), /// which is decoded by the IDE with 'NewlineifyErrorString' back into newlines, so that multi-line errors can be displayed in QuickInfo From da1526177774651fa41c5b91cd340a2aad429cbd Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:48:01 +0100 Subject: [PATCH 09/19] block --> ImmutableArray --- src/fsharp/CompilerImports.fs | 6 +- src/fsharp/CompilerImports.fsi | 6 +- .../FSharp.Compiler.Service.fsproj | 8 +- src/fsharp/{block.fs => ImmutableArray.fs} | 53 ++++++------ src/fsharp/ImmutableArray.fsi | 57 +++++++++++++ src/fsharp/OptimizeInputs.fs | 2 - src/fsharp/block.fsi | 63 -------------- src/fsharp/service/IncrementalBuild.fs | 82 ++++++++++--------- src/fsharp/symbols/FSharpDiagnostic.fsi | 6 +- 9 files changed, 139 insertions(+), 144 deletions(-) rename src/fsharp/{block.fs => ImmutableArray.fs} (74%) create mode 100644 src/fsharp/ImmutableArray.fsi delete mode 100644 src/fsharp/block.fsi diff --git a/src/fsharp/CompilerImports.fs b/src/fsharp/CompilerImports.fs index 77d147c3aef..bafd28ed504 100644 --- a/src/fsharp/CompilerImports.fs +++ b/src/fsharp/CompilerImports.fs @@ -172,11 +172,11 @@ let EncodeOptimizationData(tcGlobals, tcConfig: TcConfig, outfile, exportRemappi else [ ] -exception AssemblyNotResolved of (*originalName*) string * range +exception AssemblyNotResolved of originalName: string * range: range -exception MSBuildReferenceResolutionWarning of (*MSBuild warning code*)string * (*Message*)string * range +exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range -exception MSBuildReferenceResolutionError of (*MSBuild warning code*)string * (*Message*)string * range +exception MSBuildReferenceResolutionError of message: string * warningCode: string * range: range let OpenILBinary(fileName, reduceMemoryUsage, pdbDirPath, shadowCopyReferences, tryGetMetadataSnapshot) = let opts: ILReaderOptions = diff --git a/src/fsharp/CompilerImports.fsi b/src/fsharp/CompilerImports.fsi index 0b37beef46d..ca2f3c53c53 100644 --- a/src/fsharp/CompilerImports.fsi +++ b/src/fsharp/CompilerImports.fsi @@ -25,13 +25,13 @@ open FSharp.Compiler.TypeProviders #endif /// This exception is an old-style way of reporting a diagnostic -exception AssemblyNotResolved of string * range (*originalName*) +exception AssemblyNotResolved of originalName: string * range: range /// This exception is an old-style way of reporting a diagnostic -exception MSBuildReferenceResolutionWarning of string (*Message*) * string * range (*MSBuild warning code*) +exception MSBuildReferenceResolutionWarning of message: string * warningCode: string * range: range /// This exception is an old-style way of reporting a diagnostic -exception MSBuildReferenceResolutionError of string (*Message*) * string * range (*MSBuild warning code*) +exception MSBuildReferenceResolutionError of message: string * warningCode: string * range: range /// Determine if an IL resource attached to an F# assembly is an F# signature data resource val IsSignatureDataResource: ILResource -> bool diff --git a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 9932d69ea63..9612fe589ac 100644 --- a/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/src/fsharp/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -202,11 +202,11 @@ Utilities\lib.fs - - Utilities\block.fsi + + Utilities\ImmutableArray.fsi - - Utilities\block.fs + + Utilities\ImmutableArray.fs Utilities\rational.fsi diff --git a/src/fsharp/block.fs b/src/fsharp/ImmutableArray.fs similarity index 74% rename from src/fsharp/block.fs rename to src/fsharp/ImmutableArray.fs index 91cec44bd12..d2c4f424615 100644 --- a/src/fsharp/block.fs +++ b/src/fsharp/ImmutableArray.fs @@ -2,22 +2,19 @@ module Internal.Utilities.Library.Block open System.Collections.Immutable -type block<'T> = ImmutableArray<'T> -type blockbuilder<'T> = ImmutableArray<'T>.Builder - [] -module BlockBuilder = +module ImmutableArrayBuilder = - let create size : blockbuilder<'T> = + let create size : ImmutableArray<'T>.Builder = ImmutableArray.CreateBuilder(size) [] -module Block = +module ImmutableArray = [] let empty<'T> = ImmutableArray<'T>.Empty - let init n (f: int -> 'T) : block<_> = + let init n (f: int -> 'T) : ImmutableArray<_> = match n with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(f 0) @@ -30,29 +27,29 @@ module Block = builder.Add(f i) builder.MoveToImmutable() - let iter f (arr: block<'T>) = + let iter f (arr: ImmutableArray<'T>) = for i = 0 to arr.Length - 1 do f arr[i] - let iteri f (arr: block<'T>) = + let iteri f (arr: ImmutableArray<'T>) = for i = 0 to arr.Length - 1 do f i arr[i] - let iter2 f (arr1: block<'T1>) (arr2: block<'T2>) = + let iter2 f (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." for i = 0 to arr1.Length - 1 do f arr1[i] arr2[i] - let iteri2 f (arr1: block<'T1>) (arr2: block<'T2>) = + let iteri2 f (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." for i = 0 to arr1.Length - 1 do f i arr1[i] arr2[i] - let map (mapper: 'T -> 'U) (arr: block<'T>) : block<_> = + let map (mapper: 'T -> 'U) (arr: ImmutableArray<'T>) : ImmutableArray<_> = match arr.Length with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper arr[0]) @@ -62,7 +59,7 @@ module Block = builder.Add(mapper arr[i]) builder.MoveToImmutable() - let mapi (mapper: int -> 'T -> 'U) (arr: block<'T>) : block<_> = + let mapi (mapper: int -> 'T -> 'U) (arr: ImmutableArray<'T>) : ImmutableArray<_> = match arr.Length with | 0 -> ImmutableArray.Empty | 1 -> ImmutableArray.Create(mapper 0 arr[0]) @@ -72,7 +69,7 @@ module Block = builder.Add(mapper i arr[i]) builder.MoveToImmutable() - let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = + let map2 (mapper: 'T1 -> 'T2 -> 'T) (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) : ImmutableArray<_> = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -85,7 +82,7 @@ module Block = builder.Add(mapper arr1[i] arr2[i]) builder.MoveToImmutable() - let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: block<'T1>) (arr2: block<'T2>) : block<_> = + let mapi2 (mapper: int -> 'T1 -> 'T2 -> 'T) (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) : ImmutableArray<_> = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -98,7 +95,7 @@ module Block = builder.Add(mapper i arr1[i] arr2[i]) builder.MoveToImmutable() - let concat (arrs: block>) : block<'T> = + let concat (arrs: ImmutableArray>) : ImmutableArray<'T> = match arrs.Length with | 0 -> ImmutableArray.Empty | 1 -> arrs[0] @@ -113,12 +110,12 @@ module Block = builder.AddRange(arrs[i]) builder.MoveToImmutable() - let forall predicate (arr: block<'T>) = + let forall predicate (arr: ImmutableArray<'T>) = let len = arr.Length let rec loop i = i >= len || (predicate arr[i] && loop (i+1)) loop 0 - let forall2 predicate (arr1: block<'T1>) (arr2: block<'T2>) = + let forall2 predicate (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T2>) = if arr1.Length <> arr2.Length then invalidOp "Block lengths do not match." @@ -127,18 +124,18 @@ module Block = let rec loop i = i >= len1 || (f.Invoke(arr1[i], arr2[i]) && loop (i+1)) loop 0 - let tryFind predicate (arr: block<'T>) = + let tryFind predicate (arr: ImmutableArray<'T>) = let rec loop i = if i >= arr.Length then None else if predicate arr[i] then Some arr[i] else loop (i+1) loop 0 - let tryFindIndex predicate (arr: block<'T>) = + let tryFindIndex predicate (arr: ImmutableArray<'T>) = let len = arr.Length let rec go n = if n >= len then None elif predicate arr[n] then Some n else go (n+1) go 0 - let tryPick chooser (arr: block<'T>) = + let tryPick chooser (arr: ImmutableArray<'T>) = let rec loop i = if i >= arr.Length then None else match chooser arr[i] with @@ -149,13 +146,13 @@ module Block = let ofSeq (xs: 'T seq) = ImmutableArray.CreateRange(xs) - let append (arr1: block<'T1>) (arr2: block<'T1>) : block<_> = + let append (arr1: ImmutableArray<'T1>) (arr2: ImmutableArray<'T1>) : ImmutableArray<_> = arr1.AddRange(arr2) - let createOne (item: 'T) : block<_> = + let createOne (item: 'T) : ImmutableArray<_> = ImmutableArray.Create(item) - let filter predicate (arr: block<'T>) : block<'T> = + let filter predicate (arr: ImmutableArray<'T>) : ImmutableArray<'T> = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do if predicate arr[i] then @@ -163,12 +160,12 @@ module Block = builder.Capacity <- builder.Count builder.MoveToImmutable() - let exists predicate (arr: block<'T>) = + let exists predicate (arr: ImmutableArray<'T>) = let len = arr.Length let rec loop i = i < len && (predicate arr[i] || loop (i+1)) len > 0 && loop 0 - let choose (chooser: 'T -> 'U option) (arr: block<'T>) : block<'U> = + let choose (chooser: 'T -> 'U option) (arr: ImmutableArray<'T>) : ImmutableArray<'U> = let builder = ImmutableArray.CreateBuilder(arr.Length) for i = 0 to arr.Length - 1 do let result = chooser arr[i] @@ -177,9 +174,9 @@ module Block = builder.Capacity <- builder.Count builder.MoveToImmutable() - let isEmpty (arr: block<_>) = arr.IsEmpty + let isEmpty (arr: ImmutableArray<_>) = arr.IsEmpty - let fold folder state (arr: block<_>) = + let fold folder state (arr: ImmutableArray<_>) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) let mutable state = state for i = 0 to arr.Length - 1 do diff --git a/src/fsharp/ImmutableArray.fsi b/src/fsharp/ImmutableArray.fsi new file mode 100644 index 00000000000..a1cd577350e --- /dev/null +++ b/src/fsharp/ImmutableArray.fsi @@ -0,0 +1,57 @@ +[] +module internal Internal.Utilities.Library.Block + +open System.Collections.Immutable + +[] +module ImmutableArrayBuilder = + + val create: size: int -> ImmutableArray<'T>.Builder + +[] +module ImmutableArray = + + [] + val empty<'T> : ImmutableArray<'T> + + val init: n: int -> f: (int -> 'T) -> ImmutableArray<'T> + + val iter: f: ('T -> unit) -> ImmutableArray<'T> -> unit + + val iteri: f: (int -> 'T -> unit) -> ImmutableArray<'T> -> unit + + val iter2: f: ('T1 -> 'T2 -> unit) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> unit + + val iteri2: f: (int -> 'T1 -> 'T2 -> unit) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> unit + + val map: mapper: ('T1 -> 'T2) -> ImmutableArray<'T1> -> ImmutableArray<'T2> + + val mapi: mapper: (int -> 'T1 -> 'T2) -> ImmutableArray<'T1> -> ImmutableArray<'T2> + + val concat: ImmutableArray> -> ImmutableArray<'T> + + val forall: predicate: ('T -> bool) -> ImmutableArray<'T> -> bool + + val forall2: predicate: ('T1 -> 'T2 -> bool) -> ImmutableArray<'T1> -> ImmutableArray<'T2> -> bool + + val tryFind: predicate: ('T -> bool) -> ImmutableArray<'T> -> 'T option + + val tryFindIndex: predicate: ('T -> bool) -> ImmutableArray<'T> -> int option + + val tryPick: chooser: ('T1 -> 'T2 option) -> ImmutableArray<'T1> -> 'T2 option + + val ofSeq: seq<'T> -> ImmutableArray<'T> + + val append: ImmutableArray<'T> -> ImmutableArray<'T> -> ImmutableArray<'T> + + val createOne: 'T -> ImmutableArray<'T> + + val filter: predicate: ('T -> bool) -> ImmutableArray<'T> -> ImmutableArray<'T> + + val exists: predicate: ('T -> bool) -> ImmutableArray<'T> -> bool + + val choose: chooser: ('T -> 'U option) -> ImmutableArray<'T> -> ImmutableArray<'U> + + val isEmpty: ImmutableArray<'T> -> bool + + val fold: folder: ('State -> 'T -> 'State) -> 'State -> ImmutableArray<'T> -> 'State diff --git a/src/fsharp/OptimizeInputs.fs b/src/fsharp/OptimizeInputs.fs index 4ba358d7172..97cfd577807 100644 --- a/src/fsharp/OptimizeInputs.fs +++ b/src/fsharp/OptimizeInputs.fs @@ -1,7 +1,5 @@ // Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. -// # FSComp.SR.opts - module internal FSharp.Compiler.OptimizeInputs open System.IO diff --git a/src/fsharp/block.fsi b/src/fsharp/block.fsi deleted file mode 100644 index 13f53ee479b..00000000000 --- a/src/fsharp/block.fsi +++ /dev/null @@ -1,63 +0,0 @@ -[] -module internal Internal.Utilities.Library.Block - -open System.Collections.Immutable - -/// Type alias for System.Collections.Immutable.ImmutableArray<'T> -type block<'T> = ImmutableArray<'T> - -/// Type alias for System.Collections.Immutable.ImmutableArray<'T>.Builder -type blockbuilder<'T> = ImmutableArray<'T>.Builder - -[] -module BlockBuilder = - - val create: size: int -> blockbuilder<'T> - -[] -module Block = - - [] - val empty<'T> : block<'T> - - val init: n: int -> f: (int -> 'T) -> block<'T> - - val iter: f: ('T -> unit) -> block<'T> -> unit - - val iteri: f: (int -> 'T -> unit) -> block<'T> -> unit - - val iter2: f: ('T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit - - val iteri2: f: (int -> 'T1 -> 'T2 -> unit) -> block<'T1> -> block<'T2> -> unit - - val map: mapper: ('T1 -> 'T2) -> block<'T1> -> block<'T2> - - val mapi: mapper: (int -> 'T1 -> 'T2) -> block<'T1> -> block<'T2> - - val concat: block> -> block<'T> - - val forall: predicate: ('T -> bool) -> block<'T> -> bool - - val forall2: predicate: ('T1 -> 'T2 -> bool) -> block<'T1> -> block<'T2> -> bool - - val tryFind: predicate: ('T -> bool) -> block<'T> -> 'T option - - val tryFindIndex: predicate: ('T -> bool) -> block<'T> -> int option - - val tryPick: chooser: ('T1 -> 'T2 option) -> block<'T1> -> 'T2 option - - val ofSeq: seq<'T> -> block<'T> - - val append: block<'T> -> block<'T> -> block<'T> - - val createOne: 'T -> block<'T> - - val filter: predicate: ('T -> bool) -> block<'T> -> block<'T> - - val exists: predicate: ('T -> bool) -> block<'T> -> bool - - val choose: chooser: ('T -> 'U option) -> block<'T> -> block<'U> - - val isEmpty: block<'T> -> bool - - val fold: folder: ('State -> 'T -> 'State) -> 'State -> block<'T> -> 'State diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index 785cc86d7c8..dcaba811288 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -4,6 +4,7 @@ namespace FSharp.Compiler.CodeAnalysis open System open System.Collections.Generic +open System.Collections.Immutable open System.Diagnostics open System.IO open System.Threading @@ -727,25 +728,26 @@ module IncrementalBuilderHelpers = // Link all the assemblies together and produce the input typecheck accumulator let CombineImportedAssembliesTask ( - assemblyName, - tcConfig: TcConfig, - tcConfigP, - tcGlobals, - frameworkTcImports, - nonFrameworkResolutions, - unresolvedReferences, - dependencyProvider, - loadClosureOpt: LoadClosure option, - niceNameGen, - basicDependencies, - keepAssemblyContents, - keepAllBackgroundResolutions, - keepAllBackgroundSymbolUses, - enableBackgroundItemKeyStoreAndSemanticClassification, - defaultPartialTypeChecking, - beforeFileChecked, - fileChecked, - importsInvalidatedByTypeProvider: Event) : NodeCode = + assemblyName, + tcConfig: TcConfig, + tcConfigP, + tcGlobals, + frameworkTcImports, + nonFrameworkResolutions, + unresolvedReferences, + dependencyProvider, + loadClosureOpt: LoadClosure option, + niceNameGen, + basicDependencies, + keepAssemblyContents, + keepAllBackgroundResolutions, + keepAllBackgroundSymbolUses, + enableBackgroundItemKeyStoreAndSemanticClassification, + defaultPartialTypeChecking, + beforeFileChecked, + fileChecked, + importsInvalidatedByTypeProvider: Event) : NodeCode = + node { let errorLogger = CompilationDiagnosticLogger("CombineImportedAssembliesTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.Parameter) @@ -838,14 +840,14 @@ module IncrementalBuilderHelpers = } /// Finish up the typechecking to produce outputs for the rest of the compilation process - let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: block) = + let FinalizeTypeCheckTask (tcConfig: TcConfig) tcGlobals enablePartialTypeChecking assemblyName outfile (boundModels: ImmutableArray) = node { let errorLogger = CompilationDiagnosticLogger("FinalizeTypeCheckTask", tcConfig.diagnosticsOptions) use _ = new CompilationGlobalsScope(errorLogger, BuildPhase.TypeCheck) let! results = boundModels - |> Block.map (fun boundModel -> node { + |> ImmutableArray.map (fun boundModel -> node { if enablePartialTypeChecking then let! tcInfo = boundModel.GetOrComputeTcInfo() return tcInfo, None @@ -853,7 +855,7 @@ module IncrementalBuilderHelpers = let! tcInfo, tcInfoExtras = boundModel.GetOrComputeTcInfoWithExtras() return tcInfo, tcInfoExtras.latestImplFile }) - |> Block.map (fun work -> + |> ImmutableArray.map (fun work -> node { let! tcInfo, latestImplFile = work return (tcInfo.tcEnvAtEndOfFile, defaultArg tcInfo.topAttribs EmptyTopAttrs, latestImplFile, tcInfo.latestCcuSigForFile) @@ -934,12 +936,12 @@ type IncrementalBuilderInitialState = { initialBoundModel: BoundModel tcGlobals: TcGlobals - referencedAssemblies: block * (TimeStampCache -> DateTime)> + referencedAssemblies: ImmutableArray * (TimeStampCache -> DateTime)> tcConfig: TcConfig outfile: string assemblyName: string lexResourceManager: Lexhelp.LexResourceManager - fileNames: block + fileNames: ImmutableArray enablePartialTypeChecking: bool beforeFileChecked: Event fileChecked: Event @@ -975,12 +977,12 @@ type IncrementalBuilderInitialState = { initialBoundModel = initialBoundModel tcGlobals = tcGlobals - referencedAssemblies = nonFrameworkAssemblyInputs |> Block.ofSeq + referencedAssemblies = nonFrameworkAssemblyInputs |> ImmutableArray.ofSeq tcConfig = tcConfig outfile = outfile assemblyName = assemblyName lexResourceManager = lexResourceManager - fileNames = sourceFiles |> Block.ofSeq + fileNames = sourceFiles |> ImmutableArray.ofSeq enablePartialTypeChecking = enablePartialTypeChecking beforeFileChecked = beforeFileChecked fileChecked = fileChecked @@ -1003,18 +1005,18 @@ type IncrementalBuilderState = { // stampedFileNames represent the real stamps of the files. // logicalStampedFileNames represent the stamps of the files that are used to calculate the project's logical timestamp. - stampedFileNames: block - logicalStampedFileNames: block - stampedReferencedAssemblies: block + stampedFileNames: ImmutableArray + logicalStampedFileNames: ImmutableArray + stampedReferencedAssemblies: ImmutableArray initialBoundModel: GraphNode - boundModels: block> + boundModels: ImmutableArray> finalizedBoundModel: GraphNode<(ILAssemblyRef * ProjectAssemblyDataResult * TypedImplFile list option * BoundModel) * DateTime> } [] module IncrementalBuilderStateHelpers = - let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: blockbuilder>) i = + let createBoundModelGraphNode (initialState: IncrementalBuilderInitialState) initialBoundModel (boundModels: ImmutableArray>.Builder) i = let fileInfo = initialState.fileNames[i] let prevBoundModelGraphNode = match i with @@ -1026,13 +1028,13 @@ module IncrementalBuilderStateHelpers = return! TypeCheckTask initialState.enablePartialTypeChecking prevBoundModel syntaxTree }) - let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: blockbuilder>) = + let rec createFinalizeBoundModelGraphNode (initialState: IncrementalBuilderInitialState) (boundModels: ImmutableArray>.Builder) = GraphNode(node { // Compute last bound model then get all the evaluated models. let! _ = boundModels[boundModels.Count - 1].GetOrComputeValue() let boundModels = boundModels.ToImmutable() - |> Block.map (fun x -> x.TryPeekValue().Value) + |> ImmutableArray.map (fun x -> x.TryPeekValue().Value) let! result = FinalizeTypeCheckTask @@ -1086,7 +1088,7 @@ module IncrementalBuilderStateHelpers = and computeStampedFileNames (initialState: IncrementalBuilderInitialState) state (cache: TimeStampCache) = let mutable i = 0 (state, initialState.fileNames) - ||> Block.fold (fun state fileInfo -> + ||> ImmutableArray.fold (fun state fileInfo -> let newState = computeStampedFileName initialState state cache i fileInfo i <- i + 1 newState @@ -1097,7 +1099,7 @@ module IncrementalBuilderStateHelpers = let mutable referencesUpdated = false initialState.referencedAssemblies - |> Block.iteri (fun i asmInfo -> + |> ImmutableArray.iteri (fun i asmInfo -> let currentStamp = state.stampedReferencedAssemblies[i] let stamp = StampReferencedAssemblyTask cache asmInfo @@ -1132,16 +1134,16 @@ type IncrementalBuilderState with let cache = TimeStampCache(defaultTimeStamp) let initialBoundModel = GraphNode(node { return initialBoundModel }) - let boundModels = BlockBuilder.create fileNames.Length + let boundModels = ImmutableArrayBuilder.create fileNames.Length for slot = 0 to fileNames.Length - 1 do boundModels.Add(createBoundModelGraphNode initialState initialBoundModel boundModels slot) let state = { - stampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) - logicalStampedFileNames = Block.init fileNames.Length (fun _ -> DateTime.MinValue) - stampedReferencedAssemblies = Block.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) + stampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) + logicalStampedFileNames = ImmutableArray.init fileNames.Length (fun _ -> DateTime.MinValue) + stampedReferencedAssemblies = ImmutableArray.init referencedAssemblies.Length (fun _ -> DateTime.MinValue) initialBoundModel = initialBoundModel boundModels = boundModels.ToImmutable() finalizedBoundModel = createFinalizeBoundModelGraphNode initialState boundModels @@ -1352,7 +1354,7 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc String.Compare(fileName, f2.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 || String.Compare(FileSystem.GetFullPathShim fileName, FileSystem.GetFullPathShim f2.FilePath, StringComparison.CurrentCultureIgnoreCase)=0 result - match fileNames |> Block.tryFindIndex CompareFileNames with + match fileNames |> ImmutableArray.tryFindIndex CompareFileNames with | Some slot -> Some slot | None -> None diff --git a/src/fsharp/symbols/FSharpDiagnostic.fsi b/src/fsharp/symbols/FSharpDiagnostic.fsi index 4b6027e9dce..2e5ea40dcf2 100644 --- a/src/fsharp/symbols/FSharpDiagnostic.fsi +++ b/src/fsharp/symbols/FSharpDiagnostic.fsi @@ -67,7 +67,11 @@ type public FSharpDiagnostic = FSharpDiagnostic static member internal CreateFromExceptionAndAdjustEof: - diag: PhasedDiagnostic * severity: FSharpDiagnosticSeverity * range * lastPosInFile: (int * int) * suggestNames: bool -> + diag: PhasedDiagnostic * + severity: FSharpDiagnosticSeverity * + range * + lastPosInFile: (int * int) * + suggestNames: bool -> FSharpDiagnostic static member internal CreateFromException: From 48594bd6e44c0e59db3f834f491329eadd7b79a4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 17:49:35 +0100 Subject: [PATCH 10/19] format --- src/fsharp/service/ServiceLexing.fsi | 1 + 1 file changed, 1 insertion(+) diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index 7f882ee3d62..0822067267b 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -6,6 +6,7 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text + #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing From 090083d02cf28be24560f0495c8036c548ce4889 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 18:31:22 +0100 Subject: [PATCH 11/19] Error --> SRDiagnostic --- src/fsharp/CompilerConfig.fs | 6 +- src/fsharp/CompilerConfig.fsi | 4 +- src/fsharp/CompilerDiagnostics.fs | 48 +++++------ src/fsharp/CompilerDiagnostics.fsi | 4 +- src/fsharp/CompilerOptions.fs | 8 +- src/fsharp/DiagnosticsLogger.fs | 46 ++++++----- src/fsharp/DiagnosticsLogger.fsi | 48 +++++++---- src/fsharp/NameResolution.fs | 4 +- src/fsharp/fsc.fs | 13 +-- src/fsharp/fsi/fsi.fs | 10 +-- src/fsharp/service/ServiceLexing.fsi | 1 - tests/FSharp.Compiler.UnitTests/BlockTests.fs | 14 ++-- tests/service/Common.fs | 38 ++++----- tests/service/PatternMatchCompilationTests.fs | 82 +++++++++---------- 14 files changed, 172 insertions(+), 154 deletions(-) diff --git a/src/fsharp/CompilerConfig.fs b/src/fsharp/CompilerConfig.fs index c317cb026ee..7027e682d8e 100644 --- a/src/fsharp/CompilerConfig.fs +++ b/src/fsharp/CompilerConfig.fs @@ -430,7 +430,7 @@ type TcConfigBuilder = mutable legacyReferenceResolver: LegacyReferenceResolver mutable showFullPaths: bool - mutable errorStyle: ErrorStyle + mutable diagnosticStyle: DiagnosticStyle mutable utf8output: bool mutable flatErrors: bool @@ -646,7 +646,7 @@ type TcConfigBuilder = includewin32manifest = true linkResources = [] showFullPaths = false - errorStyle = ErrorStyle.DefaultErrors + diagnosticStyle = DiagnosticStyle.Default utf8output = false flatErrors = false @@ -1118,7 +1118,7 @@ type TcConfig private (data: TcConfigBuilder, validate: bool) = member _.includewin32manifest = data.includewin32manifest member _.linkResources = data.linkResources member _.showFullPaths = data.showFullPaths - member _.errorStyle = data.errorStyle + member _.diagnosticStyle = data.diagnosticStyle member _.utf8output = data.utf8output member _.flatErrors = data.flatErrors member _.maxErrors = data.maxErrors diff --git a/src/fsharp/CompilerConfig.fsi b/src/fsharp/CompilerConfig.fsi index ba09e77b8a0..99c2684caae 100644 --- a/src/fsharp/CompilerConfig.fsi +++ b/src/fsharp/CompilerConfig.fsi @@ -366,7 +366,7 @@ type TcConfigBuilder = mutable showFullPaths: bool - mutable errorStyle: ErrorStyle + mutable diagnosticStyle: DiagnosticStyle mutable utf8output: bool @@ -674,7 +674,7 @@ type TcConfig = member showFullPaths: bool - member errorStyle: ErrorStyle + member diagnosticStyle: DiagnosticStyle member utf8output: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index 3c2adad42c5..307c36e38ae 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -125,8 +125,8 @@ let GetRangeOfDiagnostic(diag: PhasedDiagnostic) = | NotUpperCaseConstructor m | RecursiveUseCheckedAtRuntime (_, _, m) | LetRecEvaluatedOutOfOrder (_, _, _, m) - | Error (_, m) - | ErrorWithSuggestions (_, m, _, _) + | SRDiagnostic (_, _, m) + | SRDiagnosticWithSuggestions (_, _, m, _, _) | SyntaxError (_, m) | InternalError (_, m) | InterfaceNotRevealed(_, _, m) @@ -340,8 +340,8 @@ let GetDiagnosticNumber(diag: PhasedDiagnostic) = | WrappedError(e, _) -> GetFromException e - | Error ((n, _), _) -> n - | ErrorWithSuggestions ((n, _), _, _, _) -> n + | SRDiagnostic (n, _, _) -> n + | SRDiagnosticWithSuggestions (n, _, _, _, _) -> n | Failure _ -> 192 | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)) #if !NO_TYPEPROVIDERS @@ -358,8 +358,8 @@ let GetWarningLevel diag = | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ -> 5 - | Error((n, _), _) - | ErrorWithSuggestions((n, _), _, _, _) -> + | SRDiagnostic(n, _, _) + | SRDiagnosticWithSuggestions(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..." // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." // 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..." @@ -1480,9 +1480,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN os.AppendString(NonUniqueInferredAbstractSlot3E().Format ty1 ty2) os.AppendString(NonUniqueInferredAbstractSlot4E().Format) - | Error ((_, s), _) -> os.AppendString s + | SRDiagnostic (_, s, _) -> os.AppendString s - | ErrorWithSuggestions ((_, s), _, idText, suggestionF) -> + | SRDiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> os.AppendString(DecompileOpName s) suggestNames suggestionF idText @@ -1764,8 +1764,8 @@ type Diagnostic = | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = - let outputWhere (showFullPaths, errorStyle) m: DiagnosticLocation = +let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = + let outputWhere (showFullPaths, diagnosticStyle) m: DiagnosticLocation = if equals m rangeStartup || equals m rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } else @@ -1775,30 +1775,30 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt else SanitizeFileName file implicitIncludeDir let text, m, file = - match errorStyle with - | ErrorStyle.EmacsErrors -> + match diagnosticStyle with + | DiagnosticStyle.Emacs -> let file = file.Replace("\\", "/") (sprintf "File \"%s\", line %d, characters %d-%d: " file m.StartLine m.StartColumn m.EndColumn), m, file // We're adjusting the columns here to be 1-based - both for parity with C# and for MSBuild, which assumes 1-based columns for error output - | ErrorStyle.DefaultErrors -> + | DiagnosticStyle.Default -> let file = file.Replace('/', Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) m.End (sprintf "%s(%d,%d): " file m.StartLine m.StartColumn), m, file - // We may also want to change TestErrors to be 1-based - | ErrorStyle.TestErrors -> + // We may also want to change Test to be 1-based + | DiagnosticStyle.Test -> let file = file.Replace("/", "\\") let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s(%d,%d-%d,%d): " file m.StartLine m.StartColumn m.EndLine m.EndColumn, m, file - | ErrorStyle.GccErrors -> + | DiagnosticStyle.Gcc -> let file = file.Replace('/', Path.DirectorySeparatorChar) let m = mkRange m.FileName (mkPos m.StartLine (m.StartColumn + 1)) (mkPos m.EndLine (m.EndColumn + 1) ) sprintf "%s:%d:%d: " file m.StartLine m.StartColumn, m, file // Here, we want the complete range information so Project Systems can generate proper squiggles - | ErrorStyle.VSErrors -> + | DiagnosticStyle.VisualStudio -> // Show prefix only for real files. Otherwise, we just want a truncated error like: // parse error FS0031: blah blah if not (equals m range0) && not (equals m rangeStartup) && not (equals m rangeCmdArgs) then @@ -1821,7 +1821,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt let report diag = let OutputWhere diag = match GetRangeOfDiagnostic diag with - | Some m -> Some(outputWhere (showFullPaths, errorStyle) m) + | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) | None -> None let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = @@ -1832,9 +1832,9 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt | FSharpDiagnosticSeverity.Info | FSharpDiagnosticSeverity.Hidden -> "info" let text = - match errorStyle with + match diagnosticStyle 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 -> sprintf "%s %s FS%04d: " subcategory message errorNumber + | DiagnosticStyle.VisualStudio -> sprintf "%s %s FS%04d: " subcategory message errorNumber | _ -> sprintf "%s FS%04d: " message errorNumber { ErrorNumber = errorNumber; Subcategory = subcategory; TextRepresentation = text} @@ -1851,9 +1851,9 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt errors.Add (Diagnostic.Long(severity, entry)) let OutputRelatedError(diag: PhasedDiagnostic) = - match errorStyle with + match diagnosticStyle with // Give a canonical string when --vserror. - | ErrorStyle.VSErrors -> + | DiagnosticStyle.VisualStudio -> let relWhere = OutputWhere mainError // mainError? let relCanonical = OutputCanonicalInformation(diag.Subcategory(), GetDiagnosticNumber mainError) // Use main error for code let relMessage = @@ -1885,10 +1885,10 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorSt /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder -let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity) os (diag: PhasedDiagnostic) = +let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diag: PhasedDiagnostic) = // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. - let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, errorStyle, severity, diag, true) + let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diag, true) for e in errors do Printf.bprintf os "\n" match e with diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 6ee7a2f56c4..202c59aca67 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -64,7 +64,7 @@ val OutputDiagnostic: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * - errorStyle: ErrorStyle * + diagnosticStyle: DiagnosticStyle * severity: FSharpDiagnosticSeverity -> StringBuilder -> PhasedDiagnostic -> @@ -107,7 +107,7 @@ val CollectDiagnostic: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * - errorStyle: ErrorStyle * + diagnosticStyle: DiagnosticStyle * severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> diff --git a/src/fsharp/CompilerOptions.fs b/src/fsharp/CompilerOptions.fs index 3450c8e139d..4df98259688 100644 --- a/src/fsharp/CompilerOptions.fs +++ b/src/fsharp/CompilerOptions.fs @@ -1057,7 +1057,7 @@ let testFlag tcConfigB = OptionString (fun s -> match s with | "StackSpan" -> tcConfigB.internalTestSpanStackReferring <- true - | "ErrorRanges" -> tcConfigB.errorStyle <- ErrorStyle.TestErrors + | "ErrorRanges" -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Test | "Tracking" -> tracking <- true (* general purpose on/off diagnostics flag *) | "NoNeedToTailcall" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportNoNeedToTailcall = true } | "FunctionSizes" -> tcConfigB.optSettings <- { tcConfigB.optSettings with reportFunctionSizes = true } @@ -1077,12 +1077,12 @@ let testFlag tcConfigB = // Not shown in fsc.exe help, no warning on use, motivation is for use from tooling. let editorSpecificFlags (tcConfigB: TcConfigBuilder) = - [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.VSErrors), None, None) + [ CompilerOption("vserrors", tagNone, OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.VisualStudio), None, None) CompilerOption("validate-type-providers", tagNone, OptionUnit id, None, None) // preserved for compatibility's sake, no longer has any effect CompilerOption("LCID", tagInt, OptionInt ignore, None, None) CompilerOption("flaterrors", tagNone, OptionUnit (fun () -> tcConfigB.flatErrors <- true), None, None) CompilerOption("sqmsessionguid", tagNone, OptionString ignore, None, None) - CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.GccErrors), None, None) + CompilerOption("gccerrors", tagNone, OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Gcc), None, None) CompilerOption("exename", tagNone, OptionString (fun s -> tcConfigB.exename <- Some s), None, None) CompilerOption("maxerrors", tagInt, OptionInt (fun n -> tcConfigB.maxErrors <- n), None, None) CompilerOption("noconditionalerasure", tagNone, OptionUnit (fun () -> tcConfigB.noConditionalErasure <- true), None, None) @@ -1314,7 +1314,7 @@ let mlKeywordsFlag = let gnuStyleErrorsFlag tcConfigB = CompilerOption ("gnu-style-errors", tagNone, - OptionUnit (fun () -> tcConfigB.errorStyle <- ErrorStyle.EmacsErrors), + OptionUnit (fun () -> tcConfigB.diagnosticStyle <- DiagnosticStyle.Emacs), Some(DeprecatedCommandLineOptionNoDescription("--gnu-style-errors", rangeCmdArgs)), None) let deprecatedFlagsBoth tcConfigB = diff --git a/src/fsharp/DiagnosticsLogger.fs b/src/fsharp/DiagnosticsLogger.fs index dad41adff9e..e7b72269678 100644 --- a/src/fsharp/DiagnosticsLogger.fs +++ b/src/fsharp/DiagnosticsLogger.fs @@ -14,12 +14,12 @@ open Internal.Utilities.Library.Extras /// Represents the style being used to format errors [] -type ErrorStyle = - | DefaultErrors - | EmacsErrors - | TestErrors - | VSErrors - | GccErrors +type DiagnosticStyle = + | Default + | Emacs + | Test + | VisualStudio + | Gcc /// Thrown when we want to add some range information to a .NET exception exception WrappedError of exn * range with @@ -66,46 +66,52 @@ let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ let StopProcessing<'T> = StopProcessingExn None -exception Error of (int * string) * range with // int is e.g. 191 in FS0191 +// int is e.g. 191 in FS0191 +exception SRDiagnostic of number: int * message: string * range: range with override this.Message = match this :> exn with - | Error((_, msg), _) -> msg + | SRDiagnostic(_, msg, _) -> msg | _ -> "impossible" -exception InternalError of msg: string * range with +exception InternalError of message: string * range: range with override this.Message = match this :> exn with | InternalError(msg, m) -> msg + m.ToString() | _ -> "impossible" -exception UserCompilerMessage of string * int * range +exception UserCompilerMessage of message: string * number: int * range: range -exception LibraryUseOnly of range +exception LibraryUseOnly of range: range -exception Deprecated of string * range +exception Deprecated of message: string * range: range -exception Experimental of string * range +exception Experimental of message: string * range: range -exception PossibleUnverifiableCode of range +exception PossibleUnverifiableCode of range: range -exception UnresolvedReferenceNoRange of (*assemblyName*) string +exception UnresolvedReferenceNoRange of assemblyName: string -exception UnresolvedReferenceError of (*assemblyName*) string * range +exception UnresolvedReferenceError of assemblyName: string * range: range -exception UnresolvedPathReferenceNoRange of (*assemblyName*) string * (*path*) string with +exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string with override this.Message = match this :> exn with | UnresolvedPathReferenceNoRange(assemblyName, path) -> sprintf "Assembly: %s, full path: %s" assemblyName path | _ -> "impossible" -exception UnresolvedPathReference of (*assemblyName*) string * (*path*) string * range +exception UnresolvedPathReference of assemblyName: string * path: string * range: range -exception ErrorWithSuggestions of (int * string) * range * string * Suggestions with // int is e.g. 191 in FS0191 +exception SRDiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | ErrorWithSuggestions((_, msg), _, _, _) -> msg + | SRDiagnosticWithSuggestions(_, msg, _, _, _) -> msg | _ -> "impossible" +/// The F# compiler code currently uses 'Error(...)' to create an SRDiagnostic as an exception even if it's a warning +let Error ((n, text), m) = SRDiagnostic (n, text, m) + +/// The F# compiler code currently uses 'ErrorWithSuggestions(...)' to create an SRDiagnostic as an exception even if it's a warning +let ErrorWithSuggestions ((n, message), m, id, suggestions) = SRDiagnosticWithSuggestions (n, message, m, id, suggestions) let inline protectAssemblyExploration dflt f = try diff --git a/src/fsharp/DiagnosticsLogger.fsi b/src/fsharp/DiagnosticsLogger.fsi index 1ea8fae6366..59dbfb7655d 100644 --- a/src/fsharp/DiagnosticsLogger.fsi +++ b/src/fsharp/DiagnosticsLogger.fsi @@ -9,12 +9,12 @@ open FSharp.Compiler.Text /// Represents the style being used to format errors [] -type ErrorStyle = - | DefaultErrors - | EmacsErrors - | TestErrors - | VSErrors - | GccErrors +type DiagnosticStyle = + | Default + | Emacs + | Test + | VisualStudio + | Gcc /// Thrown when we want to add some range information to a .NET exception exception WrappedError of exn * range @@ -41,29 +41,41 @@ val (|StopProcessing|_|): exn: exn -> unit option val StopProcessing<'T> : exn -exception Error of (int * string) * range +/// Represents a diagnostic exeption whose text comes via SR.* +exception SRDiagnostic of number: int * message: string * range: range -exception InternalError of msg: string * range +/// Creates a diagnostic exeption whose text comes via SR.* +val Error: (int * string) * range -> exn -exception UserCompilerMessage of string * int * range +exception InternalError of message: string * range: range -exception LibraryUseOnly of range +exception UserCompilerMessage of message: string * number: int * range: range -exception Deprecated of string * range +exception LibraryUseOnly of range: range -exception Experimental of string * range +exception Deprecated of message: string * range: range -exception PossibleUnverifiableCode of range +exception Experimental of message: string * range: range -exception UnresolvedReferenceNoRange of string +exception PossibleUnverifiableCode of range: range -exception UnresolvedReferenceError of string * range +exception UnresolvedReferenceNoRange of assemblyName: string -exception UnresolvedPathReferenceNoRange of string * string +exception UnresolvedReferenceError of assemblyName: string * range: range -exception UnresolvedPathReference of string * string * range +exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string -exception ErrorWithSuggestions of (int * string) * range * string * Suggestions +exception UnresolvedPathReference of assemblyName: string * path: string * range: range + +exception SRDiagnosticWithSuggestions of + number: int * + message: string * + range: range * + identifier: string * + suggestions: Suggestions + +/// Creates a SRDiagnosticWithSuggestions whose text comes via SR.* +val ErrorWithSuggestions: (int * string) * range * string * Suggestions -> exn val inline protectAssemblyExploration: dflt: 'a -> f: (unit -> 'a) -> 'a diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 4ceaa99aff1..613981b37ae 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1525,8 +1525,8 @@ let AddResults res1 res2 = | Exception (UndefinedName(n1, _, _, _) as e1), Exception (UndefinedName(n2, _, _, _) as e2) -> if n1 < n2 then Exception e2 else Exception e1 // Prefer more concrete errors about things being undefined - | Exception (UndefinedName _ as e1), Exception (Error _) -> Exception e1 - | Exception (Error _), Exception (UndefinedName _ as e2) -> Exception e2 + | Exception (UndefinedName _ as e1), Exception (SRDiagnostic _) -> Exception e1 + | Exception (SRDiagnostic _), Exception (UndefinedName _ as e2) -> Exception e2 | Exception e1, Exception _ -> Exception e1 let NoResultsOrUsefulErrors = Result [] diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index b9818430590..8ee78bb8606 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -107,7 +107,7 @@ let ConsoleDiagnosticsLoggerUpToMaxErrors (tcConfigB: TcConfigBuilder, exiter : member _.HandleIssue(tcConfigB, err, severity) = DoWithDiagnosticColor severity (fun () -> - let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.errorStyle, severity) + let diag = OutputDiagnostic (tcConfigB.implicitIncludeDir, tcConfigB.showFullPaths, tcConfigB.flatErrors, tcConfigB.diagnosticStyle, severity) writeViaBuffer stderr diag err stderr.WriteLine()) } :> DiagnosticsLogger @@ -139,19 +139,19 @@ type InProcDiagnosticsLoggerProvider() = member _.Provider = { new DiagnosticsLoggerProvider() with - member log.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with - member this.HandleTooManyErrors text = + member _.HandleTooManyErrors text = warnings.Add(Diagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - member this.HandleIssue(tcConfigBuilder, err, severity) = + member _.HandleIssue(tcConfigBuilder, err, severity) = // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf let diagnostics = CollectDiagnostic (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.errorStyle, severity, err, true) + tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) match severity with | FSharpDiagnosticSeverity.Error -> errors.AddRange(diagnostics) @@ -169,7 +169,8 @@ type ConsoleLoggerProvider() = inherit DiagnosticsLoggerProvider() - override this.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) + override _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + ConsoleDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) /// Notify the exiter if any error has occurred let AbortOnError (errorLogger: DiagnosticsLogger, exiter : Exiter) = diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 0e9190d4fbf..13db0d746b8 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -729,9 +729,9 @@ type internal FsiStdinSyphon(errorWriter: TextWriter) = ignoreAllErrors (fun () -> let severity = FSharpDiagnosticSeverity.Error DoWithDiagnosticColor severity (fun () -> - errorWriter.WriteLine(); - writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err; - writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.errorStyle,severity)) err; + errorWriter.WriteLine() + writeViaBuffer errorWriter (OutputDiagnosticContext " " syphon.GetLine) err + writeViaBuffer errorWriter (OutputDiagnostic (tcConfig.implicitIncludeDir,tcConfig.showFullPaths,tcConfig.flatErrors,tcConfig.diagnosticStyle,severity)) err errorWriter.WriteLine() errorWriter.WriteLine() errorWriter.Flush())) @@ -783,7 +783,7 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, DoWithDiagnosticColor FSharpDiagnosticSeverity.Warning (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) @@ -791,7 +791,7 @@ type internal DiagnosticsLoggerThatStopsOnFirstError(tcConfigB:TcConfigBuilder, DoWithDiagnosticColor FSharpDiagnosticSeverity.Info (fun () -> fsiConsoleOutput.Error.WriteLine() writeViaBuffer fsiConsoleOutput.Error (OutputDiagnosticContext " " fsiStdinSyphon.GetLine) err - writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.errorStyle,severity)) err + writeViaBuffer fsiConsoleOutput.Error (OutputDiagnostic (tcConfigB.implicitIncludeDir,tcConfigB.showFullPaths,tcConfigB.flatErrors,tcConfigB.diagnosticStyle,severity)) err fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.WriteLine() fsiConsoleOutput.Error.Flush()) diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index 0822067267b..7f882ee3d62 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -6,7 +6,6 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text - #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing diff --git a/tests/FSharp.Compiler.UnitTests/BlockTests.fs b/tests/FSharp.Compiler.UnitTests/BlockTests.fs index 08a718f5244..aaa0084773e 100644 --- a/tests/FSharp.Compiler.UnitTests/BlockTests.fs +++ b/tests/FSharp.Compiler.UnitTests/BlockTests.fs @@ -5,15 +5,15 @@ open Xunit open FSharp.Test open Internal.Utilities.Library -module BlockTests = +module ImmutableArrayTests = [] let ``Iter should work correctly``() = - let b = Block.init 5 id + let b = ImmutableArray.init 5 id let results = ResizeArray() b - |> Block.iter (fun x -> + |> ImmutableArray.iter (fun x -> results.Add(x) ) @@ -30,9 +30,9 @@ module BlockTests = [] let ``Map should work correctly``() = - let b = Block.init 5 id + let b = ImmutableArray.init 5 id - let b2 = b |> Block.map (fun x -> x + 1) + let b2 = b |> ImmutableArray.map (fun x -> x + 1) Assert.Equal( [ @@ -47,11 +47,11 @@ module BlockTests = [] let ``Fold should work correctly``() = - let b = Block.init 5 id + let b = ImmutableArray.init 5 id let result = (0, b) - ||> Block.fold (fun state n -> + ||> ImmutableArray.fold (fun state n -> state + n ) diff --git a/tests/service/Common.fs b/tests/service/Common.fs index d73c89e7bfb..efc7e115084 100644 --- a/tests/service/Common.fs +++ b/tests/service/Common.fs @@ -235,16 +235,16 @@ let tups (m: range) = (m.StartLine, m.StartColumn), (m.EndLine, m.EndColumn) /// Extract range info and convert to zero-based line - please don't use this one any more let tupsZ (m: range) = (m.StartLine-1, m.StartColumn), (m.EndLine-1, m.EndColumn) -let attribsOfSymbolUse (s:FSharpSymbolUse) = - [ if s.IsFromDefinition then yield "defn" - if s.IsFromType then yield "type" - if s.IsFromAttribute then yield "attribute" - if s.IsFromDispatchSlotImplementation then yield "override" - if s.IsFromPattern then yield "pattern" - if s.IsFromComputationExpression then yield "compexpr" ] - -let attribsOfSymbol (s:FSharpSymbol) = - [ match s with +let attribsOfSymbolUse (symbolUse: FSharpSymbolUse) = + [ if symbolUse.IsFromDefinition then yield "defn" + if symbolUse.IsFromType then yield "type" + if symbolUse.IsFromAttribute then yield "attribute" + if symbolUse.IsFromDispatchSlotImplementation then yield "override" + if symbolUse.IsFromPattern then yield "pattern" + if symbolUse.IsFromComputationExpression then yield "compexpr" ] + +let attribsOfSymbol (symbol: FSharpSymbol) = + [ match symbol with | :? FSharpField as v -> yield "field" if v.IsCompilerGenerated then yield "compgen" @@ -310,26 +310,26 @@ let attribsOfSymbol (s:FSharpSymbol) = | _ -> () ] let rec allSymbolsInEntities compGen (entities: IList) = - [ for e in entities do - yield (e :> FSharpSymbol) - for gp in e.GenericParameters do + [ for entity in entities do + yield (entity :> FSharpSymbol) + for gp in entity.GenericParameters do if compGen || not gp.IsCompilerGenerated then yield (gp :> FSharpSymbol) - for x in e.MembersFunctionsAndValues do + for x in entity.MembersFunctionsAndValues do if compGen || not x.IsCompilerGenerated then yield (x :> FSharpSymbol) for gp in x.GenericParameters do if compGen || not gp.IsCompilerGenerated then yield (gp :> FSharpSymbol) - for x in e.UnionCases do + for x in entity.UnionCases do yield (x :> FSharpSymbol) for f in x.Fields do if compGen || not f.IsCompilerGenerated then yield (f :> FSharpSymbol) - for x in e.FSharpFields do + for x in entity.FSharpFields do if compGen || not x.IsCompilerGenerated then yield (x :> FSharpSymbol) - yield! allSymbolsInEntities compGen e.NestedEntities ] + yield! allSymbolsInEntities compGen entity.NestedEntities ] let getParseResults (source: string) = @@ -351,8 +351,8 @@ let getParseAndCheckResults50 (source: string) = parseAndCheckScript50("Test.fsx", source) -let inline dumpErrors results = - (^TResults: (member Diagnostics: FSharpDiagnostic[]) results) +let inline dumpDiagnostics (results: FSharpCheckFileResults) = + results.Diagnostics |> Array.map (fun e -> let message = e.Message.Split('\n') diff --git a/tests/service/PatternMatchCompilationTests.fs b/tests/service/PatternMatchCompilationTests.fs index 92b184d99c9..9ca4362ead7 100644 --- a/tests/service/PatternMatchCompilationTests.fs +++ b/tests/service/PatternMatchCompilationTests.fs @@ -14,7 +14,7 @@ match () with | x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,4): This expression was expected to have type 'unit' but here has type 'string'" ] @@ -27,7 +27,7 @@ let ``Wrong type 02 - Binding`` () = let ("": unit), (x: int) = let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(2,5--2,7): This expression was expected to have type 'unit' but here has type 'string'" "(2,41--2,43): This expression was expected to have type 'unit * int' but here has type 'unit'" "(2,4--2,24): Incomplete pattern matches on this expression." @@ -44,7 +44,7 @@ match () with | [] x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"; "CompiledNameAttribute"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,25): Attributes are not allowed within patterns" "(3,4--3,16): This attribute is not valid for use on this language element" ] @@ -60,7 +60,7 @@ match () with | ?x -> let y = () in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,4): Optional arguments are only permitted on type members" ] @@ -75,7 +75,7 @@ match 1, 2 with | null -> let y = () in () """ assertHasSymbolUsages ["y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,6): The type '(int * int)' does not have 'null' as a proper value" "(2,6--2,10): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." ] @@ -95,7 +95,7 @@ match A with | B (x, _) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,10): This union case expects 3 arguments in tupled form" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -115,7 +115,7 @@ match A with | B (_, _, x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,5--7,12): This expression was expected to have type 'int' but here has type ''a * 'b * 'c'" "(6,6--6,7): Incomplete pattern matches on this expression." ] @@ -135,7 +135,7 @@ match A with | B (_, _, x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,11--7,12): This constructor is applied to 3 argument(s) but expects 2" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -154,7 +154,7 @@ match A with | A x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,5): This union case does not take arguments" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'B (_)' may indicate a case not covered by the pattern(s)." ] @@ -173,7 +173,7 @@ match A with | B x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -192,7 +192,7 @@ match A with | B (name = x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,5--7,9): The union case 'B' does not have a field named 'name'." "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -212,7 +212,7 @@ match A with | B (field = x; field = z) -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,16--7,21): Union case/exception field 'field' cannot be used more than once." "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -232,7 +232,7 @@ match A with | B x z -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,7): This union case expects 2 arguments in tupled form" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." ] @@ -246,7 +246,7 @@ match None with | Some (x, z) -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ ] @@ -262,7 +262,7 @@ match 1 with | Foo (field = x) -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,2--5,17): Foo is an active pattern and cannot be treated as a discriminated union case with named fields." ] @@ -279,7 +279,7 @@ match 1 with | Foo x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,2--5,7): This literal pattern does not take arguments" "(4,6--4,7): Incomplete pattern matches on this expression. For example, the value '0' may indicate a case not covered by the pattern(s)." ] @@ -297,7 +297,7 @@ match TraceLevel.Off with | TraceLevel.Off x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,2--5,18): This literal pattern does not take arguments" "(4,6--4,20): Incomplete pattern matches on this expression. For example, the value 'TraceLevel.Error' may indicate a case not covered by the pattern(s)." ] @@ -319,7 +319,7 @@ let dowork () = f (Case 1) 0 // return an integer exit code""" assertHasSymbolUsages ["DU"; "dowork"; "du"; "f"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(6,6--6,10): This constructor is applied to 0 argument(s) but expects 1" ] @@ -330,7 +330,7 @@ match 1 with | x | x -> let y = x + 1 in () """ assertHasSymbolUsages ["x"; "y"] checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] @@ -343,7 +343,7 @@ match 1 with | x | z -> let y = x + z + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(3,2--3,7): The two sides of this 'or' pattern bind different sets of variables" ] @@ -362,7 +362,7 @@ match A with | B (x, y) | B (a, x) -> let z = x + 1 in () """ assertHasSymbolUsages ["x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,2--7,21): The two sides of this 'or' pattern bind different sets of variables" "(7,19--7,20): This expression was expected to have type 'int' but here has type 'string'" "(6,6--6,7): Incomplete pattern matches on this expression. For example, the value 'A' may indicate a case not covered by the pattern(s)." @@ -381,7 +381,7 @@ match 3 with | a as b -> let c = a + b in () """ assertHasSymbolUsages ["a"; "b"; "c"; "w"; "x"; "y"; "z"] checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] @@ -399,7 +399,7 @@ match box 1 with | :? int8 as Id i as j -> let x = i + 5y + j in () // Only the first "as" will have the derived type """ assertHasSymbolUsages (List.map string ['a'..'j']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,34--5,35): The type 'obj' does not support the operator '+'" "(5,32--5,33): The type 'obj' does not support the operator '+'" "(7,45--7,46): The type 'obj' does not match the type 'uint64'" @@ -423,7 +423,7 @@ match Unchecked.defaultof with | _ -> () """ assertHasSymbolUsages ["a"; "b"; "c"; "d"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,21--5,27): Type constraint mismatch. The type 'int' is not compatible with type 'System.Enum' " ] @@ -439,7 +439,7 @@ match Unchecked.defaultof with | g -> () """ assertHasSymbolUsages ["a"; "b"; "c"; "d"; "e"; "f"; "g"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(4,2--4,85): This rule will never be matched" ] @@ -456,7 +456,7 @@ match Unchecked.defaultof with | :? _ as z -> let _ = z in () """ assertHasSymbolUsages ["a"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(2,6--2,30): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." "(6,2--6,6): The type 'int' does not have any proper subtypes and cannot be used as the source of a type test or runtime coercion." ] @@ -477,7 +477,7 @@ match Unchecked.defaultof with | k & l as (m as (false as n)) as (o as _) -> if k || l || m || n || o then () """ assertHasSymbolUsages (List.map string ['a'..'o']) checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] let ``As 07 - syntactical precedence matrix testing right - total patterns`` () = @@ -556,7 +556,7 @@ Some v |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] #if !NETCOREAPP @@ -601,7 +601,7 @@ Some w |> eq () """ assertHasSymbolUsages (List.map string ['a'..'y']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(8,4--8,18): Incomplete pattern matches on this expression. For example, the value '[]' may indicate a case not covered by the pattern(s)." "(9,4--9,14): Incomplete pattern matches on this expression." "(10,4--10,18): Incomplete pattern matches on this expression." @@ -643,7 +643,7 @@ let v as struct w = 15 let x as () = y let z as """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,9--10,10): Unexpected symbol ',' in binding" "(11,9--11,10): Unexpected symbol ':' in binding" "(12,9--12,11): Unexpected symbol '::' in binding" @@ -692,7 +692,7 @@ Some x |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpErrors checkResults |> shouldEqual [] + dumpDiagnostics checkResults |> shouldEqual [] [] #if !NETCOREAPP @@ -737,7 +737,7 @@ Some w |> eq () """ assertHasSymbolUsages (List.map string ['a'..'y']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(8,4--8,20): Incomplete pattern matches on this expression. For example, the value '[]' may indicate a case not covered by the pattern(s)." "(9,4--9,14): Incomplete pattern matches on this expression." "(10,4--10,18): Incomplete pattern matches on this expression." @@ -779,7 +779,7 @@ let v struct as w = 15 let () as x = y let z as = """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" @@ -854,7 +854,7 @@ Some x |> eq () """ assertHasSymbolUsages (List.map string ['a'..'z']) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(11,25--11,26): This expression was expected to have type 'int' but here has type 'obj'" "(28,6--28,24): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." "(26,6--26,12): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." @@ -930,7 +930,7 @@ Some w |> eq () """ assertHasSymbolUsages (set ['a' .. 'y'] |> Set.remove 'n' |> Set.map string |> Set.toList) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(21,2--21,8): This type test or downcast will always hold" "(34,6--34,14): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." "(32,6--32,14): Incomplete pattern matches on this expression. For example, the value '``some-non-null-value``' may indicate a case not covered by the pattern(s)." @@ -973,7 +973,7 @@ let :? v as struct w = 15 let :? x as () = y let :? z as """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,12--10,13): Unexpected symbol ',' in binding" "(11,12--11,13): Unexpected symbol ':' in binding" "(12,12--12,14): Unexpected symbol '::' in binding" @@ -1046,7 +1046,7 @@ match box {{ aaa = 9 }} with Some "" |> eq // No more type checks after the above line? """ assertHasSymbolUsages (Set.toList validSet) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(27,2--27,14): This expression was expected to have type 'obj' but here has type 'struct ('a * 'b)'" "(52,2--52,13): This expression was expected to have type 'obj' but here has type 'AAA'" "(26,6--26,24): Incomplete pattern matches on this expression. For example, the value '``some-other-subtype``' may indicate a case not covered by the pattern(s)." @@ -1131,7 +1131,7 @@ match box [|11|] with Some "" |> eq """ assertHasSymbolUsages (set ['a'..'y'] - set [ 'm'..'r' ] |> Set.map string |> Set.toList) checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(19,2--19,4): This expression was expected to have type 'obj' but here has type 'int'" "(21,2--21,7): This expression was expected to have type 'obj' but here has type 'bool'" "(23,2--23,6): This expression was expected to have type 'obj' but here has type 'bool'" @@ -1180,7 +1180,7 @@ let v [ as :? w = 15 let () as :? x = y let as :? z = """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(10,7--10,9): Unexpected keyword 'as' in binding" "(11,10--11,12): Unexpected keyword 'as' in binding. Expected '=' or other token." "(12,9--12,11): Unexpected keyword 'as' in binding" @@ -1234,7 +1234,7 @@ let ?w as x = 7 let y as ?z = 8 () """ - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(7,9--7,11): Unexpected symbol '[<' in binding" "(4,4--4,12): This construct is deprecated: Character range matches have been removed in F#. Consider using a 'when' pattern guard instead." "(4,4--4,17): Incomplete pattern matches on this expression. For example, the value '' '' may indicate a case not covered by the pattern(s)." @@ -1266,6 +1266,6 @@ let f : obj -> _ = () """ assertHasSymbolUsages ["i"] checkResults - dumpErrors checkResults |> shouldEqual [ + dumpDiagnostics checkResults |> shouldEqual [ "(5,6--5,18): Feature 'non-variable patterns to the right of 'as' patterns' is not available in F# 5.0. Please use language version 6.0 or greater." ] \ No newline at end of file From 781ee94c8657d8d4755fe81c53ae9925aa0b9f24 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 18:33:05 +0100 Subject: [PATCH 12/19] Error --> SRDiagnostic --- tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs index b2d2166d1a0..2ee9c323639 100644 --- a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs +++ b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs @@ -5,5 +5,5 @@ module CompilerTestHelpers = let (|Warning|_|) (exn: System.Exception) = match exn with - | :? FSharp.Compiler.DiagnosticsLogger.Error as e -> let n,d = e.Data0 in Some (n,d) + | :? FSharp.Compiler.DiagnosticsLogger.SRDiagnostic as e -> Some (e.number, e.message) | _ -> None From e7a20066624b460e1c3e84ac553655f2111d4143 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Sun, 8 May 2022 20:02:43 +0100 Subject: [PATCH 13/19] this -> _ --- src/fsharp/CheckExpressions.fs | 16 ++-- .../DependencyManager/DependencyProvider.fs | 2 +- .../FSharp.Build/FSharpEmbedResXSource.fs | 14 +-- .../FSharp.Build/FSharpEmbedResourceText.fs | 12 +-- src/fsharp/FSharp.Core/Query.fs | 8 +- .../FSharp.Core/fslib-extra-pervasives.fs | 22 ++--- src/fsharp/FSharp.Core/prim-types.fs | 2 +- .../FSharp.DependencyManager.fs | 2 +- src/fsharp/LegacyHostedCompilerForTesting.fs | 6 +- src/fsharp/NameResolution.fs | 50 ++++++---- src/fsharp/ParseAndCheckInputs.fs | 2 +- src/fsharp/PatternMatchCompilation.fs | 32 +++---- src/fsharp/fsi/fsi.fs | 2 +- src/fsharp/fsi/fsimain.fs | 4 +- src/fsharp/import.fs | 9 +- src/fsharp/service/IncrementalBuild.fs | 17 ++-- src/fsharp/service/ServiceLexing.fs | 16 +++- .../service/ServiceParamInfoLocations.fs | 30 +++--- src/fsharp/service/ServiceParsedInputOps.fs | 2 +- .../HashIfExpression.fs | 91 +++++++++---------- 20 files changed, 187 insertions(+), 152 deletions(-) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index aae35b3f7e1..602079ccd12 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -1819,19 +1819,19 @@ let MakeAndPublishSimpleValsForMergedScope (cenv: cenv) env m (names: NameMap<_> let values, vspecMap = let sink = { new ITypecheckResultsSink with - member this.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports + member _.NotifyEnvWithScope(_, _, _) = () // ignore EnvWithScope reports - member this.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = + member _.NotifyNameResolution(pos, item, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, item, itemTyparInst, occurence, nenv, ad, m, replacing) - member this.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = + member _.NotifyMethodGroupNameResolution(pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) = notifyNameResolution (pos, item, itemGroup, itemTyparInst, occurence, nenv, ad, m, replacing) - member this.NotifyExprHasType(_, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals - member this.NotifyFormatSpecifierLocation(_, _) = () - member this.NotifyOpenDeclaration _ = () - member this.CurrentSourceText = None - member this.FormatStringCheckContext = None } + member _.NotifyExprHasType(_, _, _, _) = assert false // no expr typings in MakeAndPublishSimpleVals + member _.NotifyFormatSpecifierLocation(_, _) = () + member _.NotifyOpenDeclaration _ = () + member _.CurrentSourceText = None + member _.FormatStringCheckContext = None } use _h = WithNewTypecheckResultsSink(sink, cenv.tcSink) MakeAndPublishSimpleVals cenv env names diff --git a/src/fsharp/DependencyManager/DependencyProvider.fs b/src/fsharp/DependencyManager/DependencyProvider.fs index f3c99e6186f..aeb5f43f3e8 100644 --- a/src/fsharp/DependencyManager/DependencyProvider.fs +++ b/src/fsharp/DependencyManager/DependencyProvider.fs @@ -238,7 +238,7 @@ type ReflectionDependencyManagerProvider(theType: Type, member _.HelpMessages = instance |> helpMessagesProperty /// Resolve the dependencies for the given arguments - member this.ResolveDependencies(scriptDir, mainScriptName, scriptName, scriptExt, packageManagerTextLines, tfm, rid, timeout): IResolveDependenciesResult = + member _.ResolveDependencies(scriptDir, mainScriptName, scriptName, scriptExt, packageManagerTextLines, tfm, rid, timeout): IResolveDependenciesResult = // The ResolveDependencies method, has two signatures, the original signaature in the variable resolveDeps and the updated signature resolveDepsEx // the resolve method can return values in two different tuples: // (bool * string list * string list * string list) diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs index b24e0fc1a77..fc8b9167d38 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResXSource.fs @@ -93,30 +93,32 @@ module internal {1} = None [] - member this.EmbeddedResource + member _.EmbeddedResource with get() = _embeddedText and set(value) = _embeddedText <- value [] - member this.IntermediateOutputPath + member _.IntermediateOutputPath with get() = _outputPath and set(value) = _outputPath <- value - member this.TargetFramework + member _.TargetFramework with get() = _targetFramework and set(value) = _targetFramework <- value [] - member this.GeneratedSource + member _.GeneratedSource with get() = _generatedSource interface ITask with - member this.BuildEngine + member _.BuildEngine with get() = _buildEngine and set(value) = _buildEngine <- value - member this.HostObject + + member _.HostObject with get() = _hostObject and set(value) = _hostObject <- value + member this.Execute() = let getBooleanMetadata (metadataName:string) (defaultValue:bool) (item:ITaskItem) = match item.GetMetadata(metadataName) with diff --git a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs index 7081761e2c5..f43fef77a43 100644 --- a/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs +++ b/src/fsharp/FSharp.Build/FSharpEmbedResourceText.fs @@ -452,28 +452,28 @@ open Printf None [] - member this.EmbeddedText + member _.EmbeddedText with get() = _embeddedText and set(value) = _embeddedText <- value [] - member this.IntermediateOutputPath + member _.IntermediateOutputPath with get() = _outputPath and set(value) = _outputPath <- value [] - member this.GeneratedSource + member _.GeneratedSource with get() = _generatedSource [] - member this.GeneratedResx + member _.GeneratedResx with get() = _generatedResx interface ITask with - member this.BuildEngine + member _.BuildEngine with get() = _buildEngine and set(value) = _buildEngine <- value - member this.HostObject + member _.HostObject with get() = _hostObject and set(value) = _hostObject <- value member this.Execute() = diff --git a/src/fsharp/FSharp.Core/Query.fs b/src/fsharp/FSharp.Core/Query.fs index 8d54ff85228..18fec9dfef8 100644 --- a/src/fsharp/FSharp.Core/Query.fs +++ b/src/fsharp/FSharp.Core/Query.fs @@ -45,8 +45,8 @@ module ForwardDeclarations = let mutable Query = { new IQueryMethods with - member this.Execute(_) = failwith "IQueryMethods.Execute should never be called" - member this.EliminateNestedQueries(_) = failwith "IQueryMethods.EliminateNestedQueries should never be called" + member _.Execute(_) = failwith "IQueryMethods.Execute should never be called" + member _.EliminateNestedQueries(_) = failwith "IQueryMethods.EliminateNestedQueries should never be called" } type QueryBuilder() = @@ -1925,8 +1925,8 @@ module Query = do ForwardDeclarations.Query <- { new ForwardDeclarations.IQueryMethods with - member this.Execute q = QueryExecute q - member this.EliminateNestedQueries e = EliminateNestedQueries e + member _.Execute q = QueryExecute q + member _.EliminateNestedQueries e = EliminateNestedQueries e } diff --git a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs index 534ae14958c..789533419b0 100644 --- a/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs +++ b/src/fsharp/FSharp.Core/fslib-extra-pervasives.fs @@ -328,9 +328,9 @@ namespace Microsoft.FSharp.Core.CompilerServices let mutable filePath : string = null let mutable line : int = 0 let mutable column : int = 0 - member this.FilePath with get() = filePath and set v = filePath <- v - member this.Line with get() = line and set v = line <- v - member this.Column with get() = column and set v = column <- v + member _.FilePath with get() = filePath and set v = filePath <- v + member _.Line with get() = line and set v = line <- v + member _.Column with get() = column and set v = column <- v [] type TypeProviderEditorHideMethodsAttribute() = @@ -349,14 +349,14 @@ namespace Microsoft.FSharp.Core.CompilerServices let mutable isInvalidationSupported : bool = false let mutable useResolutionFolderAtRuntime : bool = false let mutable systemRuntimeAssemblyVersion : System.Version = null - member this.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v - member this.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v - member this.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v - member this.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v - member this.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v - member this.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v - member this.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v - member this.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName + member _.ResolutionFolder with get() = resolutionFolder and set v = resolutionFolder <- v + member _.RuntimeAssembly with get() = runtimeAssembly and set v = runtimeAssembly <- v + member _.ReferencedAssemblies with get() = referencedAssemblies and set v = referencedAssemblies <- v + member _.TemporaryFolder with get() = temporaryFolder and set v = temporaryFolder <- v + member _.IsInvalidationSupported with get() = isInvalidationSupported and set v = isInvalidationSupported <- v + member _.IsHostedExecution with get() = useResolutionFolderAtRuntime and set v = useResolutionFolderAtRuntime <- v + member _.SystemRuntimeAssemblyVersion with get() = systemRuntimeAssemblyVersion and set v = systemRuntimeAssemblyVersion <- v + member _.SystemRuntimeContainsType (typeName : string) = systemRuntimeContainsType typeName type IProvidedNamespace = abstract NamespaceName : string diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index bef9923e35b..585ded6e589 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -5395,7 +5395,7 @@ namespace Microsoft.FSharp.Core member _.GetEnumerator () = variableStepRangeEnumerator () interface IEnumerable with - member this.GetEnumerator () = (variableStepRangeEnumerator ()) :> IEnumerator } + member _.GetEnumerator () = (variableStepRangeEnumerator ()) :> IEnumerator } let inline simpleIntegralRange minValue maxValue n step m = if step <> LanguagePrimitives.GenericOne || n > m || n = minValue || m = maxValue then diff --git a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs index 43332d53373..38cff9c84b2 100644 --- a/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs +++ b/src/fsharp/FSharp.DependencyManager.Nuget/FSharp.DependencyManager.fs @@ -269,7 +269,7 @@ type FSharpDependencyManager (outputDirectory:string option) = sprintf """ #r "nuget:FSharp.Data";; // %s 'FSharp.Data' %s""" (SR.loadNugetPackage()) (SR.highestVersion()) |] - member this.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = + member _.ResolveDependencies(scriptDirectory: string, scriptName: string, scriptExt: string, packageManagerTextLines: (string * string) seq, targetFrameworkMoniker: string, runtimeIdentifier: string, timeout: int) : obj = ignore scriptName let poundRprefix = match scriptExt with diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index cc21e80c399..c68e8a88b16 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -55,7 +55,7 @@ type internal CompilationOutput = Warnings : Diagnostic[] } type internal InProcCompiler(legacyReferenceResolver) = - member this.Compile(argv) = + member _.Compile(argv) = // Explanation: Compilation happens on whichever thread calls this function. let ctok = AssumeCompilationThreadWithoutEvidence () @@ -64,7 +64,7 @@ type internal InProcCompiler(legacyReferenceResolver) = let mutable exitCode = 0 let exiter = { new Exiter with - member this.Exit n = exitCode <- n; raise StopProcessing } + member _.Exit n = exitCode <- n; raise StopProcessing } try mainCompile(ctok, argv, legacyReferenceResolver, false, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.Yes, exiter, loggerProvider.Provider, None, None) with @@ -136,7 +136,7 @@ type internal FscCompiler(legacyReferenceResolver) = fun arg -> regex.IsMatch(arg) /// do compilation as if args was argv to fsc.exe - member this.Compile(args : string array) = + member _.Compile(args : string array) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 613981b37ae..ab1a2df96e8 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1841,14 +1841,23 @@ let ItemsAreEffectivelyEqualHash (g: TcGlobals) orig = [] type CapturedNameResolution(i: Item, tpinst, io: ItemOccurence, nre: NameResolutionEnv, ad: AccessorDomain, m: range) = - member this.Pos = m.End - member this.Item = i - member this.ItemWithInst = ({ Item = i; TyparInst = tpinst } : ItemWithInst) - member this.ItemOccurence = io - member this.DisplayEnv = nre.DisplayEnv - member this.NameResolutionEnv = nre - member this.AccessorDomain = ad - member this.Range = m + + member _.Pos = m.End + + member _.Item = i + + member _.ItemWithInst = ({ Item = i; TyparInst = tpinst } : ItemWithInst) + + member _.ItemOccurence = io + + member _.DisplayEnv = nre.DisplayEnv + + member _.NameResolutionEnv = nre + + member _.AccessorDomain = ad + + member _.Range = m + member this.DebugToString() = sprintf "%A: %+A" (this.Pos.Line, this.Pos.Column) i @@ -1861,10 +1870,13 @@ type TcResolutions static let empty = TcResolutions(ResizeArray 0, ResizeArray 0, ResizeArray 0, ResizeArray 0) - member this.CapturedEnvs = capturedEnvs - member this.CapturedExpressionTypings = capturedExprTypes - member this.CapturedNameResolutions = capturedNameResolutions - member this.CapturedMethodGroupResolutions = capturedMethodGroupResolutions + member _.CapturedEnvs = capturedEnvs + + member _.CapturedExpressionTypings = capturedExprTypes + + member _.CapturedNameResolutions = capturedNameResolutions + + member _.CapturedMethodGroupResolutions = capturedMethodGroupResolutions static member Empty = empty @@ -1890,7 +1902,7 @@ type TcSymbolUses(g, capturedNameResolutions: ResizeArray ItemsAreEffectivelyEqual g item symbolUse.ItemWithInst.Item) then yield symbolUse |] - member this.AllUsesOfSymbols = allUsesOfSymbols + member _.AllUsesOfSymbols = allUsesOfSymbols - member this.GetFormatSpecifierLocationsAndArity() = formatSpecifierLocations + member _.GetFormatSpecifierLocationsAndArity() = formatSpecifierLocations static member Empty = TcSymbolUses(Unchecked.defaultof<_>, ResizeArray(), Array.empty) @@ -1969,16 +1981,16 @@ type TcResultsSinkImpl(tcGlobals, ?sourceText: ISourceText) = { SourceText = sourceText LineStartPositions = positions }) - member this.GetResolutions() = + member _.GetResolutions() = TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions) - member this.GetSymbolUses() = + member _.GetSymbolUses() = TcSymbolUses(tcGlobals, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray()) - member this.GetOpenDeclarations() = + member _.GetOpenDeclarations() = capturedOpenDeclarations |> Seq.distinctBy (fun x -> x.Range, x.AppliedScope, x.IsOwnNamespace) |> Seq.toArray - member this.GetFormatSpecifierLocations() = + member _.GetFormatSpecifierLocations() = capturedFormatSpecifierLocations.ToArray() interface ITypecheckResultsSink with diff --git a/src/fsharp/ParseAndCheckInputs.fs b/src/fsharp/ParseAndCheckInputs.fs index b32fe20b8cd..66f55246223 100644 --- a/src/fsharp/ParseAndCheckInputs.fs +++ b/src/fsharp/ParseAndCheckInputs.fs @@ -497,7 +497,7 @@ let ParseInputFiles (tcConfig: TcConfig, lexResourceManager, sourceFiles, errorL let mutable exitCode = 0 let delayedExiter = { new Exiter with - member this.Exit n = exitCode <- n; raise StopProcessing } + member _.Exit n = exitCode <- n; raise StopProcessing } // Check input files and create delayed error loggers before we try to parallel parse. let delayedDiagnosticsLoggers = diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index 1832034434f..f25d87ee8a8 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -55,21 +55,21 @@ type Pattern = member this.Range = match this with - | TPat_const(_, m) -> m - | TPat_wild m -> m - | TPat_as(_, _, m) -> m - | TPat_disjs(_, m) -> m - | TPat_conjs(_, m) -> m - | TPat_query(_, _, m) -> m - | TPat_unioncase(_, _, _, m) -> m - | TPat_exnconstr(_, _, m) -> m - | TPat_tuple(_, _, _, m) -> m - | TPat_array(_, _, m) -> m - | TPat_recd(_, _, _, m) -> m - | TPat_range(_, _, m) -> m - | TPat_null m -> m - | TPat_isinst(_, _, _, m) -> m - | TPat_error m -> m + | TPat_const(_, m) -> m + | TPat_wild m -> m + | TPat_as(_, _, m) -> m + | TPat_disjs(_, m) -> m + | TPat_conjs(_, m) -> m + | TPat_query(_, _, m) -> m + | TPat_unioncase(_, _, _, m) -> m + | TPat_exnconstr(_, _, m) -> m + | TPat_tuple(_, _, _, m) -> m + | TPat_array(_, _, m) -> m + | TPat_recd(_, _, _, m) -> m + | TPat_range(_, _, m) -> m + | TPat_null m -> m + | TPat_isinst(_, _, _, m) -> m + | TPat_error m -> m and PatternValBinding = PBind of Val * TypeScheme @@ -859,7 +859,7 @@ let rec BuildSwitch inpExprOpt g expr edges dflt m = compactify (Some (h :: prev :: moreprev)) t | Const.Char cprev, Const.Char cnext when (int32 cprev + 1 = int32 cnext) -> compactify (Some (h :: prev :: moreprev)) t - | _ -> (List.rev (prev :: moreprev)) :: compactify None edges + | _ -> (List.rev (prev :: moreprev)) :: compactify None edges | _ -> failwith "internal error: compactify" let edgeGroups = compactify None edges' diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 13db0d746b8..78804da1e4c 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -2503,7 +2503,7 @@ type FsiStdinLexerProvider CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) // Create a new lexer to read a string - member this.CreateStringLexer (sourceFileName, source, errorLogger) = + member _.CreateStringLexer (sourceFileName, source, errorLogger) = let lexbuf = UnicodeLexing.StringAsLexbuf(true, tcConfigB.langVersion, source) CreateLexerForLexBuffer (sourceFileName, lexbuf, errorLogger) diff --git a/src/fsharp/fsi/fsimain.fs b/src/fsharp/fsi/fsimain.fs index 9a94dfeaabb..f5975dc0282 100644 --- a/src/fsharp/fsi/fsimain.fs +++ b/src/fsharp/fsi/fsimain.fs @@ -123,11 +123,11 @@ let StartServer (fsiSession : FsiEvaluationSession) (fsiServerName) = #if FSI_SERVER let server = {new Server.Shared.FSharpInteractiveServer() with - member this.Interrupt() = + member _.Interrupt() = //printf "FSI-SERVER: received CTRL-C request...\n" try fsiSession.Interrupt() - with e -> + with _ -> // Final sanity check! - catch all exns - but not expected assert false () diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index f16629472d2..a40ebb591be 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -58,9 +58,12 @@ type AssemblyLoader = [] type ImportMap(g: TcGlobals, assemblyLoader: AssemblyLoader) = let typeRefToTyconRefCache = ConcurrentDictionary() - member this.g = g - member this.assemblyLoader = assemblyLoader - member this.ILTypeRefToTyconRefCache = typeRefToTyconRefCache + + member _.g = g + + member _.assemblyLoader = assemblyLoader + + member _.ILTypeRefToTyconRefCache = typeRefToTyconRefCache let CanImportILScopeRef (env: ImportMap) m scoref = diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index c58512bcec6..ebdea9d50eb 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -57,14 +57,17 @@ module IncrementalBuilderEventTesting = let data = Array.create MAX None let mutable curIndex = 0 let mutable numAdds = 0 + // called by the product, to note when a parse/typecheck happens for a file member _.Add(fileName:'T) = numAdds <- numAdds + 1 data[curIndex] <- Some fileName curIndex <- (curIndex + 1) % MAX + member _.CurrentEventNum = numAdds // called by unit tests, returns 'n' most recent additions. - member this.MostRecentList(n: int) : list<'T> = + + member _.MostRecentList(n: int) : list<'T> = if n < 0 || n > MAX then raise <| ArgumentOutOfRangeException("n", sprintf "n must be between 0 and %d, inclusive, but got %d" MAX n) let mutable remaining = n @@ -360,7 +363,7 @@ type BoundModel private (tcConfig: TcConfig, else this - member this.Next(syntaxTree, tcInfo) = + member _.Next(syntaxTree, tcInfo) = BoundModel( tcConfig, tcGlobals, @@ -376,7 +379,7 @@ type BoundModel private (tcConfig: TcConfig, Some syntaxTree, None) - member this.Finish(finalTcDiagnosticsRev, finalTopAttribs) = + member _.Finish(finalTcDiagnosticsRev, finalTopAttribs) = node { let createFinish tcInfo = { tcInfo with tcDiagnosticsRev = finalTcDiagnosticsRev; topAttribs = finalTopAttribs } @@ -1358,15 +1361,15 @@ type IncrementalBuilder(initialState: IncrementalBuilderInitialState, state: Inc | Some slot -> Some slot | None -> None - member this.GetSlotOfFileName(fileName: string) = - match this.TryGetSlotOfFileName(fileName) with + member builder.GetSlotOfFileName(fileName: string) = + match builder.TryGetSlotOfFileName(fileName) with | Some slot -> slot | None -> failwith (sprintf "The file '%s' was not part of the project. Did you call InvalidateConfiguration when the list of files in the project changed?" fileName) member _.GetSlotsCount () = fileNames.Length - member this.ContainsFile(fileName: string) = - (this.TryGetSlotOfFileName fileName).IsSome + member builder.ContainsFile(fileName: string) = + (builder.TryGetSlotOfFileName fileName).IsSome member builder.GetParseResultsForFile fileName = let slotOfFile = builder.GetSlotOfFileName fileName diff --git a/src/fsharp/service/ServiceLexing.fs b/src/fsharp/service/ServiceLexing.fs index 8d06ddfac77..a823215c5f3 100644 --- a/src/fsharp/service/ServiceLexing.fs +++ b/src/fsharp/service/ServiceLexing.fs @@ -334,10 +334,20 @@ module internal TestExpose = type FSharpTokenizerLexState = { PosBits: int64 OtherBits: int64 } + static member Initial = { PosBits = 0L; OtherBits = 0L } - member this.Equals (other: FSharpTokenizerLexState) = (this.PosBits = other.PosBits) && (this.OtherBits = other.OtherBits) - override this.Equals (obj: obj) = match obj with :? FSharpTokenizerLexState as other -> this.Equals other | _ -> false - override this.GetHashCode () = hash this.PosBits + hash this.OtherBits + + member this.Equals (other: FSharpTokenizerLexState) = + (this.PosBits = other.PosBits) && + (this.OtherBits = other.OtherBits) + + override this.Equals (obj: obj) = + match obj with + | :? FSharpTokenizerLexState as other -> this.Equals other + | _ -> false + + override this.GetHashCode () = + hash this.PosBits + hash this.OtherBits type FSharpTokenizerColorState = | Token = 1 diff --git a/src/fsharp/service/ServiceParamInfoLocations.fs b/src/fsharp/service/ServiceParamInfoLocations.fs index f883e171430..8d1f8e93d23 100755 --- a/src/fsharp/service/ServiceParamInfoLocations.fs +++ b/src/fsharp/service/ServiceParamInfoLocations.fs @@ -34,14 +34,22 @@ type ParameterLocations // (compare to f( or f(42, where the parser injects a fake "AbrExpr" to represent the missing argument) assert(tupleEndLocations.Length = namedParamNames.Length + 1) [| yield! namedParamNames; yield None |] // None is representation of a non-named param - member this.LongId = longId - member this.LongIdStartLocation = longIdRange.Start - member this.LongIdEndLocation = longIdRange.End - member this.OpenParenLocation = openParenLocation - member this.TupleEndLocations = tupleEndLocations - member this.IsThereACloseParen = isThereACloseParen - member this.NamedParamNames = namedParamNames - member this.ArgumentLocations = argRanges |> Array.ofList + + member _.LongId = longId + + member _.LongIdStartLocation = longIdRange.Start + + member _.LongIdEndLocation = longIdRange.End + + member _.OpenParenLocation = openParenLocation + + member _.TupleEndLocations = tupleEndLocations + + member _.IsThereACloseParen = isThereACloseParen + + member _.NamedParamNames = namedParamNames + + member _.ArgumentLocations = argRanges |> Array.ofList [] module internal ParameterLocationsImpl = @@ -183,7 +191,7 @@ module internal ParameterLocationsImpl = let traverseInput(pos, parseTree) = SyntaxTraversal.Traverse(pos, parseTree, { new SyntaxVisitorBase<_>() with - member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let expr = expr // fix debug locals match expr with @@ -258,12 +266,12 @@ module internal ParameterLocationsImpl = | _ -> defaultTraverse expr - member this.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = + member _.VisitTypeAbbrev(_path, tyAbbrevRhs, _m) = match tyAbbrevRhs with | StaticParameters pos loc -> Some loc | _ -> None - member this.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = + member _.VisitImplicitInherit(_path, defaultTraverse, ty, expr, m) = match defaultTraverse expr with | Some _ as r -> r | None -> diff --git a/src/fsharp/service/ServiceParsedInputOps.fs b/src/fsharp/service/ServiceParsedInputOps.fs index d48c16a49d7..16000de1e75 100644 --- a/src/fsharp/service/ServiceParsedInputOps.fs +++ b/src/fsharp/service/ServiceParsedInputOps.fs @@ -355,7 +355,7 @@ module ParsedInput = let pick x = SyntaxTraversal.pick pos x let walker = { new SyntaxVisitorBase<_>() with - member this.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = + member _.VisitExpr(_path, traverseSynExpr, defaultTraverse, expr) = let pick = pick expr.Range let traverseSynExpr, defaultTraverse, expr = traverseSynExpr, defaultTraverse, expr // for debugging: debugger does not get object expression params as local vars if not(rangeContainsPos expr.Range pos) then diff --git a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs index 84d4a1dc9ff..42442377a5a 100644 --- a/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs +++ b/tests/FSharp.Compiler.UnitTests/HashIfExpression.fs @@ -13,37 +13,34 @@ open Internal.Utilities.Text.Lexing open FSharp.Compiler open FSharp.Compiler.Diagnostics -open FSharp.Compiler.Lexer open FSharp.Compiler.Lexhelp open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.Features open FSharp.Compiler.ParseHelpers -open FSharp.Compiler.Syntax type public HashIfExpression() = - let preludes = [|"#if "; "#elif "|] - let epilogues = [|""; " // Testing"|] + let preludes = [|"#if "; "#elif "|] + let epilogues = [|""; " // Testing"|] - let ONE = IfdefId "ONE" - let TWO = IfdefId "TWO" - let THREE = IfdefId "THREE" + let ONE = IfdefId "ONE" + let TWO = IfdefId "TWO" + let THREE = IfdefId "THREE" let isSet l r = (l &&& r) <> 0 - let (!!) e = IfdefNot(e) - let (&&&) l r = IfdefAnd(l,r) - let (|||) l r = IfdefOr(l,r) - + let (!!) e = IfdefNot(e) + let (&&&) l r = IfdefAnd(l,r) + let (|||) l r = IfdefOr(l,r) let exprAsString (e : LexerIfdefExpression) : string = - let sb = StringBuilder() + let sb = StringBuilder() let append (s : string) = ignore <| sb.Append s let rec build (e : LexerIfdefExpression) : unit = match e with - | IfdefAnd (l,r)-> append "("; build l; append " && "; build r; append ")" + | IfdefAnd (l,r) -> append "("; build l; append " && "; build r; append ")" | IfdefOr (l,r) -> append "("; build l; append " || "; build r; append ")" - | IfdefNot ee -> append "!"; build ee - | IfdefId nm -> append nm + | IfdefNot ee -> append "!"; build ee + | IfdefId nm -> append nm build e @@ -56,8 +53,8 @@ type public HashIfExpression() = let errorLogger = { new DiagnosticsLogger("TestDiagnosticsLogger") with - member x.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e - member x.ErrorCount = errors.Count + member _.DiagnosticSink(e, sev) = if sev = FSharpDiagnosticSeverity.Error then errors.Add e else warnings.Add e + member _.ErrorCount = errors.Count } let lightSyntax = IndentationAwareSyntaxStatus(true, false) @@ -69,24 +66,24 @@ type public HashIfExpression() = CompileThreadStatic.DiagnosticsLogger <- errorLogger let parser (s : string) = - let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) - lexbuf.StartPos <- startPos - lexbuf.EndPos <- startPos - let tokenStream = PPLexer.tokenstream args + let lexbuf = LexBuffer.FromChars (true, LanguageVersion.Default, s.ToCharArray ()) + lexbuf.StartPos <- startPos + lexbuf.EndPos <- startPos + let tokenStream = PPLexer.tokenstream args PPParser.start tokenStream lexbuf errors, warnings, parser do // Setup - CompileThreadStatic.BuildPhase <- BuildPhase.Compile + CompileThreadStatic.BuildPhase <- BuildPhase.Compile interface IDisposable with // Teardown member _.Dispose() = - CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase + CompileThreadStatic.BuildPhase <- BuildPhase.DefaultPhase CompileThreadStatic.DiagnosticsLogger <- CompileThreadStatic.DiagnosticsLogger [] - member this.PositiveParserTestCases()= + member _.PositiveParserTestCases()= let errors, warnings, parser = createParser () @@ -117,8 +114,8 @@ type public HashIfExpression() = "false" , IfdefId "false" |] - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for test,expected in positiveTestCases do for prelude in preludes do @@ -126,12 +123,12 @@ type public HashIfExpression() = for epilogue in epilogues do let test = test + epilogue try - let expr = parser test + let expr = parser test if expected <> expr then fail <| sprintf "'%s', expected %A, actual %A" test (exprAsString expected) (exprAsString expr) - with - | e -> fail <| sprintf "'%s', expected %A, actual %s,%A" test (exprAsString expected) (e.GetType().Name) e.Message + with e -> + fail <| sprintf "'%s', expected %A, actual %s,%A" test (exprAsString expected) (e.GetType().Name) e.Message let fs = @@ -147,9 +144,9 @@ type public HashIfExpression() = () [] - member this.NegativeParserTestCases()= + member _.NegativeParserTestCases()= - let errors, warnings, parser = createParser () + let errors, _warnings, parser = createParser () let negativeTests = [| @@ -183,18 +180,18 @@ type public HashIfExpression() = "ONE )(@$&%*@^#%#!$)" |] - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for test in negativeTests do for prelude in preludes do let test = prelude + test for epilogue in epilogues do - let test = test + epilogue + let test = test + epilogue try - let bec = errors.Count - let expr = parser test - let aec = errors.Count + let bec = errors.Count + let expr = parser test + let aec = errors.Count if bec = aec then // No new errors discovered fail <| sprintf "'%s', expected 'parse error', actual %A" test (exprAsString expr) @@ -208,22 +205,22 @@ type public HashIfExpression() = Assert.shouldBe "" fails [] - member this.LexerIfdefEvalTestCases()= + member _.LexerIfdefEvalTestCases()= - let failures = ResizeArray () - let fail = failures.Add + let failures = ResizeArray () + let fail = failures.Add for i in 0..7 do - let one = isSet i 1 - let two = isSet i 2 - let three = isSet i 4 + let one = isSet i 1 + let two = isSet i 2 + let three = isSet i 4 let lookup s = match s with - | "ONE" -> one - | "TWO" -> two - | "THREE" -> three - | _ -> false + | "ONE" -> one + | "TWO" -> two + | "THREE" -> three + | _ -> false let testCases = [| From b229ea97c6c8be45536ac1a7090e69311852b71f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 11:22:12 +0100 Subject: [PATCH 14/19] rename and cleanup --- src/fsharp/CheckExpressions.fs | 8 +- src/fsharp/CompilerDiagnostics.fs | 18 +- src/fsharp/CompilerImports.fsi | 2 +- src/fsharp/ConstraintSolver.fs | 6 +- src/fsharp/DiagnosticsLogger.fs | 38 ++- src/fsharp/DiagnosticsLogger.fsi | 6 +- .../FSharp.Build/Microsoft.FSharp.Targets | 4 +- src/fsharp/FSharp.Core/async.fs | 2 +- src/fsharp/FSharp.Core/list.fs | 72 +++--- src/fsharp/FSharp.Core/local.fs | 2 +- src/fsharp/FSharp.Core/map.fs | 4 +- src/fsharp/FSharp.Core/option.fs | 242 ++++++++++++++---- src/fsharp/FSharp.Core/prim-types.fs | 2 +- src/fsharp/FSharp.Core/quotations.fs | 24 +- src/fsharp/FSharp.Core/quotations.fsi | 12 +- src/fsharp/FSharp.Core/seq.fs | 2 +- src/fsharp/FSharp.Core/string.fs | 4 +- src/fsharp/NameResolution.fs | 4 +- src/fsharp/NicePrint.fs | 2 +- src/fsharp/Optimizer.fs | 10 +- src/fsharp/PatternMatchCompilation.fs | 16 +- src/fsharp/QueueList.fs | 2 +- src/fsharp/StaticLinking.fs | 4 +- src/fsharp/TypedTree.fs | 2 +- src/fsharp/TypedTreeOps.fs | 2 +- src/fsharp/TypedTreePickle.fs | 2 +- src/fsharp/absil/il.fs | 6 +- src/fsharp/absil/il.fsi | 2 +- src/fsharp/absil/illib.fs | 2 +- src/fsharp/absil/ilmorph.fs | 2 +- src/fsharp/absil/ilreflect.fs | 2 +- src/fsharp/fsi/fsi.fs | 4 +- src/fsharp/infos.fs | 4 +- src/fsharp/service/IncrementalBuild.fs | 2 +- src/fsharp/service/ServiceNavigation.fs | 45 ++-- src/fsharp/service/ServiceParseTreeWalk.fs | 2 +- src/fsharp/service/ServiceStructure.fs | 2 +- src/fsharp/tainted.fs | 6 +- src/fsharp/utils/CompilerLocationUtils.fs | 2 +- src/fsharp/utils/sformat.fs | 2 +- .../MapSourceRootsTests.fs | 43 ++-- .../WriteCodeFragmentTests.fs | 32 ++- .../checkedOperatorsNoOverflow.fs | 2 +- .../EmittedIL/Misc/AbstractClass.fs | 2 +- .../SteppingMatch/SteppingMatch09.fs | 6 +- .../EmittedIL/Tuples/OptionalArg01.fs | 2 +- .../Printing/ParamArrayInSignatures.fsx | 2 +- .../CompilerTestHelpers.fs | 2 +- .../FSharp.Core/ComparersRegression.fs | 2 +- .../Microsoft.FSharp.Control/AsyncModule.fs | 2 +- .../Microsoft.FSharp.Control/AsyncType.fs | 4 +- .../MailboxProcessorType.fs | 6 +- .../FSharp.Core/PrimTypes.fs | 2 +- tests/benchmarks/TaskPerf/option.fs | 4 +- tests/fsharp/tests.fs | 16 +- tests/service/ProjectAnalysisTests.fs | 4 +- tests/service/data/TestTP/ProvidedTypes.fs | 2 +- .../Completion/CompletionProvider.fs | 2 +- .../FSharp.Editor/Options/EditorOptions.fs | 2 +- .../FSharp.ProjectSystem.FSharp/Project.fs | 2 +- .../src/FSharp.VS.FSI/fsiTextBufferStream.fs | 2 +- .../ProvidedTypes.fs | 4 +- .../UnitTests/BraceMatchingServiceTests.fs | 2 +- .../UnitTests/CompletionProviderTests.fs | 2 +- .../DocumentDiagnosticAnalyzerTests.fs | 2 +- .../Tests.LanguageService.Completion.fs | 50 ++-- .../Tests.LanguageService.ErrorList.fs | 8 +- .../Tests.LanguageService.GotoDefinition.fs | 8 +- .../Tests.LanguageService.ParameterInfo.fs | 93 ++++--- .../Tests.LanguageService.QuickInfo.fs | 10 +- .../Tests.LanguageService.Script.fs | 6 +- .../Tests.LanguageService.TimeStamp.fs | 8 +- .../Tests.ProjectSystem.Project.fs | 4 +- .../Tests.ProjectSystem.References.fs | 4 +- .../UnitTests/TestLib.LanguageService.fs | 69 +++-- .../UnitTests/Workspace/WorkspaceTests.fs | 20 +- 76 files changed, 597 insertions(+), 409 deletions(-) diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 602079ccd12..11c535acb78 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -8620,9 +8620,11 @@ and TcUnionCaseOrExnCaseOrActivePatternResultItemThen cenv overallTy env item tp let SEEN_NAMED_ARGUMENT = -1 - // dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: - // regular notation for named parameters Some(Value = 5) can mean either 1) create option with value - result of equality operation or 2) create option using named arg syntax. - // so far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. + // Dealing with named arguments is a bit tricky since prior to these changes we have an ambiguous situation: + // regular notation for named parameters Some(Value = 5) can mean either + // 1) create "bool option" with value - result of equality operation or + // 2) create "int option" using named arg syntax. + // So far we've used 1) so we cannot immediately switch to 2) since it will be a definite breaking change. for _, id, arg in namedCallerArgs do match argNames |> List.tryFindIndex (fun id2 -> id.idText = id2.idText) with diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index 307c36e38ae..6f2ca6ecd2f 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -125,8 +125,8 @@ let GetRangeOfDiagnostic(diag: PhasedDiagnostic) = | NotUpperCaseConstructor m | RecursiveUseCheckedAtRuntime (_, _, m) | LetRecEvaluatedOutOfOrder (_, _, _, m) - | SRDiagnostic (_, _, m) - | SRDiagnosticWithSuggestions (_, _, m, _, _) + | DiagnosticWithText (_, _, m) + | DiagnosticWithSuggestions (_, _, m, _, _) | SyntaxError (_, m) | InternalError (_, m) | InterfaceNotRevealed(_, _, m) @@ -340,8 +340,8 @@ let GetDiagnosticNumber(diag: PhasedDiagnostic) = | WrappedError(e, _) -> GetFromException e - | SRDiagnostic (n, _, _) -> n - | SRDiagnosticWithSuggestions (n, _, _, _, _) -> n + | DiagnosticWithText (n, _, _) -> n + | DiagnosticWithSuggestions (n, _, _, _, _) -> n | Failure _ -> 192 | IllegalFileNameChar(fileName, invalidChar) -> fst (FSComp.SR.buildUnexpectedFileNameCharacter(fileName, string invalidChar)) #if !NO_TYPEPROVIDERS @@ -358,8 +358,8 @@ let GetWarningLevel diag = | LetRecEvaluatedOutOfOrder _ | DefensiveCopyWarning _ -> 5 - | SRDiagnostic(n, _, _) - | SRDiagnosticWithSuggestions(n, _, _, _, _) -> + | DiagnosticWithText(n, _, _) + | DiagnosticWithSuggestions(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..." // 1178, tcNoComparisonNeeded2, "The struct, record or union type '%s' is not structurally comparable because the type '%s' does not satisfy the 'comparison' constraint...." // 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..." @@ -1356,7 +1356,7 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN | None -> os.AppendString(OverrideDoesntOverride1E().Format sig1) | Some minfoVirt -> - // https://github.com/Microsoft/visualfsharp/issues/35 + // https://github.com/dotnet/fsharp/issues/35 // Improve error message when attempting to override generic return type with unit: // we need to check if unit was used as a type argument let hasUnitTType_app (types: TType list) = @@ -1480,9 +1480,9 @@ let OutputPhasedErrorR (os: StringBuilder) (diag: PhasedDiagnostic) (canSuggestN os.AppendString(NonUniqueInferredAbstractSlot3E().Format ty1 ty2) os.AppendString(NonUniqueInferredAbstractSlot4E().Format) - | SRDiagnostic (_, s, _) -> os.AppendString s + | DiagnosticWithText (_, s, _) -> os.AppendString s - | SRDiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> + | DiagnosticWithSuggestions (_, s, _, idText, suggestionF) -> os.AppendString(DecompileOpName s) suggestNames suggestionF idText diff --git a/src/fsharp/CompilerImports.fsi b/src/fsharp/CompilerImports.fsi index ca2f3c53c53..61d8dc1d172 100644 --- a/src/fsharp/CompilerImports.fsi +++ b/src/fsharp/CompilerImports.fsi @@ -156,7 +156,7 @@ type TcImports = member FindDllInfo: CompilationThreadToken * range * string -> ImportedBinary - member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> option + member TryFindDllInfo: CompilationThreadToken * range * string * lookupOnly: bool -> ImportedBinary option member FindCcuFromAssemblyRef: CompilationThreadToken * range * ILAssemblyRef -> CcuResolutionResult diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index 2dbb006024b..293ce77491e 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -355,7 +355,7 @@ let MakeConstraintSolverEnv contextInfo css m denv = /// Check whether a type variable occurs in the r.h.s. of a type, e.g. to catch /// infinite equations such as -/// 'a = list<'a> +/// 'a = 'a list let rec occursCheck g un ty = match stripTyEqns g ty with | TType_ucase(_, l) @@ -976,7 +976,7 @@ let CheckWarnIfRigid (csenv: ConstraintSolverEnv) ty1 (r: Typar) ty = let rec SolveTyparEqualsTypePart1 (csenv: ConstraintSolverEnv) m2 (trace: OptionalTrace) ty1 r ty = trackErrors { // The types may still be equivalent due to abbreviations, which we are trying not to eliminate if typeEquiv csenv.g ty1 ty then () else - // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/Microsoft/visualfsharp/issues/1170 + // The famous 'occursCheck' check to catch "infinite types" like 'a = list<'a> - see also https://github.com/dotnet/fsharp/issues/1170 if occursCheck csenv.g r ty then return! ErrorD (ConstraintSolverInfiniteTypes(csenv.DisplayEnv, csenv.eContextInfo, ty1, ty, csenv.m, m2)) else // Note: warn _and_ continue! do! CheckWarnIfRigid csenv ty1 r ty @@ -1903,7 +1903,7 @@ and GetSupportOfMemberConstraint (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, and SupportOfMemberConstraintIsFullySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = tys |> List.forall (isAnyParTy csenv.g >> not) -// This may be relevant to future bug fixes, see https://github.com/Microsoft/visualfsharp/issues/3814 +// This may be relevant to future bug fixes, see https://github.com/dotnet/fsharp/issues/3814 // /// Check if some part of the support is solved. // and SupportOfMemberConstraintIsPartiallySolved (csenv: ConstraintSolverEnv) (TTrait(tys, _, _, _, _, _)) = // tys |> List.exists (isAnyParTy csenv.g >> not) diff --git a/src/fsharp/DiagnosticsLogger.fs b/src/fsharp/DiagnosticsLogger.fs index e7b72269678..6dd5ee7aef7 100644 --- a/src/fsharp/DiagnosticsLogger.fs +++ b/src/fsharp/DiagnosticsLogger.fs @@ -67,10 +67,10 @@ let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ let StopProcessing<'T> = StopProcessingExn None // int is e.g. 191 in FS0191 -exception SRDiagnostic of number: int * message: string * range: range with +exception DiagnosticWithText of number: int * message: string * range: range with override this.Message = match this :> exn with - | SRDiagnostic(_, msg, _) -> msg + | DiagnosticWithText(_, msg, _) -> msg | _ -> "impossible" exception InternalError of message: string * range: range with @@ -101,17 +101,25 @@ exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string exception UnresolvedPathReference of assemblyName: string * path: string * range: range -exception SRDiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191 +exception DiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions with // int is e.g. 191 in FS0191 override this.Message = match this :> exn with - | SRDiagnosticWithSuggestions(_, msg, _, _, _) -> msg + | DiagnosticWithSuggestions(_, msg, _, _, _) -> msg | _ -> "impossible" -/// The F# compiler code currently uses 'Error(...)' to create an SRDiagnostic as an exception even if it's a warning -let Error ((n, text), m) = SRDiagnostic (n, text, m) +/// The F# compiler code currently uses 'Error(...)' in many places to create +/// an DiagnosticWithText as an exception even if it's a warning. +/// +/// We will eventually rename this to remove this use of "Error" +let Error ((n, text), m) = + DiagnosticWithText (n, text, m) -/// The F# compiler code currently uses 'ErrorWithSuggestions(...)' to create an SRDiagnostic as an exception even if it's a warning -let ErrorWithSuggestions ((n, message), m, id, suggestions) = SRDiagnosticWithSuggestions (n, message, m, id, suggestions) +/// The F# compiler code currently uses 'ErrorWithSuggestions(...)' in many places to create +/// an DiagnosticWithText as an exception even if it's a warning. +/// +/// We will eventually rename this to remove this use of "Error" +let ErrorWithSuggestions ((n, message), m, id, suggestions) = + DiagnosticWithSuggestions (n, message, m, id, suggestions) let inline protectAssemblyExploration dflt f = try @@ -174,32 +182,44 @@ type BuildPhase = module BuildPhaseSubcategory = [] let DefaultPhase = "" + [] let Compile = "compile" + [] let Parameter = "parameter" + [] let Parse = "parse" + [] let TypeCheck = "typecheck" + [] let CodeGen = "codegen" + [] let Optimize = "optimize" + [] let IlxGen = "ilxgen" + [] let IlGen = "ilgen" + [] let Output = "output" + [] let Interactive = "interactive" + [] let Internal = "internal" // Compiler ICE [] type PhasedDiagnostic = - { Exception:exn; Phase:BuildPhase } + { Exception:exn + Phase:BuildPhase } /// Construct a phased error static member Create(exn:exn, phase:BuildPhase) : PhasedDiagnostic = diff --git a/src/fsharp/DiagnosticsLogger.fsi b/src/fsharp/DiagnosticsLogger.fsi index 59dbfb7655d..aed2884149e 100644 --- a/src/fsharp/DiagnosticsLogger.fsi +++ b/src/fsharp/DiagnosticsLogger.fsi @@ -42,7 +42,7 @@ val (|StopProcessing|_|): exn: exn -> unit option val StopProcessing<'T> : exn /// Represents a diagnostic exeption whose text comes via SR.* -exception SRDiagnostic of number: int * message: string * range: range +exception DiagnosticWithText of number: int * message: string * range: range /// Creates a diagnostic exeption whose text comes via SR.* val Error: (int * string) * range -> exn @@ -67,14 +67,14 @@ exception UnresolvedPathReferenceNoRange of assemblyName: string * path: string exception UnresolvedPathReference of assemblyName: string * path: string * range: range -exception SRDiagnosticWithSuggestions of +exception DiagnosticWithSuggestions of number: int * message: string * range: range * identifier: string * suggestions: Suggestions -/// Creates a SRDiagnosticWithSuggestions whose text comes via SR.* +/// Creates a DiagnosticWithSuggestions whose text comes via SR.* val ErrorWithSuggestions: (int * string) * range * string * Suggestions -> exn val inline protectAssemblyExploration: dflt: 'a -> f: (unit -> 'a) -> 'a diff --git a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets index e200ed8a7b0..3ba06c1e4bf 100644 --- a/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets +++ b/src/fsharp/FSharp.Build/Microsoft.FSharp.Targets @@ -288,8 +288,8 @@ this file. correct list of resources based on the build system being used. This could be a bit simpler, but xbuild doesn't seem to support msbuild 4.0 'item functions' like Distinct(). - Reference: https://github.com/Microsoft/visualfsharp/pull/2595 - https://github.com/Microsoft/visualfsharp/pull/2605 + Reference: https://github.com/dotnet/fsharp/pull/2595 + https://github.com/dotnet/fsharp/pull/2605 --> > = [] + let mutable savedConts: SuspendedAsync<'T> list = [] // The WaitHandle event for the result. Only created if needed, and set to null when disposed. let mutable resEvent = null diff --git a/src/fsharp/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index cd22fb65be3..d0eeda4e854 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -42,7 +42,7 @@ namespace Microsoft.FSharp.Collections [] let concat lists = Microsoft.FSharp.Primitives.Basics.List.concat lists - let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection:'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list:'T list) = + let inline countByImpl (comparer:IEqualityComparer<'SafeKey>) ([] projection: 'T->'SafeKey) ([] getKey:'SafeKey->'Key) (list: 'T list) = let dict = Dictionary comparer let rec loop srcList = match srcList with @@ -56,13 +56,13 @@ namespace Microsoft.FSharp.Collections Microsoft.FSharp.Primitives.Basics.List.countBy dict getKey // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let countByValueType (projection:'T->'Key) (list:'T list) = countByImpl HashIdentity.Structural<'Key> projection id list + let countByValueType (projection: 'T->'Key) (list: 'T list) = countByImpl HashIdentity.Structural<'Key> projection id list // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let countByRefType (projection:'T->'Key) (list:'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list + let countByRefType (projection: 'T->'Key) (list: 'T list) = countByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (projection t)) (fun sb -> sb.Value) list [] - let countBy (projection:'T->'Key) (list:'T list) = + let countBy (projection: 'T->'Key) (list: 'T list) = match list with | [] -> [] | _ -> @@ -84,7 +84,7 @@ namespace Microsoft.FSharp.Collections Microsoft.FSharp.Primitives.Basics.List.mapFold mapping state list [] - let mapFoldBack<'T, 'State, 'Result> (mapping:'T -> 'State -> 'Result * 'State) list state = + let mapFoldBack<'T, 'State, 'Result> (mapping: 'T -> 'State -> 'Result * 'State) list state = match list with | [] -> [], state | [h] -> let h', s' = mapping h state in [h'], s' @@ -99,19 +99,19 @@ namespace Microsoft.FSharp.Collections loop ([], state) (rev list) [] - let inline iter ([] action) (list:'T list) = for x in list do action x + let inline iter ([] action) (list: 'T list) = for x in list do action x [] - let distinct (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list + let distinct (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctWithComparer HashIdentity.Structural<'T> list [] - let distinctBy projection (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list + let distinctBy projection (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.distinctByWithComparer HashIdentity.Structural<_> projection list [] - let ofArray (array:'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array + let ofArray (array: 'T array) = Microsoft.FSharp.Primitives.Basics.List.ofArray array [] - let toArray (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list + let toArray (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.toArray list [] let empty<'T> = ([ ] : 'T list) @@ -154,7 +154,7 @@ namespace Microsoft.FSharp.Collections let choose chooser list = Microsoft.FSharp.Primitives.Basics.List.choose chooser list [] - let splitAt index (list:'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list + let splitAt index (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.splitAt index list [] let take count (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.take count list @@ -233,14 +233,14 @@ namespace Microsoft.FSharp.Collections | h :: t -> fold reduction h t [] - let scan<'T, 'State> folder (state:'State) (list:'T list) = + let scan<'T, 'State> folder (state:'State) (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.scan folder state list [] let inline singleton value = [value] [] - let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:list<'T1>) (list2:list<'T2>) = + let fold2<'T1, 'T2, 'State> folder (state:'State) (list1:'T1 list) (list2:'T2 list) = let f = OptimizedClosures.FSharpFunc<_, _, _, _>.Adapt(folder) let rec loop acc list1 list2 = match list1, list2 with @@ -258,7 +258,7 @@ namespace Microsoft.FSharp.Collections // this version doesn't causes stack overflow - it uses a private stack [] - let foldBack<'T, 'State> folder (list:'T list) (state:'State) = + let foldBack<'T, 'State> folder (list: 'T list) (state:'State) = let f = OptimizedClosures.FSharpFunc<_, _, _>.Adapt(folder) match list with | [] -> state @@ -283,7 +283,7 @@ namespace Microsoft.FSharp.Collections let arrn = arr.Length foldArraySubRight f arr 0 (arrn - 2) arr.[arrn - 1] - let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr:_[]) start fin initState = + let scanArraySubRight<'T, 'State> (f:OptimizedClosures.FSharpFunc<'T, 'State, 'State>) (arr: _[]) start fin initState = let mutable state = initState let mutable res = [state] for i = fin downto start do @@ -292,7 +292,7 @@ namespace Microsoft.FSharp.Collections res [] - let scanBack<'T, 'State> folder (list:'T list) (state:'State) = + let scanBack<'T, 'State> folder (list: 'T list) (state:'State) = match list with | [] -> [state] | [h] -> @@ -428,17 +428,17 @@ namespace Microsoft.FSharp.Collections [] let where predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list - let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf:'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = + let inline groupByImpl (comparer:IEqualityComparer<'SafeKey>) (keyf: 'T->'SafeKey) (getKey:'SafeKey->'Key) (list: 'T list) = Microsoft.FSharp.Primitives.Basics.List.groupBy comparer keyf getKey list // We avoid wrapping a StructBox, because under 64 JIT we get some "hard" tailcalls which affect performance - let groupByValueType (keyf:'T->'Key) (list:'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list + let groupByValueType (keyf: 'T->'Key) (list: 'T list) = groupByImpl HashIdentity.Structural<'Key> keyf id list // Wrap a StructBox around all keys in case the key type is itself a type using null as a representation - let groupByRefType (keyf:'T->'Key) (list:'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list + let groupByRefType (keyf: 'T->'Key) (list: 'T list) = groupByImpl RuntimeHelpers.StructBox<'Key>.Comparer (fun t -> RuntimeHelpers.StructBox (keyf t)) (fun sb -> sb.Value) list [] - let groupBy (projection:'T->'Key) (list:'T list) = + let groupBy (projection: 'T->'Key) (list: 'T list) = match list with | [] -> [] | _ -> @@ -548,13 +548,19 @@ namespace Microsoft.FSharp.Collections loop 0 list [] - let findIndexBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate + let findIndexBack predicate list = + list + |> toArray + |> Microsoft.FSharp.Primitives.Basics.Array.findIndexBack predicate [] - let tryFindIndexBack predicate list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate + let tryFindIndexBack predicate list = + list + |> toArray + |> Microsoft.FSharp.Primitives.Basics.Array.tryFindIndexBack predicate [] - let inline sum (list:list<'T>) = + let inline sum (list: 'T list) = match list with | [] -> LanguagePrimitives.GenericZero<'T> | t -> @@ -564,7 +570,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline sumBy ([] projection: 'T -> 'U) (list:list<'T>) = + let inline sumBy ([] projection: 'T -> 'U) (list: 'T list) = match list with | [] -> LanguagePrimitives.GenericZero<'U> | t -> @@ -574,7 +580,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline max (list:list<_>) = + let inline max (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -585,7 +591,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline maxBy projection (list:list<_>) = + let inline maxBy projection (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -599,7 +605,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline min (list:list<_>) = + let inline min (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -610,7 +616,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline minBy projection (list:list<_>) = + let inline minBy projection (list: _ list) = match list with | [] -> invalidArg "list" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | h :: t -> @@ -624,7 +630,7 @@ namespace Microsoft.FSharp.Collections acc [] - let inline average (list:list<'T>) = + let inline average (list: 'T list) = match list with | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | xs -> @@ -636,7 +642,7 @@ namespace Microsoft.FSharp.Collections LanguagePrimitives.DivideByInt sum count [] - let inline averageBy ([] projection: 'T -> 'U) (list:list<'T>) = + let inline averageBy ([] projection: 'T -> 'U) (list: 'T list) = match list with | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | xs -> @@ -654,7 +660,7 @@ namespace Microsoft.FSharp.Collections let allPairs list1 list2 = Microsoft.FSharp.Primitives.Basics.List.allPairs list1 list2 [] - let inline compareWith ([] comparer:'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = + let inline compareWith ([] comparer: 'T -> 'T -> int) (list1: 'T list) (list2: 'T list) = let rec loop list1 list2 = match list1, list2 with | head1 :: tail1, head2 :: tail2 -> @@ -670,14 +676,14 @@ namespace Microsoft.FSharp.Collections let permute indexMap list = list |> toArray |> Microsoft.FSharp.Primitives.Basics.Array.permute indexMap |> ofArray [] - let exactlyOne (list: list<_>) = + let exactlyOne (list: _ list) = match list with | [x] -> x | [] -> invalidArg "source" LanguagePrimitives.ErrorStrings.InputSequenceEmptyString | _ -> invalidArg "source" (SR.GetString(SR.inputSequenceTooLong)) [] - let tryExactlyOne (list: list<_>) = + let tryExactlyOne (list: _ list) = match list with | [x] -> Some x | _ -> None diff --git a/src/fsharp/FSharp.Core/local.fs b/src/fsharp/FSharp.Core/local.fs index 99de5a7b172..16c7c77e63e 100644 --- a/src/fsharp/FSharp.Core/local.fs +++ b/src/fsharp/FSharp.Core/local.fs @@ -531,7 +531,7 @@ module internal List = let inline ofSeq (e : IEnumerable<'T>) = match e with - | :? list<'T> as l -> l + | :? ('T list) as l -> l | :? ('T[]) as arr -> ofArray arr | _ -> use ie = e.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/map.fs b/src/fsharp/FSharp.Core/map.fs index 31458e94db3..8a4c0b64fb0 100644 --- a/src/fsharp/FSharp.Core/map.fs +++ b/src/fsharp/FSharp.Core/map.fs @@ -453,8 +453,8 @@ module MapTree = let ofSeq comparer (c : seq<'Key * 'T>) = match c with - | :? array<'Key * 'T> as xs -> ofArray comparer xs - | :? list<'Key * 'T> as xs -> ofList comparer xs + | :? (('Key * 'T)[]) as xs -> ofArray comparer xs + | :? (('Key * 'T) list) as xs -> ofList comparer xs | _ -> use ie = c.GetEnumerator() mkFromEnumerator comparer empty ie diff --git a/src/fsharp/FSharp.Core/option.fs b/src/fsharp/FSharp.Core/option.fs index 552d1c9231f..8b28af7531d 100644 --- a/src/fsharp/FSharp.Core/option.fs +++ b/src/fsharp/FSharp.Core/option.fs @@ -8,49 +8,94 @@ open Microsoft.FSharp.Core.Operators module Option = [] - let get option = match option with None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | Some x -> x + let get option = + match option with + | None -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) + | Some x -> x [] - let inline isSome option = match option with None -> false | Some _ -> true + let inline isSome option = + match option with + | None -> false + | Some _ -> true [] - let inline isNone option = match option with None -> true | Some _ -> false + let inline isNone option = + match option with + | None -> true + | Some _ -> false [] - let defaultValue value option = match option with None -> value | Some v -> v + let defaultValue value option = + match option with + | None -> value + | Some v -> v [] - let defaultWith defThunk option = match option with None -> defThunk () | Some v -> v + let defaultWith defThunk option = + match option with + | None -> defThunk () + | Some v -> v [] - let orElse ifNone option = match option with None -> ifNone | Some _ -> option + let orElse ifNone option = + match option with + | None -> ifNone + | Some _ -> option [] - let orElseWith ifNoneThunk option = match option with None -> ifNoneThunk () | Some _ -> option + let orElseWith ifNoneThunk option = + match option with + | None -> ifNoneThunk () + | Some _ -> option [] - let count option = match option with None -> 0 | Some _ -> 1 + let count option = + match option with + | None -> 0 + | Some _ -> 1 [] - let fold<'T,'State> folder (state:'State) (option: option<'T>) = match option with None -> state | Some x -> folder state x + let fold<'T,'State> folder (state:'State) (option: 'T option) = + match option with + | None -> state + | Some x -> folder state x [] - let foldBack<'T,'State> folder (option: option<'T>) (state:'State) = match option with None -> state | Some x -> folder x state + let foldBack<'T,'State> folder (option: option<'T>) (state:'State) = + match option with + | None -> state + | Some x -> folder x state [] - let exists predicate option = match option with None -> false | Some x -> predicate x + let exists predicate option = + match option with + | None -> false + | Some x -> predicate x [] - let forall predicate option = match option with None -> true | Some x -> predicate x + let forall predicate option = + match option with + | None -> true + | Some x -> predicate x [] - let inline contains value option = match option with None -> false | Some v -> v = value + let inline contains value option = + match option with + | None -> false + | Some v -> v = value [] - let iter action option = match option with None -> () | Some x -> action x + let iter action option = + match option with + | None -> () + | Some x -> action x [] - let map mapping option = match option with None -> None | Some x -> Some (mapping x) + let map mapping option = + match option with + | None -> None + | Some x -> Some (mapping x) [] let map2 mapping option1 option2 = @@ -65,78 +110,151 @@ module Option = | _ -> None [] - let bind binder option = match option with None -> None | Some x -> binder x + let bind binder option = + match option with + | None -> None + | Some x -> binder x [] - let flatten option = match option with None -> None | Some x -> x + let flatten option = + match option with + | None -> None + | Some x -> x [] - let filter predicate option = match option with None -> None | Some x -> if predicate x then Some x else None + let filter predicate option = + match option with + | None -> None + | Some x -> if predicate x then Some x else None [] - let toArray option = match option with None -> [| |] | Some x -> [| x |] + let toArray option = + match option with + | None -> [| |] + | Some x -> [| x |] [] - let toList option = match option with None -> [ ] | Some x -> [ x ] + let toList option = + match option with + | None -> [ ] + | Some x -> [ x ] [] - let toNullable option = match option with None -> System.Nullable() | Some v -> System.Nullable(v) + let toNullable option = + match option with + | None -> System.Nullable() + | Some v -> System.Nullable(v) [] - let ofNullable (value:System.Nullable<'T>) = if value.HasValue then Some value.Value else None + let ofNullable (value:System.Nullable<'T>) = + if value.HasValue then + Some value.Value + else + None [] - let ofObj value = match value with null -> None | _ -> Some value + let ofObj value = + match value with + | null -> None + | _ -> Some value [] - let toObj value = match value with None -> null | Some x -> x + let toObj value = + match value with + | None -> null + | Some x -> x module ValueOption = [] - let get voption = match voption with ValueNone -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) | ValueSome x -> x + let get voption = + match voption with + | ValueNone -> invalidArg "option" (SR.GetString(SR.optionValueWasNone)) + | ValueSome x -> x [] - let inline isSome voption = match voption with ValueNone -> false | ValueSome _ -> true + let inline isSome voption = + match voption with + | ValueNone -> false + | ValueSome _ -> true [] - let inline isNone voption = match voption with ValueNone -> true | ValueSome _ -> false + let inline isNone voption = + match voption with + | ValueNone -> true + | ValueSome _ -> false [] - let defaultValue value voption = match voption with ValueNone -> value | ValueSome v -> v + let defaultValue value voption = + match voption with + | ValueNone -> value + | ValueSome v -> v [] - let defaultWith defThunk voption = match voption with ValueNone -> defThunk () | ValueSome v -> v + let defaultWith defThunk voption = + match voption with + | ValueNone -> defThunk () + | ValueSome v -> v [] - let orElse ifNone voption = match voption with ValueNone -> ifNone | ValueSome _ -> voption + let orElse ifNone voption = + match voption with + | ValueNone -> ifNone + | ValueSome _ -> voption [] - let orElseWith ifNoneThunk voption = match voption with ValueNone -> ifNoneThunk () | ValueSome _ -> voption + let orElseWith ifNoneThunk voption = + match voption with + | ValueNone -> ifNoneThunk () + | ValueSome _ -> voption [] - let count voption = match voption with ValueNone -> 0 | ValueSome _ -> 1 + let count voption = + match voption with + | ValueNone -> 0 + | ValueSome _ -> 1 [] - let fold<'T,'State> folder (state:'State) (voption: voption<'T>) = match voption with ValueNone -> state | ValueSome x -> folder state x + let fold<'T,'State> folder (state:'State) (voption: voption<'T>) = + match voption with + | ValueNone -> state + | ValueSome x -> folder state x [] - let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) = match voption with ValueNone -> state | ValueSome x -> folder x state + let foldBack<'T,'State> folder (voption: voption<'T>) (state:'State) = + match voption with + | ValueNone -> state + | ValueSome x -> folder x state [] - let exists predicate voption = match voption with ValueNone -> false | ValueSome x -> predicate x + let exists predicate voption = + match voption with + | ValueNone -> false + | ValueSome x -> predicate x [] - let forall predicate voption = match voption with ValueNone -> true | ValueSome x -> predicate x + let forall predicate voption = + match voption with + | ValueNone -> true + | ValueSome x -> predicate x [] - let inline contains value voption = match voption with ValueNone -> false | ValueSome v -> v = value + let inline contains value voption = + match voption with + | ValueNone -> false + | ValueSome v -> v = value [] - let iter action voption = match voption with ValueNone -> () | ValueSome x -> action x + let iter action voption = + match voption with + | ValueNone -> () + | ValueSome x -> action x [] - let map mapping voption = match voption with ValueNone -> ValueNone | ValueSome x -> ValueSome (mapping x) + let map mapping voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> ValueSome (mapping x) [] let map2 mapping voption1 voption2 = @@ -151,28 +269,56 @@ module ValueOption = | _ -> ValueNone [] - let bind binder voption = match voption with ValueNone -> ValueNone | ValueSome x -> binder x + let bind binder voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> binder x [] - let flatten voption = match voption with ValueNone -> ValueNone | ValueSome x -> x + let flatten voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> x [] - let filter predicate voption = match voption with ValueNone -> ValueNone | ValueSome x -> if predicate x then ValueSome x else ValueNone + let filter predicate voption = + match voption with + | ValueNone -> ValueNone + | ValueSome x -> if predicate x then ValueSome x else ValueNone [] - let toArray voption = match voption with ValueNone -> [| |] | ValueSome x -> [| x |] + let toArray voption = + match voption with + | ValueNone -> [| |] + | ValueSome x -> [| x |] [] - let toList voption = match voption with ValueNone -> [ ] | ValueSome x -> [ x ] + let toList voption = + match voption with + | ValueNone -> [ ] + | ValueSome x -> [ x ] [] - let toNullable voption = match voption with ValueNone -> System.Nullable() | ValueSome v -> System.Nullable(v) + let toNullable voption = + match voption with + | ValueNone -> System.Nullable() + | ValueSome v -> System.Nullable(v) [] - let ofNullable (value:System.Nullable<'T>) = if value.HasValue then ValueSome value.Value else ValueNone + let ofNullable (value:System.Nullable<'T>) = + if value.HasValue then + ValueSome value.Value + else + ValueNone [] - let ofObj value = match value with null -> ValueNone | _ -> ValueSome value + let ofObj value = + match value with + | null -> ValueNone + | _ -> ValueSome value [] - let toObj value = match value with ValueNone -> null | ValueSome x -> x + let toObj value = + match value with + | ValueNone -> null + | ValueSome x -> x diff --git a/src/fsharp/FSharp.Core/prim-types.fs b/src/fsharp/FSharp.Core/prim-types.fs index 585ded6e589..baa7fd5cb0b 100644 --- a/src/fsharp/FSharp.Core/prim-types.fs +++ b/src/fsharp/FSharp.Core/prim-types.fs @@ -3625,7 +3625,7 @@ namespace Microsoft.FSharp.Collections //------------------------------------------------------------------------- and - ListDebugView<'T>(l:list<'T>) = + ListDebugView<'T>(l: 'T list) = let ListDebugViewMaxLength = 50 // default displayed Max Length let ListDebugViewMaxFullLength = 5000 // display only when FullList opened (5000 is a super big display used to cut-off an infinite list or undebuggably huge one) diff --git a/src/fsharp/FSharp.Core/quotations.fs b/src/fsharp/FSharp.Core/quotations.fs index 03ca84a5667..81d02f40a54 100644 --- a/src/fsharp/FSharp.Core/quotations.fs +++ b/src/fsharp/FSharp.Core/quotations.fs @@ -377,7 +377,7 @@ module Patterns = let ES ts = List.map E ts let (|E|) (e: Expr) = e.Tree - let (|ES|) (es: list) = es |> List.map (fun e -> e.Tree) + let (|ES|) (es: Expr list) = es |> List.map (fun e -> e.Tree) let (|FrontAndBack|_|) es = let rec loop acc xs = match xs with [] -> None | [h] -> Some (List.rev acc, h) | h :: t -> loop (h :: acc) t loop [] es @@ -742,7 +742,7 @@ module Patterns = if (not (assignableFrom expectedType receivedType)) then invalidArg "receivedType" (String.Format(threeHoleSR, name, expectedType, receivedType)) - let checkArgs (paramInfos: ParameterInfo[]) (args:list) = + let checkArgs (paramInfos: ParameterInfo[]) (args: Expr list) = if (paramInfos.Length <> args.Length) then invalidArg "args" (SR.GetString(SR.QincorrectNumArgs)) List.iter2 ( fun (p:ParameterInfo) a -> checkTypesWeakSR p.ParameterType (typeOf a) "args" (SR.GetString(SR.QtmmInvalidParam))) @@ -837,7 +837,7 @@ module Patterns = mkFE1 (TupleGetOp (ty, n)) x // Records - let mkNewRecord (ty, args:list) = + let mkNewRecord (ty, args: Expr list) = let mems = FSharpType.GetRecordFields(ty, publicOrPrivateBindingFlags) if (args.Length <> mems.Length) then invalidArg "args" (SR.GetString(SR.QincompatibleRecordLength)) List.iter2 (fun (minfo: PropertyInfo) a -> checkTypesSR minfo.PropertyType (typeOf a) "recd" (SR.GetString(SR.QtmmIncorrectArgForRecord))) (Array.toList mems) args @@ -845,7 +845,7 @@ module Patterns = // Discriminated unions - let mkNewUnionCase (unionCase:UnionCaseInfo, args:list) = + let mkNewUnionCase (unionCase:UnionCaseInfo, args: Expr list) = if Unchecked.defaultof = unionCase then raise (new ArgumentNullException()) let sargs = unionCase.GetFields() if (args.Length <> sargs.Length) then invalidArg "args" (SR.GetString(SR.QunionNeedsDiffNumArgs)) @@ -897,7 +897,7 @@ module Patterns = mkFE2 (InstanceFieldSetOp finfo) (obj, value) | true -> invalidArg "finfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkCtorCall (ci:ConstructorInfo, args:list) = + let mkCtorCall (ci:ConstructorInfo, args: Expr list) = if Unchecked.defaultof = ci then raise (new ArgumentNullException()) checkArgs (ci.GetParameters()) args mkFEN (NewObjectOp ci) args @@ -905,7 +905,7 @@ module Patterns = let mkDefaultValue (ty: Type) = mkFE0 (DefaultValueOp ty) - let mkStaticPropGet (pinfo: PropertyInfo, args:list) = + let mkStaticPropGet (pinfo: PropertyInfo, args: Expr list) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanRead) then invalidArg "pinfo" (SR.GetString(SR.QreadingSetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -913,7 +913,7 @@ module Patterns = | true -> mkFEN (StaticPropGetOp pinfo) args | false -> invalidArg "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) - let mkInstancePropGet (obj, pinfo: PropertyInfo, args:list) = + let mkInstancePropGet (obj, pinfo: PropertyInfo, args: Expr list) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanRead) then invalidArg "pinfo" (SR.GetString(SR.QreadingSetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -923,7 +923,7 @@ module Patterns = mkFEN (InstancePropGetOp pinfo) (obj :: args) | true -> invalidArg "pinfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkStaticPropSet (pinfo: PropertyInfo, args:list, value: Expr) = + let mkStaticPropSet (pinfo: PropertyInfo, args: Expr list, value: Expr) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanWrite) then invalidArg "pinfo" (SR.GetString(SR.QwritingGetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -931,7 +931,7 @@ module Patterns = | true -> mkFEN (StaticPropSetOp pinfo) (args@[value]) | false -> invalidArg "pinfo" (SR.GetString(SR.QnonStaticNoReceiverObject)) - let mkInstancePropSet (obj, pinfo: PropertyInfo, args:list, value: Expr) = + let mkInstancePropSet (obj, pinfo: PropertyInfo, args: Expr list, value: Expr) = if Unchecked.defaultof = pinfo then raise (new ArgumentNullException()) if (not pinfo.CanWrite) then invalidArg "pinfo" (SR.GetString(SR.QwritingGetOnly)) checkArgs (pinfo.GetIndexParameters()) args @@ -941,7 +941,7 @@ module Patterns = mkFEN (InstancePropSetOp pinfo) (obj :: (args@[value])) | true -> invalidArg "pinfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkInstanceMethodCall (obj, minfo:MethodInfo, args:list) = + let mkInstanceMethodCall (obj, minfo:MethodInfo, args: Expr list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args match minfo.IsStatic with @@ -959,7 +959,7 @@ module Patterns = mkFEN (InstanceMethodCallWOp (minfo, minfoW, nWitnesses)) (obj::args) | true -> invalidArg "minfo" (SR.GetString(SR.QstaticWithReceiverObject)) - let mkStaticMethodCall (minfo:MethodInfo, args:list) = + let mkStaticMethodCall (minfo:MethodInfo, args: Expr list) = if Unchecked.defaultof = minfo then raise (new ArgumentNullException()) checkArgs (minfo.GetParameters()) args match minfo.IsStatic with @@ -1002,7 +1002,7 @@ module Patterns = | [x] -> mkApplication (f, x) | _ -> mkApplication (f, mkNewTuple args) - let mkApplications(f: Expr, es:list>) = mkLLinear mkTupledApplication (f, es) + let mkApplications(f: Expr, es: Expr list list) = mkLLinear mkTupledApplication (f, es) let mkIteratedLambdas(vs, b) = mkRLinear mkLambda (vs, b) diff --git a/src/fsharp/FSharp.Core/quotations.fsi b/src/fsharp/FSharp.Core/quotations.fsi index 32728b76f74..42946640323 100644 --- a/src/fsharp/FSharp.Core/quotations.fsi +++ b/src/fsharp/FSharp.Core/quotations.fsi @@ -266,7 +266,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ (fun (x, y) z -> x + y + z) (1,2) 3 @>. /// - static member Applications: functionExpr: Expr * arguments: list> -> Expr + static member Applications: functionExpr: Expr * arguments: Expr list list -> Expr /// Builds an expression that represents a call to an static method or module-bound function /// @@ -292,7 +292,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ Console.WriteLine("Hello World") @>. /// - static member Call: methodInfo: MethodInfo * arguments: list -> Expr + static member Call: methodInfo: MethodInfo * arguments: Expr list -> Expr /// Builds an expression that represents a call to an instance method associated with an object /// @@ -319,7 +319,7 @@ type Expr = /// /// Evaluates to a quotation with the same structure as <@ Console.Out.WriteLine("Hello World") @>. /// - static member Call: obj: Expr * methodInfo: MethodInfo * arguments: list -> Expr + static member Call: obj: Expr * methodInfo: MethodInfo * arguments: Expr list -> Expr /// Builds an expression that represents a call to an static method or module-bound function, potentially passing additional witness arguments /// @@ -1253,7 +1253,7 @@ type Expr = /// /// The resulting expression. static member Deserialize: - qualifyingType: System.Type * spliceTypes: list * spliceExprs: list * bytes: byte [] -> Expr + qualifyingType: Type * spliceTypes: Type list * spliceExprs: Expr list * bytes: byte [] -> Expr /// This function is called automatically when quotation syntax (<@ @>) and other sources of /// quotations are used. @@ -2248,7 +2248,7 @@ module ExprShape = /// /// [] - val (|ShapeVar|ShapeLambda|ShapeCombination|): input: Expr -> Choice)> + val (|ShapeVar|ShapeLambda|ShapeCombination|): input: Expr -> Choice /// Re-build combination expressions. The first parameter should be an object /// returned by the ShapeCombination case of the active pattern in this module. @@ -2259,4 +2259,4 @@ module ExprShape = /// The rebuilt expression. /// /// - val RebuildShapeCombination: shape: obj * arguments: list -> Expr + val RebuildShapeCombination: shape: obj * arguments: Expr list -> Expr diff --git a/src/fsharp/FSharp.Core/seq.fs b/src/fsharp/FSharp.Core/seq.fs index 7020fd084df..fb6fd554ff7 100644 --- a/src/fsharp/FSharp.Core/seq.fs +++ b/src/fsharp/FSharp.Core/seq.fs @@ -695,7 +695,7 @@ namespace Microsoft.FSharp.Collections checkNonNull "source" source match source with | :? ('T[]) as a -> a.Length = 0 - | :? list<'T> as a -> a.IsEmpty + | :? ('T list) as a -> a.IsEmpty | :? ICollection<'T> as a -> a.Count = 0 | _ -> use ie = source.GetEnumerator() diff --git a/src/fsharp/FSharp.Core/string.fs b/src/fsharp/FSharp.Core/string.fs index 4ed8b4e9183..a653cbf20b7 100644 --- a/src/fsharp/FSharp.Core/string.fs +++ b/src/fsharp/FSharp.Core/string.fs @@ -32,10 +32,10 @@ namespace Microsoft.FSharp.Core | _ -> String.Join(sep, strings, 0, strings.Length) match strings with - | :? array as arr -> + | :? (string[]) as arr -> concatArray sep arr - | :? list as lst -> + | :? (string list) as lst -> lst |> List.toArray |> concatArray sep diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index ab1a2df96e8..6e927ff49c8 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1525,8 +1525,8 @@ let AddResults res1 res2 = | Exception (UndefinedName(n1, _, _, _) as e1), Exception (UndefinedName(n2, _, _, _) as e2) -> if n1 < n2 then Exception e2 else Exception e1 // Prefer more concrete errors about things being undefined - | Exception (UndefinedName _ as e1), Exception (SRDiagnostic _) -> Exception e1 - | Exception (SRDiagnostic _), Exception (UndefinedName _ as e2) -> Exception e2 + | Exception (UndefinedName _ as e1), Exception (DiagnosticWithText _) -> Exception e1 + | Exception (DiagnosticWithText _), Exception (UndefinedName _ as e2) -> Exception e2 | Exception e1, Exception _ -> Exception e1 let NoResultsOrUsefulErrors = Result [] diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index 5b71aaeed15..7a2312dff16 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -2505,7 +2505,7 @@ let minimalStringsOfTwoTypes denv t1 t2= match attempt4 with | Some res -> res | None -> - // https://github.com/Microsoft/visualfsharp/issues/2561 + // https://github.com/dotnet/fsharp/issues/2561 // still identical, we better (try to) show assembly qualified name to disambiguate let denv = denv.SetOpenPaths [] let denv = { denv with includeStaticParametersInTypeNames=true } diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 33721292577..b4ebb0838c8 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -379,12 +379,12 @@ type OptimizationSettings = /// Determines if we should eliminate for-loops around an expr if it has no effect /// - /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/dotnet/fsharp/pull/376 member x.EliminateForLoop = x.LocalOptimizationsEnabled /// Determines if we should eliminate try/with or try/finally around an expr if it has no effect /// - /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/Microsoft/visualfsharp/pull/376 + /// This optimization is off by default, given tiny overhead of including try/with. See https://github.com/dotnet/fsharp/pull/376 member _.EliminateTryWithAndTryFinally = false /// Determines if we should eliminate first part of sequential expression if it has no effect @@ -1110,7 +1110,7 @@ let OrTailcalls l = List.exists (fun x -> x.MightMakeCriticalTailcall) l let OptimizeList f l = l |> List.map f |> List.unzip -let NoExprs : Expr list * list> = [], [] +let NoExprs : Expr list * Summary list = [], [] /// Common ways of building new value infos let CombineValueInfos einfos res = @@ -1386,7 +1386,7 @@ let IsKnownOnlyMutableBeforeUse (vref: ValRef) = // | SingleUnion of int // member x.Next = let (SingleUnion i) = x in SingleUnion (i+1) // -// See https://github.com/Microsoft/visualfsharp/issues/5136 +// See https://github.com/dotnet/fsharp/issues/5136 // // // note: allocating an object with observable identity (i.e. a name) @@ -1643,7 +1643,7 @@ let rec RewriteBoolLogicTree (targets: DecisionTreeTarget[], outerCaseTree, oute and RewriteBoolLogicCase data (TCase(test, tree)) = TCase(test, RewriteBoolLogicTree data tree) -/// Repeatedly combine switch-over-match decision trees, see https://github.com/Microsoft/visualfsharp/issues/635. +/// Repeatedly combine switch-over-match decision trees, see https://github.com/dotnet/fsharp/issues/635. /// The outer decision tree is doing a switch over a boolean result, the inner match is producing only /// constant boolean results in its targets. let rec CombineBoolLogic expr = diff --git a/src/fsharp/PatternMatchCompilation.fs b/src/fsharp/PatternMatchCompilation.fs index f25d87ee8a8..5c60efab813 100644 --- a/src/fsharp/PatternMatchCompilation.fs +++ b/src/fsharp/PatternMatchCompilation.fs @@ -430,9 +430,9 @@ type Implication = /// /// Example: /// match x with -/// | :? option -> ... +/// | :? (int option) -> ... /// | null -> ... -/// Nothing can be learned. If ':? option' succeeds, 'null' may still have to be run. +/// Nothing can be learned. If ':? (int option)' succeeds, 'null' may still have to be run. let computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 = if TypeNullIsTrueValue g tgtTy1 then Implication.Nothing @@ -443,9 +443,9 @@ let computeWhatSuccessfulTypeTestImpliesAboutNullTest g tgtTy1 = /// /// Example: /// match x with -/// | :? option -> ... +/// | :? (int option) -> ... /// | null -> ... -/// If ':? option' fails then 'null' will fail +/// If ':? (int option)' fails then 'null' will fail let computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = if TypeNullIsTrueValue g tgtTy1 then Implication.Fails @@ -463,8 +463,8 @@ let computeWhatFailingTypeTestImpliesAboutNullTest g tgtTy1 = /// Example: /// match x with /// | null -> ... -/// | :? option -> ... -/// For any inputs where 'null' succeeds, ':? option' will succeed +/// | :? (int option) -> ... +/// For any inputs where 'null' succeeds, ':? (int option)' will succeed let computeWhatSuccessfulNullTestImpliesAboutTypeTest g tgtTy2 = if TypeNullIsTrueValue g tgtTy2 then Implication.Succeeds @@ -518,8 +518,8 @@ let computeWhatSuccessfulTypeTestImpliesAboutTypeTest g amap m tgtTy1 tgtTy2 = // // This doesn't apply to types with null as true value: // match x with - // | :? option -> ... - // | :? option -> ... + // | :? (int option) -> ... + // | :? (string option) -> ... // // Here on 'null' input the first pattern succeeds, and the second pattern will also succeed elif isSealedTy g tgtTy1 && diff --git a/src/fsharp/QueueList.fs b/src/fsharp/QueueList.fs index cb823d0bd87..19591b66c8b 100644 --- a/src/fsharp/QueueList.fs +++ b/src/fsharp/QueueList.fs @@ -68,7 +68,7 @@ module internal QueueList = let forall f (x:QueueList<_>) = Seq.forall f x - let ofList (x:list<_>) = QueueList(x) + let ofList (x:_ list) = QueueList(x) let toList (x:QueueList<_>) = Seq.toList x diff --git a/src/fsharp/StaticLinking.fs b/src/fsharp/StaticLinking.fs index f09ae579634..94d3c7f3f33 100644 --- a/src/fsharp/StaticLinking.fs +++ b/src/fsharp/StaticLinking.fs @@ -197,9 +197,9 @@ let StaticLinkILModules (tcConfig:TcConfig, ilGlobals, tcImports, ilxMainModule, type Node = { name: string data: ILModuleDef - ccu: option + ccu: CcuThunk option refs: ILReferences - mutable edges: list + mutable edges: Node list mutable visited: bool } // Find all IL modules that are to be statically linked given the static linking roots. diff --git a/src/fsharp/TypedTree.fs b/src/fsharp/TypedTree.fs index 07dcf3f0514..975b28ef1c5 100644 --- a/src/fsharp/TypedTree.fs +++ b/src/fsharp/TypedTree.fs @@ -4062,7 +4062,7 @@ type TType = | TType_measure of measure: Measure /// For now, used only as a discriminant in error message. - /// See https://github.com/Microsoft/visualfsharp/issues/2561 + /// See https://github.com/dotnet/fsharp/issues/2561 member x.GetAssemblyName() = match x with | TType_forall (_tps, ty) -> ty.GetAssemblyName() diff --git a/src/fsharp/TypedTreeOps.fs b/src/fsharp/TypedTreeOps.fs index b20a03b9efa..868da58b6f3 100644 --- a/src/fsharp/TypedTreeOps.fs +++ b/src/fsharp/TypedTreeOps.fs @@ -6217,7 +6217,7 @@ let isRecdOrUnionOrStructTyconRefDefinitelyMutable (tcref: TyconRef) = tycon.UnionCasesArray |> Array.exists isUnionCaseDefinitelyMutable elif tycon.IsRecordTycon || tycon.IsStructOrEnumTycon then // Note: This only looks at the F# fields, causing oddities. - // See https://github.com/Microsoft/visualfsharp/pull/4576 + // See https://github.com/dotnet/fsharp/pull/4576 tycon.AllFieldsArray |> Array.exists isRecdOrStructFieldDefinitelyMutable else false diff --git a/src/fsharp/TypedTreePickle.fs b/src/fsharp/TypedTreePickle.fs index 53eff22c771..010e2939431 100644 --- a/src/fsharp/TypedTreePickle.fs +++ b/src/fsharp/TypedTreePickle.fs @@ -1616,7 +1616,7 @@ let rec p_normalized_measure unt st = // numerator and denominator) is used only when absolutely necessary, maintaining // compatibility of formats with versions prior to F# 4.0. // -// See https://github.com/Microsoft/visualfsharp/issues/69 +// See https://github.com/dotnet/fsharp/issues/69 let p_measure_expr unt st = p_normalized_measure (normalizeMeasure st.oglobals unt) st let u_rational st = diff --git a/src/fsharp/absil/il.fs b/src/fsharp/absil/il.fs index 92fc33f8fc0..a972c7cd4b1 100644 --- a/src/fsharp/absil/il.fs +++ b/src/fsharp/absil/il.fs @@ -1269,7 +1269,7 @@ type ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } -type ILLocals = list +type ILLocals = ILLocal list [] type ILDebugImport = @@ -1547,7 +1547,7 @@ type ILParameter = member x.CustomAttrs = x.CustomAttrsStored.GetCustomAttrs x.MetadataIndex -type ILParameters = list +type ILParameters = ILParameter list [] type ILReturn = @@ -3892,7 +3892,7 @@ let getCustomAttrData cattr = // as a compressed int to indicate the size followed by an array of UTF8 characters.) // - A set of properties, encoded as the named arguments to a custom attribute would be (as // in §23.3, beginning with NumNamed). -let mkPermissionSet (action, attributes: list) = +let mkPermissionSet (action, attributes: (ILTypeRef * (string * ILType * ILAttribElem) list) list) = let bytes = [| yield (byte '.') yield! z_unsigned_int attributes.Length diff --git a/src/fsharp/absil/il.fsi b/src/fsharp/absil/il.fsi index e8dba23f758..c3d784a77e5 100644 --- a/src/fsharp/absil/il.fsi +++ b/src/fsharp/absil/il.fsi @@ -753,7 +753,7 @@ type internal ILLocal = IsPinned: bool DebugInfo: (string * int * int) option } -type internal ILLocals = list +type internal ILLocals = ILLocal list /// Defines an opened namespace, type relevant to a code location. /// diff --git a/src/fsharp/absil/illib.fs b/src/fsharp/absil/illib.fs index 7fce4b83fcc..ac837cd6a81 100644 --- a/src/fsharp/absil/illib.fs +++ b/src/fsharp/absil/illib.fs @@ -393,7 +393,7 @@ module List = loop [] l let order (eltOrder: IComparer<'T>) = - { new IComparer> with + { new IComparer<'T list> with member _.Compare(xs, ys) = let rec loop xs ys = match xs, ys with diff --git a/src/fsharp/absil/ilmorph.fs b/src/fsharp/absil/ilmorph.fs index f26844c6e92..9ddcdf7df89 100644 --- a/src/fsharp/absil/ilmorph.fs +++ b/src/fsharp/absil/ilmorph.fs @@ -25,7 +25,7 @@ let code_instr2instrs f (code: ILCode) = let mutable nw = 0 for instr in instrs do adjust[old] <- nw - let instrs : list<_> = f instr + let instrs : _ list = f instr for instr2 in instrs do codebuf.Add instr2 nw <- nw + 1 diff --git a/src/fsharp/absil/ilreflect.fs b/src/fsharp/absil/ilreflect.fs index 2fda2716936..35339c31abf 100644 --- a/src/fsharp/absil/ilreflect.fs +++ b/src/fsharp/absil/ilreflect.fs @@ -718,7 +718,7 @@ let queryableTypeGetMethodBySearch cenv emEnv parentT (mref: ILMethodRef) = // we should reject methods which don't satisfy parameter types by also checking // type parameters which can be contravariant for delegates for example - // see https://github.com/Microsoft/visualfsharp/issues/2411 + // see https://github.com/dotnet/fsharp/issues/2411 // without this check, subsequent call to convTypes would fail because it // constructs generic type without checking constraints if not (satisfiesAllParameters mrefParameterTypes haveArgTs) then false else diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 78804da1e4c..52bdb119f83 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -2743,7 +2743,7 @@ type FsiInteractionProcessor /// /// #directive comes through with other definitions as a SynModuleDecl.HashDirective. /// We split these out for individual processing. - let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult:option, cancellationToken: CancellationToken) = + let rec execParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = cancellationToken.ThrowIfCancellationRequested() let action,nextAction,istate = match action with @@ -2806,7 +2806,7 @@ type FsiInteractionProcessor /// Execute a single parsed interaction which may contain multiple items to be executed /// independently - let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult:option, cancellationToken: CancellationToken) = + let executeParsedInteractions (ctok, tcConfig, istate, action, errorLogger: DiagnosticsLogger, lastResult: FsiInteractionStepStatus option, cancellationToken: CancellationToken) = let istate, completed = execParsedInteractions (ctok, tcConfig, istate, action, errorLogger, lastResult, cancellationToken) match completed with | Completed _ -> diff --git a/src/fsharp/infos.fs b/src/fsharp/infos.fs index ef000fdcaa6..de977d0681b 100755 --- a/src/fsharp/infos.fs +++ b/src/fsharp/infos.fs @@ -139,7 +139,7 @@ let private GetInstantiationForMemberVal g isCSharpExt (ty, vref, methTyArgs: Ty let memberParentTypars, memberMethodTypars, _retTy, parentTyArgs = AnalyzeTypeOfMemberVal isCSharpExt g (ty, vref) /// In some recursive inference cases involving constraints this may need to be /// fixed up - we allow uniform generic recursion but nothing else. - /// See https://github.com/Microsoft/visualfsharp/issues/3038#issuecomment-309429410 + /// See https://github.com/dotnet/fsharp/issues/3038#issuecomment-309429410 let methTyArgsFixedUp = if methTyArgs.Length < memberMethodTypars.Length then methTyArgs @ (List.skip methTyArgs.Length memberMethodTypars |> generalizeTypars) @@ -1926,7 +1926,7 @@ type PropInfo = match pi with | ILProp ilpinfo -> hash ilpinfo.RawMetadata.Name | FSProp(_, _, vrefOpt1, vrefOpt2) -> - // Hash on option*option + // Hash on string option * string option let vth = (vrefOpt1 |> Option.map (fun vr -> vr.LogicalName), (vrefOpt2 |> Option.map (fun vr -> vr.LogicalName))) hash vth #if !NO_TYPEPROVIDERS diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index ebdea9d50eb..f87d4bf9ffe 100644 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -67,7 +67,7 @@ module IncrementalBuilderEventTesting = member _.CurrentEventNum = numAdds // called by unit tests, returns 'n' most recent additions. - member _.MostRecentList(n: int) : list<'T> = + member _.MostRecentList(n: int) : 'T list = if n < 0 || n > MAX then raise <| ArgumentOutOfRangeException("n", sprintf "n must be between 0 and %d, inclusive, but got %d" MAX n) let mutable remaining = n diff --git a/src/fsharp/service/ServiceNavigation.fs b/src/fsharp/service/ServiceNavigation.fs index 520587fd50d..de3b0bece2c 100755 --- a/src/fsharp/service/ServiceNavigation.fs +++ b/src/fsharp/service/ServiceNavigation.fs @@ -218,7 +218,7 @@ module NavigationImpl = | _ -> [] // Returns class-members for the right dropdown - and processMembers members enclosingEntityKind : range * list = + and processMembers members enclosingEntityKind = let members = members |> List.groupBy (fun x -> x.Range) @@ -389,7 +389,7 @@ module NavigationImpl = //| TyconCore_repr_hidden of range | _ -> [] - and processSigMembers (members: SynMemberSig list): list = + and processSigMembers (members: SynMemberSig list) = [ for memb in members do match memb with | SynMemberSig.Member(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _, _) -> @@ -399,37 +399,40 @@ module NavigationImpl = | _ -> () ] // Process declarations in a module that belong to the right drop-down (let bindings) - let processNestedSigDeclarations decls = decls |> List.collect (function - | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> - [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] - | _ -> [] ) + let processNestedSigDeclarations decls = + decls |> List.collect (fun decl -> + match decl with + | SynModuleSigDecl.Val(SynValSig.SynValSig(ident=SynIdent(id,_); accessibility=access; range=m), _) -> + [ createMember(id, NavigationItemKind.Method, FSharpGlyph.Method, m, NavigationEntityKind.Module, false, access) ] + | _ -> [] ) // Process declarations nested in a module that should be displayed in the left dropdown // (such as type declarations, nested modules etc.) let rec processNavigationTopLevelSigDeclarations(baseName, decls) = - decls - |> List.collect (function - | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> - [ createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, rangeOfLid lid, [], NavigationEntityKind.Module, false, None) ] + decls |> List.collect (fun decl -> + match decl with + | SynModuleSigDecl.ModuleAbbrev(id, lid, m) -> + [ createDecl(baseName, id, NavigationItemKind.Module, FSharpGlyph.Module, m, rangeOfLid lid, [], NavigationEntityKind.Module, false, None) ] - | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> - // Find let bindings (for the right dropdown) - let nested = processNestedSigDeclarations(decls) - let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) + | SynModuleSigDecl.NestedModule(moduleInfo=SynComponentInfo(longId=lid; accessibility=access); moduleDecls=decls; range=m) -> + // Find let bindings (for the right dropdown) + let nested = processNestedSigDeclarations(decls) + let newBaseName = (if baseName = "" then "" else baseName + ".") + (textOfLid lid) - // Get nested modules and types (for the left dropdown) - let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) - createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other), nested, NavigationEntityKind.Module, false, access) :: other + // Get nested modules and types (for the left dropdown) + let other = processNavigationTopLevelSigDeclarations(newBaseName, decls) + createDeclLid(baseName, lid, NavigationItemKind.Module, FSharpGlyph.Module, m, unionRangesChecked (rangeOfDecls nested) (moduleRange (rangeOfLid lid) other), nested, NavigationEntityKind.Module, false, access) :: other - | SynModuleSigDecl.Types(tydefs, _) -> tydefs |> List.collect (processTycon baseName) - | SynModuleSigDecl.Exception (defn,_) -> processExnSig baseName defn - | _ -> []) + | SynModuleSigDecl.Types(tydefs, _) -> tydefs |> List.collect (processTycon baseName) + | SynModuleSigDecl.Exception (defn,_) -> processExnSig baseName defn + | _ -> []) // Collect all the items let items = // Show base name for this module only if it's not the root one let singleTopLevel = (modules.Length = 1) - modules |> List.collect (fun (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) -> + modules |> List.collect (fun modulSig -> + let (SynModuleOrNamespaceSig(id, _isRec, kind, decls, _, _, access, m, _)) = modulSig let baseName = if (not singleTopLevel) then textOfLid id else "" // Find let bindings (for the right dropdown) let nested = processNestedSigDeclarations(decls) diff --git a/src/fsharp/service/ServiceParseTreeWalk.fs b/src/fsharp/service/ServiceParseTreeWalk.fs index b98dd95378b..5e19aed8106 100755 --- a/src/fsharp/service/ServiceParseTreeWalk.fs +++ b/src/fsharp/service/ServiceParseTreeWalk.fs @@ -165,7 +165,7 @@ module SyntaxTraversal = let dive node range project = range,(fun() -> project node) - let pick pos (outerRange:range) (debugObj:obj) (diveResults:list) = + let pick pos (outerRange:range) (debugObj:obj) (diveResults: (range * _) list) = match diveResults with | [] -> None | _ -> diff --git a/src/fsharp/service/ServiceStructure.fs b/src/fsharp/service/ServiceStructure.fs index 8aa0a7e1ed4..bc9f5255c3e 100644 --- a/src/fsharp/service/ServiceStructure.fs +++ b/src/fsharp/service/ServiceStructure.fs @@ -705,7 +705,7 @@ module Structure = with the following construct. This necessitates inspecting the children of the construct and finding the end of the last child's range to use instead. - Detailed further in - https://github.com/Microsoft/visualfsharp/issues/2094 + Detailed further in - https://github.com/dotnet/fsharp/issues/2094 *) let lastMemberSigRangeElse r memberSigs = diff --git a/src/fsharp/tainted.fs b/src/fsharp/tainted.fs index a50b2dd2dba..0eb274fa48b 100644 --- a/src/fsharp/tainted.fs +++ b/src/fsharp/tainted.fs @@ -107,7 +107,7 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = let errNum,_ = FSComp.SR.etProviderError("", "") raise <| TypeProviderError((errNum, e.Message), this.TypeProviderDesignation, range) - member this.TypeProvider = Tainted<_>(context, context.TypeProvider) + member _.TypeProvider = Tainted<_>(context, context.TypeProvider) member this.PApply(f,range: range) = let u = this.Protect f range @@ -148,13 +148,13 @@ type internal Tainted<'T> (context: TaintedContext, value: 'T) = member this.PUntaintNoFailure f = this.PUntaint(f, range0) /// Access the target object directly. Use with extreme caution. - member this.AccessObjectDirectly = value + member _.AccessObjectDirectly = value static member CreateAll(providerSpecs: (ITypeProvider * ILScopeRef) list) = [for tp,nm in providerSpecs do yield Tainted<_>({ TypeProvider=tp; TypeProviderAssemblyRef=nm; Lock=TypeProviderLock() },tp) ] - member this.OfType<'U> () = + member _.OfType<'U> () = match box value with | :? 'U as u -> Some (Tainted(context,u)) | _ -> None diff --git a/src/fsharp/utils/CompilerLocationUtils.fs b/src/fsharp/utils/CompilerLocationUtils.fs index d6df7915d7f..3e22c1aab0a 100644 --- a/src/fsharp/utils/CompilerLocationUtils.fs +++ b/src/fsharp/utils/CompilerLocationUtils.fs @@ -248,7 +248,7 @@ module internal FSharpEnvironment = // Specify the tooling-compatible fragments of a path such as: // typeproviders/fsharp41/net461/MyProvider.DesignTime.dll // tools/fsharp41/net461/MyProvider.DesignTime.dll - // See https://github.com/Microsoft/visualfsharp/issues/3736 + // See https://github.com/dotnet/fsharp/issues/3736 // Represents the F#-compiler <-> type provider protocol. // When the API or protocol updates, add a new version moniker to the front of the list here. diff --git a/src/fsharp/utils/sformat.fs b/src/fsharp/utils/sformat.fs index c29ff687543..1ee3032b150 100644 --- a/src/fsharp/utils/sformat.fs +++ b/src/fsharp/utils/sformat.fs @@ -443,7 +443,7 @@ module ReflectUtils = let isListType ty = FSharpType.IsUnion ty && (let cases = FSharpType.GetUnionCases ty - cases.Length > 0 && equivHeadTypes typedefof> cases[0].DeclaringType) + cases.Length > 0 && equivHeadTypes typedefof<_ list> cases[0].DeclaringType) [] type TupleType = diff --git a/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs b/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs index a5d852b2625..ad3c87c24fc 100644 --- a/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs +++ b/tests/FSharp.Build.UnitTests/MapSourceRootsTests.fs @@ -14,27 +14,36 @@ type MockEngine() = member val Messages = ResizeArray() with get interface IBuildEngine with - member this.BuildProjectFile(projectFileName: string, targetNames: string [], globalProperties: System.Collections.IDictionary, targetOutputs: System.Collections.IDictionary): bool = + + member _.BuildProjectFile(projectFileName: string, targetNames: string [], globalProperties: System.Collections.IDictionary, targetOutputs: System.Collections.IDictionary): bool = failwith "Not Implemented" - member this.ColumnNumberOfTaskNode: int = 0 - member this.ContinueOnError: bool = true - member this.LineNumberOfTaskNode: int = 0 + + member _.ColumnNumberOfTaskNode: int = 0 + + member _.ContinueOnError = true + + member _.LineNumberOfTaskNode: int = 0 + member this.LogCustomEvent(e: CustomBuildEventArgs): unit = this.Custom.Add e failwith "Not Implemented" + member this.LogErrorEvent(e: BuildErrorEventArgs): unit = this.Errors.Add e + member this.LogMessageEvent(e: BuildMessageEventArgs): unit = this.Messages.Add e + member this.LogWarningEvent(e: BuildWarningEventArgs): unit = this.Warnings.Add e - member this.ProjectFileOfTaskNode: string = "" + + member _.ProjectFileOfTaskNode: string = "" type SourceRoot = SourceRoot of path: string * - props: list * - expectedProps: list + props: (string * string) list * + expectedProps: (string * string) list /// these tests are ported from https://github.com/dotnet/roslyn/blob/093ea477717001c58be6231cf2a793f4245cbf72/src/Compilers/Core/MSBuildTaskTests/MapSourceRootTests.cs @@ -71,7 +80,7 @@ type MapSourceRootsTests() = |> Array.iteri checkExpectations [] - member this.``basic deterministic scenarios`` () = + member _.``basic deterministic scenarios`` () = let items = [| SourceRoot(@"c:\packages\SourcePackage1\", [], ["MappedPath", @"/_1/"]) @@ -96,7 +105,7 @@ type MapSourceRootsTests() = [] - member this.``invalid chars`` () = + member _.``invalid chars`` () = let items = [| SourceRoot(@"!@#:;$%^&*()_+|{}\", [], ["MappedPath", @"/_1/"]) @@ -116,7 +125,7 @@ type MapSourceRootsTests() = successfulTest items [] - member this.``input paths must end with separator`` () = + member _.``input paths must end with separator`` () = let items = [| SourceRoot(@"C:\", [], []) @@ -145,7 +154,7 @@ type MapSourceRootsTests() = Assert.Fail("Expected to fail on the inputs") [] - member this.``nested roots separators`` () = + member _.``nested roots separators`` () = let items = [| SourceRoot(@"c:\MyProjects\MyProject\", [], [ @@ -174,7 +183,7 @@ type MapSourceRootsTests() = successfulTest items [] - member this.``sourceroot case sensitivity``() = + member _.``sourceroot case sensitivity``() = let items = [| SourceRoot(@"c:\packages\SourcePackage1\", [], ["MappedPath", @"/_/"]) SourceRoot(@"C:\packages\SourcePackage1\", [], ["MappedPath", @"/_1/"]) @@ -184,7 +193,7 @@ type MapSourceRootsTests() = successfulTest items [] - member this.``recursion error`` () = + member _.``recursion error`` () = let path1 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\1\" let path2 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\2\" let path3 = Utilities.FixFilePath @"c:\MyProjects\MyProject\" @@ -225,7 +234,7 @@ type MapSourceRootsTests() = [] [] [] - member this.``metadata merge 1`` (deterministic: bool) = + member _.``metadata merge 1`` (deterministic: bool) = let path1 = Utilities.FixFilePath @"c:\packages\SourcePackage1\" let path2 = Utilities.FixFilePath @"c:\packages\SourcePackage2\" let path3 = Utilities.FixFilePath @"c:\packages\SourcePackage3\" @@ -319,7 +328,7 @@ type MapSourceRootsTests() = |> Array.iteri checkExpectations [] - member this.``missing containing root`` () = + member _.``missing containing root`` () = let items = [| SourceRoot(@"c:\MyProjects\MYPROJECT\", [], []) SourceRoot(@"c:\MyProjects\MyProject\a\b\", [ @@ -352,7 +361,7 @@ type MapSourceRootsTests() = Assert.Fail("Expected to fail on the inputs") [] - member this.``no containing root`` () = + member _.``no containing root`` () = let items = [| SourceRoot(@"c:\MyProjects\MyProject\", [], []) SourceRoot(@"c:\MyProjects\MyProject\a\b\", [ @@ -385,7 +394,7 @@ type MapSourceRootsTests() = [] [] [] - member this.``no top level source root`` (deterministic: bool) = + member _.``no top level source root`` (deterministic: bool) = let path1 = Utilities.FixFilePath @"c:\MyProjects\MyProject\a\b\" let items = [| SourceRoot(path1, [ diff --git a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs index 642541c7f90..d295f60f4ee 100644 --- a/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs +++ b/tests/FSharp.Build.UnitTests/WriteCodeFragmentTests.fs @@ -18,26 +18,24 @@ type WriteCodeFragmentFSharpTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member this.``No parameters``() = + member _.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member this.``Skipped and out of order positional parameters``() = + member _.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member this.``Named parameters``() = + member _.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member this.``Named and positional parameters``() = + member _.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member this.``Escaped string parameters``() = + member _.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" - // this should look like: SomeAttribute("\"uno\"") - [] type WriteCodeFragmentCSharpTests() = @@ -50,23 +48,23 @@ type WriteCodeFragmentCSharpTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member this.``No parameters``() = + member _.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member this.``Skipped and out of order positional parameters``() = + member _.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member this.``Named parameters``() = + member _.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member this.``Named and positional parameters``() = + member _.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member this.``Escaped string parameters``() = + member _.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" // this should look like: SomeAttribute("\"uno\"") @@ -82,23 +80,23 @@ type WriteCodeFragmentVisualBasicTests() = Assert.AreEqual(fullExpectedAttributeText, actualAttributeText) [] - member this.``No parameters``() = + member _.``No parameters``() = verifyAttribute "SomeAttribute" [] "SomeAttribute()" [] - member this.``Skipped and out of order positional parameters``() = + member _.``Skipped and out of order positional parameters``() = verifyAttribute "SomeAttribute" [("_Parameter3", "3"); ("_Parameter5", "5"); ("_Parameter2", "2")] "SomeAttribute(null, \"2\", \"3\", null, \"5\")" [] - member this.``Named parameters``() = + member _.``Named parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("Two", "2")] "SomeAttribute(One = \"1\", Two = \"2\")" [] - member this.``Named and positional parameters``() = + member _.``Named and positional parameters``() = verifyAttribute "SomeAttribute" [("One", "1"); ("_Parameter2", "2.2"); ("Two", "2")] "SomeAttribute(null, \"2.2\", One = \"1\", Two = \"2\")" [] - member this.``Escaped string parameters``() = + member _.``Escaped string parameters``() = verifyAttribute "SomeAttribute" [("_Parameter1", "\"uno\"")] "SomeAttribute(\"\\\"uno\\\"\")" // this should look like: SomeAttribute("\"uno\"") diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs index 325dcc0f769..3eb8c174d29 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/PrecedenceAndOperators/checkedOperatorsNoOverflow.fs @@ -12,7 +12,7 @@ let testNoOverflow op overflowArg = | :? OverflowException -> failwith "Failed: 1" type T(x : float) = - member this.Data = x + member _.Data = x static member op_Explicit (x : T) = byte x.Data static member op_Explicit (x : T) = char x.Data static member op_Explicit (x : T) = int16 x.Data diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs index 5210295c8eb..fb57826cbe9 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Misc/AbstractClass.fs @@ -1,4 +1,4 @@ -// regression test for https://github.com/Microsoft/visualfsharp/issues/420 +// regression test for https://github.com/dotnet/fsharp/issues/420 [] type X public (i : int) = diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs index b1cca3856b1..7c67a679fa9 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/SteppingMatch/SteppingMatch09.fs @@ -10,7 +10,7 @@ let public funcA n = | _ -> Some( 22 ) // debug range should cover all of "Some( 22 )" -// Test case from https://github.com/Microsoft/visualfsharp/issues/105 +// Test case from https://github.com/dotnet/fsharp/issues/105 let OuterWithGenericInner list = let GenericInner (list: 'T list) = match list with @@ -19,7 +19,7 @@ let OuterWithGenericInner list = GenericInner list -// Test case from https://github.com/Microsoft/visualfsharp/issues/105 +// Test case from https://github.com/dotnet/fsharp/issues/105 let OuterWithNonGenericInner list = let NonGenericInner (list: int list) = match list with @@ -28,7 +28,7 @@ let OuterWithNonGenericInner list = NonGenericInner list -// Test case from https://github.com/Microsoft/visualfsharp/issues/105 +// Test case from https://github.com/dotnet/fsharp/issues/105 let OuterWithNonGenericInnerWithCapture x list = let NonGenericInnerWithCapture (list: int list) = match list with diff --git a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs index 05e33058136..c150c1b81a1 100644 --- a/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs +++ b/tests/FSharp.Compiler.ComponentTests/EmittedIL/Tuples/OptionalArg01.fs @@ -1,7 +1,7 @@ // #NoMono #NoMT #CodeGen #EmittedIL #Tuples type A() = class end -// A code+optimization pattern, see https://github.com/Microsoft/visualfsharp/issues/6532 +// A code+optimization pattern, see https://github.com/dotnet/fsharp/issues/6532 type C() = static member inline F (?x1: A, ?x2: A) = let count = 0 diff --git a/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx b/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx index 26fc292d037..f10327acf31 100644 --- a/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx +++ b/tests/FSharp.Compiler.ComponentTests/resources/tests/Conformance/Printing/ParamArrayInSignatures.fsx @@ -1,5 +1,5 @@ // #Regression #NoMT #Printing -// Regression test for https://github.com/Microsoft/visualfsharp/issues/109 +// Regression test for https://github.com/dotnet/fsharp/issues/109 // pretty printing signatures with params arguments //type Heterogeneous = diff --git a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs index 2ee9c323639..91244459fdd 100644 --- a/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs +++ b/tests/FSharp.Compiler.UnitTests/CompilerTestHelpers.fs @@ -5,5 +5,5 @@ module CompilerTestHelpers = let (|Warning|_|) (exn: System.Exception) = match exn with - | :? FSharp.Compiler.DiagnosticsLogger.SRDiagnostic as e -> Some (e.number, e.message) + | :? FSharp.Compiler.DiagnosticsLogger.DiagnosticWithText as e -> Some (e.number, e.message) | _ -> None diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs index cb74c489da0..817d1fcc473 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/ComparersRegression.fs @@ -1552,7 +1552,7 @@ module ComparersRegression = exception ValidationException of lhs:obj * rhs:obj * expected:obj * received:obj - let make_result_set<'a,'b when 'b : equality> (f:IOperation<'a>) (items:array<'a>) (validation_set:option>)= + let make_result_set<'a,'b when 'b : equality> (f: IOperation<'a>) (items: 'a[]) (validation_set: int[] option)= let results = Array.zeroCreate (items.Length*items.Length) for i = 0 to items.Length-1 do for j = 0 to items.Length-1 do diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs index 89b74783e9f..103b636c127 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncModule.fs @@ -580,7 +580,7 @@ type AsyncModule() = #if IGNORED - [] + [] member _.``SleepContinuations``() = let okCount = ref 0 let errCount = ref 0 diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs index 30fef17666e..29d086d0f20 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/AsyncType.fs @@ -338,7 +338,7 @@ type AsyncType() = #if IGNORED [] - [] + [] member _.CancellationPropagatesToImmediateTask () = let a = async { while true do () @@ -355,7 +355,7 @@ type AsyncType() = #if IGNORED [] - [] + [] member _.CancellationPropagatesToGroupImmediate () = let ewh = new ManualResetEvent(false) let cancelled = ref false diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs index c887eb470c8..2a180783da0 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/Microsoft.FSharp.Control/MailboxProcessorType.fs @@ -72,7 +72,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/Microsoft/visualfsharp/issues/3337 + // https://github.com/dotnet/fsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = @@ -114,7 +114,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/Microsoft/visualfsharp/issues/3337 + // https://github.com/dotnet/fsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = @@ -156,7 +156,7 @@ type MailboxProcessorType() = use mre1 = new ManualResetEventSlim(false) use mre2 = new ManualResetEventSlim(false) - // https://github.com/Microsoft/visualfsharp/issues/3337 + // https://github.com/dotnet/fsharp/issues/3337 let cts = new CancellationTokenSource () let addMsg msg = diff --git a/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs b/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs index 81429996a05..ee2b662bfe5 100644 --- a/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs +++ b/tests/FSharp.Core.UnitTests/FSharp.Core/PrimTypes.fs @@ -911,7 +911,7 @@ open NonStructuralComparison type NonStructuralComparisonTests() = [] - member _.CompareFloat32() = // https://github.com/Microsoft/visualfsharp/pull/4493 + member _.CompareFloat32() = // https://github.com/dotnet/fsharp/pull/4493 let x = 32 |> float32 let y = 32 |> float32 diff --git a/tests/benchmarks/TaskPerf/option.fs b/tests/benchmarks/TaskPerf/option.fs index 20003378273..2df8610880f 100644 --- a/tests/benchmarks/TaskPerf/option.fs +++ b/tests/benchmarks/TaskPerf/option.fs @@ -72,11 +72,11 @@ type OptionBuilderUsingInlineIfLambdaBase() = (fun () -> ValueSome value) - member inline this.ReturnFrom (source: option<'T>) : OptionCode<'T> = + member inline _.ReturnFrom (source: 'T option) : OptionCode<'T> = (fun () -> match source with Some x -> ValueOption.Some x | None -> ValueOption.None) - member inline this.ReturnFrom (source: voption<'T>) : OptionCode<'T> = + member inline _.ReturnFrom (source: voption<'T>) : OptionCode<'T> = (fun () -> source) type OptionBuilderUsingInlineIfLambda() = diff --git a/tests/fsharp/tests.fs b/tests/fsharp/tests.fs index 4cdc2adaf89..8e7669ddc69 100644 --- a/tests/fsharp/tests.fs +++ b/tests/fsharp/tests.fs @@ -1318,7 +1318,7 @@ module CoreTests = exec cfg ("." ++ "main.exe") "" - // Repro for https://github.com/Microsoft/visualfsharp/issues/1298 + // Repro for https://github.com/dotnet/fsharp/issues/1298 [] let fileorder () = let cfg = testConfig "core/fileorder" @@ -1345,7 +1345,7 @@ module CoreTests = exec cfg ("." ++ "test2.exe") "" - // Repro for https://github.com/Microsoft/visualfsharp/issues/2679 + // Repro for https://github.com/dotnet/fsharp/issues/2679 [] let ``add files with same name from different folders`` () = let cfg = testConfig "core/samename" @@ -1390,7 +1390,7 @@ module CoreTests = [] let ``no-warn-2003-tests`` () = - // see https://github.com/Microsoft/visualfsharp/issues/3139 + // see https://github.com/dotnet/fsharp/issues/3139 let cfg = testConfig "core/versionAttributes" let stdoutPath = "out.stdout.txt" |> getfullpath cfg let stderrPath = "out.stderr.txt" |> getfullpath cfg @@ -1593,7 +1593,7 @@ module CoreTests = [] let ``patterns-FSC_OPTIMIZED`` () = singleTestBuildAndRunVersion "core/patterns" FSC_OPTIMIZED "preview" -//BUGBUG: https://github.com/Microsoft/visualfsharp/issues/6601 +//BUGBUG: https://github.com/dotnet/fsharp/issues/6601 // [] // let ``patterns-FSI`` () = singleTestBuildAndRun' "core/patterns" FSI @@ -2105,7 +2105,7 @@ module VersionTests = [] module ToolsTests = - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let bundle () = let cfg = testConfig "tools/bundle" @@ -2265,7 +2265,7 @@ module RegressionTests = let ``321`` () = singleTestBuildAndRun "regression/321" FSC_OPTIMIZED #if !NETCOREAPP - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let ``655`` () = let cfg = testConfig "regression/655" @@ -2284,7 +2284,7 @@ module RegressionTests = testOkFile.CheckExists() - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let ``656`` () = let cfg = testConfig "regression/656" @@ -2318,7 +2318,7 @@ module RegressionTests = let ``struct-tuple-bug-1-FSI`` () = singleTestBuildAndRun "regression/struct-tuple-bug-1" FSI #if !NETCOREAPP - // This test is disabled in coreclr builds dependent on fixing : https://github.com/Microsoft/visualfsharp/issues/2600 + // This test is disabled in coreclr builds dependent on fixing : https://github.com/dotnet/fsharp/issues/2600 [] let ``struct-measure-bug-1`` () = let cfg = testConfig "regression/struct-measure-bug-1" diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 342712caa39..00ae15bc4e1 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -5246,7 +5246,7 @@ module internal ProjectBig = [] -// Simplified repro for https://github.com/Microsoft/visualfsharp/issues/2679 +// Simplified repro for https://github.com/dotnet/fsharp/issues/2679 let ``add files with same name from different folders`` () = let fileNames = [ __SOURCE_DIRECTORY__ + "/data/samename/folder1/a.fs" @@ -5333,7 +5333,7 @@ let x = (1 = 3.0) let options = checker.GetProjectOptionsFromCommandLineArgs (projFileName, args) [] -let ``Test line directives in foreground analysis`` () = // see https://github.com/Microsoft/visualfsharp/issues/3317 +let ``Test line directives in foreground analysis`` () = // see https://github.com/dotnet/fsharp/issues/3317 // In background analysis and normal compiler checking, the errors are reported w.r.t. the line directives let wholeProjectResults = checker.ParseAndCheckProject(ProjectLineDirectives.options) |> Async.RunImmediate diff --git a/tests/service/data/TestTP/ProvidedTypes.fs b/tests/service/data/TestTP/ProvidedTypes.fs index 7ea2cd5ba46..2b609793233 100644 --- a/tests/service/data/TestTP/ProvidedTypes.fs +++ b/tests/service/data/TestTP/ProvidedTypes.fs @@ -8102,7 +8102,7 @@ namespace ProviderImplementation.ProvidedTypes // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. // See convertConstExpr in the compiler, e.g. - // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // https://github.com/dotnet/fsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 // for the accepted types. match inp.Namespace, inp.Name with //| USome "System", "Void"-> typeof diff --git a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs index dcdc6cd7291..3d93c28d3b8 100644 --- a/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs +++ b/vsintegration/src/FSharp.Editor/Completion/CompletionProvider.fs @@ -33,7 +33,7 @@ type internal FSharpCompletionProvider inherit FSharpCompletionProviderBase() // Save the backing data in a cache, we need to save for at least the length of the completion session - // See https://github.com/Microsoft/visualfsharp/issues/4714 + // See https://github.com/dotnet/fsharp/issues/4714 static let mutable declarationItems: DeclarationListItem[] = [||] static let [] NameInCodePropName = "NameInCode" static let [] FullNamePropName = "FullName" diff --git a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs index d7995bcf509..689c410b5f1 100644 --- a/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs +++ b/vsintegration/src/FSharp.Editor/Options/EditorOptions.fs @@ -51,7 +51,7 @@ type CodeFixesOptions = SuggestNamesForErrors: bool } static member Default = { // We have this off by default, disable until we work out how to make this low priority - // See https://github.com/Microsoft/visualfsharp/pull/3238#issue-237699595 + // See https://github.com/dotnet/fsharp/pull/3238#issue-237699595 SimplifyName = false AlwaysPlaceOpensAtTopLevel = true UnusedOpens = true diff --git a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs index 38ad605c2bc..4be4c71d300 100644 --- a/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs +++ b/vsintegration/src/FSharp.ProjectSystem.FSharp/Project.fs @@ -1604,7 +1604,7 @@ namespace rec Microsoft.VisualStudio.FSharp.ProjectSystem MSBuildProject.SetGlobalProperty(projNode.BuildProject, ProjectFileConstants.Platform, currentConfigName.MSBuildPlatform) projNode.UpdateMSBuildState() - // The following event sequences are observed in Visual Studio 2017, see https://github.com/Microsoft/visualfsharp/pull/3025#pullrequestreview-38005713 + // The following event sequences are observed in Visual Studio 2017, see https://github.com/dotnet/fsharp/pull/3025#pullrequestreview-38005713 // // Loading tests\projects\misc\TestProjectChanges.sln: // diff --git a/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs b/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs index a5e3128e872..2e6291ef3ec 100644 --- a/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs +++ b/vsintegration/src/FSharp.VS.FSI/fsiTextBufferStream.fs @@ -13,7 +13,7 @@ open Microsoft.VisualStudio.Utilities // type internal TextBufferStream(textLines:ITextBuffer, contentTypeRegistry: IContentTypeRegistryService) = do if null = textLines then raise (new ArgumentNullException("textLines")) - // The following line causes unhandled excepiton on a background thread, see https://github.com/Microsoft/visualfsharp/issues/2318#issuecomment-279340343 + // The following line causes unhandled excepiton on a background thread, see https://github.com/dotnet/fsharp/issues/2318#issuecomment-279340343 // It seems we should provide a Quick Info Provider at the same time as uncommenting it. //do textLines.ChangeContentType(contentTypeRegistry.GetContentType Guids.fsiContentTypeName, Guid Guids.guidFsiLanguageService) diff --git a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs index a07104b2e7f..ca7f220fa73 100644 --- a/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs +++ b/vsintegration/tests/MockTypeProviders/DummyProviderForLanguageServiceTesting/ProvidedTypes.fs @@ -7723,7 +7723,7 @@ namespace ProviderImplementation.ProvidedTypes // We never create target types for the types of primitive values that are accepted by the F# compiler as Expr.Value nodes, // which fortunately also correspond to element types. We just use the design-time types instead. // See convertConstExpr in the compiler, e.g. - // https://github.com/Microsoft/visualfsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 + // https://github.com/dotnet/fsharp/blob/44fa027b308681a1b78a089e44fa1ab35ff77b41/src/fsharp/MethodCalls.fs#L842 // for the accepted types. match inp.Namespace, inp.Name with | USome "System", "Void"-> typeof @@ -8984,7 +8984,7 @@ namespace ProviderImplementation.ProvidedTypes let systemRuntimeContainsTypeObj = config.GetField("systemRuntimeContainsType") - // Account for https://github.com/Microsoft/visualfsharp/pull/591 + // Account for https://github.com/dotnet/fsharp/pull/591 let systemRuntimeContainsTypeObj2 = if systemRuntimeContainsTypeObj.HasField("systemRuntimeContainsTypeRef") then systemRuntimeContainsTypeObj.GetField("systemRuntimeContainsTypeRef").GetProperty("Value") diff --git a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs index c4a1d61cde8..e94163042e4 100644 --- a/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs +++ b/vsintegration/tests/UnitTests/BraceMatchingServiceTests.fs @@ -162,7 +162,7 @@ type BraceMatchingServiceTests() = [] member this.BraceMatchingAtEndOfLine_Bug1597() = - // https://github.com/Microsoft/visualfsharp/issues/1597 + // https://github.com/dotnet/fsharp/issues/1597 let code = """ [] let main argv = diff --git a/vsintegration/tests/UnitTests/CompletionProviderTests.fs b/vsintegration/tests/UnitTests/CompletionProviderTests.fs index 52193afac40..381e9d0e5ec 100644 --- a/vsintegration/tests/UnitTests/CompletionProviderTests.fs +++ b/vsintegration/tests/UnitTests/CompletionProviderTests.fs @@ -457,7 +457,7 @@ let _ = new A(Setta) let notExpected = ["SettableProperty@"; "AnotherSettableProperty@"; "NonSettableProperty@"] VerifyCompletionList(fileContents, "(Setta", expected, notExpected) -[] +[] let ``Constructing a new fully qualified class with object initializer syntax without ending paren``() = let fileContents = """ module M = diff --git a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs index 2f3b76b2965..c9674a89861 100644 --- a/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs +++ b/vsintegration/tests/UnitTests/DocumentDiagnosticAnalyzerTests.fs @@ -392,7 +392,7 @@ let g (t : T) = t.Count() [] member public this.DocumentDiagnosticsDontReportProjectErrors_Bug1596() = - // https://github.com/Microsoft/visualfsharp/issues/1596 + // https://github.com/dotnet/fsharp/issues/1596 this.VerifyNoErrors( fileContents = """ let x = 3 diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs index 68cbcec09ec..368df57ad3f 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Completion.fs @@ -29,7 +29,7 @@ module StandardSettings = type UsingMSBuild() as this = inherit LanguageServiceBaseTests() - let createFile (code : list) fileKind refs otherFlags = + let createFile (code : string list) fileKind refs otherFlags = let (_, _, file) = match code with | [code] when code.IndexOfAny([|'\r'; '\n'|]) <> -1 -> @@ -38,7 +38,7 @@ type UsingMSBuild() as this = this.CreateSingleFileProject(code, fileKind = fileKind, references = refs, ?otherFlags=otherFlags) file - let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : list) marker f = + let DoWithAutoCompleteUsingExtraRefs refs otherFlags coffeeBreak fileKind reason (code : string list) marker f = // Up to 2 untyped parse operations are OK: we do an initial parse to provide breakpoint valdiation etc. // This might be before the before the background builder is ready to process the foreground typecheck. // In this case the background builder calls us back when its ready, and we then request a foreground typecheck @@ -53,7 +53,7 @@ type UsingMSBuild() as this = gpatcc.AssertExactly(0,0) - let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : list) marker f = + let DoWithAutoComplete coffeeBreak fileKind reason otherFlags (code : string list) marker f = DoWithAutoCompleteUsingExtraRefs [] otherFlags coffeeBreak fileKind reason code marker f let AssertAutoCompleteContainsAux coffeeBreak fileName reason otherFlags code marker should shouldnot = @@ -134,7 +134,7 @@ type UsingMSBuild() as this = // There are some dot completion tests in this type as well, in the systematic tests for queries - member private this.VerifyDotCompListContainAllAtStartOfMarker(fileContents : string, marker : string, list :string list, ?addtlRefAssy:list, ?coffeeBreak:bool) = + member private this.VerifyDotCompListContainAllAtStartOfMarker(fileContents : string, marker : string, list :string list, ?addtlRefAssy:string list, ?coffeeBreak:bool) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) //to add references @@ -143,7 +143,7 @@ type UsingMSBuild() as this = AssertCompListContainsAll(completions, list) // There are some quickinfo tests in this file as well, in the systematic tests for queries - member public this.InfoInDeclarationTestQuickInfoImpl(code : string,marker,expected,atStart, ?addtlRefAssy : list) = + member public this.InfoInDeclarationTestQuickInfoImpl(code : string,marker,expected,atStart, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(code, ?references = addtlRefAssy) let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) @@ -156,7 +156,7 @@ type UsingMSBuild() as this = AssertContains(tooltip, expected) gpatcc.AssertExactly(0,0) - member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : list) = + member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : string list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,false,?addtlRefAssy=addtlRefAssy) static member charExpectedCompletions = [ "CompareTo"; // Members defined on System.Char @@ -207,7 +207,7 @@ type UsingMSBuild() as this = [ ] // should not contain //**Help Function for checking Ctrl-Space Completion Contains the expected value ************* - member private this.AssertCtrlSpaceCompletionContains(fileContents : list, marker, expected, ?addtlRefAssy: list) = + member private this.AssertCtrlSpaceCompletionContains(fileContents : string list, marker, expected, ?addtlRefAssy: string list) = this.AssertCtrlSpaceCompletion( fileContents, marker, @@ -222,19 +222,19 @@ type UsingMSBuild() as this = ) //**Help Function for checking Ctrl-Space Completion Contains the expected value ************* - member private this.AssertCtrlSpaceCompletion(fileContents : list, marker, checkCompletion: (CompletionItem array -> unit), ?addtlRefAssy: list) = + member private this.AssertCtrlSpaceCompletion(fileContents : string list, marker, checkCompletion: (CompletionItem array -> unit), ?addtlRefAssy: string list) = let (_, _, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToEndOfMarker(file,marker) let completions = CtrlSpaceCompleteAtCursor file checkCompletion completions - member private this.AutoCompletionListNotEmpty (fileContents : list) marker = + member private this.AutoCompletionListNotEmpty (fileContents : string list) marker = let (_, _, file) = this.CreateSingleFileProject(fileContents) MoveCursorToEndOfMarker(file,marker) let completions = AutoCompleteAtCursor file Assert.AreNotEqual(0,completions.Length) - member public this.TestCompletionNotShowingWhenFastUpdate (firstSrc : list) secondSrc marker = + member public this.TestCompletionNotShowingWhenFastUpdate (firstSrc : string list) secondSrc marker = let (_, _, file) = this.CreateSingleFileProject(firstSrc) MoveCursorToEndOfMarker(file,marker) @@ -257,14 +257,14 @@ type UsingMSBuild() as this = AssertCompListContainsAll(completions, list) //DoesNotContainAny At Start Of Marker Helper Function - member private this.VerifyDotCompListDoesNotContainAnyAtStartOfMarker(fileContents : string, marker : string, list : string list, ?addtlRefAssy : list) = + member private this.VerifyDotCompListDoesNotContainAnyAtStartOfMarker(fileContents : string, marker : string, list : string list, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) let completions = DotCompletionAtStartOfMarker file marker AssertCompListDoesNotContainAny(completions, list) //DotCompList Is Empty At Start Of Marker Helper Function - member private this.VerifyDotCompListIsEmptyAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : list) = + member private this.VerifyDotCompListIsEmptyAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) let completions = DotCompletionAtStartOfMarker file marker @@ -1237,7 +1237,7 @@ for i in 0..a."] AssertCtrlSpaceCompleteContains code "? y." ["Chars"; "Length"] ["abs"] [] - [] + [] member public this.``Query.ForKeywordCanCompleteIntoIdentifier``() = let code = [ @@ -1479,7 +1479,7 @@ let x = new MyClass2(0) [] - [] + [] member public this.``AfterConstructor.5039_1``() = AssertAutoCompleteContainsNoCoffeeBreak [ "let someCall(x) = null" @@ -1489,7 +1489,7 @@ let x = new MyClass2(0) [ "LastIndexOfAny" ] // should not contain (String) [] - [] + [] member public this.``AfterConstructor.5039_1.CoffeeBreak``() = AssertAutoCompleteContains [ "let someCall(x) = null" @@ -2022,7 +2022,7 @@ let x = new MyClass2(0) [] [] - [] + [] member public this.``CurriedArguments.Regression1``() = AssertCtrlSpaceCompleteContainsNoCoffeeBreak ["let fffff x y = 1" @@ -2447,7 +2447,7 @@ let x = new MyClass2(0) [] [] [] - [] + [] member this.``QueryExpressions.QueryAndSequenceExpressionWithForYieldLoopSystematic``() = let prefix = """ @@ -2549,7 +2549,7 @@ let aaaaaa = 0 [] [] [] - [] + [] /// Incrementally enter query with a 'join' and check for availability of quick info, auto completion and dot completion member this.``QueryAndOtherExpressions.WordByWordSystematicJoinQueryOnSingleLine``() = @@ -2604,7 +2604,7 @@ let aaaaaa = 0 /// This is a sanity check that the multiple-line case is much the same as the single-line cae [] [] - [] + [] member this.``QueryAndOtherExpressions.WordByWordSystematicJoinQueryOnMultipleLine``() = let prefix = """ @@ -2771,7 +2771,7 @@ let x = query { for bbbb in abbbbc(*D0*) do (* Various parser recovery test cases -------------------------------------------------- *) //*****************Helper Function***************** - member public this.AutoCompleteRecoveryTest(source : list, marker, expected) = + member public this.AutoCompleteRecoveryTest(source : string list, marker, expected) = let (_, _, file) = this.CreateSingleFileProject(source) MoveCursorToEndOfMarker(file, marker) let completions = time1 CtrlSpaceCompleteAtCursor file "Time of first autocomplete." @@ -5064,7 +5064,7 @@ let x = query { for bbbb in abbbbc(*D0*) do Assert.IsTrue(completions.Length>0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug72561``() = let code = [ " " ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -5086,7 +5086,7 @@ let x = query { for bbbb in abbbbc(*D0*) do gpatcc.AssertExactly(0,0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug72561.Noteworthy.NowWorks``() = let code = [ "123 " ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -5109,7 +5109,7 @@ let x = query { for bbbb in abbbbc(*D0*) do gpatcc.AssertExactly(0,0) [] - [] + [] member this.``BadCompletionAfterQuicklyTyping.Bug130733.NowWorks``() = let code = [ "let someCall(x) = null" "let xe = someCall(System.IO.StringReader() "] @@ -5152,7 +5152,7 @@ let x = query { for bbbb in abbbbc(*D0*) do let completions = AutoCompleteAtCursor(file) AssertCompListContainsAll(completions, list) - member private this.VerifyCtrlSpaceListContainAllAtStartOfMarker(fileContents : string, marker : string, list : string list, ?coffeeBreak:bool, ?addtlRefAssy:list) = + member private this.VerifyCtrlSpaceListContainAllAtStartOfMarker(fileContents : string, marker : string, list : string list, ?coffeeBreak:bool, ?addtlRefAssy:string list) = let coffeeBreak = defaultArg coffeeBreak false let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker(file, marker) @@ -7067,7 +7067,7 @@ let rec f l = //Regression test for bug 65740 Fsharp: dot completion is mission after a '#' statement [] - [] + [] member this.``Identifier.In#Statement``() = this.VerifyDotCompListContainAllAtStartOfMarker( fileContents = """ diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs index add5eb9cc4d..d96d3a16d61 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ErrorList.fs @@ -94,7 +94,7 @@ type UsingMSBuild() as this = (errorTexts.ToString()) //Verify the warning list Count - member private this.VerifyWarningListCountAtOpenProject(fileContents : string, expectedNum : int, ?addtlRefAssy : list) = + member private this.VerifyWarningListCountAtOpenProject(fileContents : string, expectedNum : int, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -102,7 +102,7 @@ type UsingMSBuild() as this = Assert.AreEqual(expectedNum,warnList.Length) //verify no the error list - member private this.VerifyNoErrorListAtOpenProject(fileContents : string, ?addtlRefAssy : list) = + member private this.VerifyNoErrorListAtOpenProject(fileContents : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -113,7 +113,7 @@ type UsingMSBuild() as this = Assert.IsTrue(errorList.IsEmpty) //Verify the error list containd the expected string - member private this.VerifyErrorListContainedExpectedString(fileContents : string, expectedStr : string, ?addtlRefAssy : list) = + member private this.VerifyErrorListContainedExpectedString(fileContents : string, expectedStr : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) TakeCoffeeBreak(this.VS) // Wait for the background compiler to catch up. @@ -571,7 +571,7 @@ but here has type Assert.IsTrue(errorList.IsEmpty) [] - [] + [] member public this.``UnicodeCharacters``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs index 5a369da4093..b1049408fac 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.GotoDefinition.fs @@ -22,7 +22,7 @@ type UsingMSBuild() = inherit LanguageServiceBaseTests() //GoToDefinitionSuccess Helper Function - member private this.VerifyGoToDefnSuccessAtStartOfMarker(fileContents : string, marker : string, definitionCode : string,?addtlRefAssy : list) = + member private this.VerifyGoToDefnSuccessAtStartOfMarker(fileContents : string, marker : string, definitionCode : string,?addtlRefAssy : string list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) @@ -44,7 +44,7 @@ type UsingMSBuild() = Assert.AreEqual(pos, actualPos, "pos") //GoToDefinitionFail Helper Function - member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string,?addtlRefAssy : list) = + member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string,?addtlRefAssy : string list) = this.VerifyGoToDefnFailAtStartOfMarker( fileContents = fileContents, @@ -55,7 +55,7 @@ type UsingMSBuild() = //GoToDefinitionFail Helper Function - member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string, f : OpenFile * GotoDefnResult -> unit, ?addtlRefAssy : list) = + member private this.VerifyGoToDefnFailAtStartOfMarker(fileContents : string, marker :string, f : OpenFile * GotoDefnResult -> unit, ?addtlRefAssy : string list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) @@ -67,7 +67,7 @@ type UsingMSBuild() = //The verification result should be: // Fail at automation lab // Succeed on dev machine with enlistment installed. - member private this.VerifyGoToDefnNoErrorDialogAtStartOfMarker(fileContents : string, marker :string, definitionCode : string, ?addtlRefAssy : list) = + member private this.VerifyGoToDefnNoErrorDialogAtStartOfMarker(fileContents : string, marker :string, definitionCode : string, ?addtlRefAssy : string list) = let (sln, proj, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker (file, marker) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs index 9404ca301e4..0da7fce519b 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.ParameterInfo.fs @@ -59,7 +59,7 @@ type UsingMSBuild() = (expectedParamNames,paramDisplays) ||> List.forall2 (fun expectedParamName paramDisplay -> paramDisplay.Contains(expectedParamName)))) - member private this.GetMethodListForAMethodTip(fileContents : string, marker : string, ?addtlRefAssy : list) = + member private this.GetMethodListForAMethodTip(fileContents : string, marker : string, ?addtlRefAssy : string list) = let (solution, project, file) = this.CreateSingleFileProject(fileContents, ?references = addtlRefAssy) MoveCursorToStartOfMarker(file, marker) @@ -67,22 +67,22 @@ type UsingMSBuild() = GetParameterInfoAtCursor(file) //Verify all the overload method parameterInfo - member private this.VerifyParameterInfoAtStartOfMarker(fileContents : string, marker : string, expectedParamNamesSet:string list list, ?addtlRefAssy :list) = + member private this.VerifyParameterInfoAtStartOfMarker(fileContents : string, marker : string, expectedParamNamesSet:string list list, ?addtlRefAssy :string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertMethodGroup(methodstr,expectedParamNamesSet) //Verify No parameterInfo at the marker - member private this.VerifyNoParameterInfoAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : list) = + member private this.VerifyNoParameterInfoAtStartOfMarker(fileContents : string, marker : string, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertEmptyMethodGroup(methodstr) //Verify one method parameterInfo if contained in parameterInfo list - member private this.VerifyParameterInfoContainedAtStartOfMarker(fileContents : string, marker : string, expectedParamNames:string list, ?addtlRefAssy : list) = + member private this.VerifyParameterInfoContainedAtStartOfMarker(fileContents : string, marker : string, expectedParamNames:string list, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) AssertMethodGroupContain(methodstr,expectedParamNames) //Verify the parameterInfo of one of the list order - member private this.VerifyParameterInfoOverloadMethodIndex(fileContents : string, marker : string, index : int, expectedParams:string list, ?addtlRefAssy : list) = + member private this.VerifyParameterInfoOverloadMethodIndex(fileContents : string, marker : string, index : int, expectedParams:string list, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) Assert.IsTrue(methodstr.IsSome, "Expected a method group") let methodstr = methodstr.Value @@ -102,7 +102,7 @@ type UsingMSBuild() = Assert.IsTrue (methodstr.GetCount() > 0) //Verify return content after the colon - member private this.VerifyFirstParameterInfoColonContent(fileContents : string, marker : string, expectedStr : string, ?addtlRefAssy : list) = + member private this.VerifyFirstParameterInfoColonContent(fileContents : string, marker : string, expectedStr : string, ?addtlRefAssy : string list) = let methodstr = this.GetMethodListForAMethodTip(fileContents,marker,?addtlRefAssy=addtlRefAssy) Assert.IsTrue(methodstr.IsSome, "Expected a method group") let methodstr = methodstr.Value @@ -253,7 +253,7 @@ type UsingMSBuild() = this.VerifyHasParameterInfo(fileContent, "(*Mark*)") [] - [] + [] member public this.``Single.DotNet.StaticMethod``() = let code = ["#light" @@ -426,7 +426,7 @@ type UsingMSBuild() = [] - [] + [] member public this.``Single.InMatchClause``() = let v461 = Version(4,6,1) let fileContent = """ @@ -604,7 +604,7 @@ type UsingMSBuild() = // Test PI does not pop up after non-parameterized properties and after values [] - [] + [] member public this.``Single.Locations.EndOfFile`` () = this.TestSystematicParameterInfo("System.Console.ReadLine(", [ [] ]) @@ -640,50 +640,59 @@ type UsingMSBuild() = [] member public this.``Single.Generics.Typeof``() = - let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("typeof(", []) + [] - [] + [] member public this.``Single.Generics.MathAbs``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Math.Abs(", sevenTimes ["value"]) + [] - [] + [] member public this.``Single.Generics.ExchangeInt``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange(", sevenTimes ["location1"; "value"]) + [] - [] + [] member public this.``Single.Generics.Exchange``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange(", sevenTimes ["location1"; "value"]) + [] - [] + [] member public this.``Single.Generics.ExchangeUnder``() = let sevenTimes l = [ l; l; l; l; l; l; l ] this.TestGenericParameterInfo("Interlocked.Exchange<_> (", sevenTimes ["location1"; "value"]) + [] - [] + [] member public this.``Single.Generics.Dictionary``() = this.TestGenericParameterInfo("System.Collections.Generic.Dictionary<_, option>(", [ []; ["capacity"]; ["comparer"]; ["capacity"; "comparer"]; ["dictionary"]; ["dictionary"; "comparer"] ]) + [] - [] + [] member public this.``Single.Generics.List``() = this.TestGenericParameterInfo("new System.Collections.Generic.List< _ > ( ", [ []; ["capacity"]; ["collection"] ]) + [] - [] + [] member public this.``Single.Generics.ListInt``() = this.TestGenericParameterInfo("System.Collections.Generic.List(", [ []; ["capacity"]; ["collection"] ]) + [] - [] + [] member public this.``Single.Generics.EventHandler``() = this.TestGenericParameterInfo("new System.EventHandler( ", [ [""] ]) // function arg doesn't have a name + [] - [] + [] member public this.``Single.Generics.EventHandlerEventArgs``() = this.TestGenericParameterInfo("System.EventHandler(", [ [""] ]) // function arg doesn't have a name + [] - [] + [] member public this.``Single.Generics.EventHandlerEventArgsNew``() = this.TestGenericParameterInfo("new System.EventHandler ( ", [ [""] ]) // function arg doesn't have a name @@ -697,7 +706,7 @@ type UsingMSBuild() = failwith "bad unit test: did not find '$' in input to mark cursor location!" idx, lines - member public this.TestParameterInfoNegative (testLine, ?addtlRefAssy : list) = + member public this.TestParameterInfoNegative (testLine, ?addtlRefAssy : string list) = let cursorPrefix, testLines = this.ExtractLineInfo testLine let code = @@ -712,7 +721,7 @@ type UsingMSBuild() = Assert.IsTrue(info.IsNone, "expected no parameter info") gpatcc.AssertExactly(0,0) - member public this.TestParameterInfoLocation (testLine, expectedPos, ?addtlRefAssy : list) = + member public this.TestParameterInfoLocation (testLine, expectedPos, ?addtlRefAssy : string list) = let cursorPrefix, testLines = this.ExtractLineInfo testLine let code = [ "#light" @@ -756,7 +765,7 @@ type UsingMSBuild() = this.TestParameterInfoLocation("let a = Interlocked.Exchange($", 8) [] - [] + [] member public this.``Single.Locations.WithGenericArgs``() = this.TestParameterInfoLocation("Interlocked.Exchange($", 0) @@ -779,7 +788,7 @@ type UsingMSBuild() = [] [] [] - [] + [] //This test verifies that ParamInfo location on a provided type with namespace that exposes static parameter that takes >1 argument works normally. member public this.``TypeProvider.Type.ParameterInfoLocation.WithNamespace`` () = this.TestParameterInfoLocation("type boo = N1.T<$",11, @@ -788,7 +797,7 @@ type UsingMSBuild() = [] [] [] - [] + [] //This test verifies that ParamInfo location on a provided type without the namespace that exposes static parameter that takes >1 argument works normally. member public this.``TypeProvider.Type.ParameterInfoLocation.WithOutNamespace`` () = this.TestParameterInfoLocation("open N1 \n"+"type boo = T<$", @@ -881,7 +890,7 @@ type UsingMSBuild() = ("// System.Console.WriteLine($)") [] - [] + [] member this.``Regression.LocationOfParams.AfterQuicklyTyping.Bug91373``() = let code = [ "let f x = x " "let f1 y = y " @@ -906,7 +915,7 @@ type UsingMSBuild() = AssertEqual([|(2,10);(2,12);(2,13);(3,0)|], info.GetParameterLocations()) [] - [] + [] member this.``LocationOfParams.AfterQuicklyTyping.CallConstructor``() = let code = [ "type Foo() = class end" ] let (_, _, file) = this.CreateSingleFileProject(code) @@ -1072,7 +1081,7 @@ We really need to rewrite some code paths here to use the real parse tree rather () [] - [] + [] member public this.``Regression.LocationOfParams.Bug91479``() = this.TestParameterInfoLocationOfParams("""let z = fun x -> x + ^System.Int16.Parse^(^$ """, markAtEOF=true) @@ -1198,7 +1207,7 @@ We really need to rewrite some code paths here to use the real parse tree rather ^l.Aggregate^(^$^) // was once a bug""") [] - [] + [] member public this.``LocationOfParams.BY_DESIGN.WayThatMismatchedParensFailOver.Case1``() = // when only one 'statement' after the mismatched parens after a comma, the comma swallows it and it becomes a badly-indented // continuation of the expression from the previous line @@ -1210,7 +1219,7 @@ We really need to rewrite some code paths here to use the real parse tree rather c.M(1,2,3,4)""", markAtEOF=true) [] - [] + [] member public this.``LocationOfParams.BY_DESIGN.WayThatMismatchedParensFailOver.Case2``() = // when multiple 'statements' after the mismatched parens after a comma, the parser sees a single argument to the method that // is a statement sequence, e.g. a bunch of discarded expressions. That is, @@ -1244,7 +1253,7 @@ We really need to rewrite some code paths here to use the real parse tree rather ^System.Console.WriteLine^(^ $(42,43) ^) // oops""") [] - [] + [] member public this.``LocationOfParams.Tuples.Bug123219``() = this.TestParameterInfoLocationOfParams(""" type Expr = | Num of int @@ -1385,7 +1394,7 @@ We really need to rewrite some code paths here to use the real parse tree rather [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix0``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ $ """, // missing all params, just have < @@ -1393,7 +1402,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix1``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ 42 """, // missing > @@ -1401,7 +1410,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix1Named``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored=42 """, // missing > @@ -1409,7 +1418,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ """, // missing last param @@ -1417,7 +1426,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2Named1``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored= """, // missing last param after name with equals @@ -1425,7 +1434,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.Prefix2Named2``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" type U = ^N1.T^<^ "fo$o",^ ParamIgnored """, // missing last param after name sans equals @@ -1489,7 +1498,7 @@ We really need to rewrite some code paths here to use the real parse tree rather additionalReferenceAssemblies = [PathRelativeToTestAssembly(@"DummyProviderForLanguageServiceTesting.dll")]) [] - [] + [] member public this.``LocationOfParams.TypeProviders.StaticParametersAtConstructorCallSite``() = this.TestParameterInfoLocationOfParamsWithVariousSurroundingContexts(""" let x = new ^N1.T^<^ "fo$o",^ 42 ^>()""", @@ -1627,7 +1636,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["string";"System.Globalization.NumberStyles"]) [] - [] + [] member public this.``Multi.DotNet.StaticMethod.WithinLambda``() = let fileContents = """let z = fun x -> x + System.Int16.Parse("",(*Mark*)""" this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["string";"System.Globalization.NumberStyles"]) @@ -1646,7 +1655,7 @@ We really need to rewrite some code paths here to use the real parse tree rather (* Common functions for multi-parameterinfo tests -------------------------------------------------- *) [] - [] + [] member public this.``Multi.DotNet.Constructor``() = let fileContents = "let _ = new System.DateTime(2010,12,(*Mark*)" this.VerifyParameterInfoContainedAtStartOfMarker(fileContents,"(*Mark*)",["int";"int";"int"]) @@ -1742,7 +1751,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoAtStartOfMarker(fileContents,"(*Mark*)",[["int list"]]) [] - [] + [] member public this.``Multi.Function.WithOptionType``() = let fileContents = """ let foo( a : int option, b : string ref) = 0 @@ -1759,7 +1768,7 @@ We really need to rewrite some code paths here to use the real parse tree rather this.VerifyParameterInfoAtStartOfMarker(fileContents,"(*Mark*)",[["int option";"float option"]]) [] - [] + [] member public this.``Multi.Function.WithRefType``() = let fileContents = """ let foo( a : int ref, b : string ref) = 0 diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs index 388bb365fd9..d62f4274062 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.QuickInfo.fs @@ -54,7 +54,7 @@ type UsingMSBuild() = AssertContains(trimnewlines tooltip, trimnewlines expected) gpatcc.AssertExactly(0,0) - member public this.CheckTooltip(code : string,marker,atStart, f, ?addtlRefAssy : list) = + member public this.CheckTooltip(code : string,marker,atStart, f, ?addtlRefAssy : string list) = let (_, _, file) = this.CreateSingleFileProject(code, ?references = addtlRefAssy) let gpatcc = GlobalParseAndTypeCheckCounter.StartNew(this.VS) @@ -67,14 +67,14 @@ type UsingMSBuild() = f (tooltip, pos) gpatcc.AssertExactly(0,0) - member public this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,atStart, ?addtlRefAssy : list) = + member public this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,atStart, ?addtlRefAssy : string list) = let check ((tooltip, _), _) = AssertContains(tooltip, expected) this.CheckTooltip(code, marker, atStart, check, ?addtlRefAssy=addtlRefAssy ) - member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : list) = + member public this.AssertQuickInfoContainsAtEndOfMarker(code,marker,expected, ?addtlRefAssy : string list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,false,?addtlRefAssy=addtlRefAssy) - member public this.AssertQuickInfoContainsAtStartOfMarker(code, marker, expected, ?addtlRefAssy : list) = + member public this.AssertQuickInfoContainsAtStartOfMarker(code, marker, expected, ?addtlRefAssy : string list) = this.InfoInDeclarationTestQuickInfoImpl(code,marker,expected,true,?addtlRefAssy=addtlRefAssy) member public this.VerifyQuickInfoDoesNotContainAnyAtEndOfMarker (code : string) marker notexpected = @@ -1684,7 +1684,7 @@ let f (tp:ITypeProvider(*$$$*)) = tp.Invalidate /// Complete a member completion and confirm that its data tip contains the fragments /// in rhsContainsOrder - member public this.AssertMemberDataTipContainsInOrder(code : list,marker,completionName,rhsContainsOrder) = + member public this.AssertMemberDataTipContainsInOrder(code : string list,marker,completionName,rhsContainsOrder) = let code = code |> Seq.collect (fun s -> s.Split [|'\r'; '\n'|]) |> List.ofSeq let (_, project, file) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(this.VS) (* why needed? *) diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs index ea2d28ad606..7f854cb01e3 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.Script.fs @@ -24,7 +24,7 @@ type UsingMSBuild() as this = let (_, p, f) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) (p, f) - let createSingleFileFsxFromLines (code : list) = + let createSingleFileFsxFromLines (code : string list) = let (_, p, f) = this.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) (p, f) @@ -582,7 +582,7 @@ type UsingMSBuild() as this = [] [] - [] + [] member public this.``Fsx.NoError.HashR.RelativePath1``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -619,7 +619,7 @@ type UsingMSBuild() as this = AssertNoSquiggle(ans) [] - [] + [] member public this.``Fsx.NoError.HashR.RelativePath2``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs index 34021a7dd1a..e89d828ac24 100644 --- a/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs +++ b/vsintegration/tests/UnitTests/LegacyLanguageService/Tests.LanguageService.TimeStamp.fs @@ -89,7 +89,7 @@ type UsingMSBuild() = // In this bug, the referenced project output didn't exist yet. Building dependee should cause update in dependant [] - [] + [] member public this.``Regression.NoContainedString.Timestamps.Bug3368a``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -166,7 +166,7 @@ type UsingMSBuild() = // FEATURE: When a referenced assembly's timestamp changes the reference is reread. [] - [] + [] member public this.``Timestamps.ReferenceAssemblyChangeAbsolute``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -213,7 +213,7 @@ type UsingMSBuild() = // In this bug, relative paths to referenced assemblies weren't seen. [] - [] + [] member public this.``Timestamps.ReferenceAssemblyChangeRelative``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() @@ -268,7 +268,7 @@ type UsingMSBuild() = // FEATURE: When a referenced project's assembly timestamp changes the reference is reread. [] - [] + [] member public this.``Timestamps.ProjectReferenceAssemblyChange``() = use _guard = this.UsingNewVS() let solution = this.CreateSolution() diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs index 5f3f2f63c9a..8b56c8ae806 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.Project.fs @@ -684,7 +684,7 @@ type Project() = File.Delete(absFilePath) )) - [] //ref bug https://github.com/Microsoft/visualfsharp/issues/259 + [] //ref bug https://github.com/dotnet/fsharp/issues/259 member public this.``RenameFile.InFolder``() = this.MakeProjectAndDo(["file1.fs"; @"Folder1\file2.fs"; @"Folder1\nested1.fs"], [], "", (fun project -> let absFilePath = Path.Combine(project.ProjectFolder, "Folder1", "nested1.fs") @@ -746,7 +746,7 @@ type Project() = if File.Exists(absFilePath) then File.Delete(absFilePath) )) -(* Disabled for now - see https://github.com/Microsoft/visualfsharp/pull/3071 - this is testing old project system features +(* Disabled for now - see https://github.com/dotnet/fsharp/pull/3071 - this is testing old project system features [] member public this.``RenameFile.BuildActionIsResetBasedOnFilenameExtension``() = diff --git a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs index bdedda27f09..50805ed6356 100644 --- a/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs +++ b/vsintegration/tests/UnitTests/LegacyProjectSystem/Tests.ProjectSystem.References.fs @@ -508,10 +508,10 @@ type References() = AssertContains contents newPropVal ) - // Disabled due to: https://github.com/Microsoft/visualfsharp/issues/1460 + // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 // On DEV 15 Preview 4 the VS IDE Test fails with : // System.InvalidOperationException : Operation is not valid due to the current state of the object. - // [] // Disabled due to: https://github.com/Microsoft/visualfsharp/issues/1460 + // [] // Disabled due to: https://github.com/dotnet/fsharp/issues/1460 member public this.``AddReference.COM`` () = DoWithTempFile "Test.fsproj" (fun projFile -> File.AppendAllText(projFile, TheTests.SimpleFsprojText([], [], "")) diff --git a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs index c33223c6ff0..35fe73cb680 100644 --- a/vsintegration/tests/UnitTests/TestLib.LanguageService.fs +++ b/vsintegration/tests/UnitTests/TestLib.LanguageService.fs @@ -32,21 +32,21 @@ type internal SourceFileKind = FS | FSI | FSX type internal ISingleFileTestRunner = abstract CreateSingleFileProject : content : string * - ?references : list * - ?defines : list * + ?references : string list * + ?defines : string list * ?fileKind : SourceFileKind * - ?disabledWarnings : list * + ?disabledWarnings : string list * ?fileName : string -> (OpenSolution * OpenProject * OpenFile) abstract CreateSingleFileProject : - content : list * - ?references : list * - ?defines : list * + content : string list * + ?references : string list * + ?defines : string list * ?fileKind : SourceFileKind * - ?disabledWarnings : list* + ?disabledWarnings : string list* ? fileName : string -> (OpenSolution * OpenProject * OpenFile) type internal Helper = - static member TrimOutExtraMscorlibs (libList:list) = + static member TrimOutExtraMscorlibs (libList:string list) = // There may be multiple copies of mscorlib referenced; but we're only allowed to use one. Pick the highest one. let allExceptMscorlib = libList |> List.filter (fun s -> not(s.Contains("mscorlib"))) let mscorlibs = libList |> List.filter (fun s -> s.Contains("mscorlib")) @@ -78,7 +78,7 @@ type internal Helper = Impl SourceFileKind.FS Impl SourceFileKind.FSX - static member AssertMemberDataTipContainsInOrder(sftr : ISingleFileTestRunner, code : list,marker,completionName,rhsContainsOrder) = + static member AssertMemberDataTipContainsInOrder(sftr : ISingleFileTestRunner, code : string list,marker,completionName,rhsContainsOrder) = let (_solution, project, file) = sftr.CreateSingleFileProject(code, fileKind = SourceFileKind.FSX) TakeCoffeeBreak(file.VS) (* why needed? *) MoveCursorToEndOfMarker(file,marker) @@ -193,7 +193,7 @@ type internal GlobalParseAndTypeCheckCounter private(initialParseCount:int, init | Some(aat) -> aat :: (expectedTypeCheckedFiles |> List.map GetNameOfOpenFile) | _ -> (expectedTypeCheckedFiles |> List.map GetNameOfOpenFile) this.AssertExactly(p.Length, t.Length, p, t, expectCreate) - member private this.AssertExactly(expectedParses, expectedTypeChecks, expectedParsedFiles : list, expectedTypeCheckedFiles : list, expectCreate : bool) = + member private this.AssertExactly(expectedParses, expectedTypeChecks, expectedParsedFiles : string list, expectedTypeCheckedFiles : string list, expectCreate : bool) = let note,ok = if expectCreate then if this.SawIBCreated() then ("The incremental builder was created, as expected",true) else ("The incremental builder was NOT deleted and recreated, even though we expected it to be",false) @@ -254,46 +254,41 @@ type LanguageServiceBaseTests() = let mutable defaultVS : VisualStudio = Unchecked.defaultof<_> let mutable currentVS : VisualStudio = Unchecked.defaultof<_> - (* VsOps is internal, but this type needs to be public *) + // VsOps is internal, but this type needs to be public let mutable ops = BuiltMSBuildTestFlavour() let testStopwatch = new Stopwatch() - (* Timings ----------------------------------------------------------------------------- *) + // Timings ----------------------------------------------------------------------------- let stopWatch = new Stopwatch() let ResetStopWatch() = stopWatch.Reset(); stopWatch.Start() - let time1 op a message = - ResetStopWatch() - let result = op a - printf "%s %d ms\n" message stopWatch.ElapsedMilliseconds - result - member internal this.VsOpts + member internal _.VsOpts with set op = ops <- op member internal this.TestRunner : ISingleFileTestRunner = SingleFileTestRunner(this) :> _ - member internal this.VS = currentVS + member internal _.VS = currentVS member internal this.CreateSingleFileProject ( content : string, - ?references : list, - ?defines : list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string, ?otherFlags: string ) = let content = content.Split( [|"\r\n"|], StringSplitOptions.None) |> List.ofArray this.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName, ?otherFlags = otherFlags) - member internal this.CreateSingleFileProject + member internal _.CreateSingleFileProject ( - content : list, - ?references : list, - ?defines : list, + content : string list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string, ?otherFlags: string ) = @@ -353,12 +348,12 @@ type LanguageServiceBaseTests() = defaultSolution, proj, file - member internal this.CreateSolution() = + member internal _.CreateSolution() = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" GlobalFunctions.CreateSolution(currentVS) - member internal this.CloseSolution(sln : OpenSolution) = + member internal _.CloseSolution(sln : OpenSolution) = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" if (box sln.VS <> box currentVS) then @@ -366,7 +361,7 @@ type LanguageServiceBaseTests() = GlobalFunctions.CloseSolution(sln) - member internal this.AddAssemblyReference(proj, ref) = + member internal _.AddAssemblyReference(proj, ref) = if (box currentVS = box defaultVS) then failwith "You are trying to modify default instance of VS. The only operation that is permitted on default instance is CreateSingleFileProject, perhaps you forgot to add line 'use _guard = this.WithNewVS()' at the beginning of the test?" @@ -466,21 +461,21 @@ and internal SingleFileTestRunner(owner : LanguageServiceBaseTests) = member sftr.CreateSingleFileProject ( content : string, - ?references : list, - ?defines : list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string ) = owner.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) member sftr.CreateSingleFileProject ( - content : list, - ?references : list, - ?defines : list, + content : string list, + ?references : string list, + ?defines : string list, ?fileKind : SourceFileKind, - ?disabledWarnings : list, + ?disabledWarnings : string list, ?fileName : string ) = owner.CreateSingleFileProject(content, ?references = references, ?defines = defines, ?fileKind = fileKind, ?disabledWarnings = disabledWarnings, ?fileName = fileName) diff --git a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs index f33ffbc52da..bcdcd67b66b 100644 --- a/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs +++ b/vsintegration/tests/UnitTests/Workspace/WorkspaceTests.fs @@ -184,11 +184,11 @@ module WorkspaceTests = interface IFSharpWorkspaceProjectContext with - member this.Dispose(): unit = () + member _.Dispose(): unit = () - member this.FilePath: string = mainProj.FilePath + member _.FilePath: string = mainProj.FilePath - member this.HasProjectReference(filePath: string): bool = + member _.HasProjectReference(filePath: string): bool = mainProj.ProjectReferences |> Seq.exists (fun x -> let projRef = mainProj.Solution.GetProject(x.ProjectId) @@ -198,11 +198,11 @@ module WorkspaceTests = false ) - member this.Id: ProjectId = mainProj.Id + member _.Id: ProjectId = mainProj.Id - member this.ProjectReferenceCount: int = mainProj.ProjectReferences.Count() + member _.ProjectReferenceCount: int = mainProj.ProjectReferences.Count() - member this.SetProjectReferences(projRefs: seq): unit = + member _.SetProjectReferences(projRefs: seq): unit = let currentProj = mainProj let mutable solution = currentProj.Solution @@ -224,9 +224,9 @@ module WorkspaceTests = mainProj <- solution.GetProject(currentProj.Id) - member this.MetadataReferenceCount: int = mainProj.MetadataReferences.Count + member _.MetadataReferenceCount: int = mainProj.MetadataReferences.Count - member this.HasMetadataReference(referencePath: string): bool = + member _.HasMetadataReference(referencePath: string): bool = mainProj.MetadataReferences |> Seq.exists (fun x -> match x with @@ -235,7 +235,7 @@ module WorkspaceTests = | _ -> false) - member this.SetMetadataReferences(referencePaths: string seq): unit = + member _.SetMetadataReferences(referencePaths: string seq): unit = let currentProj = mainProj let mutable solution = currentProj.Solution @@ -263,7 +263,7 @@ module WorkspaceTests = type TestFSharpWorkspaceProjectContextFactory(workspace: Workspace, miscFilesWorkspace: Workspace) = interface IFSharpWorkspaceProjectContextFactory with - member this.CreateProjectContext(filePath: string): IFSharpWorkspaceProjectContext = + member _.CreateProjectContext(filePath: string): IFSharpWorkspaceProjectContext = match miscFilesWorkspace.CurrentSolution.GetDocumentIdsWithFilePath(filePath) |> Seq.tryExactlyOne with | Some docId -> let doc = miscFilesWorkspace.CurrentSolution.GetDocument(docId) From 6a07e06551b513d7a85f28f999456205c81099f0 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 11:49:03 +0100 Subject: [PATCH 15/19] rename Diagnostic --> FormattedDiagnostic --- src/fsharp/CompilerDiagnostics.fs | 42 +++++----- src/fsharp/CompilerDiagnostics.fsi | 18 ++--- src/fsharp/DiagnosticsLogger.fsi | 6 ++ src/fsharp/LegacyHostedCompilerForTesting.fs | 80 +++++++++++++++----- src/fsharp/fsc.fs | 57 +++----------- src/fsharp/fsc.fsi | 26 +++++-- 6 files changed, 124 insertions(+), 105 deletions(-) diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index 6f2ca6ecd2f..38cdc428e77 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -1740,32 +1740,32 @@ let SanitizeFileName fileName implicitIncludeDir = fileName [] -type DiagnosticLocation = +type FormattedDiagnosticLocation = { Range: range File: string TextRepresentation: string IsEmpty: bool } [] -type DiagnosticCanonicalInformation = +type FormattedDiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } [] -type DiagnosticDetailedInfo = - { Location: DiagnosticLocation option - Canonical: DiagnosticCanonicalInformation +type FormattedDiagnosticDetailedInfo = + { Location: FormattedDiagnosticLocation option + Canonical: FormattedDiagnosticCanonicalInformation Message: string } [] -type Diagnostic = +type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string - | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo + | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo /// returns sequence that contains Diagnostic for the given error + Diagnostic for all related errors -let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = - let outputWhere (showFullPaths, diagnosticStyle) m: DiagnosticLocation = +let CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity: FSharpDiagnosticSeverity, diag: PhasedDiagnostic, suggestNames: bool) = + let outputWhere (showFullPaths, diagnosticStyle) m: FormattedDiagnosticLocation = if equals m rangeStartup || equals m rangeCmdArgs then { Range = m; TextRepresentation = ""; IsEmpty = true; File = "" } else @@ -1812,10 +1812,10 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnos match diag.Exception with | ReportedError _ -> assert ("" = "Unexpected ReportedError") // this should never happen - Seq.empty + [| |] | StopProcessing -> assert ("" = "Unexpected StopProcessing") // this should never happen - Seq.empty + [| |] | _ -> let errors = ResizeArray() let report diag = @@ -1824,7 +1824,7 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnos | Some m -> Some(outputWhere (showFullPaths, diagnosticStyle) m) | None -> None - let OutputCanonicalInformation(subcategory, errorNumber) : DiagnosticCanonicalInformation = + let OutputCanonicalInformation(subcategory, errorNumber) : FormattedDiagnosticCanonicalInformation = let message = match severity with | FSharpDiagnosticSeverity.Error -> "error" @@ -1846,9 +1846,9 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnos OutputPhasedDiagnostic os mainError flattenErrors suggestNames os.ToString() - let entry: DiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } + let entry: FormattedDiagnosticDetailedInfo = { Location = where; Canonical = canonical; Message = message } - errors.Add (Diagnostic.Long(severity, entry)) + errors.Add (FormattedDiagnostic.Long(severity, entry)) let OutputRelatedError(diag: PhasedDiagnostic) = match diagnosticStyle with @@ -1861,13 +1861,13 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnos OutputPhasedDiagnostic os diag flattenErrors suggestNames os.ToString() - let entry: DiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} - errors.Add( Diagnostic.Long (severity, entry) ) + let entry: FormattedDiagnosticDetailedInfo = { Location = relWhere; Canonical = relCanonical; Message = relMessage} + errors.Add (FormattedDiagnostic.Long (severity, entry) ) | _ -> let os = StringBuilder() OutputPhasedDiagnostic os diag flattenErrors suggestNames - errors.Add( Diagnostic.Short(severity, os.ToString()) ) + errors.Add (FormattedDiagnostic.Short(severity, os.ToString()) ) relatedErrors |> List.iter OutputRelatedError @@ -1881,20 +1881,20 @@ let CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnos #endif | x -> report x - errors:> seq<_> + errors.ToArray() /// used by fsc.exe and fsi.exe, but not by VS /// prints error and related errors to the specified StringBuilder let rec OutputDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity) os (diag: PhasedDiagnostic) = // 'true' for "canSuggestNames" is passed last here because we want to report suggestions in fsc.exe and fsi.exe, just not in regular IDE usage. - let errors = CollectDiagnostic (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diag, true) + let errors = CollectFormattedDiagnostics (implicitIncludeDir, showFullPaths, flattenErrors, diagnosticStyle, severity, diag, true) for e in errors do Printf.bprintf os "\n" match e with - | Diagnostic.Short(_, txt) -> + | FormattedDiagnostic.Short(_, txt) -> os.AppendString txt |> ignore - | Diagnostic.Long(_, details) -> + | FormattedDiagnostic.Long(_, details) -> match details.Location with | Some l when not l.IsEmpty -> os.AppendString l.TextRepresentation | _ -> () diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 202c59aca67..1170a33dd40 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -76,7 +76,7 @@ val OutputDiagnosticContext: /// Part of LegacyHostedCompilerForTesting [] -type DiagnosticLocation = +type FormattedDiagnosticLocation = { Range: range File: string TextRepresentation: string @@ -84,26 +84,26 @@ type DiagnosticLocation = /// Part of LegacyHostedCompilerForTesting [] -type DiagnosticCanonicalInformation = +type FormattedDiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } /// Part of LegacyHostedCompilerForTesting [] -type DiagnosticDetailedInfo = - { Location: DiagnosticLocation option - Canonical: DiagnosticCanonicalInformation +type FormattedDiagnosticDetailedInfo = + { Location: FormattedDiagnosticLocation option + Canonical: FormattedDiagnosticCanonicalInformation Message: string } /// Part of LegacyHostedCompilerForTesting [] -type Diagnostic = +type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string - | Long of FSharpDiagnosticSeverity * DiagnosticDetailedInfo + | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo /// Part of LegacyHostedCompilerForTesting -val CollectDiagnostic: +val CollectFormattedDiagnostics: implicitIncludeDir: string * showFullPaths: bool * flattenErrors: bool * @@ -111,7 +111,7 @@ val CollectDiagnostic: severity: FSharpDiagnosticSeverity * PhasedDiagnostic * suggestNames: bool -> - seq + FormattedDiagnostic [] /// Get an error logger that filters the reporting of warnings based on scoped pragma information val GetDiagnosticsLoggerFilteringByScopedPragmas: diff --git a/src/fsharp/DiagnosticsLogger.fsi b/src/fsharp/DiagnosticsLogger.fsi index aed2884149e..b003fac96dd 100644 --- a/src/fsharp/DiagnosticsLogger.fsi +++ b/src/fsharp/DiagnosticsLogger.fsi @@ -217,11 +217,17 @@ module DiagnosticsLoggerExtensions = type DiagnosticsLogger with member ErrorR: exn: exn -> unit + member Warning: exn: exn -> unit + member Error: exn: exn -> 'b + member SimulateError: ph: PhasedDiagnostic -> 'a + member ErrorRecovery: exn: exn -> m: range -> unit + member StopProcessingRecovery: exn: exn -> m: range -> unit + member ErrorRecoveryNoRange: exn: exn -> unit /// NOTE: The change will be undone when the returned "unwind" object disposes diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index c68e8a88b16..644412866d8 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -16,13 +16,48 @@ open FSharp.Compiler.CompilerDiagnostics open FSharp.Compiler.AbstractIL.ILBinaryReader open Internal.Utilities.Library +/// Part of LegacyHostedCompilerForTesting +/// +/// Yet another DiagnosticsLogger implementation, capturing the messages but only up to the maxerrors maximum +type internal InProcDiagnosticsLoggerProvider() = + let errors = ResizeArray() + let warnings = ResizeArray() + + member _.Provider = + { new DiagnosticsLoggerProvider() with + + member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = + + { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with + + member _.HandleTooManyErrors text = + warnings.Add(FormattedDiagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) + + member _.HandleIssue(tcConfigBuilder, err, severity) = + // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf + let diagnostics = + CollectFormattedDiagnostics + (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, + tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) + match severity with + | FSharpDiagnosticSeverity.Error -> + errors.AddRange(diagnostics) + | FSharpDiagnosticSeverity.Warning -> + warnings.AddRange(diagnostics) + | _ -> ()} + :> DiagnosticsLogger } + + member _.CapturedErrors = errors.ToArray() + + member _.CapturedWarnings = warnings.ToArray() + /// build issue location type internal Location = { - StartLine : int - StartColumn : int - EndLine : int - EndColumn : int + StartLine: int + StartColumn: int + EndLine: int + EndColumn: int } type internal CompilationIssueType = Warning | Error @@ -30,19 +65,19 @@ type internal CompilationIssueType = Warning | Error /// build issue details type internal CompilationIssue = { - Location : Location - Subcategory : string - Code : string - File : string - Text : string - Type : CompilationIssueType + Location: Location + Subcategory: string + Code: string + File: string + Text: string + Type: CompilationIssueType } /// combined warning and error details type internal FailureDetails = { - Warnings : CompilationIssue list - Errors : CompilationIssue list + Warnings: CompilationIssue list + Errors: CompilationIssue list } type internal CompilationResult = @@ -51,8 +86,8 @@ type internal CompilationResult = [] type internal CompilationOutput = - { Errors : Diagnostic[] - Warnings : Diagnostic[] } + { Errors: FormattedDiagnostic[] + Warnings: FormattedDiagnostic[] } type internal InProcCompiler(legacyReferenceResolver) = member _.Compile(argv) = @@ -73,7 +108,10 @@ type internal InProcCompiler(legacyReferenceResolver) = exitCode <- 1 () - let output : CompilationOutput = { Warnings = loggerProvider.CapturedWarnings; Errors = loggerProvider.CapturedErrors } + let output: CompilationOutput = + { Warnings = loggerProvider.CapturedWarnings + Errors = loggerProvider.CapturedErrors } + exitCode = 0, output /// in-proc version of fsc.exe @@ -89,9 +127,9 @@ type internal FscCompiler(legacyReferenceResolver) = } /// converts short and long issue types to the same CompilationIssue representation - let convert issue : CompilationIssue = + let convert issue = match issue with - | Diagnostic.Short(severity, text) -> + | FormattedDiagnostic.Short(severity, text) -> { Location = emptyLocation Code = "" @@ -100,7 +138,7 @@ type internal FscCompiler(legacyReferenceResolver) = Text = text Type = if (severity = FSharpDiagnosticSeverity.Error) then CompilationIssueType.Error else CompilationIssueType.Warning } - | Diagnostic.Long(severity, details) -> + | FormattedDiagnostic.Long(severity, details) -> let loc, file = match details.Location with | Some l when not l.IsEmpty -> @@ -136,7 +174,7 @@ type internal FscCompiler(legacyReferenceResolver) = fun arg -> regex.IsMatch(arg) /// do compilation as if args was argv to fsc.exe - member _.Compile(args : string array) = + member _.Compile(args: string array) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = @@ -177,8 +215,8 @@ module internal CompilerHelpers = /// splits a provided command line string into argv array /// currently handles quotes, but not escaped quotes - let parseCommandLine (commandLine : string) = - let folder (inQuote : bool, currArg : string, argLst : string list) ch = + let parseCommandLine (commandLine: string) = + let folder (inQuote: bool, currArg: string, argLst: string list) ch = match (ch, inQuote) with | '"', _ -> (not inQuote, currArg, argLst) diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 8ee78bb8606..7a53081feae 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -73,29 +73,29 @@ type DiagnosticsLoggerUpToMaxErrors(tcConfigB: TcConfigBuilder, exiter: Exiter, /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit - override x.ErrorCount = errors + override _.ErrorCount = errors - override x.DiagnosticSink(err, severity) = - if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (err, severity) then + override x.DiagnosticSink(phasedError, severity) = + if ReportDiagnosticAsError tcConfigB.diagnosticsOptions (phasedError, severity) then if errors >= tcConfigB.maxErrors then x.HandleTooManyErrors(FSComp.SR.fscTooManyErrors()) exiter.Exit 1 - x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Error) + x.HandleIssue(tcConfigB, phasedError, FSharpDiagnosticSeverity.Error) errors <- errors + 1 - match err.Exception, tcConfigB.simulateException with + match phasedError.Exception, tcConfigB.simulateException with | InternalError (msg, _), None - | Failure msg, None -> Debug.Assert(false, sprintf "Bug in compiler: %s\n%s" msg (err.Exception.ToString())) - | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (err.Exception.ToString())) + | Failure msg, None -> Debug.Assert(false, sprintf "Bug in compiler: %s\n%s" msg (phasedError.Exception.ToString())) + | :? KeyNotFoundException, None -> Debug.Assert(false, sprintf "Lookup exception in compiler: %s" (phasedError.Exception.ToString())) | _ -> () - elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (err, severity) then - x.HandleIssue(tcConfigB, err, FSharpDiagnosticSeverity.Warning) + elif ReportDiagnosticAsWarning tcConfigB.diagnosticsOptions (phasedError, severity) then + x.HandleIssue(tcConfigB, phasedError, FSharpDiagnosticSeverity.Warning) - elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (err, severity) then - x.HandleIssue(tcConfigB, err, severity) + elif ReportDiagnosticAsInfo tcConfigB.diagnosticsOptions (phasedError, severity) then + x.HandleIssue(tcConfigB, phasedError, severity) /// Create an error logger that counts and prints errors @@ -129,41 +129,6 @@ and [] abstract CreateDiagnosticsLoggerUpToMaxErrors : tcConfigBuilder : TcConfigBuilder * exiter : Exiter -> DiagnosticsLogger -/// Part of LegacyHostedCompilerForTesting -/// -/// Yet another DiagnosticsLogger implementation, capturing the messages but only up to the maxerrors maximum -type InProcDiagnosticsLoggerProvider() = - let errors = ResizeArray() - let warnings = ResizeArray() - - member _.Provider = - { new DiagnosticsLoggerProvider() with - - member _.CreateDiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter) = - - { new DiagnosticsLoggerUpToMaxErrors(tcConfigBuilder, exiter, "InProcCompilerDiagnosticsLoggerUpToMaxErrors") with - - member _.HandleTooManyErrors text = - warnings.Add(Diagnostic.Short(FSharpDiagnosticSeverity.Warning, text)) - - member _.HandleIssue(tcConfigBuilder, err, severity) = - // 'true' is passed for "suggestNames", since we want to suggest names with fsc.exe runs and this doesn't affect IDE perf - let diagnostics = - CollectDiagnostic - (tcConfigBuilder.implicitIncludeDir, tcConfigBuilder.showFullPaths, - tcConfigBuilder.flatErrors, tcConfigBuilder.diagnosticStyle, severity, err, true) - match severity with - | FSharpDiagnosticSeverity.Error -> - errors.AddRange(diagnostics) - | FSharpDiagnosticSeverity.Warning -> - warnings.AddRange(diagnostics) - | _ -> ()} - :> DiagnosticsLogger } - - member _.CapturedErrors = errors.ToArray() - - member _.CapturedWarnings = warnings.ToArray() - /// The default DiagnosticsLogger implementation, reporting messages to the Console up to the maxerrors maximum type ConsoleLoggerProvider() = diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 6558572b3c1..54a45c128c5 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -6,7 +6,7 @@ open Internal.Utilities.Library open FSharp.Compiler.AbstractIL.IL open FSharp.Compiler.AbstractIL.ILBinaryReader open FSharp.Compiler.CompilerConfig -open FSharp.Compiler.CompilerDiagnostics +open FSharp.Compiler.Diagnostics open FSharp.Compiler.CompilerImports open FSharp.Compiler.DiagnosticsLogger open FSharp.Compiler.CodeAnalysis @@ -24,6 +24,23 @@ type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider inherit DiagnosticsLoggerProvider + +/// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached +[] +type DiagnosticsLoggerUpToMaxErrors = + inherit DiagnosticsLogger + new: tcConfigB: TcConfigBuilder * exiter: Exiter * nameForDebugging: string -> DiagnosticsLoggerUpToMaxErrors + + /// Called when an error or warning occurs + abstract HandleIssue: tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + + /// Called when 'too many errors' has occurred + abstract HandleTooManyErrors: text: string -> unit + + override ErrorCount : int + + override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + /// The main (non-incremental) compilation entry point used by fsc.exe val mainCompile: ctok: CompilationThreadToken * @@ -55,10 +72,3 @@ val compileOfAst: tcImportsCapture: (TcImports -> unit) option * dynamicAssemblyCreator: (TcConfig * TcGlobals * string * ILModuleDef -> unit) option -> unit - -/// Part of LegacyHostedCompilerForTesting -type InProcDiagnosticsLoggerProvider = - new: unit -> InProcDiagnosticsLoggerProvider - member Provider: DiagnosticsLoggerProvider - member CapturedWarnings: Diagnostic [] - member CapturedErrors: Diagnostic [] From 01df788ffae866390e385edf26c07fdc3b9c2e0f Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 11:50:26 +0100 Subject: [PATCH 16/19] format sigs --- src/fsharp/fsc.fsi | 6 +++--- src/fsharp/service/ServiceLexing.fsi | 1 + 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 54a45c128c5..9aac4e47d36 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -24,7 +24,6 @@ type ConsoleLoggerProvider = new: unit -> ConsoleLoggerProvider inherit DiagnosticsLoggerProvider - /// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached [] type DiagnosticsLoggerUpToMaxErrors = @@ -32,12 +31,13 @@ type DiagnosticsLoggerUpToMaxErrors = new: tcConfigB: TcConfigBuilder * exiter: Exiter * nameForDebugging: string -> DiagnosticsLoggerUpToMaxErrors /// Called when an error or warning occurs - abstract HandleIssue: tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit + abstract HandleIssue: + tcConfigB: TcConfigBuilder * error: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// Called when 'too many errors' has occurred abstract HandleTooManyErrors: text: string -> unit - override ErrorCount : int + override ErrorCount: int override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index 7f882ee3d62..0822067267b 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -6,6 +6,7 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text + #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing From 94b9a613c6706a4e9064a4792a604e6c0e86a1cf Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 12:02:03 +0100 Subject: [PATCH 17/19] format sigs --- src/fsharp/CheckDeclarations.fs | 4 +- src/fsharp/CheckDeclarations.fsi | 4 +- src/fsharp/CheckExpressions.fs | 46 +++++++++++++++++- src/fsharp/CheckExpressions.fsi | 48 ++++++++++++++++++- src/fsharp/CompilerDiagnostics.fsi | 40 ++++++++-------- src/fsharp/LegacyHostedCompilerForTesting.fs | 14 ++++-- src/fsharp/fsc.fs | 6 +-- src/fsharp/fsc.fsi | 6 ++- src/fsharp/fscmain.fs | 4 +- src/fsharp/service/ServiceLexing.fsi | 1 - src/fsharp/service/service.fs | 4 +- vsintegration/tests/UnitTests/Tests.Watson.fs | 2 +- 12 files changed, 138 insertions(+), 41 deletions(-) diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index e9f17bbc23c..bebef739d09 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -375,7 +375,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath (env: // Bind elements of data definitions for exceptions and types (fields, etc.) //------------------------------------------------------------------------- -exception NotUpperCaseConstructor of range +exception NotUpperCaseConstructor of range: range let CheckNamespaceModuleOrTypeName (g: TcGlobals) (id: Ident) = // type names '[]' etc. are used in fslib @@ -679,7 +679,7 @@ let TcOpenDecl (cenv: cenv) mOpenDecl scopem env target = | SynOpenDeclTarget.Type (synType, m) -> TcOpenTypeDecl cenv mOpenDecl scopem env (synType, m) -exception ParameterlessStructCtor of range +exception ParameterlessStructCtor of range: range let MakeSafeInitField (g: TcGlobals) env m isStatic = let id = diff --git a/src/fsharp/CheckDeclarations.fsi b/src/fsharp/CheckDeclarations.fsi index 4d31b04abdf..40b485d060c 100644 --- a/src/fsharp/CheckDeclarations.fsi +++ b/src/fsharp/CheckDeclarations.fsi @@ -74,6 +74,6 @@ val CheckOneSigFile: ParsedSigFileInput -> Cancellable -exception ParameterlessStructCtor of range +exception ParameterlessStructCtor of range: range -exception NotUpperCaseConstructor of range +exception NotUpperCaseConstructor of range: range diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index 11c535acb78..4049c3d3b0a 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -64,50 +64,94 @@ let TcStackGuardDepth = GetEnvInteger "FSHARP_TcStackGuardDepth" 80 //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range + exception FunctionExpected of DisplayEnv * TType * range + exception NotAFunction of DisplayEnv * TType * range * range + exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool + exception Recursion of DisplayEnv * Ident * TType * TType * range + exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range + exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range + exception LetRecCheckedAtRuntime of range + exception LetRecUnsound of DisplayEnv * ValRef list * range + exception TyconBadArgs of DisplayEnv * TyconRef * int * range + exception UnionCaseWrongArguments of DisplayEnv * int * int * range + exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range + exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range + exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range + exception MissingFields of string list * range + exception FunctionValueUnexpected of DisplayEnv * TType * range + exception UnitTypeExpected of DisplayEnv * TType * range + exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range + exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range + exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range + exception UnionPatternsBindDifferentNames of range + exception VarBoundTwice of Ident + exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range + exception ValNotMutable of DisplayEnv * ValRef * range + exception ValNotLocal of DisplayEnv * ValRef * range + exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range + exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range + exception CoercionTargetSealed of DisplayEnv * TType * range + exception UpcastUnnecessary of range + exception TypeTestUnnecessary of range + exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range + exception SelfRefObjCtor of bool * range + exception VirtualAugmentationOnNullValuedType of range + exception NonVirtualAugmentationOnNullValuedType of range + exception UseOfAddressOfOperator of range + exception DeprecatedThreadStaticBindingWarning of range + exception IntfImplInIntrinsicAugmentation of range + exception IntfImplInExtrinsicAugmentation of range + exception OverrideInIntrinsicAugmentation of range + exception OverrideInExtrinsicAugmentation of range + exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range + exception StandardOperatorRedefinitionWarning of string * range -exception InvalidInternalsVisibleToAssemblyName of (*badName*)string * (*fileName option*) string option + +exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option /// Represents information about the initialization field used to check that object constructors /// have completed before fields are accessed. diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index cedfbf5d2a5..d2513565511 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -107,7 +107,9 @@ type TcEnv = eIsControlFlow: bool } member DisplayEnv: DisplayEnv + member NameEnv: NameResolutionEnv + member AccessRights: AccessorDomain //------------------------------------------------------------------------- @@ -116,50 +118,94 @@ type TcEnv = //------------------------------------------------------------------------- exception BakedInMemberConstraintName of string * range + exception FunctionExpected of DisplayEnv * TType * range + exception NotAFunction of DisplayEnv * TType * range * range + exception NotAFunctionButIndexer of DisplayEnv * TType * string option * range * range * bool + exception Recursion of DisplayEnv * Ident * TType * TType * range + exception RecursiveUseCheckedAtRuntime of DisplayEnv * ValRef * range + exception LetRecEvaluatedOutOfOrder of DisplayEnv * ValRef * ValRef * range + exception LetRecCheckedAtRuntime of range + exception LetRecUnsound of DisplayEnv * ValRef list * range + exception TyconBadArgs of DisplayEnv * TyconRef * int * range + exception UnionCaseWrongArguments of DisplayEnv * int * int * range + exception UnionCaseWrongNumberOfArgs of DisplayEnv * int * int * range + exception FieldsFromDifferentTypes of DisplayEnv * RecdFieldRef * RecdFieldRef * range + exception FieldGivenTwice of DisplayEnv * RecdFieldRef * range + exception MissingFields of string list * range + exception UnitTypeExpected of DisplayEnv * TType * range + exception UnitTypeExpectedWithEquality of DisplayEnv * TType * range + exception UnitTypeExpectedWithPossiblePropertySetter of DisplayEnv * TType * string * string * range + exception UnitTypeExpectedWithPossibleAssignment of DisplayEnv * TType * bool * string * range + exception FunctionValueUnexpected of DisplayEnv * TType * range + exception UnionPatternsBindDifferentNames of range + exception VarBoundTwice of Ident + exception ValueRestriction of DisplayEnv * InfoReader * bool * Val * Typar * range + exception ValNotMutable of DisplayEnv * ValRef * range + exception ValNotLocal of DisplayEnv * ValRef * range + exception InvalidRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateRuntimeCoercion of DisplayEnv * TType * TType * range + exception IndeterminateStaticCoercion of DisplayEnv * TType * TType * range + exception StaticCoercionShouldUseBox of DisplayEnv * TType * TType * range + exception RuntimeCoercionSourceSealed of DisplayEnv * TType * range + exception CoercionTargetSealed of DisplayEnv * TType * range + exception UpcastUnnecessary of range + exception TypeTestUnnecessary of range + exception SelfRefObjCtor of bool * range + exception VirtualAugmentationOnNullValuedType of range + exception NonVirtualAugmentationOnNullValuedType of range + exception UseOfAddressOfOperator of range + exception DeprecatedThreadStaticBindingWarning of range + exception IntfImplInIntrinsicAugmentation of range + exception IntfImplInExtrinsicAugmentation of range + exception OverrideInIntrinsicAugmentation of range + exception OverrideInExtrinsicAugmentation of range + exception NonUniqueInferredAbstractSlot of TcGlobals * DisplayEnv * string * MethInfo * MethInfo * range + exception StandardOperatorRedefinitionWarning of string * range -exception InvalidInternalsVisibleToAssemblyName of string (*fileName option*) * string option (*badName*) + +exception InvalidInternalsVisibleToAssemblyName of badName: string * fileName: string option val TcFieldInit: range -> ILFieldInit -> Const diff --git a/src/fsharp/CompilerDiagnostics.fsi b/src/fsharp/CompilerDiagnostics.fsi index 1170a33dd40..46e8644ba24 100644 --- a/src/fsharp/CompilerDiagnostics.fsi +++ b/src/fsharp/CompilerDiagnostics.fsi @@ -74,7 +74,22 @@ val OutputDiagnostic: val OutputDiagnosticContext: prefix: string -> fileLineFunction: (string -> int -> string) -> StringBuilder -> PhasedDiagnostic -> unit -/// Part of LegacyHostedCompilerForTesting +/// Get an error logger that filters the reporting of warnings based on scoped pragma information +val GetDiagnosticsLoggerFilteringByScopedPragmas: + checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger + +val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string + +/// Indicates if we should report a diagnostic as a warning +val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Indicates if we should report a diagnostic as a warning +val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Indicates if we should report a warning as an error +val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool + +/// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnosticLocation = { Range: range @@ -82,27 +97,27 @@ type FormattedDiagnosticLocation = TextRepresentation: string IsEmpty: bool } -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnosticCanonicalInformation = { ErrorNumber: int Subcategory: string TextRepresentation: string } -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnosticDetailedInfo = { Location: FormattedDiagnosticLocation option Canonical: FormattedDiagnosticCanonicalInformation Message: string } -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting [] type FormattedDiagnostic = | Short of FSharpDiagnosticSeverity * string | Long of FSharpDiagnosticSeverity * FormattedDiagnosticDetailedInfo -/// Part of LegacyHostedCompilerForTesting +/// Used internally and in LegacyHostedCompilerForTesting val CollectFormattedDiagnostics: implicitIncludeDir: string * showFullPaths: bool * @@ -112,18 +127,3 @@ val CollectFormattedDiagnostics: PhasedDiagnostic * suggestNames: bool -> FormattedDiagnostic [] - -/// Get an error logger that filters the reporting of warnings based on scoped pragma information -val GetDiagnosticsLoggerFilteringByScopedPragmas: - checkFile: bool * ScopedPragma list * FSharpDiagnosticOptions * DiagnosticsLogger -> DiagnosticsLogger - -val SanitizeFileName: fileName: string -> implicitIncludeDir: string -> string - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsInfo: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a diagnostic as a warning -val ReportDiagnosticAsWarning: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool - -/// Indicates if we should report a warning as an error -val ReportDiagnosticAsError: FSharpDiagnosticOptions -> (PhasedDiagnostic * FSharpDiagnosticSeverity) -> bool diff --git a/src/fsharp/LegacyHostedCompilerForTesting.fs b/src/fsharp/LegacyHostedCompilerForTesting.fs index 644412866d8..26b43155830 100644 --- a/src/fsharp/LegacyHostedCompilerForTesting.fs +++ b/src/fsharp/LegacyHostedCompilerForTesting.fs @@ -101,10 +101,16 @@ type internal InProcCompiler(legacyReferenceResolver) = { new Exiter with member _.Exit n = exitCode <- n; raise StopProcessing } try - mainCompile(ctok, argv, legacyReferenceResolver, false, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.Yes, exiter, loggerProvider.Provider, None, None) + CompileFromCommandLineArguments ( + ctok, argv, legacyReferenceResolver, + false, ReduceMemoryFlag.Yes, + CopyFSharpCoreFlag.Yes, exiter, + loggerProvider.Provider, None, None + ) with | StopProcessing -> () - | ReportedError _ | WrappedError(ReportedError _,_) -> + | ReportedError _ + | WrappedError(ReportedError _,_) -> exitCode <- 1 () @@ -126,7 +132,7 @@ type internal FscCompiler(legacyReferenceResolver) = EndLine = 0 } - /// converts short and long issue types to the same CompilationIssue representation + /// Converts short and long issue types to the same CompilationIssue representation let convert issue = match issue with | FormattedDiagnostic.Short(severity, text) -> @@ -174,7 +180,7 @@ type internal FscCompiler(legacyReferenceResolver) = fun arg -> regex.IsMatch(arg) /// do compilation as if args was argv to fsc.exe - member _.Compile(args: string array) = + member _.Compile(args: string[]) = // args.[0] is later discarded, assuming it is just the path to fsc. // compensate for this in case caller didn't know let args = diff --git a/src/fsharp/fsc.fs b/src/fsharp/fsc.fs index 7a53081feae..c18802e084a 100644 --- a/src/fsharp/fsc.fs +++ b/src/fsharp/fsc.fs @@ -956,13 +956,13 @@ let main6 dynamicAssemblyCreator (Args (ctok, tcConfig, tcImports: TcImports, t ReportTime tcConfig "Exiting" /// The main (non-incremental) compilation entry point used by fsc.exe -let mainCompile +let CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, bannerAlreadyPrinted, reduceMemoryUsage, defaultCopyFSharpCore, exiter: Exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) = use disposables = new DisposablesTracker() let savedOut = Console.Out - use __ = + use _ = { new IDisposable with member _.Dispose() = try @@ -977,7 +977,7 @@ let mainCompile |> main6 dynamicAssemblyCreator /// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -let compileOfAst +let CompileFromSyntaxTrees (ctok, legacyReferenceResolver, reduceMemoryUsage, assemblyName, target, targetDll, targetPdb, dependencies, noframework, exiter, loggerProvider, inputs, tcImportsCapture, dynamicAssemblyCreator) = diff --git a/src/fsharp/fsc.fsi b/src/fsharp/fsc.fsi index 9aac4e47d36..8a8ba8e91bc 100755 --- a/src/fsharp/fsc.fsi +++ b/src/fsharp/fsc.fsi @@ -25,6 +25,8 @@ type ConsoleLoggerProvider = inherit DiagnosticsLoggerProvider /// An error logger that reports errors up to some maximum, notifying the exiter when that maximum is reached +/// +/// Used only in LegacyHostedCompilerForTesting [] type DiagnosticsLoggerUpToMaxErrors = inherit DiagnosticsLogger @@ -42,7 +44,7 @@ type DiagnosticsLoggerUpToMaxErrors = override DiagnosticSink: phasedError: PhasedDiagnostic * severity: FSharpDiagnosticSeverity -> unit /// The main (non-incremental) compilation entry point used by fsc.exe -val mainCompile: +val CompileFromCommandLineArguments: ctok: CompilationThreadToken * argv: string [] * legacyReferenceResolver: LegacyReferenceResolver * @@ -56,7 +58,7 @@ val mainCompile: unit /// An additional compilation entry point used by FSharp.Compiler.Service taking syntax trees as input -val compileOfAst: +val CompileFromSyntaxTrees: ctok: CompilationThreadToken * legacyReferenceResolver: LegacyReferenceResolver * reduceMemoryUsage: ReduceMemoryFlag * diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index fbad507cf02..0e722a6c2fc 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -73,7 +73,7 @@ let main(argv) = // has been reached (e.g. type checking failed, so don't proceed to optimization). let quitProcessExiter = { new Exiter with - member x.Exit(n) = + member _.Exit(n) = try exit n with _ -> @@ -95,7 +95,7 @@ let main(argv) = // thus we can use file-locking memory mapped files. // // This is also one of only two places where CopyFSharpCoreFlag.Yes is set. The other is in LegacyHostedCompilerForTesting. - mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) + Compile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) 0 with e -> diff --git a/src/fsharp/service/ServiceLexing.fsi b/src/fsharp/service/ServiceLexing.fsi index 0822067267b..7f882ee3d62 100755 --- a/src/fsharp/service/ServiceLexing.fsi +++ b/src/fsharp/service/ServiceLexing.fsi @@ -6,7 +6,6 @@ open System open System.Threading open FSharp.Compiler open FSharp.Compiler.Text - #nowarn "57" /// Represents encoded information for the end-of-line continuation of lexing diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index 9c80bfa04e5..9f4bb64466e 100644 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -126,7 +126,7 @@ module CompileHelpers = let diagnostics, errorLogger, loggerProvider = mkCompilationDiagnosticsHandlers() let result = tryCompile errorLogger (fun exiter -> - mainCompile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) + CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)true, ReduceMemoryFlag.Yes, CopyFSharpCoreFlag.No, exiter, loggerProvider, tcImportsCapture, dynamicAssemblyCreator) ) diagnostics.ToArray(), result @@ -139,7 +139,7 @@ module CompileHelpers = let result = tryCompile errorLogger (fun exiter -> - compileOfAst (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) + CompileFromSyntaxTrees (ctok, legacyReferenceResolver, ReduceMemoryFlag.Yes, assemblyName, target, outFile, pdbFile, dependencies, noframework, exiter, loggerProvider, asts, tcImportsCapture, dynamicAssemblyCreator)) diagnostics.ToArray(), result diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index 24dc100a18a..ea0e3bbacde 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -31,7 +31,7 @@ type Check = |] let ctok = AssumeCompilationThreadWithoutEvidence () - let _code = mainCompile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) + let _code = Compile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) () with | :? 'TException as e -> From c8b61370fa47f30de8dec13ffe6a6dec97dbb3f4 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 12:35:50 +0100 Subject: [PATCH 18/19] fix build --- src/fsharp/fscmain.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fsharp/fscmain.fs b/src/fsharp/fscmain.fs index 0e722a6c2fc..b75934ac783 100644 --- a/src/fsharp/fscmain.fs +++ b/src/fsharp/fscmain.fs @@ -95,7 +95,7 @@ let main(argv) = // thus we can use file-locking memory mapped files. // // This is also one of only two places where CopyFSharpCoreFlag.Yes is set. The other is in LegacyHostedCompilerForTesting. - Compile (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) + CompileFromCommandLineArguments (ctok, argv, legacyReferenceResolver, (*bannerAlreadyPrinted*)false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.Yes, quitProcessExiter, ConsoleLoggerProvider(), None, None) 0 with e -> From 6c6f9e892675e639fa77a08d87d4d924b45e58c9 Mon Sep 17 00:00:00 2001 From: Don Syme Date: Mon, 9 May 2022 13:03:50 +0100 Subject: [PATCH 19/19] fix build --- vsintegration/tests/UnitTests/Tests.Watson.fs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vsintegration/tests/UnitTests/Tests.Watson.fs b/vsintegration/tests/UnitTests/Tests.Watson.fs index ea0e3bbacde..54122e4ff71 100644 --- a/vsintegration/tests/UnitTests/Tests.Watson.fs +++ b/vsintegration/tests/UnitTests/Tests.Watson.fs @@ -31,7 +31,7 @@ type Check = |] let ctok = AssumeCompilationThreadWithoutEvidence () - let _code = Compile (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) + let _code = CompileFromCommandLineArguments (ctok, argv, LegacyMSBuildReferenceResolver.getResolver(), false, ReduceMemoryFlag.No, CopyFSharpCoreFlag.No, FSharp.Compiler.DiagnosticsLogger.QuitProcessExiter, ConsoleLoggerProvider(), None, None) () with | :? 'TException as e ->