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