Support for extension property initializers

Closes #17

commit 3d639ab68e247b52bbbbcc83d48b908e7db447af
Author: latkin <latkin@microsoft.com>
Date:   Thu Jan 15 13:43:40 2015 -0800

    Cleaning up tests configs

commit cbf4d76
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Thu Jan 15 16:38:35 2015 +0100

    Fix calls in #if EXTENSIONTYPING

commit fd548e3
Author: Steffen Forkmann <steffen.forkmann@msu-solutions.de>
Date:   Thu Jan 15 16:21:08 2015 +0100

    Reorder build order in proto-Compiler

commit 8968e4f
Author: xepaul <edwardpaul44@gmail.com>
Date:   Tue Nov 18 23:59:43 2014 +0000

    Added Tests

commit 3fd4931
Author: xepaul <edwardpaul44@gmail.com>
Date:   Thu Nov 13 23:27:27 2014 +0000

    type argument bug fix

commit 848cacf
Author: xepaul <edwardpaul44@gmail.com>
Date:   Sun Sep 7 15:36:49 2014 +0100

    Changes following PR comments :-
    match styling change.
    added open module to remove fully qualified path
    removed unnecessary comment  "//need to hide"  added during prototyping

commit 0b2381f
Author: xepaul <edwardpaul44@gmail.com>
Date:   Tue Jul 22 01:38:18 2014 +0100

    Experiment to support assigning values to extension properties at initialization

Author: xepaul

src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj

@@ -307,6 +307,18 @@
     <Compile Include="..\augment.fs">
       <Link>augment.fs</Link>
     </Compile>
+    <Compile Include="..\outcome.fsi">
+      <Link>outcome.fsi</Link>
+    </Compile>
+    <Compile Include="..\outcome.fs">
+      <Link>outcome.fs</Link>
+    </Compile>
+	  <Compile Include="..\nameres.fsi">
+		  <Link>nameres.fsi</Link>
+	  </Compile>
+	  <Compile Include="..\nameres.fs">
+      <Link>nameres.fs</Link>
+    </Compile>
     <Compile Include="..\typrelns.fs">
       <Link>typrelns.fs</Link>
     </Compile>
@@ -315,12 +327,6 @@
     </Compile>
     <Compile Include="..\patcompile.fs">
       <Link>patcompile.fs</Link>
-    </Compile>
-    <Compile Include="..\outcome.fsi">
-      <Link>outcome.fsi</Link>
-    </Compile>
-    <Compile Include="..\outcome.fs">
-      <Link>outcome.fs</Link>
     </Compile>
 	  <Compile Include="..\csolve.fsi">
 		  <Link>csolve.fsi</Link>
@@ -333,12 +339,6 @@
     </Compile>
     <Compile Include="..\formats.fs">
       <Link>formats.fs</Link>
-    </Compile>
-	  <Compile Include="..\nameres.fsi">
-		  <Link>nameres.fsi</Link>
-	  </Compile>
-	  <Compile Include="..\nameres.fs">
-      <Link>nameres.fs</Link>
     </Compile>
     <Compile Include="..\unsolved.fs">
       <Link>unsolved.fs</Link>

src/fsharp/csolve.fs

@@ -1204,7 +1204,7 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) permitWeakResolution ndeep
                       let callerArgs = argtys |> List.map (fun argty -> CallerArg(argty,m,false,dummyExpr))
                       let minst = FreshenMethInfo m minfo
                       let objtys = minfo.GetObjArgTypes(amap, m, minst)
-                      CalledMeth<Expr>(csenv.InfoReader,false,FreshenMethInfo,m,AccessibleFromEverywhere,minfo,minst,minst,None,objtys,[(callerArgs,[])],false,false))
+                      CalledMeth<Expr>(csenv.InfoReader,None,false,FreshenMethInfo,m,AccessibleFromEverywhere,minfo,minst,minst,None,objtys,[(callerArgs,[])],false,false,None))
 
               let methOverloadResult,errors = 
                   CollectThenUndo (fun trace -> ResolveOverloading csenv (WithTrace(trace)) nm ndeep true (0,0) AccessibleFromEverywhere calledMethGroup false (Some rty))  

