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