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