Skip to content

Commit e3e46c4

Browse files
dsymelatkin
dsyme
authored and
latkin
committed
Support class names as functions
1 parent 6ae5c70 commit e3e46c4

7 files changed

Lines changed: 416 additions & 28 deletions

File tree

‎.gitignore‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -58,9 +58,11 @@ tests/projects/Sample_VS2012_FSharp_ConsoleApp_net45_with_resource/Sample_VS2012
5858
obj
5959
extras
6060
ossreadme*.txt
61+
tests/fsharp/typecheck/sigs/*.exe
6162
tests/fsharp/typecheck/sigs/*.diff
6263
tests/fsharp/typecheck/sigs/*.err
6364
tests/fsharp/typecheck/sigs/*.vsdiff
65+
tests/fsharp/typecheck/sigs/*.dll
6466
tests/fsharp/typecheck/sigs/*.vserr
6567
src/fsharp/FSharp.LanguageService.Compiler/illex.*
6668
src/fsharp/FSharp.LanguageService.Compiler/ilpars.*
@@ -77,5 +79,4 @@ tests/XFSharpQA_Failures.log.*
7779
vsintegration/src/vs/FsPkgs/FSharp.Project/FS/FSharp.ProjectSystem.FSharp.fsi
7880
vsintegration/src/vs/FsPkgs/FSharp.Project/FS/ctofiles/
7981
tests/fsharpqa/Source/CodeGen/EmittedIL/QueryExpressionStepping/Utils.dll
80-
tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.dll
81-
82+
tests/fsharpqa/Source/CodeGen/EmittedIL/ComputationExpressions/ComputationExprLibrary.dll

‎src/fsharp/FSComp.txt‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -656,8 +656,8 @@ tcExpressionWithIfRequiresParenthesis,"This list or array expression includes an
656656
799,tcInvalidAssignment,"Invalid assignment"
657657
800,tcInvalidUseOfTypeName,"Invalid use of a type name"
658658
801,tcTypeHasNoAccessibleConstructor,"This type has no accessible object constructors"
659-
802,tcInvalidUseOfTypeNameOrConstructor,"Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'."
660-
803,tcInvalidUseOfTypeNameOrConstructorWithOverloads,"Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'. The required signature is:\n\t%s."
659+
#802,tcInvalidUseOfTypeNameOrConstructor,"Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'."
660+
#803,tcInvalidUseOfTypeNameOrConstructorWithOverloads,"Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'. The required signature is:\n\t%s."
661661
804,tcInvalidUseOfInterfaceType,"Invalid use of an interface type"
662662
805,tcInvalidUseOfDelegate,"Invalid use of a delegate constructor. Use the syntax 'new Type(args)' or just 'Type(args)'."
663663
806,tcPropertyIsNotStatic,"Property '%s' is not static"

‎src/fsharp/tc.fs‎

Lines changed: 28 additions & 20 deletions
Original file line numberDiff line numberDiff line change
@@ -5713,19 +5713,19 @@ and TcNewExpr cenv env tpenv objTy mObjTyOpt superInit arg mWholeExprOrObjTy =
57135713
if not (isAppTy cenv.g objTy) then error(Error(FSComp.SR.tcNamedTypeRequired(if superInit then "inherit" else "new"),mWholeExprOrObjTy))
57145714
let item = ForceRaise (ResolveObjectConstructor cenv.nameResolver env.DisplayEnv mWholeExprOrObjTy ad objTy)
57155715

5716-
TcCtorCall false cenv env tpenv objTy objTy mObjTyOpt item superInit arg mWholeExprOrObjTy [] None
5716+
TcCtorCall false cenv env tpenv objTy objTy mObjTyOpt item superInit [arg] mWholeExprOrObjTy [] None
57175717

57185718
/// Check an 'inheritedTys declaration in an implicit or explicit class
5719-
and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit arg mWholeCall delayed afterTcOverloadResolutionOpt =
5719+
and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit args mWholeCall delayed afterTcOverloadResolutionOpt =
57205720
let ad = env.eAccessRights
57215721
let isSuperInit = (if superInit then CtorValUsedAsSuperInit else NormalValUse)
57225722
let mItem = match mObjTyOpt with Some m -> m | None -> mWholeCall
57235723

57245724
if isInterfaceTy cenv.g objTy then
57255725
error(Error((if superInit then FSComp.SR.tcInheritCannotBeUsedOnInterfaceType() else FSComp.SR.tcNewCannotBeUsedOnInterfaceType()),mWholeCall))
57265726

5727-
match item with
5728-
| Item.CtorGroup(methodName,minfos) ->
5727+
match item, args with
5728+
| Item.CtorGroup(methodName,minfos), _ ->
57295729
let meths = List.map (fun minfo -> minfo,None) minfos
57305730
if isNaked && TypeFeasiblySubsumesType 0 cenv.g cenv.amap mWholeCall cenv.g.system_IDisposable_typ NoCoerce objTy then
57315731
warning(Error(FSComp.SR.tcIDisposableTypeShouldUseNew(),mWholeCall))
@@ -5741,9 +5741,9 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a
57415741
| Some mObjTy,None -> AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env mObjTy methodName minfos
57425742
| None, _ -> AfterTcOverloadResolution.DoNothing
57435743

5744-
TcMethodApplicationThen cenv env overallTy tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterTcOverloadResolution isSuperInit [arg] ExprAtomicFlag.NonAtomic delayed
5744+
TcMethodApplicationThen cenv env overallTy tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterTcOverloadResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed
57455745

5746-
| Item.DelegateCtor typ ->
5746+
| Item.DelegateCtor typ, [arg] ->
57475747
// Re-record the name resolution since we now know it's a constructor call
57485748
match mObjTyOpt with
57495749
| Some mObjTy -> CallNameResolutionSink cenv.tcSink (mObjTy,env.NameEnv,item,item,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights)
@@ -7783,13 +7783,13 @@ and TcLongIdentThen cenv overallTy env tpenv (LongIdentWithDots(longId,_)) delay
77837783
// resolve type name lookup of 'MyOverloadedType'
77847784
// Also determine if type names should resolve to Item.Types or Item.CtorGroup
77857785
match delayed with
7786-
| DelayedTypeApp (tyargs, _, _) :: DelayedApp _ :: _ ->
7787-
TypeNameResolutionInfo(ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
7786+
| DelayedTypeApp (tyargs, _, _) :: DelayedDotLookup _ :: _ ->
7787+
// cases like 'MyType<int>.Sth'
7788+
TypeNameResolutionInfo(ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
77887789

77897790
| DelayedTypeApp (tyargs, _, _) :: _ ->
7790-
// cases like 'MyType<int>.Sth' but also only 'MyType<int>.'
7791-
// (without LValue_get), which is needed for VS (when typing)
7792-
TypeNameResolutionInfo(ResolveTypeNamesToTypeRefs, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
7791+
// Note, this also covers the case 'MyType<int>.' (without LValue_get), which is needed for VS (when typing)
7792+
TypeNameResolutionInfo(ResolveTypeNamesToCtors, TypeNameResolutionStaticArgsInfo.FromTyArgs tyargs.Length)
77937793

77947794
| _ ->
77957795
TypeNameResolutionInfo.Default
@@ -7995,7 +7995,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
79957995
| _ ->
79967996
TcMethodApplicationThen cenv env overallTy tpenv None [] mItem mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [] ExprAtomicFlag.Atomic delayed
79977997

7998-
| Item.CtorGroup(_,minfos) ->
7998+
| Item.CtorGroup(nm,minfos) ->
79997999
let objTy =
80008000
match minfos with
80018001
| (minfo :: _) -> minfo.EnclosingType
@@ -8005,21 +8005,29 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
80058005
| ((DelayedApp (_, arg, mExprAndArg))::otherDelayed) ->
80068006

80078007
CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv,objTy, env.DisplayEnv, env.eAccessRights)
8008-
TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false arg mExprAndArg otherDelayed (Some afterTcOverloadResolution)
8008+
TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [arg] mExprAndArg otherDelayed (Some afterTcOverloadResolution)
80098009

80108010
| ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::(DelayedApp (_, arg, mExprAndArg))::otherDelayed) ->
80118011

80128012
let objTy,tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs
80138013
CallExprHasTypeSink cenv.tcSink (mExprAndArg, env.NameEnv, objTy, env.DisplayEnv, env.eAccessRights)
80148014
minfos |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.EnclosingType objTy)
8015-
TcCtorCall true cenv env tpenv overallTy objTy (Some mExprAndTypeArgs) item false arg mExprAndArg otherDelayed (Some afterTcOverloadResolution)
8015+
TcCtorCall true cenv env tpenv overallTy objTy (Some mExprAndTypeArgs) item false [arg] mExprAndArg otherDelayed (Some afterTcOverloadResolution)
80168016

8017-
| _ ->
8018-
if minfos.Length = 1 then
8019-
let text = List.map (NicePrint.stringOfMethInfo cenv.amap mItem env.DisplayEnv) minfos
8020-
error(Error(FSComp.SR.tcInvalidUseOfTypeNameOrConstructorWithOverloads(String.concat "\n\r" text),mItem))
8021-
else
8022-
error(Error(FSComp.SR.tcInvalidUseOfTypeNameOrConstructor(),mItem))
8017+
| ((DelayedTypeApp(tyargs, _mTypeArgs, mExprAndTypeArgs))::otherDelayed) ->
8018+
8019+
let objTy,tpenv = TcNestedTypeApplication cenv NewTyparsOK CheckCxs ItemOccurence.UseInType env tpenv mExprAndTypeArgs objTy tyargs
8020+
8021+
// A case where we have an incomplete name e.g. 'Foo<int>.' - we still want to report it to VS!
8022+
let resolvedItem = Item.Types(nm, [objTy])
8023+
CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,resolvedItem,resolvedItem,ItemOccurence.Use,env.DisplayEnv,env.eAccessRights)
8024+
8025+
minfos |> List.iter (fun minfo -> UnifyTypes cenv env mExprAndTypeArgs minfo.EnclosingType objTy)
8026+
TcCtorCall true cenv env tpenv overallTy objTy (Some mExprAndTypeArgs) item false [] mExprAndTypeArgs otherDelayed (Some afterTcOverloadResolution)
8027+
8028+
| _ ->
8029+
8030+
TcCtorCall true cenv env tpenv overallTy objTy (Some mItem) item false [] mItem delayed (Some afterTcOverloadResolution)
80238031

80248032
| Item.FakeInterfaceCtor _ ->
80258033
error(Error(FSComp.SR.tcInvalidUseOfInterfaceType(),mItem))

‎tests/fsharp/typecheck/sigs/build.bat‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,15 @@ call ..\..\single-neg-test.bat neg91
1717
pos16.exe
1818
@if ERRORLEVEL 1 goto Error
1919

20+
"%FSC%" %fsc_flags% --target:exe -o:pos17.exe pos17.fs
21+
@if ERRORLEVEL 1 goto Error
22+
23+
"%PEVERIFY%" pos17.exe
24+
@if ERRORLEVEL 1 goto Error
25+
26+
pos17.exe
27+
@if ERRORLEVEL 1 goto Error
28+
2029
"%FSC%" %fsc_flags% --target:exe -o:pos15.exe pos15.fs
2130
@if ERRORLEVEL 1 goto Error
2231

‎tests/fsharp/typecheck/sigs/neg20.bsl‎

Lines changed: 23 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -356,9 +356,28 @@ neg20.fs(319,8,319,17): typecheck error FS3132: This type definition may not hav
356356

357357
neg20.fs(322,8,322,18): typecheck error FS3132: This type definition may not have the 'CLIMutable' attribute. Only record types may have this attribute.
358358

359-
neg20.fs(335,11,335,24): typecheck error FS0802: Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'.
359+
neg20.fs(335,11,335,24): typecheck error FS0041: A unique overload for method 'String' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: System.String(value: char []) : unit, System.String(value: nativeptr<char>) : unit, System.String(value: nativeptr<sbyte>) : unit
360360

361-
neg20.fs(336,11,336,22): typecheck error FS0802: Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'.
361+
neg20.fs(336,11,336,22): typecheck error FS0041: A unique overload for method 'Guid' could not be determined based on type information prior to this program point. A type annotation may be needed. Candidates: System.Guid(b: byte []) : unit, System.Guid(g: string) : unit
362362

363-
neg20.fs(340,11,340,34): typecheck error FS0803: Invalid use of a type name and/or object constructor. If necessary use 'new' and apply the constructor to its arguments, e.g. 'new Type(args)'. The required signature is:
364-
new : x:int -> ClassWithOneConstructor.
363+
neg20.fs(355,19,355,38): typecheck error FS1124: Multiple types exist called 'OverloadedClassName', taking different numbers of generic parameters. Provide a type instantiation to disambiguate the type resolution, e.g. 'OverloadedClassName<_>'.
364+
365+
neg20.fs(356,22,356,41): typecheck error FS1124: Multiple types exist called 'OverloadedClassName', taking different numbers of generic parameters. Provide a type instantiation to disambiguate the type resolution, e.g. 'OverloadedClassName<_>'.
366+
367+
neg20.fs(370,19,370,38): typecheck error FS0039: The value or constructor 'OverloadedClassName' is not defined
368+
369+
neg20.fs(371,19,371,38): typecheck error FS1124: Multiple types exist called 'OverloadedClassName', taking different numbers of generic parameters. Provide a type instantiation to disambiguate the type resolution, e.g. 'OverloadedClassName<_>'.
370+
371+
neg20.fs(372,22,372,41): typecheck error FS0039: The value or constructor 'OverloadedClassName' is not defined
372+
373+
neg20.fs(373,22,373,41): typecheck error FS1124: Multiple types exist called 'OverloadedClassName', taking different numbers of generic parameters. Provide a type instantiation to disambiguate the type resolution, e.g. 'OverloadedClassName<_>'.
374+
375+
neg20.fs(382,19,382,40): typecheck error FS1124: Multiple types exist called 'OverloadedClassName', taking different numbers of generic parameters. Provide a type instantiation to disambiguate the type resolution, e.g. 'OverloadedClassName<_>'.
376+
377+
neg20.fs(383,39,383,41): typecheck error FS0039: The field, constructor or member 'S2' is not defined
378+
379+
neg20.fs(428,19,428,38): typecheck error FS0039: The value or constructor 'OverloadedClassName' is not defined
380+
381+
neg20.fs(430,22,430,41): typecheck error FS0039: The value or constructor 'OverloadedClassName' is not defined
382+
383+
neg20.fs(444,39,444,41): typecheck error FS0039: The field, constructor or member 'S2' is not defined

‎tests/fsharp/typecheck/sigs/neg20.fs‎

Lines changed: 103 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -340,3 +340,106 @@ type ClassWithOneConstructor(x:int) = member x.P = 1
340340
let ss3 = ClassWithOneConstructor
341341

342342

343+
module OverloadedTypeNamesBothHaveConstructors =
344+
type OverloadedClassName<'T>(x:int) =
345+
new (y:string) = OverloadedClassName<'T>(1)
346+
member __.P = x
347+
static member S() = 3
348+
349+
350+
type OverloadedClassName<'T1,'T2>(x:int) =
351+
new (y:string) = OverloadedClassName<'T1,'T2>(1)
352+
member __.P = x
353+
static member S() = 3
354+
355+
let t3 = 3 |> OverloadedClassName // expected error - multiple types exist
356+
let t3s = "3" |> OverloadedClassName // expected error - multiple types exist
357+
358+
359+
module OverloadedTypeNamesSomeConstructors =
360+
type OverloadedClassName<'T>(x:int) =
361+
new (y:string) = OverloadedClassName<'T>(1)
362+
member __.P = x
363+
static member S() = 3
364+
365+
366+
type OverloadedClassName<'T1,'T2> =
367+
member __.P = 1
368+
static member S() = 3
369+
370+
let t2 = 3 |> OverloadedClassName<int,int> // CHANGE IN ERROR MESSAGE IN F# 4.x: Was "Invalid use of a type name", now "The value or constructor 'OverloadedClassName' is not defined"
371+
let t3 = 3 |> OverloadedClassName // expected error - multiple types exist
372+
let t2s = "3" |> OverloadedClassName<int,int> // CHANGE IN ERROR MESSAGE IN F# 4.x: Was "Invalid use of a type name", now "The value or constructor 'OverloadedClassName' is not defined"
373+
let t3s = "3" |> OverloadedClassName // expected error - multiple types exist
374+
375+
module OverloadedTypeNamesNoConstructors =
376+
type OverloadedClassName<'T> =
377+
static member S(x:int) = 3
378+
379+
type OverloadedClassName<'T1,'T2> =
380+
static member S(x:int) = 3
381+
382+
let t3 = 3 |> OverloadedClassName.S // expected error - multiple types exist
383+
let t4 = 3 |> OverloadedClassName.S2 // expected error - The field, constructor or member 'S2' is not defined
384+
385+
386+
387+
388+
389+
390+
module OverloadedTypeNamesIncludingNonGenericTypeBothHaveConstructors =
391+
392+
type OverloadedClassName(x:int) =
393+
new (y:string) = OverloadedClassName(1)
394+
member __.P = x
395+
static member S() = 3
396+
397+
type OverloadedClassName<'T>(x:int) =
398+
new (y:string) = OverloadedClassName<'T>(1)
399+
member __.P = x
400+
static member S() = 3
401+
402+
403+
type OverloadedClassName<'T1,'T2>(x:int) =
404+
new (y:string) = OverloadedClassName<'T1,'T2>(1)
405+
member __.P = x
406+
static member S() = 3
407+
408+
let t3 = 3 |> OverloadedClassName // expected error - multiple types exist
409+
let t3s = "3" |> OverloadedClassName // expected error - multiple types exist
410+
411+
412+
module OverloadedTypeNamesIncludingNonGenericTypeSomeConstructors =
413+
type OverloadedClassName(x:int) =
414+
new (y:string) = OverloadedClassName(1)
415+
member __.P = x
416+
static member S() = 3
417+
418+
type OverloadedClassName<'T>(x:int) =
419+
new (y:string) = OverloadedClassName<'T>(1)
420+
member __.P = x
421+
static member S() = 3
422+
423+
424+
type OverloadedClassName<'T1,'T2> =
425+
member __.P = 1
426+
static member S() = 3
427+
428+
let t2 = 3 |> OverloadedClassName<int,int> // CHANGE IN ERROR MESSAGE IN F# 4.x: Was "Invalid use of a type name", now "The value or constructor 'OverloadedClassName' is not defined"
429+
let t3 = 3 |> OverloadedClassName // NO ERROR EXPECTED
430+
let t2s = "3" |> OverloadedClassName<int,int> // CHANGE IN ERROR MESSAGE IN F# 4.x: Was "Invalid use of a type name", now "The value or constructor 'OverloadedClassName' is not defined"
431+
let t3s = "3" |> OverloadedClassName // expected error - multiple types exist
432+
433+
module OverloadedTypeNamesIncludingNonGenericTypeNoConstructors =
434+
type OverloadedClassName =
435+
static member S(x:int) = 3
436+
437+
type OverloadedClassName<'T> =
438+
static member S(x:int) = 3
439+
440+
type OverloadedClassName<'T1,'T2> =
441+
static member S(x:int) = 3
442+
443+
let t3 = 3 |> OverloadedClassName.S // NO ERROR EXPECTED
444+
let t4 = 3 |> OverloadedClassName.S2 // expected error - The field, constructor or member 'S2' is not defined
445+

0 commit comments

Comments
 (0)