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

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