src/fsharp/nameres.fsi

@@ -206,6 +206,9 @@ val internal CallExprHasTypeSink        : TcResultsSink -> range * NameResolutio
 /// Get all the available properties of a type (both intrinsic and extension)
 val internal AllPropInfosOfTypeInScope : InfoReader -> NameResolutionEnv -> string option * AccessorDomain -> FindMemberFlag -> range -> TType -> PropInfo list
 
+/// Get all the available properties of a type (only extension)
+val internal ExtensionPropInfosOfTypeInScope : InfoReader -> NameResolutionEnv -> string option * AccessorDomain  -> range -> TType -> PropInfo list
+
 /// Get the available methods of a type (both declared and inherited)
 val internal AllMethInfosOfTypeInScope : InfoReader -> NameResolutionEnv -> string option * AccessorDomain -> FindMemberFlag -> range -> TType -> MethInfo list
 

src/fsharp/tc.fs

@@ -5775,7 +5775,7 @@ and TcCtorCall isNaked cenv env tpenv overallTy objTy mObjTyOpt item superInit a
             |   Some mObjTy,None -> AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env mObjTy methodName minfos 
             |   None, _ -> AfterTcOverloadResolution.DoNothing
 
-        TcMethodApplicationThen cenv env overallTy tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterTcOverloadResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed 
+        TcMethodApplicationThen cenv env overallTy (Some objTy) tpenv None [] mWholeCall mItem methodName ad PossiblyMutates false meths afterTcOverloadResolution isSuperInit args ExprAtomicFlag.NonAtomic delayed 
 
     | Item.DelegateCtor typ, [arg] ->
         // Re-record the name resolution since we now know it's a constructor call
@@ -6137,7 +6137,7 @@ and TcObjectExpr cenv overallTy env tpenv (synObjTy,argopt,binds,extraImpls,mNew
                 let afterTcOverloadResolution = AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env synObjTy.Range methodName minfos
                 let ad = env.eAccessRights
 
-                let expr,tpenv = TcMethodApplicationThen cenv env objTy tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterTcOverloadResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] 
+                let expr,tpenv = TcMethodApplicationThen cenv env objTy None tpenv None [] mWholeExpr mObjTy methodName ad PossiblyMutates false meths afterTcOverloadResolution CtorValUsedAsSuperInit [arg] ExprAtomicFlag.Atomic [] 
                 // The 'base' value is always bound
                 let baseIdOpt = (match baseIdOpt with None -> Some(ident("base",mObjTy)) | Some id -> Some(id))
                 expr,baseIdOpt,tpenv
@@ -8018,7 +8018,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
         let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForMethods
         match delayed with 
         | (DelayedApp (atomicFlag, arg, mExprAndArg)::otherDelayed) ->
-            TcMethodApplicationThen cenv env overallTy tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
+            TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
 
         | (DelayedTypeApp(tys, mTypeArgs, mExprAndTypeArgs) :: DelayedApp(atomicFlag, arg, mExprAndArg) :: otherDelayed) ->
 
@@ -8028,7 +8028,7 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
 
               // // NOTE: This doesn't take instantiation into account
               // CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,item (* ! *), item, ItemOccurence.Use,env.DisplayEnv,env.eAccessRights)                        
-              TcMethodApplicationThen cenv env overallTy tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
+              TcMethodApplicationThen cenv env overallTy None tpenv None [] mExprAndArg mItem methodName ad NeverMutates false [(minfoAfterStaticArguments, None)] afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
 
             | None ->
 #endif
