f793754eed215be13e6ead654b115dac722b5df2
[simantics/platform.git] / bundles / org.simantics.scl.compiler / src / org / simantics / scl / compiler / types / Types.java
1 package org.simantics.scl.compiler.types;
2
3 import java.io.StringReader;
4 import java.util.ArrayList;
5 import java.util.Arrays;
6 import java.util.Collections;
7 import java.util.List;
8
9 import org.simantics.scl.compiler.errors.Locations;
10 import org.simantics.scl.compiler.internal.parsing.exceptions.SCLSyntaxErrorException;
11 import org.simantics.scl.compiler.internal.parsing.parser.SCLParserImpl;
12 import org.simantics.scl.compiler.internal.types.HashConsing;
13 import org.simantics.scl.compiler.internal.types.TypeElaborationContext;
14 import org.simantics.scl.compiler.internal.types.effects.EffectIdMap;
15 import org.simantics.scl.compiler.types.exceptions.KindUnificationException;
16 import org.simantics.scl.compiler.types.exceptions.MatchException;
17 import org.simantics.scl.compiler.types.exceptions.Problem;
18 import org.simantics.scl.compiler.types.exceptions.SCLTypeParseException;
19 import org.simantics.scl.compiler.types.exceptions.UnificationException;
20 import org.simantics.scl.compiler.types.kinds.Kind;
21 import org.simantics.scl.compiler.types.kinds.Kinds;
22 import org.simantics.scl.compiler.types.util.ITypeEnvironment;
23 import org.simantics.scl.compiler.types.util.MultiApply;
24 import org.simantics.scl.compiler.types.util.MultiFunction;
25 import org.simantics.scl.compiler.types.util.TMultiApply;
26 import org.simantics.scl.compiler.types.util.TypeUnparsingContext;
27 import org.simantics.scl.compiler.types.util.Typed;
28
29 import gnu.trove.map.hash.THashMap;
30 import gnu.trove.set.hash.THashSet;
31
32 /**
33  * An utility class for creating and manipulating types.
34  * 
35  * @author Hannu Niemistö
36  */
37 public class Types {
38
39     private static final HashConsing<TCon> conCache = 
40             new HashConsing<TCon>() {
41         protected boolean equals(TCon a, TCon b) {
42             return a.name.equals(b.name) && a.module.equals(b.module);
43         }
44
45         protected int hashCode(TCon obj) {
46             return obj.module.hashCode()*31 + obj.name.hashCode();
47         }
48     };
49
50     public static final String BUILTIN = "Builtin";
51
52     public static final TCon BOOLEAN = con(BUILTIN, "Boolean");
53     public static final TCon BYTE = con(BUILTIN, "Byte");
54     public static final TCon CHARACTER = con(BUILTIN, "Character");
55     public static final TCon SHORT = con(BUILTIN, "Short");
56     public static final TCon INTEGER = con(BUILTIN, "Integer");
57     public static final TCon LONG = con(BUILTIN, "Long");
58     public static final TCon FLOAT = con(BUILTIN, "Float");
59     public static final TCon DOUBLE = con(BUILTIN, "Double");
60     
61     public static final TCon BOOLEAN_ARRAY = con(BUILTIN, "BooleanArray");
62     public static final TCon BYTE_ARRAY = con(BUILTIN, "ByteArray");
63     public static final TCon CHARACTER_ARRAY = con(BUILTIN, "CharacterArray");
64     public static final TCon SHORT_ARRAY = con(BUILTIN, "ShortArray");
65     public static final TCon INTEGER_ARRAY = con(BUILTIN, "IntegerArray");
66     public static final TCon LONG_ARRAY = con(BUILTIN, "LongArray");
67     public static final TCon FLOAT_ARRAY = con(BUILTIN, "FloatArray");
68     public static final TCon DOUBLE_ARRAY = con(BUILTIN, "DoubleArray");
69
70     public static final TCon STRING = con(BUILTIN, "String");
71     public static final TCon ARROW = con(BUILTIN, "->");
72
73     public static final TCon LIST = con(BUILTIN, "[]");
74     public static final TCon VECTOR = con(BUILTIN, "Vector");
75     public static final TCon MVECTOR = con(BUILTIN, "MVector");
76     public static final TCon MAYBE = con(BUILTIN, "Maybe");
77     public static final TCon ARRAY = con(BUILTIN, "Array");
78     public static final TCon UNIT = con(BUILTIN, "()");
79     
80     public static final TCon PUNIT = con(BUILTIN, "@");
81     
82     public static final TCon TYPE_PROXY = con(BUILTIN, "TypeProxy");
83
84     public static final TCon TYPEABLE = con(BUILTIN, "Typeable");
85     public static final TCon SERIALIZABLE = con(BUILTIN, "Serializable");
86     public static final TCon VEC_COMP = con(BUILTIN, "VecComp");
87     public static final TCon BINDING = con(BUILTIN, "Binding");
88
89     public static final TCon TYPE = con(BUILTIN, "Type");
90     
91     public static final TCon DYNAMIC = con("Prelude", "Dynamic");
92     public static final TCon VARIANT = con(BUILTIN, "Variant");
93     
94     public static final TCon ADDITIVE = con("Prelude", "Additive");
95     public static final TCon MONAD = con("Prelude", "Monad");
96     public static final TCon INTEGRAL = con("Prelude", "Integral");
97     public static final TCon RING = con("Prelude", "Ring");
98     public static final TCon ORDERED_RING = con("Prelude", "OrderedRing");
99     public static final TCon REAL = con("Prelude", "Real");
100     public static final TCon SHOW = con("Prelude", "Show");
101     public static final TCon ORD = con("Prelude", "Ord");
102     public static final TCon IO = con("Serialization", "IO");
103
104     public static final Type REF = con("Prelude", "Ref");
105     
106     public static final TCon RANDOM = Types.con("Random", "Random");
107     public static final TCon READ_GRAPH = Types.con("Simantics/DB", "ReadGraph");
108     public static final TCon WRITE_GRAPH = Types.con("Simantics/DB", "WriteGraph");
109     public static final Type RESOURCE = Types.con("Simantics/DB", "Resource"); 
110     
111     public static final TUnion NO_EFFECTS = new TUnion();
112     public static final TCon PROC = con(BUILTIN, "Proc");
113     
114     public static final TCon BRANCH_POINT = con(BUILTIN, "BranchPoint");
115
116     private volatile static TCon[] tupleCache = new TCon[] {
117         UNIT, null
118     };
119
120     private static final ITypeEnvironment DUMMY_TYPE_ENVIRONMENT = new ITypeEnvironment() {
121
122         @Override
123         public TCon resolve(String namespace, String name) {
124             if(namespace == null)
125                 return con(BUILTIN, name);
126             else
127                 return con(namespace, name);
128         }
129
130     };
131     
132     public static boolean isPrimitive(Type type) {
133         return type == BOOLEAN || type == BYTE || type == CHARACTER || type == SHORT ||
134                         type == INTEGER || type == LONG || type == FLOAT || type == DOUBLE || type == STRING;
135     }
136     
137     public static boolean isNumeric(Type type) {
138         return type == BYTE || type == SHORT || type == INTEGER || type == LONG || type == FLOAT || type == DOUBLE;
139     }
140         
141     public static TApply apply(Type function, Type parameter) {
142         return new TApply(function, parameter);
143     }
144
145     public static Type apply(Type function, Type ... parameters) {
146         for(Type parameter : parameters)
147             function = apply(function, parameter);
148         return function;
149     }
150     
151     /**
152      * Get the concrete type pointed to by a chain of type meta-variables.
153      */
154     public static Type canonical(Type type) {
155         if(type instanceof TMetaVar) {
156             TMetaVar metaVar = (TMetaVar)type;
157             type = metaVar.ref;
158             if(type == null)
159                 return metaVar;
160             else
161                 return metaVar.ref = canonical(type);
162         }
163         return type;
164     }
165
166     public static Type closure(Type type, ArrayList<TVar> vars) {
167         for(int i=vars.size()-1;i>=0;--i)
168             type = forAll(vars.get(i), type);
169         return type;
170     }
171
172     public static Type closure(Type type, TVar[] vars) {
173         for(int i=vars.length-1;i>=0;--i)
174             type = forAll(vars[i], type);
175         return type;
176     }
177
178     public static Type closure(Type type) {
179         return closure(type, freeVars(type));
180     }
181
182     public static TCon con(String module, String name) {
183         return conCache.canonical(new TCon(module, name));
184     }
185
186     public static Type[] concat(Type[] a, Type[] b) {
187         if(a.length == 0)
188             return b;
189         if(b.length == 0)
190             return a;
191         Type[] result = new Type[a.length + b.length];
192         for(int i=0;i<a.length;++i)
193             result[i] = a[i];
194         for(int i=0;i<b.length;++i)
195             result[i+a.length] = b[i];
196         return result;
197     }
198
199     public static TVar[] concat(TVar[] a, TVar[] b) {
200         if(a.length == 0)
201             return b;
202         if(b.length == 0)
203             return a;
204         TVar[] result = new TVar[a.length + b.length];
205         for(int i=0;i<a.length;++i)
206             result[i] = a[i];
207         for(int i=0;i<b.length;++i)
208             result[i+a.length] = b[i];
209         return result;
210     }
211
212     public static boolean equals(TApply a, TApply b) {
213         return equals(a.parameter, b.parameter)
214                 && equals(a.function , b.function );
215     }
216
217     public static boolean equals(TFun a, TFun b) {
218         return equals(a.domain, b.domain)
219                 && equals(a.effect, b.effect)
220                 && equals(a.range, b.range);
221     }
222     
223     public static boolean subsumes(TFun a, TFun b) {
224         return subsumes(b.domain, a.domain)
225                 && subsumesEffect(a.effect, b.effect)
226                 && subsumes(a.range, b.range);
227     }
228
229     public static boolean subsumesEffect(Type a, Type b) {
230         EffectIdMap idMap = new EffectIdMap();
231         ArrayList<TMetaVar> mVars = new ArrayList<TMetaVar>(0);
232         int idA = idMap.toId(a, mVars);
233         int idB = idMap.toId(b, mVars);
234         return (idA&idB) == idA;
235     }
236     
237     public static boolean equalsEffect(Type a, Type b) {
238         EffectIdMap idMap = new EffectIdMap();
239         ArrayList<TMetaVar> mVars = new ArrayList<TMetaVar>(0);
240         int idA = idMap.toId(a, mVars);
241         int idB = idMap.toId(b, mVars);
242         return idA == idB;
243     }
244
245     public static boolean equals(TForAll a, TForAll b) {
246         Kind aKind = a.var.getKind();
247         if(!Kinds.equalsCanonical(aKind, b.var.getKind()))
248             return false;
249         TVar newVar = var(aKind);
250         return equals(a.type.replace(a.var, newVar), b.type.replace(b.var, newVar));
251     }
252
253     public static boolean equals(TPred a, TPred b) {
254         if(a.typeClass != b.typeClass 
255                 || a.parameters.length != b.parameters.length)
256             return false;
257         Type[] aParameters = a.parameters;
258         Type[] bParameters = b.parameters;
259         for(int i=0;i<aParameters.length;++i)
260             if(!equals(aParameters[i], bParameters[i]))
261                 return false;
262         return true;
263     }
264
265     public static boolean equals(TUnion a, TUnion b) {
266         if(a.effects.length != b.effects.length)
267             return false;
268         for(int i=0;i<a.effects.length;++i)
269             if(!equals(a.effects[i], b.effects[i]))
270                 return false;
271         return true;
272     }
273
274     /**
275      * Tests equality of two types. Unbound TVars
276      * are equal only if they are the same variable.
277      * Bound TMetaVar is equal to the type it is bound to.
278      * Unbound TMetaVars are equal only if they are the same metavariable.
279      * Order of predicates and forall quantifiers matters.
280      */
281     public static boolean equals(Type a, Type b) {
282         a = canonical(a);
283         b = canonical(b);
284         if(a == b)
285             return true;
286         Class<?> ca = a.getClass();
287         Class<?> cb = b.getClass();
288         if(ca != cb)
289             return false;
290         if(ca == TApply.class) 
291             return equals((TApply)a, (TApply)b);
292         else if(ca == TFun.class) 
293             return equals((TFun)a, (TFun)b);
294         else if(ca == TForAll.class)
295             return equals((TForAll)a, (TForAll)b);
296         else if(ca == TPred.class) 
297             return equals((TPred)a, (TPred)b);
298         else if(ca == TUnion.class) 
299             return equals((TUnion)a, (TUnion)b);        
300         else // ca == TCon.class 
301             // || (ca == TMetaVar.class && a.ref == null && b.ref == null) 
302             // || ca = TVar.class 
303             return false; // Equals only if a == b, that was already tested
304     }
305     
306     public static boolean subsumes(Type a, Type b) {
307         a = canonical(a);
308         b = canonical(b);
309         if(a == b)
310             return true;
311         Class<?> ca = a.getClass();
312         Class<?> cb = b.getClass();
313         if(ca != cb)
314             return false;
315         if(ca == TApply.class) 
316             return equals((TApply)a, (TApply)b);
317         else if(ca == TFun.class) 
318             return subsumes((TFun)a, (TFun)b);
319         else if(ca == TForAll.class) {
320             TForAll aForAll = (TForAll)a;
321             TForAll bForAll = (TForAll)b;
322             TVar newVar = var(aForAll.var.getKind());
323             return subsumes(aForAll.type.replace(aForAll.var, newVar),
324                             bForAll.type.replace(bForAll.var, newVar));
325         }
326         else if(ca == TPred.class) 
327             return equals((TPred)a, (TPred)b);
328         else if(ca == TUnion.class) 
329             return equals((TUnion)a, (TUnion)b);        
330         else // ca == TCon.class 
331             // || (ca == TMetaVar.class && a.ref == null && b.ref == null) 
332             // || ca = TVar.class 
333             return false; // Equals only if a == b, that was already tested
334     }
335
336     public static TForAll forAll(TVar parameter, Type type) {
337         return new TForAll(parameter, type);
338     }
339
340     public static Type forAll(TVar[] parameters, Type type) {
341         for(int i=parameters.length-1;i>=0;--i)
342             type = forAll(parameters[i], type);
343         return type;
344     }
345
346     public static ArrayList<TVar> freeVars(Type type) {
347         ArrayList<TVar> vars = new ArrayList<TVar>(2);
348         type.collectFreeVars(vars);
349         return vars;
350     }
351
352     public static ArrayList<TVar> freeVars(Type[] types) {
353         ArrayList<TVar> vars = new ArrayList<TVar>(2);
354         for(Type type : types)
355             type.collectFreeVars(vars);
356         return vars;
357     }
358
359     public static TVar[] freeVarsArray(Type type) {
360         ArrayList<TVar> vars = freeVars(type);        
361         return vars.toArray(new TVar[vars.size()]);
362     }
363
364     public static TVar[] freeVarsArray(Type[] types) {
365         ArrayList<TVar> vars = freeVars(types);        
366         return vars.toArray(new TVar[vars.size()]);
367     }
368
369     public static TPred pred(TCon typeClass, Type ... parameters) {
370         return new TPred(typeClass, parameters);
371     }
372
373     public static Type function(Type ... types) {
374         Type result = types[types.length-1];
375         for(int i=types.length-2;i>=0;--i)
376             result = function(types[i], result);
377         return result;
378     }
379
380     public static Type function(Type from, Type to) {
381         return new TFun(from, Types.NO_EFFECTS, to);
382     }
383
384     public static Type function(Type[] from, Type to) {
385         for(int i=from.length-1;i>=0;--i)
386             to = function(from[i], to);
387         return to;
388     }
389
390     public static TFun functionE(Type from, Type effect, Type to) {
391         return new TFun(from, effect, to);
392     }
393
394     public static Type functionE(Type[] from, Type effect, Type to) {
395         for(int i=from.length-1;i>=0;--i) {
396             to = functionE(from[i], effect, to);
397             effect = Types.NO_EFFECTS;
398         }
399         return to;
400     }
401
402     public static Type removeForAll(Type type, ArrayList<TVar> vars) {
403         while(true) {
404             if(type instanceof TForAll) {
405                 TForAll forAll = (TForAll)type;
406                 type = forAll.type;
407                 vars.add(forAll.var);
408             }
409             else if(type instanceof TMetaVar) {
410                 TMetaVar var = (TMetaVar)type;
411                 if(var.ref != null)
412                     type = var.ref;
413                 else
414                     return type;
415             }
416             else
417                 return type;
418         }
419     }
420     
421     public static Type removeForAll(Type type) {
422         while(true) {
423             if(type instanceof TForAll) {
424                 TForAll forAll = (TForAll)type;
425                 type = forAll.type;
426             }
427             else if(type instanceof TMetaVar) {
428                 TMetaVar var = (TMetaVar)type;
429                 if(var.ref != null)
430                     type = var.ref;
431                 else
432                     return type;
433             }
434             else
435                 return type;
436         }
437     }
438
439     public static Type instantiate(TForAll forAll, ArrayList<TMetaVar> vars) {
440         TMetaVar metaVar = metaVar(forAll.var.getKind());
441         vars.add(metaVar);
442         return instantiate(forAll.type.replace(forAll.var, metaVar), vars);
443     }
444
445     public static Type instantiate(Type type, ArrayList<TMetaVar> vars) {
446         if(type == null)
447             throw new NullPointerException();
448         type = canonical(type);
449         if(type instanceof TForAll)
450             return instantiate((TForAll)type, vars);
451         else
452             return type;
453     }
454
455     public static Type list(Type parameter) {
456         return apply(LIST, parameter);
457     }
458     
459     public static Type vector(Type parameter) {
460         return apply(VECTOR, parameter);
461     }
462     
463     public static Type mvector(Type parameter) {
464         return apply(MVECTOR, parameter);
465     }
466
467     public static MultiFunction matchFunction(Type type, int arity) throws MatchException {
468         if (type instanceof TForAll)
469                 return matchFunction(((TForAll)type).type, arity);
470         
471         type = canonical(type);
472         /*while(type instanceof TForAll)
473             type = canonical(((TForAll)type).type);*/
474         Type[] parameterTypes = new Type[arity];
475         Type effect = Types.NO_EFFECTS;
476         for(int i=0;i<arity;++i) {
477             if(type instanceof TFun) {
478                 TFun fun = (TFun)type;            
479                 parameterTypes[i] = fun.domain;
480                 type = canonical(fun.range);
481                 if(i == arity-1)
482                     effect = fun.effect;
483                 else if(Types.canonical(fun.effect) != Types.NO_EFFECTS)
484                     throw new MatchException();
485             }
486             /*else if(type instanceof TMetaVar) {
487                 TMetaVar metaVar = (TMetaVar)type;
488                 type = Types.metaVar(Kinds.STAR);
489                 Type template = type;
490                 effect = Types.metaVar(Kinds.EFFECT);
491                 for(int j=arity-1;j>=i;--j) {
492                     Type pType = Types.metaVar(Kinds.STAR);
493                     parameterTypes[j] = pType;
494                     template = Types.functionE(pType, 
495                             j==arity-1 ? effect : Types.NO_EFFECTS,
496                                     template);
497                 }
498                 try {
499                     metaVar.setRef(template);
500                 } catch (UnificationException e) {
501                     // Should never happen
502                     throw new MatchException();                    
503                 }
504                 break;
505             }*/
506             /*else if(type instanceof TApply) {
507                 TApply apply1 = (TApply)type;
508                 Type function1 = canonical(apply1.function);
509                 if(function1 instanceof TApply) {
510                     TApply apply2 = (TApply)function1;
511                     Type function2 = canonical(apply2.function);
512                     if(function2 == ARROW) {
513                         result[i] = apply2.parameter;
514                         type = canonical(apply1.parameter);
515                     }
516                     else
517                         throw new MatchException();
518                 }
519                 else
520                     throw new MatchException();
521             }*/
522             else
523                 throw new MatchException();
524         }
525         return new MultiFunction(parameterTypes, effect, type);
526     }
527
528     public static boolean isApply(Type func, int arity, Type type) {        
529         while(arity-- > 0) {
530             type = canonical(type);
531             if(!(type instanceof TApply))
532                 return false;
533             type = ((TApply)type).function;
534         }
535         return equals(func, type);
536     }
537
538     public static Type matchApply(TCon func, Type type) throws MatchException {
539         type = canonical(type);
540         if(type instanceof TApply) {
541             TApply apply = (TApply)type;
542             Type f = canonical(apply.function);
543             if(f.equals(func))
544                 return canonical(apply.parameter);
545         }
546         throw new MatchException();
547     }
548     
549     public static MultiApply matchApply(Type type) {
550         ArrayList<Type> parameters = new ArrayList<Type>();
551         type = canonical(type);
552         while(type instanceof TApply) {
553             TApply apply = (TApply)type;
554             parameters.add(Types.canonical(apply.parameter));
555             type = canonical(apply.function);
556         }
557         Type[] parametersArray;
558         if(parameters.isEmpty())
559             parametersArray = Type.EMPTY_ARRAY;
560         else {
561             parametersArray = new Type[parameters.size()];
562             for(int i=0,j=parametersArray.length-1;i<parametersArray.length;++i,--j)
563                 parametersArray[i] = parameters.get(j);
564         }
565         return new MultiApply(type, parametersArray);
566     }
567     
568     public static Type unifyApply(TCon func, Type type) throws MatchException {
569         type = canonical(type);
570         if(type instanceof TApply) {
571             TApply apply = (TApply)type;
572             Type f = canonical(apply.function);
573             if(f.equals(func))
574                 return canonical(apply.parameter);
575             else if(f instanceof TMetaVar)
576                 try {
577                     ((TMetaVar)f).setRef(func);
578                     return canonical(apply.parameter);
579                 } catch (UnificationException e) {
580                     throw new MatchException();
581                 }
582         }
583         else if(type instanceof TMetaVar) {
584             TMetaVar parameter = Types.metaVar(Kinds.metaVar());
585             try {
586                 ((TMetaVar) type).setRef(apply(func, parameter));
587             } catch (UnificationException e) {
588                 throw new MatchException();
589             }
590             return parameter;
591         }
592         throw new MatchException();
593     }
594
595     public static MultiFunction matchFunction(Type type) {
596         type = canonical(type);
597         while(type instanceof TForAll)
598             type = canonical(((TForAll)type).type);
599         ArrayList<Type> parameterTypes = new ArrayList<Type>();
600         Type effect = Types.NO_EFFECTS;
601         while(true) {
602             if(type instanceof TFun) {
603                 TFun fun = (TFun)type;
604                 parameterTypes.add(fun.domain);
605                 type = canonical(fun.range);
606                 if(canonical(fun.effect) != Types.NO_EFFECTS) {
607                     effect = fun.effect;
608                     break;
609                 }
610             }            
611             /*else if(type instanceof TApply) {
612                 TApply apply1 = (TApply)type;
613                 Type function1 = canonical(apply1.function);
614                 if(function1 instanceof TApply) {
615                     TApply apply2 = (TApply)function1;
616                     Type function2 = canonical(apply2.function);
617                     if(function2 == ARROW) {
618                         types.add(apply2.parameter);
619                         type = apply1.parameter;
620                     }
621                     else {
622                         types.add(type);
623                         break;
624                     }
625                 }
626                 else {
627                     types.add(type);
628                     break;
629                 }
630             }*/
631             else {
632                 break;
633             }
634         }
635         return new MultiFunction(
636                 parameterTypes.toArray(new Type[parameterTypes.size()]),
637                 effect,
638                 type);
639     }
640
641     public static MultiFunction unifyFunction(Type type, int arity) throws UnificationException {
642         Type[] parameterTypes = new Type[arity];
643         for(int i=0;i<arity;++i)
644             parameterTypes[i] = metaVar(Kinds.STAR);
645         Type effect = metaVar(Kinds.EFFECT);
646         Type requiredType = metaVar(Kinds.STAR);
647         MultiFunction result = new MultiFunction(parameterTypes, effect, requiredType);
648
649         for(int i=arity-1;i>=0;--i) {
650             requiredType = functionE(parameterTypes[i], effect, requiredType);
651             effect = Types.NO_EFFECTS;
652         }
653         unify(type, requiredType);
654         return result;
655     }
656
657     private static Type getRangeIfFunction(Type type) {
658         type = canonical(type);
659
660         if(type instanceof TFun) {
661             return ((TFun)type).range;
662         }
663         /*else if(type instanceof TApply) {
664             TApply apply1 = (TApply)type;
665             Type f = canonical(apply1.function);
666             if(f instanceof TApply) {
667                 if( canonical(((TApply)f).function) == Types.ARROW ) {
668                     return apply1.parameter;
669                 }
670                 else
671                     return null;
672             }
673             else
674                 return null;
675         }*/
676         else
677             return null;
678     }
679
680     public static int getArity(Type type) {
681         int arity = 0;
682         while(true) {
683             type = getRangeIfFunction(type);
684             if(type == null)
685                 break;
686             ++arity;
687         }
688         return arity;
689     }
690
691     public static TMetaVar metaVar(Kind kind) {
692         return new TMetaVar(kind);
693     }
694
695     public static Type constrained(TPred constraint, Type type) {
696         return new TFun(constraint, Types.NO_EFFECTS, type);
697     }
698
699     public static Type constrained(TPred[] constraints, Type type) {
700         for(int i=constraints.length-1;i>=0;--i)
701             type = constrained(constraints[i], type);
702         return type;
703     }
704
705     public static TMultiApply toMultiApply(Type type) {
706         ArrayList<Type> parameters = new ArrayList<Type>();
707         type = canonical(type);
708         while(type instanceof TApply) {
709             TApply apply = (TApply)type;
710             parameters.add(apply.parameter);
711             type = canonical(apply.function);
712         }
713         Collections.reverse(parameters);
714         return new TMultiApply(type, parameters);
715     }
716
717     public static Type tuple(Type ... parameters) {
718         if(parameters.length == 1)
719             return parameters[0];
720         else
721             return apply(tupleConstructor(parameters.length), parameters);
722     }
723
724     public static TCon tupleConstructor(int arity) {
725         if(arity < 0 || arity == 1)
726             throw new IllegalArgumentException("The arity of a tuple cannot be " + arity + ".");
727
728         TCon[] oldTupleCache = tupleCache;
729         if(oldTupleCache.length <= arity) {         
730             int oldLength = oldTupleCache.length;
731             int newLength = oldLength*2;
732             while(newLength <= arity)
733                 newLength *= 2;
734             TCon[] newTupleCache = Arrays.copyOf(oldTupleCache, newLength);
735             for(int i=oldLength;i<newLength;++i) {
736                 StringBuilder b = new StringBuilder();
737                 b.append('(');
738                 for(int j=1;j<i;++j)
739                     b.append(',');
740                 b.append(')');
741                 newTupleCache[i] = con(BUILTIN, b.toString());
742             }
743             TCon result = newTupleCache[arity];
744             tupleCache = newTupleCache;
745             return result;
746         }
747         else
748             return oldTupleCache[arity];
749     }
750
751     public static void unify(TFun a, TFun b) throws UnificationException {
752         unify(a.domain, b.domain);
753         unify(a.effect, b.effect);
754         unify(a.range, b.range);
755     }
756
757     public static void unify(TApply a, TApply b) throws UnificationException {
758         unify(a.function, b.function);
759         unify(a.parameter, b.parameter);
760     }
761
762     public static void unify(TForAll a, TForAll b) throws UnificationException {
763         try {
764             Kinds.unify(a.var.getKind(), b.var.getKind());
765         } catch (KindUnificationException e) {
766             throw new UnificationException(a, b);
767         }
768         TVar newVar = var(a.var.getKind());
769         unify(a.type.replace(a.var, newVar), b.type.replace(b.var, newVar));
770     }
771
772     public static void unify(TPred a, TPred b) throws UnificationException {
773         if(a.typeClass != b.typeClass
774                 || a.parameters.length != b.parameters.length)
775             throw new UnificationException(a, b);
776         for(int i=0;i<a.parameters.length;++i)
777             unify(a.parameters[i], b.parameters[i]);
778     }
779
780     public static void unify(TUnion a, TUnion b) throws UnificationException {
781         if(a.effects.length != b.effects.length)
782             throw new UnificationException(a, b);
783         for(int i=0;i<a.effects.length;++i)
784             unify(a.effects[i], b.effects[i]);        
785     }
786
787     public static void unify(Type a, Type b) throws UnificationException {
788         a = canonical(a);
789         b = canonical(b);
790         if(a == b)
791             return;
792         if(a instanceof TMetaVar) {
793             ((TMetaVar)a).setRef(b);
794             return;
795         }
796         if(b instanceof TMetaVar) {
797             ((TMetaVar)b).setRef(a);
798             return;
799         }
800         else
801             b = canonical(b);
802         Class<?> ca = a.getClass();
803         Class<?> cb = b.getClass();
804         if(ca != cb) {
805             throw new UnificationException(a, b);
806         }
807         if(ca == TApply.class) 
808             unify((TApply)a, (TApply)b);
809         else if(ca == TFun.class) 
810             unify((TFun)a, (TFun)b);
811         else if(ca == TForAll.class)
812             unify((TForAll)a, (TForAll)b);
813         else if(ca == TPred.class) 
814             unify((TPred)a, (TPred)b);
815         else if(ca == TUnion.class) 
816             unify((TUnion)a, (TUnion)b);
817         else // ca == TCon.class || ca = TVar.class 
818             throw new UnificationException(a, b);
819     }
820
821     public static TVar var(Kind kind) {
822         return new TVar(kind);
823     }
824
825     public static TVar[] vars(TVar[] otherVars) {
826         TVar[] vars = new TVar[otherVars.length];
827         for(int i=0;i<otherVars.length;++i)
828             vars[i] = var(otherVars[i].getKind());
829         return vars;
830     }
831
832     public static Type instantiate(Type type, Type ... parameters) {
833         for(int i=0;i<parameters.length;++i) {
834             type = canonical(type);
835             if(!(type instanceof TForAll))
836                 throw new IllegalArgumentException();
837             TForAll forAll = (TForAll)type;
838             type = forAll.type.replace(forAll.var, parameters[i]);
839         }
840         return type;
841     }
842
843     public static Type[] getTypes(Typed[] values) {
844         Type[] types = new Type[values.length];
845         for(int i=0;i<values.length;++i)
846             types[i] = values[i].getType();
847         return types;                
848     }
849
850     /**
851      * Matches b to a, i.e. finds a substitution such that a[substitution] = b.
852      * Unbound metavariables in b are consired as normal variables. It is assumed
853      * that a does not contain metavariables and b does not contain any type variables
854      * in a (no occurs checks needed).
855      * @param a pattern
856      * @param b instance
857      * @param substitution
858      * @return
859      */
860     public static boolean match(Type a, Type b, THashMap<TVar, Type> substitution) {
861         b = canonical(b);
862
863         Class<?> ca = a.getClass();
864         if(ca == TVar.class) {
865             TVar ta = (TVar)a;
866             Type t = substitution.get(ta);
867             if(t == null) {
868                 substitution.put(ta, b); // no occurs check needed
869                 return true;
870             }
871             else
872                 return match(t, b, substitution);                
873         }        
874         if(a == b)
875             return true;        
876         Class<?> cb = b.getClass();
877         if(ca != cb || ca == TCon.class)
878             return false;
879         if(ca == TApply.class) 
880             return match((TApply)a, (TApply)b, substitution);        
881         else if(ca == TFun.class) 
882             return match((TFun)a, (TFun)b, substitution);
883         else if(ca == TPred.class) 
884             return match((TPred)a, (TPred)b, substitution);
885         else {
886             throw new UnsupportedOperationException("match(" + a + ", " + b +") not supported"); // TForAll not supported
887         }
888     }
889
890     public static boolean match(TApply a, TApply b, THashMap<TVar, Type> substitution) {
891         return match(a.function, b.function, substitution) && match(a.parameter, b.parameter, substitution);
892     }
893
894     public static boolean match(TPred a, TPred b, THashMap<TVar, Type> substitution) {
895         if(a.typeClass != b.typeClass || a.parameters.length != b.parameters.length)
896             return false;
897         for(int i=0;i<a.parameters.length;++i)
898             if(!match(a.parameters[i], b.parameters[i], substitution))
899                 return false;
900         return true;
901     }
902
903     public static boolean match(TFun a, TFun b, THashMap<TVar, Type> substitution) {
904         return match(a.domain, b.domain, substitution) 
905                 && match(a.effect, b.effect, substitution)
906                 && match(a.range, b.range, substitution);
907     }
908
909     public static Type removePred(Type type,
910             ArrayList<TPred> preds) {
911         while(type instanceof TFun) {
912             TFun pred = (TFun)type;
913             if(!(pred.domain instanceof TPred))
914                 break;
915             preds.add((TPred)pred.domain);
916             type = canonical(pred.range);
917         }
918         return type;
919     }
920
921     public static <T extends Typed> Type[] getTypes(List<T> vars) {
922         Type[] result = new Type[vars.size()];
923         for(int i=0;i<result.length;++i)
924             result[i] = vars.get(i).getType();
925         return result;
926     }
927
928     public static boolean isBoxed(Type type) {
929         while(true) {
930             if(type instanceof TVar)
931                 return true;
932             else if(type instanceof TApply) {
933                 TApply apply = (TApply)type;
934                 Type function = Types.canonical(apply.function);
935                 if(function == Types.MAYBE || function == Types.MVECTOR || function == Types.VECTOR) 
936                     // FIXME Special case handled now here.
937                     // The same problem is possibly with other types also!!!
938                     type = apply.parameter;
939                 else
940                     type = function;
941             }
942             else if(type instanceof TMetaVar) {
943                 type = ((TMetaVar)type).ref;
944                 if(type == null)
945                     return true;
946             }
947             else if(type instanceof TForAll) {
948                 type = ((TForAll)type).type;
949             }
950             else
951                 return false;
952         }
953     }
954
955     public static boolean isFunction(Type type) {
956         type = canonical(type);
957         return type instanceof TFun;
958         /*if(!(type instanceof TApply))
959             return false;
960         type = canonical(((TApply)type).function);
961         if(!(type instanceof TApply))
962             return false;
963         type = canonical(((TApply)type).function);
964         return type == ARROW;*/
965     }
966
967     public static boolean equals(Type[] as, Type[] bs) {
968         if(as.length != bs.length)
969             return false;
970         for(int i=0;i<as.length;++i)
971             if(!equals(as[i], bs[i]))
972                 return false;
973         return true;
974     }
975
976     public static String toString(Type[] types) {
977         StringBuilder b = new StringBuilder();
978         TypeUnparsingContext tuc = new TypeUnparsingContext();
979         b.append('[');
980         boolean first = true;
981         for(Type type : types) {
982             if(first)
983                 first = false;
984             else
985                 b.append(", ");
986             b.append(type.toString(tuc));
987         }
988         b.append(']');
989         return b.toString();
990     }
991
992     public static TCon getConstructor(Type type) throws MatchException {
993         while(true) {
994             if(type instanceof TCon)
995                 return (TCon)type;
996             else if(type instanceof TApply)
997                 type = ((TApply)type).function;
998             else if(type instanceof TMetaVar) {
999                 Type ref = ((TMetaVar)type).ref;
1000                 if(ref == null)
1001                     throw new MatchException();
1002                 type = ref;
1003             }
1004             else
1005                 throw new MatchException();
1006         }
1007     }
1008
1009     public static Type[] replace(Type[] types, TVar[] from, Type[] to) {
1010         if(types.length == 0)
1011             return Type.EMPTY_ARRAY;
1012         Type[] result = new Type[types.length];
1013         for(int i=0;i<types.length;++i)
1014             result[i] = types[i].replace(from, to);
1015         return result;
1016     }
1017     
1018     public static TPred[] replace(TPred[] types, TVar[] from, Type[] to) {
1019         if(types.length == 0)
1020             return TPred.EMPTY_ARRAY;
1021         TPred[] result = new TPred[types.length];
1022         for(int i=0;i<types.length;++i)
1023             result[i] = (TPred)types[i].replace(from, to);
1024         return result;
1025     }
1026     
1027     public static <T extends Type> Type[] replace(Type[] types, THashMap<TVar, T> map) {
1028         if(types.length == 0)
1029             return Type.EMPTY_ARRAY;
1030         Type[] result = new Type[types.length];
1031         for(int i=0;i<types.length;++i)
1032             result[i] = types[i].replace(map);
1033         return result;
1034     }
1035
1036     public static Type union(Type ... effects) {
1037         if(effects.length == 0)
1038             return NO_EFFECTS;
1039         else if(effects.length == 1)
1040             return effects[0];
1041         else
1042             return new TUnion(effects);
1043     }
1044     
1045     public static Type union(Type effect1, Type effect2) {
1046         return new TUnion(effect1, effect2);
1047     }
1048
1049     public static Type union(List<Type> effects) {
1050         if(effects.size() == 0)
1051             return NO_EFFECTS;
1052         else if(effects.size() == 1)
1053             return effects.get(0);
1054         else
1055             return new TUnion(effects.toArray(new Type[effects.size()]));
1056     }
1057
1058     public static void canonize(Type[] types) {
1059         for(int i=0;i<types.length;++i)
1060             types[i] = canonical(types[i]);
1061     }
1062     
1063     public static Type simplifyFinalEffect(Type effect) {
1064         effect = canonical(effect);
1065         if(effect instanceof TMetaVar) {
1066             try {
1067                 //((TMetaVar) effect).setRef(Types.NO_EFFECTS);
1068                 Type t = Types.var(Kinds.EFFECT);
1069                 ((TMetaVar) effect).setRef(t);
1070                 return t;
1071             } catch (UnificationException e) {
1072                 // Should not happen.
1073                 throw new RuntimeException(e);
1074             }
1075         }
1076         if(effect instanceof TUnion) {
1077             TUnion union = (TUnion)effect;
1078             if(union.effects.length == 0)
1079                 return Types.NO_EFFECTS;
1080             ArrayList<Type> effects = new ArrayList<Type>(union.effects.length);
1081             for(Type c : union.effects) {
1082                 c = simplifyFinalEffect(c);
1083                 if(c instanceof TUnion)
1084                     for(Type c2 : ((TUnion)c).effects)
1085                         effects.add(c2);
1086                 else
1087                     effects.add(c);
1088             }
1089             return union(effects);
1090         }
1091         return effect;
1092     }
1093     
1094     public static Type simplifyType(Type effect) {
1095         effect = canonical(effect);
1096         if(effect instanceof TUnion) {
1097             TUnion union = (TUnion)effect;
1098             if(union.effects.length == 0)
1099                 return Types.NO_EFFECTS;
1100             THashSet<Type> effects = new THashSet<Type>(union.effects.length);
1101             for(Type c : union.effects) {
1102                 c = simplifyFinalEffect(c);
1103                 if(c instanceof TUnion)
1104                     for(Type c2 : ((TUnion)c).effects)
1105                         effects.add(c2);
1106                 else
1107                     effects.add(c);
1108             }
1109             return union(effects.toArray(new Type[effects.size()]));
1110         }
1111         return effect;
1112     }
1113
1114     public static Type parseType(ITypeEnvironment environment, String text) throws SCLTypeParseException {
1115         return parseType(new TypeElaborationContext(environment), text);
1116     }
1117
1118     public static Type parseType(ITypeEnvironment environment, THashMap<String, TVar> localTypeVars, String text) throws SCLTypeParseException {
1119         return parseType(new TypeElaborationContext(localTypeVars, environment), text);
1120     }
1121
1122     public static Type parseType(String text) throws SCLTypeParseException {
1123         return parseType(new TypeElaborationContext(DUMMY_TYPE_ENVIRONMENT), text);
1124     }
1125
1126     public static Type parseType(THashMap<String, TVar> localTypeVars, String text) throws SCLTypeParseException {
1127         return parseType(new TypeElaborationContext(localTypeVars, DUMMY_TYPE_ENVIRONMENT), text);
1128     }
1129     
1130     private static Type parseType(TypeElaborationContext context, String text) throws SCLTypeParseException {
1131         SCLParserImpl parser = new SCLParserImpl(new StringReader(text));
1132         try {
1133             org.simantics.scl.compiler.internal.parsing.types.TypeAst ast = 
1134                     (org.simantics.scl.compiler.internal.parsing.types.TypeAst)parser.parseType();
1135             return ast.toType(context);
1136         } catch (SCLSyntaxErrorException e) {
1137             throw new SCLTypeParseException(new Problem(
1138                     Locations.beginOf(e.location),
1139                     Locations.endOf(e.location),
1140                     e.getMessage()));
1141         }
1142     }
1143
1144     public static Type instantiateAndStrip(Type type) {
1145         while(true) {
1146             if(type instanceof TForAll) {
1147                 TForAll forAll = (TForAll)type;
1148                 type = forAll.type.replace(forAll.var, metaVar(forAll.var.getKind()));
1149             }
1150             else if(type instanceof TFun) {
1151                 TFun fun = (TFun)type;
1152                 if(fun.domain instanceof TPred || fun.domain == Types.PUNIT)
1153                     type = fun.range;
1154                 else
1155                     return type;
1156             }
1157             else if(type instanceof TMetaVar) {
1158                 TMetaVar metaVar = (TMetaVar)type;
1159                 if(metaVar.ref == null)
1160                     return type;
1161                 else
1162                     type = metaVar.ref;
1163             }
1164             else
1165                 return type;
1166         }
1167     }
1168     
1169 }