--- /dev/null
+package org.simantics.scl.compiler.internal.elaboration.constraints;\r
+\r
+import gnu.trove.map.hash.THashMap;\r
+import gnu.trove.set.hash.THashSet;\r
+\r
+import java.util.ArrayList;\r
+import java.util.Arrays;\r
+import java.util.Collections;\r
+import java.util.List;\r
+\r
+import org.simantics.scl.compiler.common.exceptions.InternalCompilerError;\r
+import org.simantics.scl.compiler.elaboration.expressions.EVariable;\r
+import org.simantics.scl.compiler.top.SCLCompilerConfiguration;\r
+import org.simantics.scl.compiler.types.TCon;\r
+import org.simantics.scl.compiler.types.TMetaVar;\r
+import org.simantics.scl.compiler.types.TPred;\r
+import org.simantics.scl.compiler.types.Type;\r
+import org.simantics.scl.compiler.types.Types;\r
+import org.simantics.scl.compiler.types.exceptions.UnificationException;\r
+import org.simantics.scl.compiler.types.util.TConComparator;\r
+import org.simantics.scl.compiler.types.util.TypeUnparsingContext;\r
+\r
+public class ConstraintSolver {\r
+\r
+ public static THashSet<TCon> DEFAULTS_IGNORE = new THashSet<TCon>(); \r
+ public static THashMap<List<TCon>, Type> DEFAULTS = new THashMap<List<TCon>, Type>();\r
+ \r
+ static {\r
+ DEFAULTS_IGNORE.add(Types.SHOW);\r
+ DEFAULTS_IGNORE.add(Types.con("Json2", "JSON"));\r
+ DEFAULTS_IGNORE.add(Types.VEC_COMP);\r
+ DEFAULTS_IGNORE.add(Types.EQ);\r
+ DEFAULTS_IGNORE.add(Types.ORD);\r
+ DEFAULTS_IGNORE.add(Types.TYPEABLE);\r
+ DEFAULTS_IGNORE.add(Types.SERIALIZABLE);\r
+ DEFAULTS_IGNORE.add(Types.con("Formatting", "FormatArgument"));\r
+ \r
+ DEFAULTS.put(Arrays.asList(Types.ADDITIVE), Types.INTEGER);\r
+ DEFAULTS.put(Arrays.asList(Types.RING), Types.INTEGER);\r
+ DEFAULTS.put(Arrays.asList(Types.ORDERED_RING), Types.INTEGER);\r
+ DEFAULTS.put(Arrays.asList(Types.INTEGRAL), Types.INTEGER); \r
+ DEFAULTS.put(Arrays.asList(Types.REAL), Types.DOUBLE);\r
+ \r
+ { // Some R -module specific hacks\r
+ TCon RCOMPATIBLE = Types.con("R/RExp", "RCompatible");\r
+ TCon REXP = Types.con("R/RExp", "RExp");\r
+ DEFAULTS.put(Arrays.asList(RCOMPATIBLE), REXP);\r
+ DEFAULTS.put(Arrays.asList(RCOMPATIBLE, Types.ADDITIVE), Types.DOUBLE);\r
+ DEFAULTS.put(Arrays.asList(RCOMPATIBLE, Types.RING), Types.DOUBLE);\r
+ DEFAULTS.put(Arrays.asList(RCOMPATIBLE, Types.ORDERED_RING), Types.DOUBLE);\r
+ DEFAULTS.put(Arrays.asList(RCOMPATIBLE, Types.INTEGRAL), Types.DOUBLE);\r
+ DEFAULTS.put(Arrays.asList(RCOMPATIBLE, Types.REAL), Types.DOUBLE);\r
+ }\r
+ }\r
+ \r
+ public static ReducedConstraints solve(\r
+ ConstraintEnvironment environment,\r
+ ArrayList<TPred> given,\r
+ ArrayList<EVariable> demands,\r
+ boolean applyDefaults) {\r
+ TypeUnparsingContext tuc = SCLCompilerConfiguration.TRACE_CONSTRAINT_SOLVER ? \r
+ new TypeUnparsingContext() : null;\r
+ if(SCLCompilerConfiguration.TRACE_CONSTRAINT_SOLVER) {\r
+ System.out.println();\r
+ System.out.println("GIVEN:");\r
+ for(TPred g : given)\r
+ System.out.println(" " + g.toString(tuc));\r
+ System.out.println("DEMANDS:");\r
+ for(EVariable demand : demands)\r
+ System.out.println(" " + demand.getType().toString(tuc));\r
+ System.out.println("==>");\r
+ }\r
+ \r
+ ConstraintSet cs = new ConstraintSet(environment);\r
+ ArrayList<Constraint> givenConstraints =\r
+ new ArrayList<Constraint>(given.size());\r
+ \r
+ for(TPred g : given)\r
+ givenConstraints.add(cs.addGiven(g));\r
+ \r
+ for(EVariable d : demands)\r
+ cs.addDemand(d);\r
+ \r
+ cs.reduce();\r
+ \r
+ ArrayList<Constraint> unsolvedConstraints = new ArrayList<Constraint>();\r
+ ArrayList<Constraint> solvedConstraints = new ArrayList<Constraint>();\r
+ cs.collect(unsolvedConstraints, solvedConstraints);\r
+ \r
+ // Apply defaults\r
+ if(applyDefaults && !unsolvedConstraints.isEmpty()) {\r
+ ArrayList<ArrayList<Constraint>> groups = \r
+ groupConstraintsByCommonMetavars(unsolvedConstraints);\r
+ if(SCLCompilerConfiguration.TRACE_CONSTRAINT_SOLVER) {\r
+ System.out.println("DEFAULT GROUPS:");\r
+ for(ArrayList<Constraint> group : groups) {\r
+ for(Constraint c : group)\r
+ System.out.println(" " + c.constraint.toString(tuc));\r
+ System.out.println(" --");\r
+ }\r
+ }\r
+ \r
+ unsolvedConstraints.clear();\r
+ ArrayList<Constraint> newSolvedConstraints = new ArrayList<Constraint>(unsolvedConstraints.size() + solvedConstraints.size()); \r
+ for(ArrayList<Constraint> group : groups) {\r
+ // Special rule for Typeable\r
+ /*if(group.size() == 1 && group.get(0).constraint.typeFunction == Types.TYPEABLE) {\r
+ Type parameter = Types.canonical(group.get(0).constraint.parameters[0]);\r
+ if(parameter instanceof TMetaVar) {\r
+ try {\r
+ ((TMetaVar)parameter).setRef(Types.INTEGER);\r
+ } catch (UnificationException e) {\r
+ throw new InternalCompilerError(e);\r
+ }\r
+\r
+ Constraint constraint = group.get(0);\r
+ Reduction reduction = environment.reduce(constraint.constraint);\r
+ if(reduction.parameters.length > 0)\r
+ throw new InternalCompilerError();\r
+ constraint.setGenerator(Constraint.STATE_HAS_INSTANCE,\r
+ reduction.generator, reduction.parameters);\r
+ newSolvedConstraints.add(constraint);\r
+ }\r
+ continue;\r
+ }*/\r
+ \r
+ // Standard rule\r
+ ArrayList<TCon> cons = new ArrayList<TCon>(group.size());\r
+ for(Constraint constraint : group)\r
+ if(!DEFAULTS_IGNORE.contains(constraint.constraint.typeClass))\r
+ cons.add(constraint.constraint.typeClass);\r
+ Collections.sort(cons, TConComparator.INSTANCE);\r
+ \r
+ Type defaultType = DEFAULTS.get(cons);\r
+ if(defaultType != null) {\r
+ TMetaVar var = null;\r
+ for(Constraint constraint : group) {\r
+ if(constraint.constraint.parameters.length != 1) {\r
+ var = null;\r
+ break;\r
+ }\r
+ Type parameter = Types.canonical(constraint.constraint.parameters[0]);\r
+ if(!(parameter instanceof TMetaVar)) {\r
+ var = null;\r
+ break;\r
+ }\r
+ if(var == null)\r
+ var = (TMetaVar)parameter;\r
+ }\r
+ if(var != null) {\r
+ try {\r
+ var.setRef(defaultType);\r
+ } catch (UnificationException e) {\r
+ throw new InternalCompilerError();\r
+ }\r
+ for(Constraint constraint : group) {\r
+ Reduction reduction = environment.reduce(constraint.constraint);\r
+ if(reduction.parameters.length > 0)\r
+ throw new InternalCompilerError();\r
+ constraint.setGenerator(Constraint.STATE_HAS_INSTANCE,\r
+ reduction.generator, reduction.parameters);\r
+ newSolvedConstraints.add(constraint);\r
+ } \r
+ continue;\r
+ } \r
+ }\r
+ unsolvedConstraints.addAll(group);\r
+ }\r
+ \r
+ Collections.sort(unsolvedConstraints, ConstraintComparator.INSTANCE);\r
+ \r
+ newSolvedConstraints.addAll(solvedConstraints);\r
+ solvedConstraints = newSolvedConstraints; \r
+ }\r
+\r
+ if(SCLCompilerConfiguration.TRACE_CONSTRAINT_SOLVER) {\r
+ System.out.println("UNSOLVED:");\r
+ for(Constraint c : unsolvedConstraints)\r
+ System.out.println(" " + c.constraint.toString(tuc)); \r
+ System.out.println("SOLVED:");\r
+ for(Constraint c : solvedConstraints)\r
+ System.out.println(" " + c.constraint.toString(tuc) + " <= " + c.generator);\r
+ //System.out.println("APPLY DEFAULTS: " + applyDefaults);\r
+ }\r
+ \r
+ return new ReducedConstraints(givenConstraints, \r
+ solvedConstraints,\r
+ unsolvedConstraints);\r
+ }\r
+\r
+ private static <K,V> void add(\r
+ THashMap<K, ArrayList<V>> map, \r
+ K k, V v) {\r
+ ArrayList<V> list = map.get(k);\r
+ if(list == null) {\r
+ list = new ArrayList<V>(2);\r
+ map.put(k, list);\r
+ }\r
+ list.add(v);\r
+ }\r
+ \r
+ private static TMetaVar canonical(\r
+ THashMap<TMetaVar, TMetaVar> cMap,\r
+ TMetaVar v) {\r
+ while(true) {\r
+ TMetaVar temp = cMap.get(v);\r
+ if(temp == null)\r
+ return v;\r
+ else\r
+ v = temp;\r
+ }\r
+ } \r
+ \r
+ private static void merge(\r
+ THashMap<TMetaVar, TMetaVar> cMap,\r
+ THashMap<TMetaVar, ArrayList<Constraint>> groups,\r
+ TMetaVar a,\r
+ TMetaVar b) {\r
+ if(a != b) {\r
+ cMap.put(b, a);\r
+ ArrayList<Constraint> listB = groups.remove(b);\r
+ if(listB != null) {\r
+ ArrayList<Constraint> listA = groups.get(a);\r
+ if(listA == null)\r
+ groups.put(a, listB);\r
+ else\r
+ listA.addAll(listB);\r
+ }\r
+ }\r
+ }\r
+ \r
+ private static ArrayList<ArrayList<Constraint>> groupConstraintsByCommonMetavars(\r
+ ArrayList<Constraint> constraints) {\r
+ THashMap<TMetaVar, ArrayList<Constraint>> groups =\r
+ new THashMap<TMetaVar, ArrayList<Constraint>>();\r
+ THashMap<TMetaVar, TMetaVar> cMap = new THashMap<TMetaVar, TMetaVar>();\r
+ \r
+ ArrayList<TMetaVar> vars = new ArrayList<TMetaVar>(); \r
+ for(Constraint constraint : constraints) {\r
+ constraint.constraint.collectMetaVars(vars);\r
+ if(vars.isEmpty()) {\r
+ add(groups, null, constraint);\r
+ } \r
+ else {\r
+ TMetaVar first = canonical(cMap, vars.get(0));\r
+ for(int i=1;i<vars.size();++i)\r
+ merge(cMap, groups, first, canonical(cMap, vars.get(i)));\r
+ vars.clear();\r
+ add(groups, first, constraint); \r
+ }\r
+ }\r
+ \r
+ return new ArrayList<ArrayList<Constraint>>(groups.values());\r
+ }\r
+ \r
+}\r
Code Review / simantics / platform.git / blobdiff