diff --git a/compiler/src/dotty/tools/dotc/core/NameKinds.scala b/compiler/src/dotty/tools/dotc/core/NameKinds.scala index 430a36fda1c0..89f907e8943f 100644 --- a/compiler/src/dotty/tools/dotc/core/NameKinds.scala +++ b/compiler/src/dotty/tools/dotc/core/NameKinds.scala @@ -310,9 +310,8 @@ object NameKinds { val PatMatCaseName = new UniqueNameKind("case") val PatMatMatchFailName = new UniqueNameKind("matchFail") val PatMatSelectorName = new UniqueNameKind("selector") - val LocalOptFact = new UniqueNameKind("fact") - val LocalOptSelector = new UniqueNameKind("selector") - val LocalOptFallback = new UniqueNameKind("fallback") + + val LocalOptInlineLocalObj = new UniqueNameKind("ilo") /** The kind of names of default argument getters */ val DefaultGetterName = new NumberedNameKind(DEFAULTGETTER, "DefaultGetter") { diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/BubbleUpNothing.scala b/compiler/src/dotty/tools/dotc/transform/localopt/BubbleUpNothing.scala index ccf3d2fb2d64..936c79f02bce 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/BubbleUpNothing.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/BubbleUpNothing.scala @@ -23,6 +23,7 @@ class BubbleUpNothing extends Optimisation { import ast.tpd._ def visitor(implicit ctx: Context) = NoVisitor + def clear(): Unit = () def transformer(implicit ctx: Context): Tree => Tree = { case t @ Apply(Select(Notathing(qual), _), args) => diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/ConstantFold.scala b/compiler/src/dotty/tools/dotc/transform/localopt/ConstantFold.scala index 8bbb25ba84dc..ae3df2239771 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/ConstantFold.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/ConstantFold.scala @@ -30,6 +30,7 @@ import Simplify.desugarIdent import ast.tpd._ def visitor(implicit ctx: Context) = NoVisitor + def clear(): Unit = () def transformer(implicit ctx: Context): Tree => Tree = { x => preEval(x) match { // TODO: include handling of isInstanceOf similar to one in IsInstanceOfEvaluator diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/Devalify.scala b/compiler/src/dotty/tools/dotc/transform/localopt/Devalify.scala index de58139ad531..3cdcd3744328 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/Devalify.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/Devalify.scala @@ -4,13 +4,12 @@ package transform.localopt import core.Constants.Constant import core.Contexts.Context import core.Flags._ -import core.NameOps._ import core.Symbols._ import core.Types._ import ast.Trees._ import scala.collection.mutable import config.Printers.simplify -import Simplify.{desugarIdent, isEffectivelyMutable} +import Simplify._ import transform.SymUtils._ /** Inline vals and remove vals that are aliases to other vals @@ -32,6 +31,14 @@ class Devalify extends Optimisation { // Either a duplicate or a read through series of immutable fields val copies = mutable.HashMap[Symbol, Tree]() + def clear(): Unit = { + timesUsed.clear() + timesUsedAsType.clear() + defined.clear() + usedInInnerClass.clear() + copies.clear() + } + def visitType(tp: Type)(implicit ctx: Context): Unit = { tp.foreachPart(x => x match { case TermRef(NoPrefix, _) => @@ -164,66 +171,38 @@ class Devalify extends Optimisation { case _ => t } - def readingOnlyVals(t: Tree)(implicit ctx: Context): Boolean = { - def isGetterOfAImmutableField = t.symbol.isGetter && !t.symbol.is(Mutable) - def isCaseClassWithVar = t.symbol.info.decls.exists(_.is(Mutable)) - def isAccessingProductField = t.symbol.exists && - t.symbol.owner.derivesFrom(defn.ProductClass) && - t.symbol.owner.is(CaseClass) && - t.symbol.name.isSelectorName && - !isCaseClassWithVar // Conservatively covers case class A(var x: Int) - def isImmutableCaseAccessor = t.symbol.is(CaseAccessor) && !t.symbol.is(Mutable) - - dropCasts(t) match { - case Typed(exp, _) => readingOnlyVals(exp) - - case TypeApply(fun @ Select(rec, _), List(tp)) => - if ((fun.symbol eq defn.Any_asInstanceOf) && rec.tpe.derivesFrom(tp.tpe.classSymbol)) - readingOnlyVals(rec) - else false - - case Apply(Select(rec, _), Nil) => - if (isGetterOfAImmutableField || isAccessingProductField || isImmutableCaseAccessor) - readingOnlyVals(rec) - else false - - case Select(rec, _) if t.symbol.is(Method) => - if (isGetterOfAImmutableField) - readingOnlyVals(rec) // Getter of an immutable field - else if (isAccessingProductField) { - def isImmutableField = { - val fieldId = t.symbol.name.toString.drop(1).toInt - 1 - !t.symbol.owner.caseAccessors(ctx)(fieldId).is(Mutable) - } - if (isImmutableField) readingOnlyVals(rec) // Accessing a field of a product - else false - } else if (isImmutableCaseAccessor) - readingOnlyVals(rec) - else false - - case t @ Select(qual, _) if !isEffectivelyMutable(t) => - readingOnlyVals(qual) - - case t: Ident if !t.symbol.is(Mutable | Method) && !t.symbol.info.dealias.isInstanceOf[ExprType] => - desugarIdent(t) match { - case Some(t) => readingOnlyVals(t) - case None => true - } - - case t: This => true - // null => false, or the following fails devalify: - // trait I { - // def foo: Any = null - // } - // object Main { - // def main = { - // val s: I = null - // s.foo - // } - // } - case Literal(Constant(null)) => false - case t: Literal => true - case _ => false - } + def readingOnlyVals(t: Tree)(implicit ctx: Context): Boolean = dropCasts(t) match { + case Typed(exp, _) => readingOnlyVals(exp) + + case TypeApply(fun @ Select(rec, _), List(tp)) => + val isAsInstanceOf = fun.symbol == defn.Any_asInstanceOf && rec.tpe.derivesFrom(tp.tpe.classSymbol) + isAsInstanceOf && readingOnlyVals(rec) + + case t @ Apply(Select(rec, _), Nil) => + isImmutableAccessor(t) && readingOnlyVals(rec) + + case t @ Select(rec, _) if t.symbol.is(Method) => + isImmutableAccessor(t) && readingOnlyVals(rec) + + case t @ Select(qual, _) if !isEffectivelyMutable(t) => + readingOnlyVals(qual) + + case t: Ident if !t.symbol.is(Mutable | Method) && !t.symbol.info.dealias.isInstanceOf[ExprType] => + desugarIdent(t).forall(readingOnlyVals) + + case t: This => true + // null => false, or the following fails devalify: + // trait I { + // def foo: Any = null + // } + // object Main { + // def main = { + // val s: I = null + // s.foo + // } + // } + case Literal(Constant(null)) => false + case t: Literal => true + case _ => false } } diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/DropGoodCasts.scala b/compiler/src/dotty/tools/dotc/transform/localopt/DropGoodCasts.scala index 72f2aefe0457..1bbbd10ae4bc 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/DropGoodCasts.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/DropGoodCasts.scala @@ -24,6 +24,7 @@ import Simplify.isEffectivelyMutable import ast.tpd._ def visitor(implicit ctx: Context) = NoVisitor + def clear(): Unit = () def transformer(implicit ctx: Context): Tree => Tree = { case t @ If(cond, thenp, elsep) => diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/DropNoEffects.scala b/compiler/src/dotty/tools/dotc/transform/localopt/DropNoEffects.scala index 5f8985535519..63e6321a6e5f 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/DropNoEffects.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/DropNoEffects.scala @@ -3,12 +3,11 @@ package transform.localopt import core.TypeErasure import core.Contexts.Context -import core.NameOps._ import core.Symbols._ import core.Types._ import core.Flags._ import ast.Trees._ -import Simplify.desugarIdent +import Simplify._ /** Removes side effect free statements in blocks and Defdef. * Flattens blocks (except Closure-blocks) @@ -20,6 +19,7 @@ class DropNoEffects(val simplifyPhase: Simplify) extends Optimisation { import ast.tpd._ def visitor(implicit ctx: Context) = NoVisitor + def clear(): Unit = () def transformer(implicit ctx: Context): Tree => Tree = { // Remove empty blocks @@ -79,11 +79,7 @@ class DropNoEffects(val simplifyPhase: Simplify) extends Optimisation { elsep = nelsep.orElse(if (elsep.isInstanceOf[Literal]) elsep else unitLiteral)) // Accessing a field of a product - case t @ Select(rec, _) - if (t.symbol.isGetter && !t.symbol.is(Mutable | Lazy)) || - (t.symbol.owner.derivesFrom(defn.ProductClass) && t.symbol.owner.is(CaseClass) && t.symbol.name.isSelectorName) || - (t.symbol.is(CaseAccessor) && !t.symbol.is(Mutable)) => - + case t @ Select(rec, _) if isImmutableAccessor(t) => keepOnlySideEffects(rec) // !name.eq(nme.TYPE_) && // Keep the .TYPE added by ClassOf, would be needed for AfterErasure diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/InlineCaseIntrinsics.scala b/compiler/src/dotty/tools/dotc/transform/localopt/InlineCaseIntrinsics.scala index 41ba182d8f95..8e47f84c17dc 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/InlineCaseIntrinsics.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/InlineCaseIntrinsics.scala @@ -24,6 +24,7 @@ class InlineCaseIntrinsics(val simplifyPhase: Simplify) extends Optimisation { import ast.tpd._ def visitor(implicit ctx: Context): Tree => Unit = NoVisitor + def clear(): Unit = () def transformer(implicit ctx: Context): Tree => Tree = { // For synthetic applies on case classes (both dotty/scalac) diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/InlineLabelsCalledOnce.scala b/compiler/src/dotty/tools/dotc/transform/localopt/InlineLabelsCalledOnce.scala index 67c0abd7b4ce..194a28c2028a 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/InlineLabelsCalledOnce.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/InlineLabelsCalledOnce.scala @@ -18,6 +18,11 @@ class InlineLabelsCalledOnce extends Optimisation { val timesUsed = mutable.HashMap[Symbol, Int]() val defined = mutable.HashMap[Symbol, DefDef]() + def clear(): Unit = { + timesUsed.clear() + defined.clear() + } + def visitor(implicit ctx: Context): Tree => Unit = { case d: DefDef if d.symbol.is(Label) => var isRecursive = false diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/InlineLocalObjects.scala b/compiler/src/dotty/tools/dotc/transform/localopt/InlineLocalObjects.scala index 623583a54ad5..4c160fd63ae0 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/InlineLocalObjects.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/InlineLocalObjects.scala @@ -4,7 +4,9 @@ package transform.localopt import core.Constants.Constant import core.Contexts.Context import core.Decorators._ -import core.NameOps._ +import core.Names.Name +import core.NameKinds.LocalOptInlineLocalObj +import core.Types.Type import core.StdNames._ import core.Symbols._ import core.Flags._ @@ -12,165 +14,97 @@ import ast.Trees._ import scala.collection.mutable import transform.SymUtils._ import config.Printers.simplify - -/** Inline case classes as vals, this essentially (local) implements multi - * parameter value classes. The main motivation is to get ride of all the - * intermediate tuples coming from pattern matching expressions. +import Simplify._ + +/** Rewrite fields of local instances as vals. + * + * If a local instance does not escape the local scope, it will be removed + * later by DropNoEffects, thus implementing the equivalent of (local) multi + * parameter value classes. The main motivation for this transformation is to + * get ride of the intermediate tuples object somes created when pattern + * matching on Scala2 case classes. */ -class InlineLocalObjects extends Optimisation { +class InlineLocalObjects(val simplifyPhase: Simplify) extends Optimisation { import ast.tpd._ - // In the end only calls constructor. Reason for unconditional inlining - val hasPerfectRHS = mutable.HashMap[Symbol, Boolean]() - // If all values have perfect RHS than key has perfect RHS - val checkGood = mutable.HashMap[Symbol, Set[Symbol]]() - val forwarderWritesTo = mutable.HashMap[Symbol, Symbol]() - val gettersCalled = mutable.HashSet[Symbol]() - - def followTailPerfect(t: Tree, symbol: Symbol)(implicit ctx: Context): Unit = { - t match { - case Block(_, expr) => followTailPerfect(expr, symbol) - case If(_, thenp, elsep) => followTailPerfect(thenp, symbol); followTailPerfect(elsep, symbol); - case Apply(fun, _) if fun.symbol.isConstructor && t.tpe.widenDealias == symbol.info.widenDealias.finalResultType.widenDealias => - hasPerfectRHS(symbol) = true - case Apply(fun, _) if fun.symbol.is(Label) && (fun.symbol ne symbol) => - checkGood.put(symbol, checkGood.getOrElse(symbol, Set.empty) + fun.symbol) - // assert(forwarderWritesTo.getOrElse(t.symbol, symbol) == symbol) - forwarderWritesTo(t.symbol) = symbol - case t: Ident if !t.symbol.owner.isClass && (t.symbol ne symbol) => - checkGood.put(symbol, checkGood.getOrElse(symbol, Set.empty) + t.symbol) - case _ => - } - } - - def visitor(implicit ctx: Context): Tree => Unit = { - case vdef: ValDef if (vdef.symbol.info.classSymbol is CaseClass) && - !vdef.symbol.is(Lazy) && - !vdef.symbol.info.classSymbol.caseAccessors.exists(x => x.is(Mutable)) => - followTailPerfect(vdef.rhs, vdef.symbol) + // ValDefs whose rhs is a case class instantiation: potential candidates. + val candidates = mutable.HashSet[Symbol]() - case Assign(lhs, rhs) if !lhs.symbol.owner.isClass => - checkGood.put(lhs.symbol, checkGood.getOrElse(lhs.symbol, Set.empty) + rhs.symbol) - - case t @ Select(qual, _) if (t.symbol.isGetter && !t.symbol.is(Mutable)) || - (t.symbol.maybeOwner.derivesFrom(defn.ProductClass) && t.symbol.maybeOwner.is(CaseClass) && t.symbol.name.isSelectorName) || - (t.symbol.is(CaseAccessor) && !t.symbol.is(Mutable)) => - gettersCalled(qual.symbol) = true + // ValDefs whose lhs is used with `._1` (or any getter call). + val gettersCalled = mutable.HashSet[Symbol]() - case t: DefDef if t.symbol.is(Label) => - followTailPerfect(t.rhs, t.symbol) + // Map from class to new fields, initialised between visitor and transformer. + var newFieldsMapping: Map[Symbol, Map[Symbol, Symbol]] = null + // | | | + // | | New fields, replacements these getters + // | Usages of getters of these classes + // ValDefs of the classes that are being torn apart; = candidates.intersect(gettersCalled) - case _ => + def clear(): Unit = { + candidates.clear() + gettersCalled.clear() + newFieldsMapping = null } - def transformer(implicit ctx: Context): Tree => Tree = { - var hasChanged = true - while(hasChanged) { - hasChanged = false - checkGood.foreach{case (key, values) => - values.foreach { value => - if (hasPerfectRHS.getOrElse(key, false)) { - hasChanged = !hasPerfectRHS.put(value, true).getOrElse(false) - } + def initNewFieldsMapping()(implicit ctx: Context): Unit = + if (newFieldsMapping == null) { + newFieldsMapping = candidates.intersect(gettersCalled).map { refVal => + val accessors = refVal.info.classSymbol.caseAccessors.filter(_.isGetter) + val newLocals = accessors.map { x => + val owner: Symbol = refVal.owner + val name: Name = LocalOptInlineLocalObj.fresh() + val flags: FlagSet = Synthetic + val info: Type = x.asSeenFrom(refVal.info).info.finalResultType.widenDealias + ctx.newSymbol(owner, name, flags, info) } - } + (refVal, accessors.zip(newLocals).toMap) + }.toMap } - val newMappings: Map[Symbol, Map[Symbol, Symbol]] = - hasPerfectRHS.iterator.map(x => x._1).filter(x => !x.is(Method) && !x.is(Label) && gettersCalled.contains(x.symbol) && (x.symbol.info.classSymbol is CaseClass)) - .map { refVal => - simplify.println(s"replacing ${refVal.symbol.fullName} with stack-allocated fields") - var accessors = refVal.info.classSymbol.caseAccessors.filter(_.isGetter) // TODO: drop mutable ones - if (accessors.isEmpty) accessors = refVal.info.classSymbol.caseAccessors - val productAccessors = (1 to accessors.length).map(i => refVal.info.member(nme.productAccessorName(i)).symbol) // TODO: disambiguate - val newLocals = accessors.map(x => - // TODO: it would be nice to have an additional optimisation that - // TODO: is capable of turning those mutable ones into immutable in common cases - ctx.newSymbol(ctx.owner.enclosingMethod, (refVal.name + "$" + x.name).toTermName, Synthetic | Mutable, x.asSeenFrom(refVal.info).info.finalResultType.widenDealias) - ) - val fieldMapping = accessors zip newLocals - val productMappings = productAccessors zip newLocals - (refVal, (fieldMapping ++ productMappings).toMap) - }.toMap - val toSplit: mutable.Set[Symbol] = mutable.Set.empty ++ newMappings.keySet - - def splitWrites(t: Tree, target: Symbol): Tree = { - t match { - case tree@ Block(stats, expr) => cpy.Block(tree)(stats, splitWrites(expr, target)) - case tree@ If(_, thenp, elsep) => cpy.If(tree)(thenp = splitWrites(thenp, target), elsep = splitWrites(elsep, target)) - case Apply(sel , args) if sel.symbol.isConstructor && t.tpe.widenDealias == target.info.widenDealias.finalResultType.widenDealias => - val fieldsByAccessors = newMappings(target) - var accessors = target.info.classSymbol.caseAccessors.filter(_.isGetter) // TODO: when is this filter needed? - if (accessors.isEmpty) accessors = target.info.classSymbol.caseAccessors - val assigns = (accessors zip args) map (x => ref(fieldsByAccessors(x._1)).becomes(x._2)) - val recreate = sel.appliedToArgs(accessors.map(x => ref(fieldsByAccessors(x)))) - Block(assigns, recreate) - case Apply(fun, _) if fun.symbol.is(Label) => - t // Do nothing. It will do on its own. - case t: Ident if !t.symbol.owner.isClass && newMappings.contains(t.symbol) && t.symbol.info.classSymbol == target.info.classSymbol => - val fieldsByAccessorslhs = newMappings(target) - val fieldsByAccessorsrhs = newMappings(t.symbol) - val accessors = target.info.classSymbol.caseAccessors.filter(_.isGetter) - val assigns = accessors map (x => ref(fieldsByAccessorslhs(x)).becomes(ref(fieldsByAccessorsrhs(x)))) - Block(assigns, t) - // If `t` is itself split, push writes. - case _ => - evalOnce(t){ev => - if (ev.tpe.derivesFrom(defn.NothingClass)) ev - else { - val fieldsByAccessors = newMappings(target) - val accessors = target.info.classSymbol.caseAccessors.filter(_.isGetter) - val assigns = accessors map (x => ref(fieldsByAccessors(x)).becomes(ev.select(x))) - Block(assigns, ev) - } - } // Need to eval-once and update fields. - + // Pattern for candidates to this optimisation: ValDefs where the rhs is an + // immutable case class instantiation. + object NewCaseClassValDef { + def unapply(t: ValDef)(implicit ctx: Context): Option[(Tree, List[Tree])] = + t.rhs match { + case Apply(fun, args) + if t.symbol.info.classSymbol.is(CaseClass) && // is rhs a case class? + !t.symbol.is(Lazy | Mutable) && // is lhs a val? + !t.symbol.info.classSymbol.caseAccessors.exists(_.is(Mutable)) && // is the case class immutable? + fun.symbol.isConstructor && // is rhs a new? + t.tpe.widenDealias == t.symbol.info.finalResultType.widenDealias => // no case class inheritance or enums + Some((fun, args)) + case _ => None } - } - - def followCases(t: Symbol, limit: Int = 0): Symbol = if (t.symbol.is(Label)) { - // TODO: this can create cycles, see ./tests/pos/rbtree.scala - if (limit > 100 && limit > forwarderWritesTo.size + 1) NoSymbol - // There may be cycles in labels, that never in the end write to a valdef(the value is always on stack) - // there's not much we can do here, except finding such cases and bailing out - // there may not be a cycle bigger that hashmapSize > 1 - else followCases(forwarderWritesTo.getOrElse(t.symbol, NoSymbol), limit + 1) - } else t + } - hasPerfectRHS.clear() - // checkGood.clear() - gettersCalled.clear() + def visitor(implicit ctx: Context): Tree => Unit = { + case t @ NewCaseClassValDef(fun, args) => + candidates += t.symbol + case t @ Select(qual, _) if isImmutableAccessor(t) => + gettersCalled += qual.symbol + case _ => + } - val res: Tree => Tree = { - case ddef: DefDef if ddef.symbol.is(Label) => - newMappings.get(followCases(ddef.symbol)) match { - case Some(mappings) => - cpy.DefDef(ddef)(rhs = splitWrites(ddef.rhs, followCases(ddef.symbol))) - case _ => ddef - } - case a: ValDef if toSplit.contains(a.symbol) => - toSplit -= a.symbol - // Break ValDef apart into fields + boxed value - val newFields = newMappings(a.symbol).values.toSet - Thicket( - newFields.map(x => ValDef(x.asTerm, defaultValue(x.symbol.info.widenDealias))).toList ::: - List(cpy.ValDef(a)(rhs = splitWrites(a.rhs, a.symbol)))) - case ass: Assign => - newMappings.get(ass.lhs.symbol) match { - case None => ass - case Some(mapping) => - val updates = mapping.filter(x => x._1.is(CaseAccessor)).map(x => ref(x._2).becomes(ref(ass.lhs.symbol).select(x._1))).toList - Thicket(ass :: updates) + def transformer(implicit ctx: Context): Tree => Tree = { + initNewFieldsMapping(); + { + case t @ NewCaseClassValDef(fun, args) if newFieldsMapping.contains(t.symbol) => + val newFields = newFieldsMapping(t.symbol).values.toList + val newFieldsDefs = newFields.zip(args).map { case (nf, arg) => + val rhs = arg.changeOwnerAfter(t.symbol, nf.symbol, simplifyPhase) + ValDef(nf.asTerm, rhs) } - case t @ Select(rec, _) if (t.symbol.isGetter && !t.symbol.is(Mutable)) || - (t.symbol.maybeOwner.derivesFrom(defn.ProductClass) && t.symbol.owner.is(CaseClass) && t.symbol.name.isSelectorName) || - (t.symbol.is(CaseAccessor) && !t.symbol.is(Mutable)) => - newMappings.getOrElse(rec.symbol, Map.empty).get(t.symbol) match { - case None => t + val recreate = cpy.ValDef(t)(rhs = fun.appliedToArgs(newFields.map(x => ref(x)))) + simplify.println(s"Replacing ${t.symbol.fullName} with stack-allocated fields ($newFields)") + Thicket(newFieldsDefs :+ recreate) + + case t @ Select(rec, _) if isImmutableAccessor(t) => + newFieldsMapping.getOrElse(rec.symbol, Map.empty).get(t.symbol) match { + case None => t case Some(newSym) => ref(newSym) } + case t => t } - res } } diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/InlineOptions.scala b/compiler/src/dotty/tools/dotc/transform/localopt/InlineOptions.scala index a18b4c8a037b..ee767a37c1b7 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/InlineOptions.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/InlineOptions.scala @@ -17,8 +17,13 @@ import scala.collection.mutable class InlineOptions extends Optimisation { import ast.tpd._ - private val somes = mutable.HashMap[Symbol, Tree]() - private val nones = mutable.HashSet[Symbol]() + val somes = mutable.HashMap[Symbol, Tree]() + val nones = mutable.HashSet[Symbol]() + + def clear(): Unit = { + somes.clear() + nones.clear() + } def visitor(implicit ctx: Context): Tree => Unit = { case valdef: ValDef if !valdef.symbol.is(Mutable) && diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/Jumpjump.scala b/compiler/src/dotty/tools/dotc/transform/localopt/Jumpjump.scala index 131a0631c4ab..77fe85caf7cb 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/Jumpjump.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/Jumpjump.scala @@ -20,6 +20,8 @@ class Jumpjump extends Optimisation { val defined = mutable.HashMap[Symbol, Symbol]() + def clear(): Unit = defined.clear() + def visitor(implicit ctx: Context): Tree => Unit = { case defdef: DefDef if defdef.symbol.is(Label) => defdef.rhs match { diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/Optimisation.scala b/compiler/src/dotty/tools/dotc/transform/localopt/Optimisation.scala index f56a17368082..f52d4cf705bf 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/Optimisation.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/Optimisation.scala @@ -6,12 +6,15 @@ import ast.tpd.Tree trait Optimisation { - /** Run first to gather information on Trees (using mutation) */ + /** Gathers information on trees (using mutation), to be run first. */ def visitor(implicit ctx: Context): Tree => Unit /** Does the actual Tree => Tree transformation. */ def transformer(implicit ctx: Context): Tree => Tree + /** Clears all the state of this optimisation, to be run last. */ + def clear(): Unit + def name: String = this.getClass.getSimpleName val NoVisitor: Tree => Unit = _ => () diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/RemoveUnnecessaryNullChecks.scala b/compiler/src/dotty/tools/dotc/transform/localopt/RemoveUnnecessaryNullChecks.scala index 89811f8edb74..e2662405b176 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/RemoveUnnecessaryNullChecks.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/RemoveUnnecessaryNullChecks.scala @@ -26,6 +26,11 @@ import scala.collection.mutable val checkGood = mutable.HashMap[Symbol, Set[Symbol]]() + def clear(): Unit = { + initializedVals.clear() + checkGood.clear() + } + def isGood(t: Symbol)(implicit ctx: Context): Boolean = { t.exists && initializedVals.contains(t) && { var changed = true diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/Simplify.scala b/compiler/src/dotty/tools/dotc/transform/localopt/Simplify.scala index 5d17bf8608a5..9d38eadf4fc1 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/Simplify.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/Simplify.scala @@ -7,6 +7,7 @@ import core.Symbols._ import core.Types._ import core.Flags._ import core.Decorators._ +import core.NameOps._ import transform.TreeTransforms.{MiniPhaseTransform, TransformerInfo} import config.Printers.simplify import ast.tpd @@ -47,7 +48,7 @@ class Simplify extends MiniPhaseTransform with IdentityDenotTransformer { new Jumpjump :: new DropGoodCasts :: new DropNoEffects(this) :: - // new InlineLocalObjects :: // followCases needs to be fixed, see ./tests/pos/rbtree.scala + new InlineLocalObjects(this) :: // new Varify :: // varify could stop other transformations from being applied. postponed. // new BubbleUpNothing :: new ConstantFold(this) :: @@ -62,6 +63,8 @@ class Simplify extends MiniPhaseTransform with IdentityDenotTransformer { new ConstantFold(this) :: Nil + var optimisations: List[Optimisation] = Nil + /** Optimisation fuel, for debugging. Decremented every time Simplify * applies an optimisation until fuel == 0. Original idea from Automatic * Isolation of Compiler Errors by David Whalley. Unable with -Yopt-fuel. @@ -75,9 +78,17 @@ class Simplify extends MiniPhaseTransform with IdentityDenotTransformer { override def prepareForUnit(tree: Tree)(implicit ctx: Context) = { SeqFactoryClass = ctx.requiredClass("scala.collection.generic.SeqFactory") CommutativePrimitiveOperations = Set(defn.Boolean_&&, defn.Boolean_||, defn.Int_+, defn.Int_*, defn.Long_+, defn.Long_*) + val maxFuel = ctx.settings.YoptFuel.value if (fuel < 0 && maxFuel > 0) // Both defaults are at -1 fuel = maxFuel + + optimisations = { + val o = if (ctx.erasedTypes) afterErasure else beforeErasure + val p = ctx.settings.YoptPhases.value + if (p.isEmpty) o else o.filter(x => p.contains(x.name)) + } + this } @@ -86,18 +97,11 @@ class Simplify extends MiniPhaseTransform with IdentityDenotTransformer { val ctx0 = ctx if (ctx.settings.optimise.value && !tree.symbol.is(Label)) { implicit val ctx: Context = ctx0.withOwner(tree.symbol(ctx0)) - val optimisations = { - val o = if (ctx.erasedTypes) afterErasure else beforeErasure - val p = ctx.settings.YoptPhases.value - if (p.isEmpty) o else o.filter(x => p.contains(x.name)) - } - var rhs0 = tree.rhs var rhs1: Tree = null while (rhs1 ne rhs0) { rhs1 = rhs0 - val context = ctx.withOwner(tree.symbol) - optimisations.foreach { optimisation => // TODO: fuse for performance + optimisations.foreach { optimisation => // Visit rhs0.foreachSubTree(optimisation.visitor) @@ -109,6 +113,9 @@ class Simplify extends MiniPhaseTransform with IdentityDenotTransformer { printIfDifferent(childOptimizedTree, optimisation.transformer(ctx)(childOptimizedTree), optimisation) } }.transform(rhs0) + + // Clean + optimisation.clear() } } if (rhs0 ne tree.rhs) tpd.cpy.DefDef(tree)(rhs = rhs0) @@ -122,14 +129,16 @@ class Simplify extends MiniPhaseTransform with IdentityDenotTransformer { else if (fuel == 0) tree1 // No more fuel? No more transformations for you! else { // Print the trees if different and consume fuel accordingly. - if (tree1 ne tree2) { - if (fuel > 0) fuel -= 1 - if (fuel != -1) { + val t2 = tree2 + if (tree1 ne t2) { + if (fuel > 0) + fuel -= 1 + if (fuel != -1 && fuel < 5) { println(s"${tree1.symbol} was simplified by ${opt.name} (fuel=$fuel): ${tree1.show}") - println(s"became after ${opt.name}: (fuel=$fuel) ${tree2.show}") + println(s"became after ${opt.name}: (fuel=$fuel) ${t2.show}") } } - tree2 + t2 } } } @@ -157,4 +166,15 @@ object Simplify { case i: Ident => desugarIdent(i).exists(isEffectivelyMutable) case _ => false } + + def isImmutableAccessor(t: Tree)(implicit ctx: Context): Boolean = { + val isImmutableGetter = t.symbol.isGetter && !t.symbol.is(Mutable | Lazy) + val isCaseAccessor = t.symbol.is(CaseAccessor) && !t.symbol.is(Mutable | Lazy) + val isProductAccessor = t.symbol.exists && + t.symbol.owner.derivesFrom(defn.ProductClass) && + t.symbol.owner.is(CaseClass) && + t.symbol.name.isSelectorName && + !t.symbol.info.decls.exists(_.is(Mutable | Lazy)) // Conservatively covers case class A(var x: Int) + isImmutableGetter || isCaseAccessor || isProductAccessor + } } diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/Valify.scala b/compiler/src/dotty/tools/dotc/transform/localopt/Valify.scala index 8b6d31e5bc9f..7f463c4d5362 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/Valify.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/Valify.scala @@ -24,6 +24,13 @@ class Valify(val simplifyPhase: Simplify) extends Optimisation { val secondWrite: mutable.Map[Symbol, Assign] = mutable.Map() + def clear(): Unit = { + defined.clear() + firstRead.clear() + firstWrite.clear() + secondWrite.clear() + } + def visitor(implicit ctx: Context): Tree => Unit = { case t: ValDef if t.symbol.is(Mutable, Lazy) && !t.symbol.is(Method) && !t.symbol.owner.isClass => if (isPureExpr(t.rhs)) diff --git a/compiler/src/dotty/tools/dotc/transform/localopt/Varify.scala b/compiler/src/dotty/tools/dotc/transform/localopt/Varify.scala index c584f7bac100..19a53d4496a8 100644 --- a/compiler/src/dotty/tools/dotc/transform/localopt/Varify.scala +++ b/compiler/src/dotty/tools/dotc/transform/localopt/Varify.scala @@ -31,6 +31,11 @@ import scala.collection.mutable val possibleRenames = mutable.HashMap[Symbol, Set[Symbol]]() + def clear(): Unit = { + paramsTimesUsed.clear() + possibleRenames.clear() + } + def visitor(implicit ctx: Context): Tree => Unit = { case t: ValDef if t.symbol.is(Param) => paramsTimesUsed += (t.symbol -> 0) diff --git a/compiler/test/dotty/tools/dotc/SimplifyTests.scala b/compiler/test/dotty/tools/dotc/SimplifyTests.scala index f22e515a31d2..f309aa14e1e0 100644 --- a/compiler/test/dotty/tools/dotc/SimplifyTests.scala +++ b/compiler/test/dotty/tools/dotc/SimplifyTests.scala @@ -76,11 +76,7 @@ abstract class SimplifyTests(val optimise: Boolean) extends DottyBytecodeTest { |print(Tuple2.unapply(t)) """, """ - |val t = Tuple2(1, "s") - |print({ - | Tuple2 // TODO: teach Simplify that initializing Tuple2 has no effect - | new Some(new Tuple2(t._1, t._2)) - |}) + |print(new Some(new Tuple2(1, "s"))) """) @Test def constantFold = @@ -97,20 +93,84 @@ abstract class SimplifyTests(val optimise: Boolean) extends DottyBytecodeTest { @Test def dropNoEffects = check( """ - |"wow" + |val a = "wow" |print(1) """, """ |print(1) """) - // @Test def inlineOptions = + @Test def dropNoEffectsTuple = + check("new Tuple2(1, 3)", "") + + @Test def inlineLocalObjects = + check( + """ + |val t = new Tuple2(1, 3) + |print(t._1 + t._2) + """, + """ + |val i = 3 + |print(1 + i) // Prevents typer from constant folding 1 + 3 to 4 + """) + + @Test def inlineOptions = + check( + """ + |val sum = Some("s") + |println(sum.isDefined) + """, + """ + |println(true) + """) + + // @Test def listPatmapExample = + // check( + // """ + // |val l = 1 :: 2 :: Nil + // |l match { + // | case Nil => print("nil") + // | case x :: xs => print(x) + // |} + // """, + // """TODO + // """) + + // @Test def fooCCExample = + // check( + // source = + // """ + // |val x: Any = new Object {} + // |val (a, b) = x match { + // | case CC(s @ 1, CC(t, _)) => + // | (s , 2) + // | case _ => (42, 43) + // |} + // |a + b + // """, + // expected = + // """TODO + // """, + // shared = "case class CC(a: Int, b: Object)") + + // @Test def booleansFunctionExample = // check( // """ - // |val sum = Some("s") - // |println(sum.isDefined) + // |val a: Any = new Object {} + // |val (b1, b2) = (a.isInstanceOf[String], a.isInstanceOf[List[Int]]) + // |(b1, b2) match { + // | case (true, true) => true + // | case (false, false) => true + // | case _ => false + // |} // """, // """ - // |println(true) + // |val a: Any = new Object {} + // |val bl = a.isInstanceOf[List[_]] + // |val bl2 = a.isInstanceOf[String] + // |if (true == bl2 && true == bl) + // | true + // |else + // | false == bl2 && false == bl // """) }