bundles/org.simantics.scl.compiler/src/org/simantics/scl/compiler/types/Types.java

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