Merge pull request #850 from melt-umn/feature/forward-parent

Support referencing forwardParent

grammars/silver/compiler/definition/core/Expr.sv

@@ -266,6 +266,18 @@ top::Expr ::= q::'forward'
   forwards to baseExpr(qName("forward"));
 }
 
+concrete production forwardParentReference
+top::Expr ::= 'forwardParent'
+{
+  top.unparse = "forwardParent";
+
+  top.typerep = top.frame.signature.outputElement.typerep.asNtOrDecType;
+  top.errors <-
+    if !any(map((.elementShared), top.frame.signature.inputElements))
+    then [errFromOrigin(top, "This production has no shared children and is not known to be the target of forwarding.")]
+    else [];
+}
+
 concrete production application
 top::Expr ::= e::Expr '(' es::AppExprs ',' anns::AnnoAppExprs ')'
 {

grammars/silver/compiler/definition/core/Terminals.sv

@@ -43,6 +43,7 @@ terminal End_kwd         'end'          lexer classes {KEYWORD,RESERVED};
 terminal Forwarding_kwd  'forwarding'   lexer classes {KEYWORD,RESERVED};
 terminal Forward_kwd     'forward'      lexer classes {KEYWORD,RESERVED};
 terminal Forwards_kwd    'forwards'     lexer classes {KEYWORD,RESERVED};
+terminal ForwardParent_kwd 'forwardParent' lexer classes {KEYWORD,RESERVED};
 terminal Function_kwd    'function'     lexer classes {KEYWORD,RESERVED};
 terminal Global_kwd      'global'       lexer classes {KEYWORD,RESERVED};
 terminal If_kwd          'if'           lexer classes {KEYWORD,RESERVED};

grammars/silver/compiler/definition/flow/ast/Vertex.sv

@@ -129,3 +129,6 @@ fun forwardEqVertex FlowVertex ::= = localEqVertex("forward");
 -- An attribute on the forward node for this production
 fun forwardSynVertex FlowVertex ::= attrName::String = localSynVertex("forward", attrName);
 fun forwardInhVertex FlowVertex ::= attrName::String = localInhVertex("forward", attrName);
+
+-- An attribute on the production that forwarded to this one
+fun forwardParentSynVertex FlowVertex ::= attrName::String = localSynVertex("forwardParent", attrName);

grammars/silver/compiler/definition/flow/ast/VertexType.sv

@@ -109,6 +109,20 @@ top::VertexType ::=
   top.eqVertex = [forwardEqVertex_singleton];
 }
 
+abstract production forwardParentVertexType
+top::VertexType ::=
+{
+  top.vertexName = "forwardParent";
+  top.vertexPP = "forward parent";
+  top.isInhDefVertex = false;
+  top.synVertex = forwardParentSynVertex;
+  top.inhVertex = lhsInhVertex;
+  -- The forward of the forward parent is the LHS of this production, which doesn't have a vertex!
+  -- This should never really be consulted in practice.
+  top.fwdVertex = localEqVertex("__lhs");
+  top.eqVertex = [];
+}
+
 {--
  - Represents the vertexes for anonymous vertex types somewhere within a production (e.g. 'decorate with' expressions).
  -}

grammars/silver/compiler/definition/flow/driver/ProductionGraph.sv

@@ -156,7 +156,7 @@ ProductionGraph ::= dcl::ValueDclInfo  flowEnv::FlowEnv  realEnv::Env
   local inhs :: [String] = getInhAndInhOnTransAttrsOn(nt, realEnv);
   -- Does this production forward?
   local nonForwarding :: Boolean = null(lookupFwd(prod, flowEnv));
-    
+
   -- Normal edges!
   local normalEdges :: [(FlowVertex, FlowVertex)] =
     flatMap((.flowEdges), defs);
@@ -196,7 +196,13 @@ ProductionGraph ::= dcl::ValueDclInfo  flowEnv::FlowEnv  realEnv::Env
         dcl.namedSignature.inputElements,
         sig.inputElements))
     | nothing() -> []
-    end;
+    end ++
+    if any(map((.elementShared), dcl.namedSignature.inputElements))
+    -- TODO: We could be more precise here by only considering the productions
+    -- that could have actually forwarded to this one. But that would require
+    -- introducing a new sort of stitch point.
+    then nonterminalStitchPoints(realEnv, nt, forwardParentVertexType())
+    else [];
 
   local flowTypeVertexesOverall :: [FlowVertex] =
     (if nonForwarding then [] else [forwardEqVertex()]) ++
@@ -366,6 +372,14 @@ ProductionGraph ::= nt::String  flowEnv::FlowEnv  realEnv::Env
   return productionGraph("Phantom for " ++ nt, nt, flowTypeVertexes, initialGraph, suspectEdges, stitchPoints).transitiveClosure;
 }
 
+{--
+ - Constructs a graph for a dispatch signature.
+ -
+ - @param ns  The dispatch signature
+ - @param flowEnv  A full flow environment (need to find uses and impls of this sig)
+ - @param realEnv  A full real environment (need to find out original signature and what inhs occur for stitch points)
+ - @return A fixed up graph.
+ -}
 function constructDispatchGraph
 ProductionGraph ::= ns::NamedSignature  flowEnv::FlowEnv  realEnv::Env
 {

grammars/silver/compiler/definition/flow/env/Expr.sv

@@ -151,6 +151,19 @@ top::Expr ::= @q::QName
     then just(forwardVertexType)
     else nothing();
 }
