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