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