|
| 1 | +// Copyright (c) Microsoft Open Technologies, Inc. All Rights Reserved. Licensed under the Apache License, Version 2.0. See License.txt in the project root for license information. |
| 2 | + |
| 3 | +moduleinternalMicrosoft.FSharp.Compiler.AutoBox |
| 4 | + |
| 5 | +openInternal.Utilities |
| 6 | +openMicrosoft.FSharp.Compiler.AbstractIL.Internal |
| 7 | +openMicrosoft.FSharp.Compiler |
| 8 | +openMicrosoft.FSharp.Compiler.Range |
| 9 | +openMicrosoft.FSharp.Compiler.ErrorLogger |
| 10 | +openMicrosoft.FSharp.Compiler.Tast |
| 11 | +openMicrosoft.FSharp.Compiler.Tastops |
| 12 | +openMicrosoft.FSharp.Compiler.Lib |
| 13 | +openMicrosoft.FSharp.Compiler.Env |
| 14 | +openMicrosoft.FSharp.Compiler.Typrelns |
| 15 | + |
| 16 | +//---------------------------------------------------------------------------- |
| 17 | +// Decide the set of mutable locals to promote to heap-allocated reference cells |
| 18 | + |
| 19 | +typecenv= |
| 20 | +{ g:TcGlobals; |
| 21 | + amap:Import.ImportMap} |
| 22 | + |
| 23 | +/// Find all the mutable locals that escape a method, function or lambda expression |
| 24 | +letDecideEscapes syntacticArgs body= |
| 25 | +letcantBeFree v= |
| 26 | +letpassedIn= ListSet.contains valEq v syntacticArgs |
| 27 | +not passedIn&&(v.IsMutable&& v.ValReprInfo.IsNone) |
| 28 | + |
| 29 | +letfrees= freeInExpr CollectLocals body |
| 30 | + frees.FreeLocals|> Zset.filter cantBeFree |
| 31 | + |
| 32 | +/// Find all the mutable locals that escape a lambda expression, ignoring the arguments to the lambda |
| 33 | +letDecideLambda exprF cenv topValInfo expr ety z= |
| 34 | +match exprwith |
| 35 | +| Expr.Lambda_ |
| 36 | +| Expr.TyLambda_-> |
| 37 | +let_tps,ctorThisValOpt,baseValOpt,vsl,body,_bodyty= destTopLambda cenv.g cenv.amap topValInfo(expr, ety) |
| 38 | +letsnoc=fun x y-> y:: x |
| 39 | +letargs= List.concat vsl |
| 40 | +letargs= Option.fold snoc args baseValOpt |
| 41 | +letsyntacticArgs= Option.fold snoc args ctorThisValOpt |
| 42 | + |
| 43 | +letz= Zset.union z(DecideEscapes syntacticArgs body) |
| 44 | +letz=match exprFwith Some f-> f z body| None-> z |
| 45 | + z |
| 46 | +|_-> z |
| 47 | + |
| 48 | +///Special cases where representation uses Lambda. |
| 49 | +letDecideExprOp exprF z(op,tyargs,args)= |
| 50 | +(* Special cases*) |
| 51 | +match op,tyargs,argswith |
| 52 | +// Handle these as special cases since mutables are allowed inside their bodies |
| 53 | +| TOp.While_,_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_)]-> |
| 54 | + Some(exprF(exprF z e1) e2) |
| 55 | + |
| 56 | +| TOp.TryFinally_,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],e2,_,_)]-> |
| 57 | + Some(exprF(exprF z e1) e2) |
| 58 | + |
| 59 | +| TOp.For(_),_,[Expr.Lambda(_,_,_,[_],e1,_,_);Expr.Lambda(_,_,_,[_],e2,_,_);Expr.Lambda(_,_,_,[_],e3,_,_)]-> |
| 60 | + Some(exprF(exprF(exprF z e1) e2) e3) |
| 61 | + |
| 62 | +| TOp.TryCatch_,[_],[Expr.Lambda(_,_,_,[_],e1,_,_); Expr.Lambda(_,_,_,[_],_e2,_,_); Expr.Lambda(_,_,_,[_],e3,_,_)]-> |
| 63 | + Some(exprF(exprF(exprF z e1)_e2) e3) |
| 64 | +// In Check code it said |
| 65 | +// e2; -- don't check filter body - duplicates logic in 'catch' body |
| 66 | +// Is that true for this code too? |
| 67 | +|_-> None |
| 68 | + |
| 69 | + |
| 70 | +/// Find all the mutable locals that escape a lambda expression or object expression |
| 71 | +letDecideExpr cenv exprF z expr= |
| 72 | +match exprwith |
| 73 | +| Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_,m,rty)-> |
| 74 | +lettopValInfo= ValReprInfo([],[argvs|> List.map(fun _-> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal) |
| 75 | +letty= mkMultiLambdaTy m argvs rty |
| 76 | +letz= DecideLambda(Some exprF) cenv topValInfo expr ty z |
| 77 | + Some z |
| 78 | + |
| 79 | +| Expr.TyLambda(_,tps,_,_m,rty)-> |
| 80 | +lettopValInfo= ValReprInfo(ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) |
| 81 | +letty= tryMkForallTy tps rty |
| 82 | +letz= DecideLambda(Some exprF) cenv topValInfo expr ty z |
| 83 | + Some z |
| 84 | + |
| 85 | +| Expr.Obj(_,_,baseValOpt,superInitCall,overrides,iimpls,_m)-> |
| 86 | +letCheckMethod z(TObjExprMethod(_,_attribs,_tps,vs,body,_m))= |
| 87 | +letvs= List.concat vs |
| 88 | +letsyntacticArgs=(match baseValOptwith Some x-> x:: vs| None-> vs) |
| 89 | +letz= Zset.union z(DecideEscapes syntacticArgs body) |
| 90 | + exprF z body |
| 91 | + |
| 92 | +letCheckMethods z l=(z,l)||> List.fold CheckMethod |
| 93 | + |
| 94 | +letCheckInterfaceImpl z(_ty,overrides)= CheckMethods z overrides |
| 95 | + |
| 96 | +letz= exprF z superInitCall |
| 97 | +letz= CheckMethods z overrides |
| 98 | +letz=(z,iimpls)||> List.fold CheckInterfaceImpl |
| 99 | + Some z |
| 100 | + |
| 101 | +| Expr.Op(c,tyargs,args,_m)-> |
| 102 | + DecideExprOp exprF z(c,tyargs,args) |
| 103 | + |
| 104 | +|_-> None |
| 105 | + |
| 106 | +/// Find all the mutable locals that escape a binding |
| 107 | +letDecideBinding cenv z(TBind(v,expr,_m)as bind)= |
| 108 | +lettopValInfo=match bind.Var.ValReprInfowith Some info-> info|_-> ValReprInfo.emptyValData |
| 109 | + DecideLambda None cenv topValInfo expr v.Type z |
| 110 | + |
| 111 | +/// Find all the mutable locals that escape a set of bindings |
| 112 | +letDecideBindings cenv z binds=(z,binds)||> List.fold(DecideBinding cenv) |
| 113 | + |
| 114 | +/// Find all the mutable locals to promote to reference cells in an implementation file |
| 115 | +letDecideImplFile g amap implFile= |
| 116 | + |
| 117 | +letcenv={ g= g; amap= amap} |
| 118 | + |
| 119 | +letfolder= |
| 120 | +{ExprFolder0with |
| 121 | + nonRecBindingsIntercept= DecideBinding cenv |
| 122 | + recBindingsIntercept= DecideBindings cenv |
| 123 | + exprIntercept= DecideExpr cenv |
| 124 | +} |
| 125 | + |
| 126 | +letz= FoldImplFile folder emptyFreeLocals implFile |
| 127 | + |
| 128 | + z |
| 129 | + |
| 130 | + |
| 131 | +//---------------------------------------------------------------------------- |
| 132 | +// Apply the transform |
| 133 | + |
| 134 | +/// Rewrite fetches, stores and address-of expressions for mutable locals which we are transforming |
| 135 | +letTransformExpr g(nvs:ValMap<_>)exprF expr= |
| 136 | + |
| 137 | +match exprwith |
| 138 | +// Rewrite uses of mutable values |
| 139 | +| Expr.Val(ValDeref(v),_,m)when nvs.ContainsVal v-> |
| 140 | + |
| 141 | +let_nv,nve= nvs.[v] |
| 142 | + Some(mkRefCellGet g m v.Type nve) |
| 143 | + |
| 144 | +// Rewrite assignments to mutable values |
| 145 | +| Expr.Op(TOp.LValueOp(LSet, ValDeref(v)),[],[arg],m)when nvs.ContainsVal v-> |
| 146 | + |
| 147 | +let_nv,nve= nvs.[v] |
| 148 | +letarg= exprF arg |
| 149 | + Some(mkRefCellSet g m v.Type nve arg) |
| 150 | + |
| 151 | +// Rewrite taking the address of mutable values |
| 152 | +| Expr.Op(TOp.LValueOp(LGetAddr,ValDeref(v)),[],[],m)when nvs.ContainsVal v-> |
| 153 | +let_nv,nve= nvs.[v] |
| 154 | + Some(mkRecdFieldGetAddrViaExprAddr(nve,mkRefCellContentsRef g,[v.Type],m)) |
| 155 | + |
| 156 | +|_-> None |
| 157 | + |
| 158 | + |
| 159 | +/// Rewrite bindings for mutable locals which we are transforming |
| 160 | +letTransformBinding g(nvs:ValMap<_>)exprF(TBind(v,expr,m))= |
| 161 | +if nvs.ContainsVal vthen |
| 162 | +letnv,_nve= nvs.[v] |
| 163 | +letexprRange= expr.Range |
| 164 | +letexpr= exprF expr |
| 165 | + Some(TBind(nv, mkRefCell g exprRange v.Type expr,m)) |
| 166 | +else |
| 167 | + None |
| 168 | + |
| 169 | +/// Rewrite mutable locals to reference cells across an entire implementation file |
| 170 | +letTransformImplFile g amap implFile= |
| 171 | +letfvs= DecideImplFile g amap implFile |
| 172 | +if Zset.isEmpty fvsthen |
| 173 | + implFile |
| 174 | +else |
| 175 | +for fvin fvsdo |
| 176 | + warning(Error(FSComp.SR.abImplicitHeapAllocation(fv.DisplayName),fv.Range)) |
| 177 | + |
| 178 | +letnvs= |
| 179 | +[for fvin fvsdo |
| 180 | +letnty= mkRefCellTy g fv.Type |
| 181 | +letnv,nve= |
| 182 | +if fv.IsCompilerGeneratedthen mkCompGenLocal fv.Range fv.LogicalName nty |
| 183 | +else mkLocal fv.Range fv.LogicalName nty |
| 184 | +yield(fv,(nv, nve))] |
| 185 | +|> ValMap.OfList |
| 186 | + |
| 187 | + implFile|> |
| 188 | + RewriteImplFile{ PreIntercept= Some(TransformExpr g nvs) |
| 189 | + PreInterceptBinding= Some(TransformBinding g nvs) |
| 190 | + PostTransform=(fun _-> None) |
| 191 | + IsUnderQuotations=false} |
| 192 | + |
| 193 | + |