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