(refs #7250) Merging master, minor CHR bugfixes

[simantics/platform.git] / bundles / org.simantics.scl.compiler / src / org / simantics / scl / compiler / compilation / Elaboration.java

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 7887ed717f032b7d29aed50782a69e0f6b42c916..359448e1d65adf505e970e80e328ddb8d62cc079 100644 (file)
--- 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
@@ -6,6 +6,7 @@ import java.util.List;
 
 import org.cojen.classfile.TypeDesc;
 import org.simantics.scl.compiler.common.datatypes.Constructor;
+import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;
 import org.simantics.scl.compiler.common.names.Name;
 import org.simantics.scl.compiler.constants.Constant;
 import org.simantics.scl.compiler.constants.JavaTypeInstanceConstructor;
@@ -31,6 +32,7 @@ import org.simantics.scl.compiler.elaboration.expressions.EGetConstraint;
 import org.simantics.scl.compiler.elaboration.expressions.EIntegerLiteral;
 import org.simantics.scl.compiler.elaboration.expressions.EListLiteral;
 import org.simantics.scl.compiler.elaboration.expressions.ELiteral;
+import org.simantics.scl.compiler.elaboration.expressions.EPreCHRRulesetConstructor;
 import org.simantics.scl.compiler.elaboration.expressions.EVar;
 import org.simantics.scl.compiler.elaboration.expressions.Expression;
 import org.simantics.scl.compiler.elaboration.expressions.Variable;
@@ -48,6 +50,7 @@ import org.simantics.scl.compiler.elaboration.modules.TypeAlias;
 import org.simantics.scl.compiler.elaboration.modules.TypeClass;
 import org.simantics.scl.compiler.elaboration.modules.TypeClassInstance;
 import org.simantics.scl.compiler.elaboration.modules.TypeClassMethod;
+import org.simantics.scl.compiler.elaboration.modules.TypeDescriptor;
 import org.simantics.scl.compiler.elaboration.query.Query;
 import org.simantics.scl.compiler.elaboration.query.pre.QPreGuard;
 import org.simantics.scl.compiler.elaboration.relations.ConcreteRelation;
@@ -85,6 +88,7 @@ import org.simantics.scl.compiler.internal.parsing.declarations.DInstanceAst;
 import org.simantics.scl.compiler.internal.parsing.declarations.DMappingRelationAst;
 import org.simantics.scl.compiler.internal.parsing.declarations.DRelationAst;
 import org.simantics.scl.compiler.internal.parsing.declarations.DRuleAst;
+import org.simantics.scl.compiler.internal.parsing.declarations.DRulesetAst;
 import org.simantics.scl.compiler.internal.parsing.declarations.DTypeAst;
 import org.simantics.scl.compiler.internal.parsing.declarations.DValueAst;
 import org.simantics.scl.compiler.internal.parsing.declarations.DValueTypeAst;
@@ -212,7 +216,8 @@ public class Elaboration {
     public void addTypesToEnvironment(
             ArrayList<DDataAst> dataTypesAst,
             ArrayList<DTypeAst> typeAliasesAst,
-            ArrayList<DEffectAst> effectsAst) {
+            ArrayList<DEffectAst> effectsAst,
+            ArrayList<DRulesetAst> rulesetsAst) {
         for(DDataAst dataType : dataTypesAst) {
             dataType.parameterKinds = new Kind[dataType.parameters.length];
             Kind constructorKind = Kinds.STAR;
@@ -227,8 +232,7 @@ public class Elaboration {
 
             NameExistenceChecks.checkIfTypeExists(errorLog,
                     dataType.location, importedEnvironment, dataType.name);
-            if(module.addTypeDescriptor(dataType.name, typeConstructor))
-                errorLog.log(dataType.location, "Type "+dataType.name+" has already been defined in this module.");
+            addTypeDescriptor(dataType.location, dataType.name, typeConstructor);
             dataType.typeConstructor = typeConstructor;
         }
         
@@ -236,9 +240,7 @@ public class Elaboration {
             TypeAlias alias = new TypeAlias(Types.con(moduleName, typeAlias.name), typeAlias.parameters.length);
             NameExistenceChecks.checkIfTypeExists(errorLog,
                     typeAlias.location, importedEnvironment, typeAlias.name);
-            if(module.addTypeDescriptor(typeAlias.name, alias)) {
-                errorLog.log(typeAlias.location, "Type alias "+typeAlias.name+" has already been defined in this module.");
-            }
+            addTypeDescriptor(typeAlias.location, typeAlias.name, alias);
         }
         
         for(DEffectAst effect : effectsAst) {
@@ -249,11 +251,24 @@ public class Elaboration {
                             TypeDesc.forClass(effect.threadLocalType)
                             ));
             if(module.addEffectConstructor(effect.name, effectConstructor))
-                errorLog.log(effect.location, "Type "+effect.name+" has already been defined in this module.");
-        }     
+                errorLog.log(effect.location, "Effect "+effect.name+" has already been defined in this module.");
+        }
+        for(DRulesetAst ruleset : rulesetsAst) {
+            ruleset.type = Types.con(moduleName, ruleset.name);
+            ruleset.className = compilationContext.namingPolicy.getDataTypeClassName(ruleset.name);
+            StandardTypeConstructor typeConstructor = new StandardTypeConstructor(ruleset.type, Kinds.STAR,
+                    TypeDesc.forClass(ruleset.className), ruleset.documentation == null ? null : ruleset.documentation.documentation);
+            typeConstructor.external = true;
+            addTypeDescriptor(ruleset.location, ruleset.name, typeConstructor);
+        }
         javaTypeTranslator = new JavaTypeTranslator(compilationContext.environment);
         compilationContext.javaTypeTranslator = javaTypeTranslator;
     }
+        
+    private void addTypeDescriptor(long location, String name, TypeDescriptor typeDescriptor) {
+        if(module.addTypeDescriptor(name, typeDescriptor))
+            errorLog.log(location, "Type "+name+" has already been defined in this module.");
+    }
     
     private static final int[] EMPTY_INT_ARRAY = new int[0];
     
@@ -704,6 +719,18 @@ public class Elaboration {
         }
     }
     
+    public void processRulesets(ArrayList<DRulesetAst> rulesetsAst) {
+        for(DRulesetAst ruleset : rulesetsAst) {
+            String constructorName = "create" + ruleset.name;
+            supplementedTypeAnnotations.add(new SupplementedValueType(ruleset.location, constructorName, Types.functionE(Types.PUNIT, Types.PROC, ruleset.type)));
+            try {
+                valueDefinitionsAst.add(new DValueAst(new EVar(constructorName), new EPreCHRRulesetConstructor(ruleset)));
+            } catch (NotPatternException e) {
+                throw new InternalCompilerError(ruleset.location, e);
+            }
+        }
+    }
+    
     /**
      * Convert a java class method into a {@link CallJava} instance.
      * Compilation errors are logged for failures in finding the named class or in accessing the method.