@@ -8037,9 +8037,9 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
 
             // NOTE: This doesn't take instantiation into account
             CallNameResolutionSink cenv.tcSink (mExprAndTypeArgs,env.NameEnv,item (* ! *), item, ItemOccurence.Use,env.DisplayEnv,env.eAccessRights)                        
-            TcMethodApplicationThen cenv env overallTy tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
+            TcMethodApplicationThen cenv env overallTy None tpenv (Some tyargs) [] mExprAndArg mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [arg] atomicFlag otherDelayed
         | _ -> 
-            TcMethodApplicationThen cenv env overallTy tpenv None [] mItem mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [] ExprAtomicFlag.Atomic delayed 
+            TcMethodApplicationThen cenv env overallTy None tpenv None [] mItem mItem methodName ad NeverMutates false meths afterTcOverloadResolution NormalValUse [] ExprAtomicFlag.Atomic delayed 
 
     | Item.CtorGroup(nm,minfos) ->
         let objTy = 
@@ -8206,14 +8206,14 @@ and TcItemThen cenv overallTy env tpenv (item,mItem,rest,afterOverloadResolution
             if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem))
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm SettersOfPropInfos
             // Note: static calls never mutate a struct object argument
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mStmt mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse (args@[e2]) ExprAtomicFlag.NonAtomic otherDelayed
         | _ -> 
             // Static Property Get (possibly indexer) 
             let meths = pinfos |> GettersOfPropInfos
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm GettersOfPropInfos
             if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem))
             // Note: static calls never mutate a struct object argument
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse args ExprAtomicFlag.Atomic delayed
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterTcOverloadResolution NormalValUse args ExprAtomicFlag.Atomic delayed
 
     | Item.ILField finfo -> 
 
@@ -8345,14 +8345,14 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela
 
 #if EXTENSIONTYPING
         match TryTcMethodAppToStaticConstantArgs cenv env tpenv (minfos, tyargsOpt, mExprAndItem, mItem) with 
-        | Some minfo -> TcMethodApplicationThen cenv env overallTy tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfo, None)] afterTcOverloadResolution NormalValUse args atomicFlag delayed 
+        | Some minfo -> TcMethodApplicationThen cenv env overallTy None tpenv None objArgs mExprAndItem mItem methodName ad mutates false [(minfo, None)] afterTcOverloadResolution NormalValUse args atomicFlag delayed 
         | None -> 
 #endif
 
         let tyargsOpt,tpenv = TcMemberTyArgsOpt cenv env tpenv tyargsOpt
         let meths = minfos |> List.map (fun minfo -> minfo,None) 
 
-        TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
+        TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem methodName ad mutates false meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
 
     | Item.Property (nm,pinfos) ->
         // Instance property 
@@ -8377,13 +8377,13 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela
             if isNil meths then error (Error (FSComp.SR.tcPropertyCannotBeSet1 nm,mItem))
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm SettersOfPropInfos
             let mut = (if isStructTy cenv.g (tyOfExpr cenv.g objExpr) then DefinitelyMutates else PossiblyMutates)
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt objArgs mStmt mItem nm ad mut true meths afterTcOverloadResolution NormalValUse (args @ [e2]) atomicFlag [] 
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mStmt mItem nm ad mut true meths afterTcOverloadResolution NormalValUse (args @ [e2]) atomicFlag [] 
         | _ ->                   
             // Instance property getter
             let meths = GettersOfPropInfos pinfos
             if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable(nm),mItem))
             let afterTcOverloadResolution = afterOverloadResolution |> AfterTcOverloadResolution.ForProperties nm GettersOfPropInfos
-            TcMethodApplicationThen cenv env overallTy tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
+            TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt objArgs mExprAndItem mItem nm ad PossiblyMutates true meths afterTcOverloadResolution NormalValUse args atomicFlag delayed 
 
     | Item.RecdField rfinfo ->
         // Get or set instance F# field or literal 
