dotnet · vzarytovskii · Jul 14, 2021 · Jul 13, 2021
@@ -715,15 +715,15 @@ let fixupApp (penv: penv) (fx, fty, tys, args, m) =
 
     // Is it a val app, where the val has a transform? 
     match fx with
-    | Expr.Val (vref, _, m) -> 
+    | Expr.Val (vref, _, vm) -> 
         let f = vref.Deref
         match hasTransfrom penv f with
         | Some trans -> 
             // fix it 
             let callPattern       = trans.transformCallPattern 
             let transformedVal       = trans.transformedVal         
             let fCty     = transformedVal.Type
-            let fCx      = exprForVal m transformedVal
+            let fCx      = exprForVal vm transformedVal
             (* [[f tps args ]] -> transformedVal tps [[COLLAPSED: args]] *)
             let env      = {prefix = "arg";m = m;eg=penv.g}
             let bindings = []

@@ -967,13 +967,14 @@ module Pass4_RewriteAssembly =
     // pass4: lowertop - convert_vterm_bind on TopLevel binds
     //-------------------------------------------------------------------------
 
-    let ConvertBind g (TBind(v, repr, _) as bind)  =
+    let AdjustBindToTopVal g (TBind(v, repr, _))  =
         match v.ValReprInfo with
-        | None -> v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr ))
+        | None -> 
+            v.SetValReprInfo (Some (InferArityOfExprBinding g AllowTypeDirectedDetupling.Yes v repr ))
+            // Things that don't have an arity from type inference but are top-level are compiler-generated
+            v.SetIsCompilerGenerated(true)
         | Some _ -> ()
 
-        bind
-
     //-------------------------------------------------------------------------
     // pass4: transBind (translate)
     //-------------------------------------------------------------------------
@@ -1035,6 +1036,9 @@ module Pass4_RewriteAssembly =
         | None      -> List.empty           // no env for this mutual binding
         | Some envp -> envp.ep_pack // environment pack bindings
 
+    let forceTopBindToHaveArity penv (bind: Binding) =
+        if penv.topValS.Contains(bind.Var) then AdjustBindToTopVal penv.g bind
+
     let TransBindings xisRec penv (binds: Bindings) =
         let tlrBs, nonTlrBs = binds |> List.partition (fun b -> Zset.contains b.Var penv.tlrS)
         let fclass = BindingGroupSharingSameReqdItems tlrBs
@@ -1045,12 +1049,9 @@ module Pass4_RewriteAssembly =
         // QUERY: we repeat this logic in LowerCallsAndSeqs.  Do we really need to do this here?
         // QUERY: yes and no - if we don't, we have an unrealizable term, and many decisions must
         // QUERY: correlate with LowerCallsAndSeqs.
-        let forceTopBindToHaveArity (bind: Binding) =
-            if penv.topValS.Contains(bind.Var) then ConvertBind penv.g bind
-            else bind
 
-        let nonTlrBs = nonTlrBs |> List.map forceTopBindToHaveArity
-        let tlrRebinds = tlrRebinds |> List.map forceTopBindToHaveArity
+        nonTlrBs |> List.iter (forceTopBindToHaveArity penv)
+        tlrRebinds |> List.iter (forceTopBindToHaveArity penv)
         // assemble into replacement bindings
         let bindAs, rebinds =
             match xisRec with
@@ -1067,7 +1068,7 @@ module Pass4_RewriteAssembly =
         // Is it a val app, where the val f is TLR with arity wf?
         // CLEANUP NOTE: should be using a mkApps to make all applications
         match fx with
-        | Expr.Val (fvref: ValRef, _, m) when
+        | Expr.Val (fvref: ValRef, _, vm) when
                 (Zset.contains fvref.Deref penv.tlrS) &&
                 (let wf = Zmap.force fvref.Deref penv.arityM ("TransApp - wf", nameOfVal)
                  IsArityMet fvref wf tys args) ->
@@ -1078,9 +1079,9 @@ module Pass4_RewriteAssembly =
                    let envp = Zmap.force fc penv.envPackM ("TransApp - envp", string)
                    let fHat = Zmap.force f  penv.fHatM ("TransApp - fHat", nameOfVal)
                    let tys  = (List.map mkTyparTy envp.ep_etps) @ tys
-                   let aenvExprs = List.map (exprForVal m) envp.ep_aenvs
+                   let aenvExprs = List.map (exprForVal vm) envp.ep_aenvs
                    let args = aenvExprs @ args
