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