+aspect production forwardParentReference
+top::Expr ::= 'forwardParent'
+{
+  production refSet::Maybe<[String]> = getMaxRefSet(top.finalType, top.env);
+  top.flowDeps <-
+    if top.finalType.isDecorated
+    then map(forwardParentVertexType().inhVertex, fromMaybe([], refSet))
+    else [];
+  top.flowVertexInfo =
+    if top.finalType.isDecorated
+    then just(forwardParentVertexType())
+    else nothing();
+}
 
 -- The named signature of the applied production.
 -- Note that we don't project functions at the moment, since we don't build function flow graphs during inference.

grammars/silver/compiler/definition/flow/env/FlowEnv.sv

@@ -141,6 +141,7 @@ fun vertexHasInhEq Boolean ::= prodName::String  vt::VertexType  attrName::Strin
   -- but here we are remotely looking for equations that might not be the direct dependency of
   -- anything in the prod flow graph.
   | lhsVertexType_real() -> false  -- Shouldn't ever be directly needed, since the LHS is never the dec site for another vertex.
+  | forwardParentVertexType() -> false  -- Same as LHS - the thing that forwared to us.
   | forwardVertexType_real() -> false  -- Same as LHS, but we can check this if e.g. forwarding to a child.
   end;
 
@@ -164,6 +165,7 @@ fun countVertexEqs Integer ::= prodName::String  vt::VertexType  attrName::Strin
   | anonVertexType(fName) -> length(lookupLocalInh(prodName, fName, attrName, flowEnv))
   | subtermVertexType(_, remoteProdName, sigName) -> 0
   | lhsVertexType_real() -> length(lookupSyn(prodName, attrName, flowEnv))
+  | forwardParentVertexType() -> 0
   | forwardVertexType_real() -> length(lookupFwdInh(prodName, attrName, flowEnv))
   end;
 

grammars/silver/compiler/extension/implicit_monads/Expr.sv

@@ -170,6 +170,17 @@ top::Expr ::= @q::QName
   top.monadRewritten = baseExpr(new(q));
 }
 
+aspect production forwardParentReference
+top::Expr ::= 'forwardParent'
+{
+  top.merrors := [];
+  propagate mDownSubst, mUpSubst;
+  -- An LHS (and thus, forward parent) is *always* a decorable (nonterminal) type.
+  top.mtyperep = top.typerep;
+  top.monadicNames = [];
+  top.monadRewritten = top;
+}
+
 aspect production application
 top::Expr ::= e::Expr '(' es::AppExprs ',' anns::AnnoAppExprs ')'
 {

grammars/silver/compiler/translation/java/core/Expr.sv

@@ -147,6 +147,16 @@ top::Expr ::= @q::QName
   top.lazyTranslation = wrapThunk(top.translation, top.frame.lazyApplication);
 }
 
+aspect production forwardParentReference
+top::Expr ::= 'forwardParent'
+{
+  top.translation =
+    if top.finalType.isDecorated
+    then "context.getForwardParent()"
+    else s"((${top.finalType.transType})context.getForwardParent().undecorate())";
+  top.lazyTranslation = top.translation;  -- Must have already been evaluated
+}
+
 aspect production productionReference
 top::Expr ::= @q::QName
 {

grammars/silver/compiler/translation/java/core/NamedSignature.sv

@@ -351,6 +351,7 @@ fun refAccessTranslation String ::= env::Env flowEnv::FlowEnv lhsNtName::String
     end
   | transAttrVertexType(_, transAttr) -> error("trans attr on non-lhs can't be a ref decoration site")
   | forwardVertexType_real() -> s"context.forward()"
+  | forwardParentVertexType() -> error("forward parent shouldn't be a ref decoration site")
   | anonVertexType(_) -> error("dec site projection shouldn't happen with anon decorate")
   | subtermVertexType(parent, prodName, sigName) ->
     -- prodName is either a production or dispatch signature name

test/silver_features/TreeSharing.sv

@@ -81,7 +81,23 @@ top::UDExpr ::= @e::UDExpr
   top.errors2 = e2.errors2;
 }
 
-global udTerm::UDExpr = udOp1(udOp2(udOp3(udOp4(udVar("foo")))));
+production udOp5
+top::UDExpr ::= e::UDExpr
+{
+  e.env1 = top.env1;
+  top.errors1 = e.errors1;
+  forwards to udOp5Impl(e);
+}
+
+production udOp5Impl
+top::UDExpr ::= @e::UDExpr
+{
+  e.env2 = forwardParent.env2;
+  top.errors1 = forwardParent.errors1;
+  top.errors2 = e.errors2;
+}
+
+global udTerm::UDExpr = udOp1(udOp2(udOp3(udOp4(udOp5(udVar("foo"))))));
 equalityTest(decorate udTerm with { env1 = ["foo"]; env2 = ["foo"]; }.errors1, false, Boolean, silver_tests);
 equalityTest(decorate udTerm with { env1 = ["foo"]; env2 = ["foo"]; }.errors2, false, Boolean, silver_tests);
 equalityTest(decorate udTerm with { env1 = ["foo"]; env2 = []; }.errors1, false, Boolean, silver_tests);