-                   mkApps penv.g ((exprForVal m fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *)
+                   mkApps penv.g ((exprForVal vm fHat, fHat.Type), [tys], args, m) (* change, direct fHat call with closure (reqdTypars, aenvs) *)
         | _ ->
             if isNil tys && isNil args then
                 fx

@@ -103,7 +103,7 @@ type ExprValueInfo =
   ///             the number of args in each bunch. NOTE: This include type arguments.
   ///    expr: The value, a lambda term.
   ///    ty: The type of lambda term
-  | CurriedLambdaValue of id: Unique * arity: int * size: int * value: Expr * TType
+  | CurriedLambdaValue of id: Unique * arity: int * size: int * lambdaExpr: Expr * lambdaExprTy: TType
 
   /// ConstExprValue(size, value)
   | ConstExprValue of size: int * value: Expr
@@ -252,7 +252,7 @@ and SizeOfValueInfo x =
     | TupleValue vinfos
     | RecdValue (_, vinfos)
     | UnionCaseValue (_, vinfos) -> 1 + SizeOfValueInfos vinfos
-    | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> 1
+    | CurriedLambdaValue _ -> 1
     | ConstExprValue (_size, _) -> 1
 
 let [<Literal>] minDepthForASizeNode = 5  // for small vinfos do not record size info, save space
@@ -279,7 +279,7 @@ let BoundValueInfoBySize vinfo =
             | UnionCaseValue (ucr, vinfos) -> UnionCaseValue (ucr, Array.map (bound (depth-1)) vinfos)
             | ConstValue _ -> x
             | UnknownValue -> x
-            | CurriedLambdaValue(_lambdaId, _arities, _bsize, _expr, _ety) -> x
+            | CurriedLambdaValue _ -> x
             | ConstExprValue (_size, _) -> x
     let maxDepth = 6 (* beware huge constants! *)
     let trimDepth = 3
@@ -2557,6 +2557,13 @@ and OptimizeTraitCall cenv env (traitInfo, args, m) =
         let argsR, arginfos = OptimizeExprsThenConsiderSplits cenv env args 
         OptimizeExprOpFallback cenv env (TOp.TraitCall traitInfo, [], argsR, m) arginfos UnknownValue 
 
+and CopyExprForInlining cenv expr m = 
+    // Debug points are erased when doing cross-assembly inlining
+    // Locals are marked compiler generated when doing cross-assembly inlining
+    expr
+    |> copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated
+    |> remarkExpr m
+
 /// Make optimization decisions once we know the optimization information
 /// for a value
 and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m) = 
@@ -2579,9 +2586,10 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m)
               // If we have proven 'v = compilerGeneratedValue'
               // and 'v' is being eliminated in favour of 'compilerGeneratedValue'
               // then replace the name of 'compilerGeneratedValue'
-              // by 'v' and mark it not compiler generated so we preserve good debugging and names
+              // by 'v' and mark it not compiler generated so we preserve good debugging and names.
+              // Don't do this for things represented statically as it may publish multiple values with the same name.
               match vOpt with 
-              | Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated -> 
+              | Some v when not v.IsCompilerGenerated && vR.IsCompilerGenerated && not vR.IsCompiledAsTopLevel  && not v.IsCompiledAsTopLevel -> 
                   vR.Deref.SetIsCompilerGenerated(false)
                   vR.Deref.SetLogicalName(v.LogicalName)
               | _ -> ()
@@ -2591,7 +2599,8 @@ and TryOptimizeVal cenv env (vOpt: ValRef option, mustInline, valInfoForVal, m)
         Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr))
 
     | CurriedLambdaValue (_, _, _, expr, _) when mustInline ->
-        Some (remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated expr))
+        let exprCopy = CopyExprForInlining cenv expr m
+        Some exprCopy
 
     | TupleValue _ | UnionCaseValue _ | RecdValue _ when mustInline ->
         failwith "tuple, union and record values cannot be marked 'inline'"
@@ -2948,7 +2957,8 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m)
 
         // Inlining lambda 
   (* ---------- printf "Inlining lambda near %a = %s\n" outputRange m (showL (exprL f2)) (* JAMES: *) ----------*)
-        let f2R = remarkExpr m (copyExpr cenv.g CloneAllAndMarkExprValsAsCompilerGenerated f2)
+        let f2R = CopyExprForInlining cenv f2 m
+
         // Optimizing arguments after inlining
 
         // REVIEW: this is a cheapshot way of optimizing the arg expressions as well without the restriction of recursive  
@@ -2962,6 +2972,16 @@ and TryInlineApplication cenv env finfo (tyargs: TType list, args: Expr list, m)
 
     | _ -> None
 
+/// When optimizing a function in an application, use the whole range including arguments for the range
+/// to apply to 'inline' code
+and OptimizeFuncInApplication cenv env f0 mWithArgs =
+    let f0 = stripExpr f0
+    match f0 with
+    | Expr.Val (v, _vFlags, _) -> 
+        OptimizeVal cenv env f0 (v, mWithArgs)
+    | _ ->
+        OptimizeExpr cenv env f0
+
 /// Optimize/analyze an application of a function to type and term arguments
 and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
     // trying to devirtualize
@@ -2970,7 +2990,7 @@ and OptimizeApplication cenv env (f0, f0ty, tyargs, args, m) =
         // devirtualized
         res
     | None -> 
-    let newf0, finfo = OptimizeExpr cenv env f0
+    let newf0, finfo = OptimizeFuncInApplication cenv env f0 m
     match TryInlineApplication cenv env finfo (tyargs, args, m) with 
     | Some res -> 
         // inlined