@@ -8488,6 +8488,7 @@ and TcMethodApplicationThen
        env
        overallTy           // The type of the overall expression including "delayed". THe method "application" may actually be a use of a member as 
                     // a first-class function value, when this would be a function type. 
+       objTyOpt   // methodType
        tpenv 
        callerTyArgs // The return type of the overall expression including "delayed" 
        objArgs      // The 'obj' arguments in obj.M(...) and obj.M, if any 
@@ -8514,7 +8515,7 @@ and TcMethodApplicationThen
 
     // Call the helper below to do the real checking 
     let (expr,attributeAssignedNamedItems,delayed),tpenv = 
-        TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName ad mut isProp meths afterTcOverloadResolution isSuperInit args exprTy delayed
+        TcMethodApplication false cenv env tpenv callerTyArgs objArgs mWholeExpr mItem methodName objTyOpt ad mut isProp meths afterTcOverloadResolution isSuperInit args exprTy delayed
 
     // Give errors if some things couldn't be assigned 
     if nonNil attributeAssignedNamedItems then 
@@ -8545,6 +8546,7 @@ and TcMethodApplication
         mMethExpr  // range of the entire method expression 
         mItem
         methodName 
+         (objTyOpt : TType option)
         ad 
         mut 
         isProp 
@@ -8741,7 +8743,7 @@ and TcMethodApplication
                 | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs)
                 | None -> minst
             let allArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs
-            CalledMeth<SynExpr>(cenv.infoReader,checkingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,allArgs,usesParamArrayConversion,true)
+            CalledMeth<SynExpr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall, FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,allArgs,usesParamArrayConversion,true,objTyOpt)
 
         let preArgumentTypeCheckingCalledMethGroup = 
             [ for (minfo,pinfoOpt) in candidateMethsAndProps do
@@ -8834,7 +8836,7 @@ and TcMethodApplication
                     | Some tyargs -> minfo.AdjustUserTypeInstForFSharpStyleIndexedExtensionMembers(tyargs)
                     | None -> minst
                 let callerArgs = List.zip unnamedCurriedCallerArgs namedCurriedCallerArgs
-                CalledMeth<Expr>(cenv.infoReader,checkingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true))
+                CalledMeth<Expr>(cenv.infoReader,Some(env.NameEnv),checkingAttributeCall,FreshenMethInfo, mMethExpr,ad,minfo,minst,callerTyArgs,pinfoOpt,callerObjArgTys,callerArgs,usesParamArrayConversion,true,objTyOpt))
 
         let callerArgCounts = (unnamedCurriedCallerArgs.Length, namedCurriedCallerArgs.Length)
         let csenv = MakeConstraintSolverEnv cenv.css mMethExpr denv
@@ -9713,7 +9715,7 @@ and TcAttribute cenv (env: TcEnv) attrTgt (synAttr: SynAttribute)  =
                 let meths = minfos |> List.map (fun minfo -> minfo,None) 
                 let afterTcOverloadResolution = AfterTcOverloadResolution.ForNewConstructors cenv.tcSink env tyid.idRange methodName minfos
                 let (expr,namedCallerArgs,_),_ = 
-                  TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName ad PossiblyMutates false meths afterTcOverloadResolution NormalValUse [arg] (NewInferenceType ())  []
+                  TcMethodApplication true cenv env tpenv None [] mAttr mAttr methodName None ad PossiblyMutates false meths afterTcOverloadResolution NormalValUse [arg] (NewInferenceType ())  []
 
                 UnifyTypes cenv env mAttr ty (tyOfExpr cenv.g expr)
 

src/fsharp/typrelns.fs

@@ -25,6 +25,7 @@ open Microsoft.FSharp.Compiler.Lib
 open Microsoft.FSharp.Compiler.Infos
 open Microsoft.FSharp.Compiler.PrettyNaming
 open Microsoft.FSharp.Compiler.Infos.AccessibilityLogic
