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