bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java

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