+open Microsoft.FSharp.Compiler.Nameres
 
 #if EXTENSIONTYPING
 open Microsoft.FSharp.Compiler.ExtensionTyping
@@ -1630,6 +1631,7 @@ let MakeCalledArgs amap m (minfo:MethInfo) minst =
 /// and returns a CalledMeth object for further analysis.
 type CalledMeth<'T>
       (infoReader:InfoReader,
+       nameEnv: Microsoft.FSharp.Compiler.Nameres.NameResolutionEnv option,
        isCheckingAttributeCall, 
        freshenMethInfo,// a function to help generate fresh type variables the property setters methods in generic classes 
        m, 
@@ -1641,7 +1643,8 @@ type CalledMeth<'T>
        callerObjArgTys: TType list,   // the types of the actual object argument, if any 
        curriedCallerArgs: (CallerArg<'T> list * CallerNamedArg<'T> list) list,     // the data about any arguments supplied by the caller 
        allowParamArgs:bool,       // do we allow the use of a param args method in its "expanded" form?
-       allowOutAndOptArgs: bool)  // do we allow the use of the transformation that converts out arguments as tuple returns?
+       allowOutAndOptArgs: bool,  // do we allow the use of the transformation that converts out arguments as tuple returns?
+       tyargsOpt : TType option) // method parameters
     =
     let g = infoReader.g
     let methodRetTy = minfo.GetFSharpReturnTy(infoReader.amap, m, calledTyArgs)
@@ -1726,15 +1729,31 @@ type CalledMeth<'T>
                         let pminst = freshenMethInfo m pminfo
                         Choice1Of2(AssignedItemSetter(id,AssignedPropSetter(pinfo,pminfo, pminst), e))
                     | _ ->
-                        match infoReader.GetILFieldInfosOfType(Some(nm),ad,m,returnedObjTy) with
-                        | finfo :: _ -> 
-                            Choice1Of2(AssignedItemSetter(id,AssignedILFieldSetter(finfo), e))
-                        | _ ->              
-                          match infoReader.TryFindRecdOrClassFieldInfoOfType(nm,m,returnedObjTy) with
-                          | Some rfinfo -> 
-                              Choice1Of2(AssignedItemSetter(id,AssignedRecdFieldSetter(rfinfo), e))
-                          | None -> 
-                              Choice2Of2(arg))
+                        let epinfos = 
+                            match nameEnv with  
+                            | Some(ne) ->  ExtensionPropInfosOfTypeInScope infoReader ne (Some(nm), ad) m returnedObjTy
+                            | _ -> []
+                        match epinfos with 
+                        | [pinfo] when pinfo.HasSetter && not pinfo.IsIndexer -> 
+                            let pminfo = pinfo.SetterMethod
+                            let pminst = match minfo with
+                                         | MethInfo.FSMeth(_,TType.TType_app(_,types),_,_) -> types
+                                         | _ -> freshenMethInfo m pminfo
+
+                            let pminst = match tyargsOpt with
+                                          | Some(TType.TType_app(_, types)) -> types
+                                          | _ -> pminst
+                            Choice1Of2(AssignedItemSetter(id,AssignedPropSetter(pinfo,pminfo, pminst), e))
+                        |  _ ->    
+                            match infoReader.GetILFieldInfosOfType(Some(nm),ad,m,returnedObjTy) with
+                            | finfo :: _ -> 
+                                Choice1Of2(AssignedItemSetter(id,AssignedILFieldSetter(finfo), e))
+                            | _ ->              
+                              match infoReader.TryFindRecdOrClassFieldInfoOfType(nm,m,returnedObjTy) with
+                              | Some rfinfo -> 
+                                  Choice1Of2(AssignedItemSetter(id,AssignedRecdFieldSetter(rfinfo), e))
+                              | None -> 
+                                  Choice2Of2(arg))
 
             let names = namedCallerArgs |> List.map (fun (CallerNamedArg(nm,_)) -> nm.idText)