From: Hannu Niemistö <hannu.niemisto@semantum.fi>
Date: Sun, 4 Jun 2017 11:49:30 +0000 (+0300)
Subject: (refs #7250) Support for record syntax for CHR relations
X-Git-Tag: v1.31.0~339^2
X-Git-Url: https://gerrit.simantics.org/r/gitweb?a=commitdiff_plain;h=6d233d1b05176e40f634766537082d2a2ec65fd0;p=simantics%2Fplatform.git

(refs #7250) Support for record syntax for CHR relations

Change-Id: I8dd80eb5216a1b6023ab9097af58d4f1aaa077b2
---

diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/compilation/Elaboration.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/compilation/Elaboration.java
index 359448e1d..fccf26815 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/compilation/Elaboration.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/compilation/Elaboration.java
@@ -376,7 +376,7 @@ public class Elaboration {
             dataTypes.add(dataType);
             for(int j=0;j<constructors.length;++j) {
                 ConstructorAst constructor = dataTypeAst.constructors[j];
-                String name = constructor.name;
+                String name = constructor.name.text;
                 Type[] parameterTypes = new Type[constructor.parameters.length];
                 for(int i=constructor.parameters.length-1;i>=0;--i)
                     parameterTypes[i] = context.toType(constructor.parameters[i]);
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 b34328a53..7b4a5bc26 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
@@ -7,11 +7,14 @@ import org.simantics.scl.compiler.elaboration.chr.relations.SpecialCHRRelation;
 import org.simantics.scl.compiler.elaboration.chr.relations.UnresolvedCHRRelation;
 import org.simantics.scl.compiler.elaboration.contexts.SimplificationContext;
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
+import org.simantics.scl.compiler.elaboration.contexts.TranslationContext.ExistentialFrame;
 import org.simantics.scl.compiler.elaboration.contexts.TypingContext;
+import org.simantics.scl.compiler.elaboration.expressions.ERecord;
 import org.simantics.scl.compiler.elaboration.expressions.Expression;
 import org.simantics.scl.compiler.elaboration.expressions.Variable;
 import org.simantics.scl.compiler.elaboration.expressions.VariableProcedure;
 import org.simantics.scl.compiler.elaboration.expressions.printing.ExpressionToStringVisitor;
+import org.simantics.scl.compiler.elaboration.expressions.records.FieldAssignment;
 import org.simantics.scl.compiler.elaboration.relations.SCLRelation;
 import org.simantics.scl.compiler.errors.Locations;
 import org.simantics.scl.compiler.internal.parsing.Symbol;
@@ -29,6 +32,7 @@ public class CHRLiteral extends Symbol {
     public CHRRelation relation;
     public Type[] typeParameters;
     public Expression[] parameters;
+    public FieldAssignment[] fields; // optional
     public Expression[] typeConstraintEvidenceParameters;
     public boolean killAfterMatch;
     public boolean negated;
@@ -55,6 +59,10 @@ public class CHRLiteral extends Symbol {
                 if(sclRelation != null)
                     relation = new ExternalCHRRelation(sclRelation);
                 else {
+                    if(parameters == null) {
+                        context.getErrorLog().log(location, "Relation must be declared if record syntax is used.");
+                        return;
+                    }
                     Type[] parameterTypes = new Type[parameters.length];
                     for(int i=0;i<parameterTypes.length;++i)
                         parameterTypes[i] = Types.metaVar(Kinds.STAR);
@@ -67,8 +75,33 @@ public class CHRLiteral extends Symbol {
                 }
             }
         }
-        for(int i=0;i<parameters.length;++i)
-            parameters[i] = parameters[i].resolve(context);
+        if(parameters == null && fields != null) {
+            String[] fieldNames = relation.getFieldNames();
+            if(fieldNames == null) {
+                context.getErrorLog().log(location, "Relation " + relation + " does not define field names.");
+                return;
+            }
+            parameters = ERecord.translateFieldsToFunctionParameters(context, fields, fieldNames);
+            if(parameters == null)
+                return;
+            for(int i=0;i<parameters.length;++i) {
+                Expression parameter = parameters[i];
+                if(parameter == null) {
+                    ExistentialFrame frame = context.getCurrentExistentialFrame();
+                    if(frame == null || frame.disallowNewExistentials)
+                        context.getErrorLog().log(location, "Field " + fieldNames[i] + " not defined.");
+                    else
+                        parameters[i] = frame.createBlank(location);
+                }
+                else
+                    parameters[i] = parameters[i].resolve(context);
+            }
+            fields = null;
+        }
+        else {
+            for(int i=0;i<parameters.length;++i)
+                parameters[i] = parameters[i].resolve(context);
+        }
     }
 
     public void collectRefs(TObjectIntHashMap<Object> allRefs, TIntHashSet refs) {
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRRelation.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRRelation.java
index 7369d496c..3daae67a9 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRRelation.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/CHRRelation.java
@@ -12,4 +12,7 @@ public interface CHRRelation {
     TVar[] getTypeVariables();
     Type[] getParameterTypes();
     TPred[] getTypeConstraints();
+    default String[] getFieldNames() {
+        return null;
+    }
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/CHRConstraint.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/CHRConstraint.java
index c0f439288..ee7347791 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/CHRConstraint.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/CHRConstraint.java
@@ -34,6 +34,7 @@ import gnu.trove.map.hash.TIntObjectHashMap;
 public class CHRConstraint extends Symbol implements CHRRelation {
     public final String name;
     public final Type[] parameterTypes;
+    public String[] fieldNames;
     
     public boolean implicitlyDeclared;
 
@@ -229,4 +230,9 @@ public class CHRConstraint extends Symbol implements CHRRelation {
         else
             return w.apply(location, accessor, fact);
     }
+    
+    @Override
+    public String[] getFieldNames() {
+        return fieldNames;
+    }
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/ExternalCHRRelation.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/ExternalCHRRelation.java
index 5e4f5868c..6f44bc2ab 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/ExternalCHRRelation.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/relations/ExternalCHRRelation.java
@@ -32,4 +32,9 @@ public class ExternalCHRRelation implements CHRRelation {
     public String toString() {
         return relation.toString();
     }
+    
+    @Override
+    public String[] getFieldNames() {
+        return relation.getFieldNames();
+    }
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/translation/CHRTranslation.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/translation/CHRTranslation.java
index 6972eb864..367960dfa 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/translation/CHRTranslation.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/chr/translation/CHRTranslation.java
@@ -3,6 +3,7 @@ package org.simantics.scl.compiler.elaboration.chr.translation;
 import java.util.ArrayList;
 import java.util.Arrays;
 
+import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
 import org.simantics.scl.compiler.elaboration.chr.CHRLiteral;
 import org.simantics.scl.compiler.elaboration.chr.CHRQuery;
 import org.simantics.scl.compiler.elaboration.chr.CHRRule;
@@ -12,6 +13,7 @@ import org.simantics.scl.compiler.elaboration.chr.relations.UnresolvedCHRRelatio
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 import org.simantics.scl.compiler.elaboration.expressions.EApply;
 import org.simantics.scl.compiler.elaboration.expressions.EBinary;
+import org.simantics.scl.compiler.elaboration.expressions.ERecord;
 import org.simantics.scl.compiler.elaboration.expressions.EVar;
 import org.simantics.scl.compiler.elaboration.expressions.Expression;
 import org.simantics.scl.compiler.elaboration.expressions.block.CHRStatement;
@@ -20,9 +22,11 @@ import org.simantics.scl.compiler.elaboration.expressions.list.ListAssignment;
 import org.simantics.scl.compiler.elaboration.expressions.list.ListGenerator;
 import org.simantics.scl.compiler.elaboration.expressions.list.ListGuard;
 import org.simantics.scl.compiler.elaboration.expressions.list.ListQualifier;
+import org.simantics.scl.compiler.elaboration.expressions.records.FieldAssignment;
 import org.simantics.scl.compiler.environment.AmbiguousNameException;
 import org.simantics.scl.compiler.environment.Environments;
 import org.simantics.scl.compiler.errors.Locations;
+import org.simantics.scl.compiler.internal.parsing.declarations.DAnnotationAst;
 import org.simantics.scl.compiler.internal.parsing.types.TypeAst;
 
 public class CHRTranslation {
@@ -35,18 +39,27 @@ public class CHRTranslation {
     }
 
     private static CHRLiteral convertConstraint(boolean remove, boolean negated, Expression expression) {
-        ArrayList<Expression> parameters = new ArrayList<Expression>(4);
-        while(expression instanceof EApply) {
+        long location = expression.location;
+        Expression[] parameters;
+        FieldAssignment[] fields = null;
+        if(expression instanceof EApply) {
             EApply apply = (EApply)expression;
-            for(int i=apply.parameters.length-1;i>=0;--i)
-                parameters.add(apply.parameters[i]);
+            parameters = apply.parameters;
             expression = apply.function;
         }
-        EVar var = (EVar)expression;
-        Expression[] parametersArray = new Expression[parameters.size()];
-        for(int i=0,j=parametersArray.length-1;i<parametersArray.length;++i,--j)
-            parametersArray[i] = parameters.get(j);
-        return new CHRLiteral(expression.location, new UnresolvedCHRRelation(var.location, var.name), parametersArray, remove, negated);
+        else if(expression instanceof ERecord) {
+            ERecord record = (ERecord)expression;
+            parameters = null;
+            fields = record.fields;
+            expression = record.constructor;
+        }
+        else // if(expression instanceof EVar)
+            parameters = Expression.EMPTY_ARRAY;
+        EVar var = (EVar)expression; // this should succeed because of isConstraint test
+        CHRLiteral literal = new CHRLiteral(location, new UnresolvedCHRRelation(var.location, var.name),
+                parameters, remove, negated);
+        literal.fields = fields;
+        return literal;
     }
     
     private static CHRLiteral convertListQualifier(TranslationContext context, boolean isHead, ListQualifier qualifier) {
@@ -102,8 +115,10 @@ public class CHRTranslation {
     }
     
     private static boolean isConstraint(TranslationContext context, Expression expression) {
-        while(expression instanceof EApply)
+        if(expression instanceof EApply)
             expression = ((EApply)expression).function;
+        else if(expression instanceof ERecord)
+            expression = ((ERecord)expression).constructor;
         if(!(expression instanceof EVar))
             return false;
         String name = ((EVar)expression).name;
@@ -136,7 +151,15 @@ public class CHRTranslation {
     }
 
     public static CHRConstraint convertConstraintStatement(TranslationContext context, ConstraintStatement statement) {
-        return new CHRConstraint(statement.location, statement.name.text, TypeAst.toTypes(context, statement.parameterTypes));
+        CHRConstraint constraint = new CHRConstraint(statement.location, statement.name.text, TypeAst.toTypes(context, statement.parameterTypes));
+        for(DAnnotationAst annotation : statement.annotations)
+            applyConstraintAnnotation(context, constraint, annotation);
+        constraint.fieldNames = statement.fieldNames;
+        return constraint;
+    }
+
+    private static void applyConstraintAnnotation(TranslationContext context, CHRConstraint constraint, DAnnotationAst annotation) {
+        context.getErrorLog().log(annotation.location, "Invalid constraint annotation");
     }
     
 }
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TranslationContext.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TranslationContext.java
index 75090ae38..0331f9a50 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TranslationContext.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/contexts/TranslationContext.java
@@ -46,7 +46,15 @@ public class TranslationContext extends TypeTranslationContext implements Enviro
     public static class ExistentialFrame {
         THashSet<String> variables = new THashSet<String>(4);
         ArrayList<Variable> blanks = new ArrayList<Variable>(2); 
-        boolean disallowNewExistentials;
+        public boolean disallowNewExistentials;
+        
+        public EVariable createBlank(long location) {
+            Variable variable = new Variable("_");
+            blanks.add(variable);
+            EVariable result = new EVariable(variable);
+            result.location = location;
+            return result;
+        }
     }
     
     THashMap<String, Variable> variables = new THashMap<String, Variable>();
@@ -128,14 +136,12 @@ public class TranslationContext extends TypeTranslationContext implements Enviro
         }
         case '_': {
             if(name.length()==1) {
-                variable = new Variable("_");
                 ExistentialFrame existentialFrame = getCurrentExistentialFrame();
                 if(existentialFrame == null || existentialFrame.disallowNewExistentials) {
                     errorLog.log(location, "Blank variables can be used only in queries.");
                     return new EError(location);
                 }
-                existentialFrame.blanks.add(variable);
-                return new EVariable(variable);
+                return existentialFrame.createBlank(location);
             }
             break;
         }
@@ -143,7 +149,7 @@ public class TranslationContext extends TypeTranslationContext implements Enviro
         return null;
     }
     
-    private ExistentialFrame getCurrentExistentialFrame() {
+    public ExistentialFrame getCurrentExistentialFrame() {
         int size = existentialFrames.size(); 
         if(size == 0)
             return null;
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ERecord.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ERecord.java
index a41c0f042..e1f444d82 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ERecord.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/ERecord.java
@@ -2,20 +2,20 @@ package org.simantics.scl.compiler.elaboration.expressions;
 
 import org.simantics.scl.compiler.constants.SCLConstructor;
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
+import org.simantics.scl.compiler.elaboration.contexts.TranslationContext.ExistentialFrame;
 import org.simantics.scl.compiler.elaboration.expressions.records.FieldAssignment;
 import org.simantics.scl.compiler.elaboration.modules.SCLValue;
 import org.simantics.scl.compiler.environment.AmbiguousNameException;
 import org.simantics.scl.compiler.errors.Locations;
-import org.simantics.scl.compiler.internal.parsing.Token;
 
 import gnu.trove.map.hash.THashMap;
 
 public class ERecord extends ASTExpression {
 
-    Token constructor;
-    FieldAssignment[] fields;
+    public final EVar constructor;
+    public final FieldAssignment[] fields;
     
-    public ERecord(Token constructor, FieldAssignment[] fields) {
+    public ERecord(EVar constructor, FieldAssignment[] fields) {
         this.constructor = constructor;
         this.fields = fields;
     }
@@ -33,30 +33,67 @@ public class ERecord extends ASTExpression {
     public Expression resolve(TranslationContext context, boolean asPattern) {
         SCLValue constructorValue; 
         try {
-            constructorValue = context.getEnvironment().getLocalNamespace().getValue(constructor.text);
+            constructorValue = context.getEnvironment().getLocalNamespace().getValue(constructor.name);
         } catch (AmbiguousNameException e) {
             context.getErrorLog().log(constructor.location, e.getMessage());
             return new EError(constructor.location);
         }
         if(constructorValue == null) {
-            context.getErrorLog().log(constructor.location, "Couldn't resolve the record constructor " + constructor.text + ".");
+            context.getErrorLog().log(constructor.location, "Couldn't resolve the record constructor " + constructor.name + ".");
             return new EError(constructor.location);
         }
         if(!(constructorValue.getValue() instanceof SCLConstructor)) {
-            context.getErrorLog().log(constructor.location, "Value " + constructor.text + " is not a record constructor.");
+            context.getErrorLog().log(constructor.location, "Value " + constructor.name + " is not a record constructor.");
             return new EError(constructor.location);
         }
         String[] fieldNames = ((SCLConstructor)constructorValue.getValue()).recordFieldNames;
         if(fieldNames == null) {
-            context.getErrorLog().log(constructor.location, "Value " + constructor.text + " is not a record constructor.");
+            context.getErrorLog().log(constructor.location, "Value " + constructor.name + " is not a record constructor.");
             return new EError(constructor.location);
         }
+        Expression[] parameters = translateFieldsToFunctionParameters(context, fields, fieldNames);
+        if(parameters == null)
+            return new EError(location);
+        if(asPattern)
+            for(int i=0;i<parameters.length;++i) {
+                Expression parameter = parameters[i];
+                if(parameter == null)
+                    parameters[i] = Expressions.blank(null);
+                else
+                    parameters[i] = parameter.resolveAsPattern(context);
+            }
+        else {
+            boolean error = false;
+            for(int i=0;i<parameters.length;++i) {
+                Expression parameter = parameters[i];
+                if(parameter == null) {
+                    ExistentialFrame frame = context.getCurrentExistentialFrame();
+                    if(frame == null || frame.disallowNewExistentials) {
+                        context.getErrorLog().log(location, "Field " + fieldNames[i] + " not defined.");
+                        error = true;
+                    }
+                    else
+                        parameters[i] = frame.createBlank(location); 
+                }
+                else
+                    parameters[i] = parameter.resolve(context);
+            }
+            if(error)
+                return new EError(location);
+        }
+        EApply result = new EApply(new EConstant(constructorValue), parameters);
+        result.setLocationDeep(location);
+        return result;
+    }
+    
+    public static Expression[] translateFieldsToFunctionParameters(TranslationContext context, FieldAssignment[] fields, String[] fieldNames) {
         THashMap<String,FieldAssignment> recordMap = new THashMap<String,FieldAssignment>(fields.length);
+        boolean error = false;
         for(FieldAssignment field : fields) {
             if(field.value == null) {
-            	String actualName = field.name;
-            	if(actualName.charAt(0) == '?')
-            		actualName = actualName.substring(1);
+                String actualName = field.name;
+                if(actualName.charAt(0) == '?')
+                    actualName = actualName.substring(1);
                 String bestMatch = null;
                 int bestMatchLength = 0;
                 for(int i=0;i<fieldNames.length;++i) {
@@ -68,46 +105,30 @@ public class ERecord extends ASTExpression {
                 }
                 if(bestMatch == null) {
                     context.getErrorLog().log(field.location, "Invalid shorthand field " + field.name + " is defined twice.");
-                    return new EError(location);
+                    error = true;
                 }
                 field.value = new EVar(field.location, field.name);
                 field.name = bestMatch;
             }
             if(recordMap.put(field.name, field) != null) {
                 context.getErrorLog().log(field.location, "Field " + field.name + " is defined more than once.");
-                return new EError(location);
+                error = true;
             }
         }
+        if(error)
+            return null;
         Expression[] parameters = new Expression[fieldNames.length];
-        boolean error = false;
         for(int i=0;i<fieldNames.length;++i) {
             FieldAssignment assignment = recordMap.remove(fieldNames[i]);
-            if(assignment == null) {
-                if(asPattern) {
-                    parameters[i] = Expressions.blank(null);
-                }
-                else {
-                    context.getErrorLog().log(location, "Field " + fieldNames[i] + " not defined.");
-                    error = true;
-                }
-            }
-            else
-                parameters[i] = asPattern
-                        ? assignment.value.resolveAsPattern(context) 
-                        : assignment.value.resolve(context);
+            if(assignment != null)
+                parameters[i] = assignment.value;
         }
         if(!recordMap.isEmpty()) {
             for(FieldAssignment field : recordMap.values())
                 context.getErrorLog().log(field.location, "Field " + field.name + " is not defined in the constructor.");
-            error = true;
-        }
-        if(error)
-            return new EError(location);
-        else {
-            EApply result = new EApply(new EConstant(constructorValue), parameters);
-            result.setLocationDeep(location);
-            return result;
+            return null;
         }
+        return parameters;
     }
 
     @Override
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EVar.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EVar.java
index fda9d37ac..d78fa8565 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EVar.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/EVar.java
@@ -2,17 +2,22 @@ package org.simantics.scl.compiler.elaboration.expressions;
 
 import java.util.ArrayList;
 
-import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
 import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 import org.simantics.scl.compiler.elaboration.errors.NotPatternException;
 import org.simantics.scl.compiler.elaboration.expressions.lhstype.FunctionDefinitionLhs;
 import org.simantics.scl.compiler.elaboration.expressions.lhstype.LhsType;
 import org.simantics.scl.compiler.elaboration.expressions.lhstype.PatternMatchingLhs;
 import org.simantics.scl.compiler.errors.Locations;
+import org.simantics.scl.compiler.internal.parsing.Token;
 
 public class EVar extends ASTExpression {
     public final String name;
 
+    public EVar(Token token) {
+        this.location = token.location;
+        this.name = token.text;
+    }
+    
     public EVar(long location, String name) {
         this.location = location;
         this.name = name;
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/block/ConstraintStatement.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/block/ConstraintStatement.java
index fc92190a9..4cccf2f46 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/block/ConstraintStatement.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/expressions/block/ConstraintStatement.java
@@ -5,16 +5,21 @@ import org.simantics.scl.compiler.elaboration.contexts.TranslationContext;
 import org.simantics.scl.compiler.elaboration.expressions.Expression;
 import org.simantics.scl.compiler.errors.Locations;
 import org.simantics.scl.compiler.internal.parsing.Token;
+import org.simantics.scl.compiler.internal.parsing.declarations.DAnnotationAst;
 import org.simantics.scl.compiler.internal.parsing.types.TypeAst;
 
 public class ConstraintStatement extends Statement {
 
     public Token name;
     public TypeAst[] parameterTypes;
+    public String[] fieldNames;
+    public DAnnotationAst[] annotations;
     
-    public ConstraintStatement(Token name, TypeAst[] parameterTypes) {
+    public ConstraintStatement(Token name, TypeAst[] parameterTypes, String[] fieldNames, DAnnotationAst[] annotations) {
         this.name = name;
         this.parameterTypes = parameterTypes;
+        this.fieldNames = fieldNames;
+        this.annotations = annotations;
     }
     
     @Override
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/relations/SCLRelation.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/relations/SCLRelation.java
index 4ac37bbc1..e93ff6e8f 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/relations/SCLRelation.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/elaboration/relations/SCLRelation.java
@@ -35,7 +35,7 @@ public interface SCLRelation {
         return TPred.EMPTY_ARRAY;
     }
     int getPhase();
-    
+
     double getSelectivity(int boundVariables);
     int getRequiredVariablesMask();
     void generate(long location,
@@ -45,7 +45,10 @@ public interface SCLRelation {
     Expression generateEnforce(long location, EnforcingContext context,
             Type[] typeParameters,
             Variable[] parameters);
-
+    default String[] getFieldNames() {
+        return null;
+    }
+    
     void generateIterate(
             PlanContext context,
             CodeWriter w,
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/declarations/ConstructorAst.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/declarations/ConstructorAst.java
index 3edb9ce81..bbb669506 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/declarations/ConstructorAst.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/declarations/ConstructorAst.java
@@ -1,6 +1,7 @@
 package org.simantics.scl.compiler.internal.parsing.declarations;
 
 import org.simantics.scl.compiler.internal.parsing.Symbol;
+import org.simantics.scl.compiler.internal.parsing.Token;
 import org.simantics.scl.compiler.internal.parsing.types.TypeAst;
 
 
@@ -8,11 +9,11 @@ public class ConstructorAst extends Symbol {
     public static final ConstructorAst[] EMPTY_ARRAY = new ConstructorAst[0];
     
     public final DAnnotationAst[] annotations;
-    public final String name;
+    public final Token name;
     public final TypeAst[] parameters;
     public final String[] fieldNames; // null, if no field names
     
-    public ConstructorAst(DAnnotationAst[] annotations, String name,
+    public ConstructorAst(DAnnotationAst[] annotations, Token name,
             TypeAst[] parameters, String[] fieldNames) {
         this.annotations = annotations;
         this.name = name;
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCL.grammar b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCL.grammar
index b0911febe..f7ea1b263 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCL.grammar
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCL.grammar
@@ -200,7 +200,7 @@ statement
     | exp FOLLOWS queryBlock                                 # RuleStatement
     | chrQuery IMPLIES chrQuery                              # CHRStatement
     | WHEN verboseChrQuery THEN_AFTER_WHEN verboseChrQuery   # VerboseCHRStatement
-    | CONSTRAINT ID atype*                                   # ConstraintStatement
+    | CONSTRAINT constructor                                 # ConstraintStatement
     | INCLUDE ID aexp                                        # LocalInclude
     ;
 
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.dat b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.dat
index 3b8a4c400..378013be5 100644
Binary files a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.dat and b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.dat differ
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.java
index 527c66f5d..fc2242dce 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParser.java
@@ -13,18 +13,18 @@ public abstract class SCLParser {
     public static final boolean TRACE = false;
 
     private static final int INITIAL_CAPACITY = 16;
-    private static final int STATE_COUNT = 353;
+    private static final int STATE_COUNT = 358;
     private static final int TERMINAL_COUNT = 84;
-    private static final int NONTERMINAL_COUNT = 51;
-    private static final int PRODUCT_COUNT = 134;
+    private static final int NONTERMINAL_COUNT = 52;
+    private static final int PRODUCT_COUNT = 135;
     
     private static final int[] ACTION_ROW_ID = new int[STATE_COUNT];
     private static final int[] ACTION_COLUMN_ID = new int[TERMINAL_COUNT];
-    private static final short[] ACTION_TABLE = new short[6588];
-    private static final int[] ERROR_TABLE = new int[927];
+    private static final short[] ACTION_TABLE = new short[6944];
+    private static final int[] ERROR_TABLE = new int[940];
     private static final int[] GOTO_ROW_ID = new int[STATE_COUNT];
     private static final int[] GOTO_COLUMN_ID = new int[NONTERMINAL_COUNT];
-    private static final short[] GOTO_TABLE = new short[1620];
+    private static final short[] GOTO_TABLE = new short[1708];
     private static final int[] PRODUCT_LHS = new int[PRODUCT_COUNT];
 
     private static final short STATE_MASK = (short)0x0fff;
@@ -161,6 +161,7 @@ public abstract class SCLParser {
         "listQualifier",
         "chrQuery",
         "verboseChrQuery",
+        "constraintSpec",
         "caseRhs",
         "guardedExpArrow",
         "equation",
@@ -394,19 +395,19 @@ public abstract class SCLParser {
         return parse(0);
     }
     public Object parseCommands() {
-        return parse(337);
+        return parse(342);
     }
     public Object parseImport() {
-        return parse(345);
+        return parse(350);
     }
     public Object parseType() {
-        return parse(347);
+        return parse(352);
     }
     public Object parseExp() {
-        return parse(349);
+        return parse(354);
     }
     public Object parseEquationBlock() {
-        return parse(351);
+        return parse(356);
     }
 
 
@@ -650,24 +651,26 @@ public abstract class SCLParser {
         case 117:
             return reduceVerboseCHRQuery();
         case 118:
-            return reduceSimpleCaseRhs();
+            return reduceConstraintSpec();
         case 119:
-            return reduceGuardedCaseRhs();
+            return reduceSimpleCaseRhs();
         case 120:
-            return reduceGuardedExpArrow();
+            return reduceGuardedCaseRhs();
         case 121:
-            return reduceGuardEquation();
+            return reduceGuardedExpArrow();
         case 122:
-            return reduceBasicEquation();
+            return reduceGuardEquation();
         case 123:
-            return reduceEffect();
+            return reduceBasicEquation();
         case 124:
-            return reduceJustEtype();
+            return reduceEffect();
         case 125:
-            return reduceForAll();
+            return reduceJustEtype();
         case 126:
-            return reduceApplyType();
+            return reduceForAll();
         case 127:
+            return reduceApplyType();
+        case 128:
             return reduceDummy();
 
         default:
@@ -821,7 +824,7 @@ public abstract class SCLParser {
      */
     protected abstract Object reduceVerboseCHRStatement();
     /**
-     * statement ::= CONSTRAINT ID atype&#42;
+     * statement ::= CONSTRAINT constructor (WHERE constraintSpec)?
      */
     protected abstract Object reduceConstraintStatement();
     /**
@@ -1136,6 +1139,10 @@ public abstract class SCLParser {
      * verboseChrQuery ::= LBRACE listQualifier (SEMICOLON listQualifier)&#42; RBRACE
      */
     protected abstract Object reduceVerboseCHRQuery();
+    /**
+     * constraintSpec ::= LBRACE exp (SEMICOLON exp)&#42; RBRACE
+     */
+    protected abstract Object reduceConstraintSpec();
     /**
      * caseRhs ::= ARROW exp (WHERE statements)?
      */
diff --git a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParserImpl.java b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParserImpl.java
index 09fc79e0f..34f8d6a9f 100644
--- a/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParserImpl.java
+++ b/bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/parsing/parser/SCLParserImpl.java
@@ -308,7 +308,7 @@ public class SCLParserImpl extends SCLParser {
         else
             context = (ArrayList<TypeAst>)get(i++);
         Token nameToken = (Token)get(i++);
-        EVar name = new EVar(nameToken.location, nameToken.text);
+        EVar name = new EVar(nameToken);
         ArrayList<TypeAst> parameters = new ArrayList<TypeAst>();
         while(i < length()) {
             Object symbol = get(i++);
@@ -334,7 +334,7 @@ public class SCLParserImpl extends SCLParser {
         else
             context = (ArrayList<TypeAst>)get(i++);
         Token nameToken = (Token)get(i++);
-        EVar name = new EVar(nameToken.location, nameToken.text);
+        EVar name = new EVar(nameToken);
         ArrayList<TypeAst> parameters = new ArrayList<TypeAst>();
         while(i < length()) {
             Object symbol = get(i++);
@@ -424,12 +424,12 @@ public class SCLParserImpl extends SCLParser {
 
     @Override
     protected Object reduceVarId() {
-        return new EVar(((Token)get(0)).text);
+        return new EVar((Token)get(0));
     }
 
     @Override
     protected Object reduceEscapedSymbol() {
-        return new EVar(((Token)get(0)).text);
+        return new EVar((Token)get(0));
     }
 
     @Override
@@ -460,7 +460,7 @@ public class SCLParserImpl extends SCLParser {
         EVar negation = null;
         if(get(i) instanceof Token) {
             Token token = (Token)get(i++);
-            negation = new EVar(token.location, token.text);
+            negation = new EVar(token);
         }
         EBinary binary = new EBinary((Expression)get(i++), negation);
         while(i < length()) {
@@ -527,7 +527,7 @@ public class SCLParserImpl extends SCLParser {
         TypeAst[] parameters = new TypeAst[length()-idPos-1];
         for(int i=0;i<parameters.length;++i)
             parameters[i] = (TypeAst)get(i+idPos+1);
-        return new ConstructorAst(annotations, ((Token)get(idPos)).text, parameters, null);
+        return new ConstructorAst(annotations, (Token)get(idPos), parameters, null);
     }
 
     @Override
@@ -581,7 +581,7 @@ public class SCLParserImpl extends SCLParser {
 
     @Override
     protected Object reduceBlank() {
-        return new EVar("_");
+        return new EVar(((Token)get(0)).location, "_");
     }
 
     @Override
@@ -1178,7 +1178,7 @@ public class SCLParserImpl extends SCLParser {
         FieldAssignment[] fields = new FieldAssignment[length()/2-1];
         for(int i=0;i<fields.length;++i)
             fields[i] = (FieldAssignment)get(2+i*2);
-        return new ERecord((Token)get(0), fields);
+        return new ERecord(new EVar((Token)get(0)), fields);
     }
 
     @Override
@@ -1208,7 +1208,7 @@ public class SCLParserImpl extends SCLParser {
             parameters[i] = fieldDesc.type;
             fieldNames[i] = fieldDesc.name;
         }
-        return new ConstructorAst(annotations, ((Token)get(idPos)).text, parameters, fieldNames);
+        return new ConstructorAst(annotations, (Token)get(idPos), parameters, fieldNames);
     }
 
     @Override
@@ -1253,10 +1253,8 @@ public class SCLParserImpl extends SCLParser {
 
     @Override
     protected Object reduceConstraintStatement() {
-        TypeAst[] parameterTypes = new TypeAst[length()-2];
-        for(int i=0;i<parameterTypes.length;++i)
-            parameterTypes[i] = (TypeAst)get(2+i);
-        return new ConstraintStatement((Token)get(1), parameterTypes);
+        ConstructorAst constructor = (ConstructorAst)get(1);
+        return new ConstraintStatement(constructor.name, constructor.parameters, constructor.fieldNames, constructor.annotations);
     }
 
     @Override
@@ -1307,4 +1305,12 @@ public class SCLParserImpl extends SCLParser {
         return new IncludeStatement(name, value);
     }
 
+    @Override
+    protected Object reduceConstraintSpec() {
+        Expression[] expressions = new Expression[length()/2-1];
+        for(int i=0;i<expressions.length;++i)
+            expressions[i] = (Expression)get(2*i+1);
+        return expressions;
+    }
+
 }
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 f3aa463d5..f065b765e 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
@@ -30,6 +30,8 @@ public class ModuleRegressionTests extends TestBase {
     @Test public void CHR6() { test(); }
     @Test public void CHR7() { test(); }
     @Test public void CHR8() { test(); }
+    @Test public void CHR9() { test(); }
+    @Test public void CHR10() { test(); }
     @Test public void ClosureRecursion() { test(); }
     @Test public void Collaz() { test(); }
     @Test public void Compose() { test(); }
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR10.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR10.scl
new file mode 100644
index 000000000..758074d32
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR10.scl
@@ -0,0 +1,30 @@
+module { export = [main], chr }
+import "StandardLibrary"
+
+data V = V { x :: Double, y :: Double }
+
+main = ()
+  where
+    constraint X V 
+    X V { ?x } => print ?x
+    X V { ?y } => print ?y
+    True => X V { x = 1.0, y = 2.0 }
+    True => X V { x = 3.0, y = 4.0 }
+--
+1.0
+2.0
+3.0
+4.0
+()
+--
+module { export = [main], chr }
+import "StandardLibrary"
+
+data V = V { x :: Double, y :: Double }
+
+main = ()
+  where
+    constraint X V 
+    True => X V { x = 1.0 }
+--
+9:15-9:28: Field y not defined.
\ No newline at end of file
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR5.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR5.scl
index edefae634..c59c02dbb 100644
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR5.scl
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR5.scl
@@ -1,8 +1,4 @@
-module {
-    export = [main],
-    chr
-}
-
+module { export = [main], chr }
 import "StandardLibrary"
 
 ruleset IntegerSet where
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR6.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR6.scl
index 325af5270..f1e28d08a 100644
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR6.scl
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR6.scl
@@ -1,8 +1,4 @@
-module {
-    export = [main],
-    chr
-}
-
+module { export = [main], chr }
 import "StandardLibrary"
 
 ruleset RS where
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR7.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR7.scl
index 6576cf47e..b10257ca8 100644
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR7.scl
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR7.scl
@@ -1,8 +1,4 @@
-module {
-    export = [main],
-    chr
-}
-
+module { export = [main], chr }
 import "StandardLibrary"
 
 ruleset RS where
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR8.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR8.scl
index ce3064aa4..c3a88f58a 100644
--- a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR8.scl
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR8.scl
@@ -1,12 +1,8 @@
-module {
-    export = [main],
-    chr
-}
-
+module { export = [main], chr }
 import "StandardLibrary"
 
 main = ()
   where
     X ?x => Y ?y
 --
-10:15-10:17: New existential variables can be defined only in queries.
\ No newline at end of file
+6:15-6:17: New existential variables can be defined only in queries.
\ No newline at end of file
diff --git a/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR9.scl b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR9.scl
new file mode 100644
index 000000000..07514821a
--- /dev/null
+++ b/tests/org.simantics.scl.compiler.tests/src/org/simantics/scl/compiler/tests/scl/CHR9.scl
@@ -0,0 +1,42 @@
+module { export = [main], chr }
+import "StandardLibrary"
+
+main = ()
+  where
+    constraint V { x :: Double, y :: Double } 
+    V { ?x } => print ?x
+    True => V { x = 1.0, y = 2.0 }
+--
+1.0
+()
+--
+module { export = [main], chr }
+import "StandardLibrary"
+
+main = ()
+  where
+    constraint V { x :: Double, y :: Double }
+    True => V { x = 1.0 }
+--
+7:13-7:26: Field y not defined.
+--
+module { export = [main], chr }
+
+import "StandardLibrary"
+
+main = ()
+  where
+    constraint V Double Double
+    True => V { x = 1.0, y = 2.0 }
+--
+8:13-8:35: Relation V does not define field names.
+--
+module { export = [main], chr }
+
+import "StandardLibrary"
+
+main = ()
+  where
+    True => V { x = 1.0, y = 2.0 }
+--
+7:13-7:35: Relation must be declared if record syntax is used.
\ No newline at end of file