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