@@ -3639,7 +3659,8 @@ let rec u_ExprInfo st =
         | 6 -> u_tup2 u_int u_expr st |> (fun (a, b) -> ConstExprValue (a, b))
         | 7 -> u_tup2 u_tcref (u_array loop) st |> (fun (a, b) -> RecdValue (a, b))
         | _ -> failwith "loop"
-    MakeSizedValueInfo (loop st) (* calc size of unpicked ExprValueInfo *)
+    // calc size of unpicked ExprValueInfo
+    MakeSizedValueInfo (loop st)
 
 and u_ValInfo st = 
     let a, b = u_tup2 u_ExprInfo u_bool st

@@ -7539,7 +7539,7 @@ let rec MakeApplicationAndBetaReduceAux g (f, fty, tyargsl: TType list list, arg
       match f with 
       | Expr.TyLambda (_, tyvs, body, _, bodyty) when tyvs.Length = List.length tyargs -> 
           let tpenv = bindTypars tyvs tyargs emptyTyparInst
-          let body = remarkExpr m (instExpr g tpenv body)
+          let body = instExpr g tpenv body
           let bodyty' = instType tpenv bodyty
           MakeApplicationAndBetaReduceAux g (body, bodyty', rest, argsl, m) 
 

@@ -1,15 +1,17 @@
 REM == %1 --> assembly
 
 ildasm /TEXT /LINENUM /NOBAR "%~nx1" >"%~n1.il"
-IF NOT ERRORLEVEL 0 exit 1
+IF %ERRORLEVEL% NEQ 0 exit /b 1
 
 echo %~dp0..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il"
      %~dp0..\..\..\testenv\bin\ILComparer.exe "%~n1.il.bsl" "%~n1.il"
 
+IF %ERRORLEVEL% EQU 0 exit /b 0
+
 if /i "%TEST_UPDATE_BSL%" == "1" (
   echo copy /y "%~n1.il" "%~n1.il.bsl"
   copy /y "%~n1.il" "%~n1.il.bsl"
 )
 
-exit /b %ERRORLEVEL%
+exit /b 1
 
@@ -50,13 +50,13 @@
   // Offset: 0x00000408 Length: 0x00000129
 }
 .module Linq101Grouping01.exe
-// MVID: {60B78A59-FB79-E5BF-A745-0383598AB760}
+// MVID: {60D46F1F-FB79-E5BF-A745-03831F6FD460}
 .imagebase 0x00400000
 .file alignment 0x00000200
 .stackreserve 0x00100000
 .subsystem 0x0003       // WINDOWS_CUI
 .corflags 0x00000001    //  ILONLY
-// Image base: 0x06730000
+// Image base: 0x05800000
 
 
 // =============== CLASS MEMBERS DECLARATION ===================
@@ -371,7 +371,7 @@
     {
       // Code size       8 (0x8)
       .maxstack  8
-      .line 25,25 : 24,25 ''
+      .line 25,25 : 23,28 ''
       IL_0000:  ldarg.1
       IL_0001:  ldc.i4.0
       IL_0002:  callvirt   instance char [netstandard]System.String::get_Chars(int32)

@@ -45,13 +45,13 @@
   // Offset: 0x00000390 Length: 0x0000011E
 }
 .module Linq101SetOperators01.exe
-// MVID: {60B78A59-4EE5-349F-A745-0383598AB760}
+// MVID: {60D46F1F-4EE5-349F-A745-03831F6FD460}
 .imagebase 0x00400000
 .file alignment 0x00000200
 .stackreserve 0x00100000
 .subsystem 0x0003       // WINDOWS_CUI
 .corflags 0x00000001    //  ILONLY
-// Image base: 0x06940000
+// Image base: 0x04FA0000
 
 
 // =============== CLASS MEMBERS DECLARATION ===================
@@ -846,7 +846,7 @@
       IL_0057:  ldfld      class [mscorlib]System.Collections.Generic.IEnumerator`1<class [Utils]Utils/Product> Linq101SetOperators01/productFirstChars@33::'enum'
       IL_005c:  callvirt   instance !0 class [mscorlib]System.Collections.Generic.IEnumerator`1<class [Utils]Utils/Product>::get_Current()
       IL_0061:  stloc.0
-      .line 33,33 : 29,30 ''
+      .line 33,33 : 16,33 ''
       IL_0062:  ldarg.0
       IL_0063:  ldc.i4.2
       IL_0064:  stfld      int32 Linq101SetOperators01/productFirstChars@33::pc
@@ -1196,7 +1196,7 @@
       IL_0057:  ldfld      class [mscorlib]System.Collections.Generic.IEnumerator`1<class [Utils]Utils/Customer> Linq101SetOperators01/customerFirstChars@39::'enum'
       IL_005c:  callvirt   instance !0 class [mscorlib]System.Collections.Generic.IEnumerator`1<class [Utils]Utils/Customer>::get_Current()
       IL_0061:  stloc.0
-      .line 39,39 : 29,30 ''
+      .line 39,39 : 16,33 ''
       IL_0062:  ldarg.0
       IL_0063:  ldc.i4.2
       IL_0064:  stfld      int32 Linq101SetOperators01/customerFirstChars@39::pc