From: Hannu Niemistö <hannu.niemisto@semantum.fi>
Date: Fri, 21 Jul 2017 13:22:19 +0000 (+0300)
Subject: CHR query translation and support for assignment in CHR bodies
X-Git-Tag: v1.31.0~264^2~41^2
X-Git-Url: https://gerrit.simantics.org/r/gitweb?p=simantics%2Fplatform.git;a=commitdiff_plain;h=f68216dcf2f9c186211bc38847cdea345b5a0635

CHR query translation and support for assignment in CHR bodies

refs #7377

Change-Id: Ia9adf1cf52670c7a5de50210d7c155ff8bc4bf8d
---

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRLiteral.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRLiteral.java
index e7b3320d7..918dd9fb3 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRLiteral.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRLiteral.java
@@ -47,6 +47,11 @@ public class CHRLiteral extends Symbol {
     }
 
     public void resolve(TranslationContext context) {
+        if(relation == SpecialCHRRelation.ASSIGN) {
+            parameters[1] = parameters[1].resolve(context);
+            parameters[0] = parameters[0].resolveAsPattern(context);
+            return;
+        }
         if(parameters != null) {
             for(int i=0;i<parameters.length;++i)
                 parameters[i] = parameters[i].resolve(context);
@@ -123,6 +128,11 @@ public class CHRLiteral extends Symbol {
             parameters[0] = parameters[0].checkIgnoredType(context);
             typeConstraintEvidenceParameters = Expression.EMPTY_ARRAY;
         }
+        else if(relation == SpecialCHRRelation.ASSIGN) {
+            parameters[1] = parameters[1].inferType(context);
+            parameters[0] = parameters[0].checkTypeAsPattern(context, parameters[1].getType());
+            typeConstraintEvidenceParameters = Expression.EMPTY_ARRAY;
+        }
         else {
             TVar[] typeVariables = relation.getTypeVariables();
             typeParameters = typeVariables.length == 0 ? Type.EMPTY_ARRAY : new Type[typeVariables.length];
@@ -156,11 +166,16 @@ public class CHRLiteral extends Symbol {
     }
 
     public void collectFreeVariables(THashSet<Variable> vars) {
-        for(Expression parameter : parameters)
-            parameter.collectFreeVariables(vars);
-        if(typeConstraintEvidenceParameters != null)
-            for(Expression parameter : typeConstraintEvidenceParameters)
+        if(relation == SpecialCHRRelation.ASSIGN) {
+            parameters[1].collectFreeVariables(vars);
+        }
+        else {
+            for(Expression parameter : parameters)
                 parameter.collectFreeVariables(vars);
+            if(typeConstraintEvidenceParameters != null)
+                for(Expression parameter : typeConstraintEvidenceParameters)
+                    parameter.collectFreeVariables(vars);
+        }
     }
 
     public void setLocationDeep(long loc) {
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRQuery.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRQuery.java
index 70559d18f..4e5670fcd 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRQuery.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRQuery.java
@@ -4,6 +4,7 @@ import org.simantics.scl.compiler.elaboration.chr.plan.PostCommitOp;
 import org.simantics.scl.compiler.elaboration.chr.plan.PreCommitOp;
 import org.simantics.scl.compiler.elaboration.chr.planning.QueryPlanningContext;
 import org.simantics.scl.compiler.elaboration.chr.relations.CHRConstraint;
+import org.simantics.scl.compiler.elaboration.chr.relations.SpecialCHRRelation;
 import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
@@ -54,6 +55,9 @@ public class CHRQuery extends Symbol {
     public void collectFreeVariables(THashSet<Variable> vars) {
         for(CHRLiteral literal : literals)
             literal.collectFreeVariables(vars);
+        for(CHRLiteral literal : literals)
+            if(literal.relation == SpecialCHRRelation.ASSIGN)
+                literal.parameters[0].removeFreeVariables(vars);
     }
 
     public void setLocationDeep(long loc) {
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstAtom.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstAtom.java
index 031d8edd8..7b5f4ffa6 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstAtom.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstAtom.java
@@ -86,11 +86,16 @@ public class CHRAstAtom extends CHRAstQuery {
     }
 
     @Override
-    protected void translate(TranslationContext context, boolean isHead, ArrayList<CHRLiteral> literals) {
-        literals.add(
-            isConstraint(context, expression) ?
-            convertConstraint(remove, expression) :
-            convertExpression(isHead, expression));
+    protected void translate(TranslationContext context, CHRQueryTranslationMode mode, ArrayList<CHRLiteral> literals) {
+        if(isConstraint(context, expression)) {
+            literals.add(convertConstraint(remove, expression));
+        }
+        else {
+            if(remove)
+                context.getErrorLog().log(location, "Only constraints can be marked for removal");
+            else
+                literals.add(convertExpression(mode, expression));
+        }
     }
     
     private static boolean isConstraint(TranslationContext context, Expression expression) {
@@ -110,8 +115,8 @@ public class CHRAstAtom extends CHRAstQuery {
         }
     }
     
-    private static CHRLiteral convertExpression(boolean isHead, Expression expression) {
-        if(isHead)
+    private static CHRLiteral convertExpression(CHRQueryTranslationMode mode, Expression expression) {
+        if(mode.isHead)
             return new CHRLiteral(expression.location, SpecialCHRRelation.CHECK, new Expression[] {expression}, false, false);
         else
             return new CHRLiteral(expression.location, SpecialCHRRelation.EXECUTE, new Expression[] {expression}, false, false);
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstBinds.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstBinds.java
index aa78f4e98..2f2654c12 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstBinds.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstBinds.java
@@ -22,7 +22,7 @@ public class CHRAstBinds extends CHRAstQuery {
     }
     
     @Override
-    protected void translate(TranslationContext context, boolean isHead, ArrayList<CHRLiteral> literals) {
+    protected void translate(TranslationContext context, CHRQueryTranslationMode mode, ArrayList<CHRLiteral> literals) {
         literals.add(new CHRLiteral(location, SpecialCHRRelation.MEMBER,
                 new Expression[] { left, right }, false, false));
     }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstConjunction.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstConjunction.java
index 48f8ae71f..1aadb6978 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstConjunction.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstConjunction.java
@@ -33,8 +33,8 @@ public class CHRAstConjunction extends CHRAstQuery {
     }
 
     @Override
-    protected void translate(TranslationContext context, boolean isHead, ArrayList<CHRLiteral> literals) {
+    protected void translate(TranslationContext context, CHRQueryTranslationMode mode, ArrayList<CHRLiteral> literals) {
         for(CHRAstQuery conjunct : conjuncts)
-            conjunct.translate(context, isHead, literals);
+            conjunct.translate(context, mode, literals);
     }
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstEquals.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstEquals.java
index d2828934f..6c5e6e87d 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstEquals.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstEquals.java
@@ -22,8 +22,8 @@ public class CHRAstEquals extends CHRAstQuery {
     }
 
     @Override
-    protected void translate(TranslationContext context, boolean isHead, ArrayList<CHRLiteral> literals) {
-        literals.add(new CHRLiteral(location, SpecialCHRRelation.EQUALS,
+    protected void translate(TranslationContext context, CHRQueryTranslationMode mode, ArrayList<CHRLiteral> literals) {
+        literals.add(new CHRLiteral(location, mode.isHead ? SpecialCHRRelation.EQUALS : SpecialCHRRelation.ASSIGN,
                 new Expression[] { left, right }, false, false));
     }
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstNegation.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstNegation.java
index b97f1e7f7..4f73d666b 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstNegation.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstNegation.java
@@ -18,7 +18,7 @@ public class CHRAstNegation extends CHRAstQuery {
     }
 
     @Override
-    protected void translate(TranslationContext context, boolean isHead, ArrayList<CHRLiteral> literals) {
+    protected void translate(TranslationContext context, CHRQueryTranslationMode mode, ArrayList<CHRLiteral> literals) {
         context.getCompilationContext().errorLog.log(location, "CHR negation is not yet supported.");
     }
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstQuery.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstQuery.java
index bd708e690..e655c78e7 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstQuery.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRAstQuery.java
@@ -8,21 +8,13 @@ import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 import org.simantics.scl.compiler.internal.parsing.Symbol;
 
 public abstract class CHRAstQuery extends Symbol {
-    public CHRQuery translateAsHead(TranslationContext context) {
-        return translate(context, true);
-    }
-    
-    public CHRQuery translateAsBody(TranslationContext context) {
-        return translate(context, false);
-    }
-
-    private CHRQuery translate(TranslationContext context, boolean isHead) {
+    public CHRQuery translate(TranslationContext context, CHRQueryTranslationMode mode) {
         ArrayList<CHRLiteral> literals = new ArrayList<CHRLiteral>(); 
-        translate(context, isHead, literals);
+        translate(context, mode, literals);
         return new CHRQuery(literals.toArray(new CHRLiteral[literals.size()]));
     }
 
-    protected abstract void translate(TranslationContext context, boolean isHead, ArrayList<CHRLiteral> literals);
+    protected abstract void translate(TranslationContext context, CHRQueryTranslationMode mode, ArrayList<CHRLiteral> literals);
 
     public abstract void accept(CHRAstQueryVisitor visitor);
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRQueryTranslationMode.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRQueryTranslationMode.java
new file mode 100644
index 000000000..483c028c2
--- /dev/null
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/ast/CHRQueryTranslationMode.java
@@ -0,0 +1,13 @@
+package org.simantics.scl.compiler.elaboration.chr.ast;
+
+public enum CHRQueryTranslationMode {
+    RULE_HEAD(true),
+    QUERY_HEAD(true),
+    RULE_BODY(false);
+    
+    public final boolean isHead;
+
+    private CHRQueryTranslationMode(boolean isHead) {
+        this.isHead = isHead;
+    }
+}
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/planning/QueryPlanningContext.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/planning/QueryPlanningContext.java
index 61503458c..56d436f55 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/planning/QueryPlanningContext.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/planning/QueryPlanningContext.java
@@ -8,6 +8,7 @@ import org.simantics.scl.compiler.elaboration.chr.CHRLiteral;
 import org.simantics.scl.compiler.elaboration.chr.plan.AccessFactOp;
 import org.simantics.scl.compiler.elaboration.chr.plan.ClaimOp;
 import org.simantics.scl.compiler.elaboration.chr.plan.ExecuteOp;
+import org.simantics.scl.compiler.elaboration.chr.plan.MatchOp;
 import org.simantics.scl.compiler.elaboration.chr.plan.PlanOp;
 import org.simantics.scl.compiler.elaboration.chr.planning.items.CheckPrePlanItem;
 import org.simantics.scl.compiler.elaboration.chr.planning.items.EqualsPrePlanItem;
@@ -65,6 +66,8 @@ public class QueryPlanningContext {
             case MEMBER:
                 addMember(literal.location, literal.parameters[0], literal.parameters[1], secondaryPriority);
                 return;
+            case ASSIGN:
+                throw new InternalCompilerError(literal.location, "ASSIGN constraint is not allowed in query compilation.");
             case EXECUTE:
                 throw new InternalCompilerError(literal.location, "EXECUTE constraint is not allowed in query compilation.");
             }
@@ -239,6 +242,9 @@ public class QueryPlanningContext {
             case EXECUTE:
                 addPlanOp(new ExecuteOp(literal.location, literal.parameters[0]));
                 break;
+            case ASSIGN:
+                addPlanOp(new MatchOp(literal.location, literal.parameters[1], literal.parameters[0]));
+                break;
             default:
                 context.getCompilationContext().errorLog.log(
                         literal.location,
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/SpecialCHRRelation.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/SpecialCHRRelation.java
index c5dbe3c41..52da4cfe0 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/SpecialCHRRelation.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/SpecialCHRRelation.java
@@ -7,10 +7,11 @@ import org.simantics.scl.compiler.types.Type;
 import org.simantics.scl.compiler.types.Types;
 
 public enum SpecialCHRRelation implements CHRRelation {    
-    EQUALS(A, A),
-    MEMBER(A, Types.list(A)),
-    CHECK(Types.BOOLEAN),
-    EXECUTE(Types.UNIT);
+    EQUALS(A, A), // only in head
+    ASSIGN(A, A), // only in body
+    MEMBER(A, Types.list(A)), // only in head
+    CHECK(Types.BOOLEAN), // only in head
+    EXECUTE(Types.UNIT); // only in body
     
     private final TVar[] typeVariables;
     private final Type[] parameterTypes;
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBlock.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBlock.java
index e184b1397..b7f943c07 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBlock.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EBlock.java
@@ -5,6 +5,7 @@ import java.util.List;
 
 import org.simantics.scl.compiler.elaboration.chr.CHRRule;
 import org.simantics.scl.compiler.elaboration.chr.CHRRuleset;
+import org.simantics.scl.compiler.elaboration.chr.ast.CHRQueryTranslationMode;
 import org.simantics.scl.compiler.elaboration.chr.translation.CHRTranslation;
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 import org.simantics.scl.compiler.elaboration.expressions.block.CHRStatement;
@@ -95,7 +96,9 @@ public class EBlock extends ASTExpression {
             Statement statement = statements.get(i);
             if(statement instanceof CHRStatement) {
                 CHRStatement chrStatement = (CHRStatement)statement;
-                ruleset.addRule(new CHRRule(chrStatement.location, chrStatement.head.translateAsHead(context), chrStatement.body.translateAsBody(context)));
+                ruleset.addRule(new CHRRule(chrStatement.location,
+                        chrStatement.head.translate(context, CHRQueryTranslationMode.RULE_HEAD),
+                        chrStatement.body.translate(context, CHRQueryTranslationMode.RULE_BODY)));
             }
             else if(statement instanceof ConstraintStatement)
                 ruleset.constraints.add(CHRTranslation.convertConstraintStatement(context, (ConstraintStatement)statement));
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EPreCHRSelect.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EPreCHRSelect.java
index 371ffbf72..318a407f5 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EPreCHRSelect.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EPreCHRSelect.java
@@ -1,6 +1,7 @@
 package org.simantics.scl.compiler.elaboration.expressions;
 
 import org.simantics.scl.compiler.elaboration.chr.ast.CHRAstQuery;
+import org.simantics.scl.compiler.elaboration.chr.ast.CHRQueryTranslationMode;
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 
 public class EPreCHRSelect extends ASTExpression {
@@ -14,6 +15,6 @@ public class EPreCHRSelect extends ASTExpression {
 
     @Override
     public Expression resolve(TranslationContext context) {
-        return new ECHRSelect(expression, query.translateAsHead(context)).resolve(context);
+        return new ECHRSelect(expression, query.translate(context, CHRQueryTranslationMode.QUERY_HEAD)).resolve(context);
     }
 }
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
index 5403dbf27..aa3b764e8 100644
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/ModuleRegressionTests.java
@@ -34,6 +34,7 @@ public class ModuleRegressionTests extends TestBase {
     @Test public void CHR10() { test(); }
     @Test public void CHR11() { test(); }
     @Test public void CHR12() { test(); }
+    @Test public void CHR13() { test(); }
     @Test public void CHRSelect1() { test(); }
     @Test public void CHRSelect2() { test(); }
     @Test public void CHRSelect3() { test(); }
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR13.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR13.scl
new file mode 100644
index 000000000..597c0016e
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR13.scl
@@ -0,0 +1,16 @@
+module { export = [main], features = [chr] }
+import "Prelude"
+
+main = ()
+  where
+    when Foo ?x
+    then y = ?x + 1 :: Integer
+         print y
+    
+    when True
+    then Foo 1
+         Foo 2
+--
+3
+2
+()
\ No newline at end of file