]> gerrit.simantics Code Review - simantics/platform.git/blob - bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/internal/deriving/HashableDeriver.java
Re-enabled Acorn transaction cancellation support for testing
[simantics/platform.git] / bundles / org.simantics.scl.compiler / src / org / simantics / scl / compiler / internal / deriving / HashableDeriver.java
1 package org.simantics.scl.compiler.internal.deriving;
2
3 import java.util.ArrayList;
4
5 import org.simantics.scl.compiler.common.datatypes.Constructor;
6 import org.simantics.scl.compiler.constants.IntegerConstant;
7 import org.simantics.scl.compiler.elaboration.errors.NotPatternException;
8 import org.simantics.scl.compiler.elaboration.expressions.EApply;
9 import org.simantics.scl.compiler.elaboration.expressions.ELiteral;
10 import org.simantics.scl.compiler.elaboration.expressions.EVar;
11 import org.simantics.scl.compiler.elaboration.expressions.Expression;
12 import org.simantics.scl.compiler.elaboration.modules.TypeConstructor;
13 import org.simantics.scl.compiler.environment.AmbiguousNameException;
14 import org.simantics.scl.compiler.environment.Environment;
15 import org.simantics.scl.compiler.environment.Environments;
16 import org.simantics.scl.compiler.errors.ErrorLog;
17 import org.simantics.scl.compiler.internal.parsing.declarations.DDerivingInstanceAst;
18 import org.simantics.scl.compiler.internal.parsing.declarations.DInstanceAst;
19 import org.simantics.scl.compiler.internal.parsing.declarations.DValueAst;
20 import org.simantics.scl.compiler.internal.parsing.expressions.Expressions;
21 import org.simantics.scl.compiler.internal.parsing.translation.ProcessedDInstanceAst;
22 import org.simantics.scl.compiler.internal.parsing.translation.ValueRepository;
23 import org.simantics.scl.compiler.internal.parsing.types.TVarAst;
24 import org.simantics.scl.compiler.types.TCon;
25
26 class HashableDeriver implements InstanceDeriver {
27
28     @Override
29     public void derive(
30             ErrorLog errorLog,
31             Environment environment,
32             ArrayList<ProcessedDInstanceAst> instancesAst,
33             DDerivingInstanceAst der) {
34      // Analyze
35         if(der.types.length != 1) {
36             errorLog.log(der.location, "Invalid number of parameters to " + der.name);
37             return;
38         }
39         TVarAst headType = DerivingUtils.getHeadType(der.types[0]);
40         if(headType == null) {
41             errorLog.log(der.types[0].location, "Cannot derive Hashable instance for the type " + headType + ".");
42             return;
43         }
44         TCon con;
45         try {
46             con = Environments.getTypeConstructorName(environment, headType.name);
47         } catch (AmbiguousNameException e1) {
48             errorLog.log(headType.location, e1.getMessage());
49             return;
50         }
51         if(con == null) {
52             errorLog.log(headType.location, "Couldn't resolve " + headType.name);
53             return;
54         }
55         TypeConstructor tcon = environment.getTypeConstructor(con);
56         if(tcon == null) {
57             errorLog.log(headType.location, "Didn't find type constructor for " + headType.name);
58             return;
59         }
60         if(tcon.isOpen) {
61             errorLog.log(headType.location, "Cannot derive instance for open data types.");
62             return;
63         }
64         
65         // Generate
66         DInstanceAst instanceAst = new DInstanceAst(der.location, der.context, der.name, der.types);
67         ValueRepository valueDefs = new ValueRepository();
68         int cId = 0;
69         for(Constructor constructor : tcon.constructors) {
70             int l = constructor.parameterTypes.length;
71             String[] par = new String[l];
72             for(int i=0;i<l;++i) {
73                 par[i] = "v" + i;
74             }
75             Expression lhs = new EApply(
76                     new EVar("hashP"),
77                     new EApply(new EVar(constructor.name.name), Expressions.vars(par)),
78                     new EVar("accum")
79                     );
80             Expression value = new EVar("accum");
81             for(int i=0;i<l;++i) {
82                 value = new EApply(new EVar("hashP"),
83                         new EVar(par[i]),
84                         value
85                         );
86             }
87             if(tcon.constructors.length > 1)
88                 value = new EApply(new EVar("hashP"),
89                         new ELiteral(new IntegerConstant(cId)),
90                         value
91                         );
92
93             try {
94                 DValueAst valueAst = new DValueAst(lhs, value);
95                 valueAst.setLocationDeep(der.location);
96                 valueDefs.add(valueAst);
97             } catch (NotPatternException e) {
98                 errorLog.log(e.getExpression().location, "Not a pattern.");
99             }
100             ++ cId;
101         }
102         instancesAst.add(new ProcessedDInstanceAst(instanceAst, valueDefs));
103     }
104
105 }