prop-src/type.pcc

   1 /////////////////////////////////////////////////////////////////////////////
   2 //
   3 //  This file implements the type analysis and type inference module
   4 //  in the Prop -> C++ translator.
   5 //
   6 /////////////////////////////////////////////////////////////////////////////
   7
   8 #include <AD/strings/quark.h>
   9 #include "hashtab.h"
  10 #include "ir.ph"
  11 #include "ast.ph"
  12 #include "collection.ph"
  13 #include "type.h"
  14 #include "datatype.ph"
  15 #include "list.h"
  16 #include "options.h"
  17
  18 /////////////////////////////////////////////////////////////////////////////
  19 //
  20 //  Types for literals
  21 //
  22 /////////////////////////////////////////////////////////////////////////////
  23 Ty string_ty    = NOty,
  24    character_ty = NOty,
  25    integer_ty   = NOty,
  26    real_ty      = NOty,
  27    bool_ty      = NOty,
  28    void_ty      = NOty,
  29    quark_ty     = NOty,
  30    bigint_ty    = NOty;
  31
  32 /////////////////////////////////////////////////////////////////////////////
  33 //
  34 // Initialize the types
  35 //
  36 /////////////////////////////////////////////////////////////////////////////
  37 void initialize_types()
  38 {  character_ty = mkidty(#"char",#[]);
  39    string_ty    = mkptrty(QUALty(QUALconst,character_ty));
  40    integer_ty   = mkidty(#"int",#[]);
  41    real_ty      = mkidty(#"double",#[]);
  42    bool_ty      = mkidty(#"bool",#[]);
  43    void_ty      = mkidty(#"void",#[]);
  44    quark_ty     = mkidty(#"Quark",#[]);
  45    bigint_ty    = mkidty(#"BigInt",#[]);
  46 }
  47
  48 /////////////////////////////////////////////////////////////////////////////
  49 //
  50 //  Make a type variable
  51 //
  52 /////////////////////////////////////////////////////////////////////////////
  53 Ty mkvar() { return VARty(NOty); }
  54
  55 /////////////////////////////////////////////////////////////////////////////
  56 //
  57 //  Constructors for some common types
  58 //
  59 /////////////////////////////////////////////////////////////////////////////
  60 Ty mkptrty    (Ty ty)                { return TYCONty(POINTERtycon, #[ty]); }
  61 Ty mkrefty    (Ty ty)                { return TYCONty(REFtycon, #[ty]); }
  62 Ty mkfunty    (Ty a, Ty b)           { return TYCONty(FUNtycon, #[a,b]); }
  63 Ty mkarrayty  (Ty a, Exp e)          { return TYCONty(ARRAYtycon(e), #[a]); }
  64 Ty mkidty     (Id id, Tys args)      { return TYCONty(IDtycon(id), args); }
  65 Ty mkidvarty  (Id id, TyVars args)   { return TYCONty(IDtycon(id), tyvars_to_tys(args)); }
  66 Ty mktuplety  (Tys tys)              { return TYCONty(TUPLEtycon, tys); }
  67 Ty mkrecordty (Ids l, Tys t, Bool f) { return TYCONty(RECORDtycon(l,f), t); }
  68 Ty mktypety   ()                     { return TYCONty(TYPEtycon,#[]); }
  69 Tys tyvars_to_tys (TyVars a)
  70 {  match (a)
  71    {  #[]:        { return #[]; }
  72    |  #[h ... t]: { return #[mkidty(h,#[]) ... tyvars_to_tys(t)]; }
  73    }
  74 }
  75
  76 /////////////////////////////////////////////////////////////////////////////
  77 //
  78 // Return the representation tag of a constructor
  79 //
  80 /////////////////////////////////////////////////////////////////////////////
  81 int tag_of(Cons cons)
  82 {  match (cons) of
  83       ONEcons { alg_ty = DATATYPEty({ qualifiers ... },_), tag ... }:
  84           {  return tag + ((qualifiers & QUALlexeme) ? 256 : 0); }
  85    |  _:  { return 0; }
  86    end match;
  87 }
  88
  89 /////////////////////////////////////////////////////////////////////////////
  90 //  Convert type variables to a type list
  91 /////////////////////////////////////////////////////////////////////////////
  92 Tys tyvars_to_type_list(int i, TyVars tyvars)
  93 {  match (tyvars)
  94    {  #[]:        { return #[]; }
  95    |  #[a ... b]: { return #[ INDty(a,i) ... tyvars_to_type_list(i+1,b) ]; }
  96    }
  97 }
  98
  99 /////////////////////////////////////////////////////////////////////////////
 100 //
 101 //  Make a universally quantified type
 102 //
 103 /////////////////////////////////////////////////////////////////////////////
 104 Ty mkpolyty(Ty ty, TyVars tyvars)
 105 {  int arity = length(tyvars);
 106    if (arity == 0) return ty;
 107    Id * bound_vars = (Id *)mem_pool[arity * sizeof(Id)];
 108    int i = 0;
 109    for_each (TyVar, tv, tyvars)
 110       bound_vars[i++] = tv;
 111    return POLYty(deref(ty),arity,bound_vars);
 112 /*
 113    match (deref(ty))
 114    {  TYCONty(tycon,_):
 115       { return POLYty
 116           (TYCONty(tycon,tyvars_to_type_list(0,tyvars)), arity, bound_vars);
 117       }
 118    |  _: { bug("mkpolyty()"); }
 119    }
 120 */
 121 }
 122
 123 /////////////////////////////////////////////////////////////////////////////
 124 //
 125 //  Dereference a type expression
 126 //
 127 /////////////////////////////////////////////////////////////////////////////
 128 Ty deref_all(Ty ty)
 129 {  match while (ty)
 130    {  VARty (t as ! NOty):  { ty = t; }
 131    |  QUALty(_,t):          { ty = t; }
 132    |  DEFVALty(t,_):        { ty = t; }
 133    |  IDty (id, #[]):
 134       {  Ty t = lookup_ty(id); if (t != NOty) ty = t; else return ty; }
 135    |  IDty (id, a):
 136       {  match (lookup_ty(id))
 137          {  TYCONty(tycon,x): { return TYCONty(tycon,a); }
 138          |  _:                { return ty; }
 139          }
 140       }
 141    |  _:                   { return ty; }
 142    }
 143 }
 144
 145 /////////////////////////////////////////////////////////////////////////////
 146 //
 147 //  Dereference a type expression.
 148 //
 149 /////////////////////////////////////////////////////////////////////////////
 150 Ty deref(Ty ty)
 151 {  match while (ty) { VARty (t as ! NOty): { ty = t; } }
 152    return ty;
 153 }
 154
 155 /////////////////////////////////////////////////////////////////////////////
 156 //
 157 //  Get the default value of a type (if any)
 158 //
 159 /////////////////////////////////////////////////////////////////////////////
 160 Exp default_val(Ty ty)
 161 {  match (deref(ty))
 162    {  DEFVALty (_,v): { return v; }
 163    |  _:              { return NOexp; }
 164    }
 165 }
 166
 167 /////////////////////////////////////////////////////////////////////////////
 168 //
 169 //  Test for qualifiers in a type
 170 //
 171 /////////////////////////////////////////////////////////////////////////////
 172 Bool has_qual(TyQual q, Ty ty)
 173 {  match while (ty)
 174    {  VARty t:         { ty = t; }
 175    |  NESTEDty(_,t):   { ty = t; }
 176    |  DEFVALty(t,_):   { ty = t; }
 177    |  DATATYPEty({ qualifiers ... },_): { return qualifiers & q; }
 178    |  QUALty(qual,t):  { if (q & qual) return true; ty = t; }
 179    }
 180    return false;
 181 }
 182
 183 /////////////////////////////////////////////////////////////////////////////
 184 //
 185 //  Test if a type is grounded (i.e. contains no type variables.)
 186 //
 187 /////////////////////////////////////////////////////////////////////////////
 188 Bool is_ground(Ty ty)
 189 {  match while (ty)
 190    {  VARty t:         { ty = t; }
 191    |  QUALty(_,t):     { ty = t; }
 192    |  DEFVALty(t,_):   { ty = t; }
 193    |  NESTEDty(a,b):   { if (! is_ground(a)) return false; ty = b; }
 194    |  TYCONty(_, tys): { return is_ground(tys); }
 195    |  _:               { return false; }
 196    }
 197 }
 198
 199 /////////////////////////////////////////////////////////////////////////////
 200 //
 201 //  Test if a type list is grounded
 202 //
 203 /////////////////////////////////////////////////////////////////////////////
 204 Bool is_ground(Tys tys)
 205 {  for_each (Ty, t, tys) if (! is_ground(t)) return false;
 206    return true;
 207 }
 208
 209 /////////////////////////////////////////////////////////////////////////////
 210 //
 211 //  Test if a type is an array
 212 //
 213 /////////////////////////////////////////////////////////////////////////////
 214 Bool is_array_ty(Ty ty)
 215 {  match (deref_all(ty))
 216    {  ARRAYty(_,! NOexp): { return true; }
 217    |  NESTEDty(_,ty):     { return is_array_ty(ty); }
 218    |  _:                  { return false; }
 219    }
 220 }
 221
 222 /////////////////////////////////////////////////////////////////////////////
 223 //
 224 //  Test if a type is a polymorphic datatype
 225 //
 226 /////////////////////////////////////////////////////////////////////////////
 227 Bool is_poly_datatype(Ty ty)
 228 {  match (deref_all(ty))
 229    {  DATATYPEty({ tyvars ... },_): { return tyvars != #[]; }
 230    |  _:                            { return false; }
 231    }
 232 }
 233
 234 /////////////////////////////////////////////////////////////////////////////
 235 //
 236 //  Test if a type is a datatype.
 237 //
 238 /////////////////////////////////////////////////////////////////////////////
 239 Bool is_datatype(Ty ty)
 240 {  match (deref_all(ty))
 241    {  DATATYPEty(_,_): { return true; }
 242    |  _:               { return false; }
 243    }
 244 }
 245
 246 /////////////////////////////////////////////////////////////////////////////
 247 //
 248 // Add a new class to an inheritance list
 249 //
 250 /////////////////////////////////////////////////////////////////////////////
 251 Inherits add_inherit(Id id, TyVars p, Inherits i, Scope s, TyQual t)
 252 {  Inherit inh = INHERIT'{ qualifiers  = t,
 253                            scope       = s,
 254                            super_class = mkidty(id,tyvars_to_tys(p)) };
 255    return #[ inh ... i ];
 256 }
 257
 258
 259 /////////////////////////////////////////////////////////////////////////////
 260 //
 261 //  Test if a type is garbage collectable.
 262 //
 263 /////////////////////////////////////////////////////////////////////////////
 264 Bool is_gc_ty(Ty ty)
 265 {  match while (ty)
 266    {  DATATYPEty({ qualifiers, arg ... }, _):
 267       { return (qualifiers & QUALcollectable) && (arg > 0); }
 268    |  REFty t:        { ty = t; }
 269    |  POINTERty t:    { ty = t; }
 270    |  DEFVALty(t,_):  { ty = t; }
 271    |  NESTEDty(_,t):  { ty = t; }
 272    |  VARty t:        { ty = t; }
 273    |  QUALty(q,t):    { if (q & QUALcollectable) return true; ty = t; }
 274    |  IDty (_,_):
 275       {  Ty t = deref_all(ty);
 276          if (t == ty) return false;
 277          ty = t;
 278       }
 279    |  _:              { return false; }
 280    }
 281 }
 282
 283 /////////////////////////////////////////////////////////////////////////////
 284 //
 285 //  Test if type is a pointer.
 286 //
 287 /////////////////////////////////////////////////////////////////////////////
 288 Bool is_pointer_ty(Ty ty)
 289 {  match (deref_all(ty))
 290    {  TYCONty(DATATYPEtycon _ || POINTERtycon,_): { return true; }
 291    |  _:                                          { return false; }
 292    }
 293 }
 294
 295 /////////////////////////////////////////////////////////////////////////////
 296 //
 297 //  Test if type is embeddable into 1 word
 298 //
 299 /////////////////////////////////////////////////////////////////////////////
 300 Bool is_embeddable_ty(Ty ty)
 301 {  match (deref_all(ty))
 302    {  TYCONty(DATATYPEtycon { arg = 0 ... },_):     { return true; }
 303    |  TYCONty(DATATYPEtycon { opt ... },_)
 304         | (opt & OPTtaggedpointer) == 0:            { return true; }
 305    |  POINTERty t | t != character_ty:              { return true; }
 306    |  t | ty_equal(t,integer_ty) ||
 307           ty_equal(t,character_ty) ||
 308           ty_equal(t,bool_ty):                      { return true; }
 309    |  _:                                            { return false; }
 310    }
 311 }
 312
 313 /////////////////////////////////////////////////////////////////////////////
 314 //
 315 //  Test if constructor is an array-style constructor
 316 //
 317 /////////////////////////////////////////////////////////////////////////////
 318 Bool is_array_constructor(Id id) { return id[1] == '|'; }
 319 Bool is_list_constructor(Id id) { return id[0] == '#' &&
 320                                      (id[1] == '[' ||
 321                                       id[1] == '(' ||
 322                                       id[1] == '{'); }
 323 Bool is_list_constructor(Cons cons)
 324 { return cons != NOcons && is_list_constructor(cons->name); }
 325
 326 /////////////////////////////////////////////////////////////////////////////
 327 //
 328 //  Returns the number of boxed variants.
 329 //
 330 /////////////////////////////////////////////////////////////////////////////
 331 int boxed_variants(Ty ty)
 332 {  match (deref_all(ty))
 333    {  DATATYPEty ({ arg ... }, _): { return arg; }
 334    |  _:                           { return 0; }
 335    }
 336 }
 337
 338 int unboxed_variants(Ty ty)
 339 {  match (deref_all(ty))
 340    {  DATATYPEty ({ unit ... }, _): { return unit; }
 341    |  _:                            { return 0; }
 342    }
 343 }
 344
 345 /////////////////////////////////////////////////////////////////////////////
 346 //
 347 //  Returns the arity of a type
 348 //
 349 /////////////////////////////////////////////////////////////////////////////
 350 int arity_of(Ty ty)
 351 {  match (deref_all(ty))
 352    {  NOty:                                      { return 0; }
 353    |  TYCONty(TUPLEtycon || RECORDtycon _,tys):  { return length(tys); }
 354    |  NESTEDty(_,t):                             { return arity_of(t); }
 355    |  _:                                         { return 1; }
 356    }
 357 }
 358
 359 /////////////////////////////////////////////////////////////////////////////
 360 //
 361 //  Instantiate a polymorphic type scheme
 362 //
 363 /////////////////////////////////////////////////////////////////////////////
 364 Ty inst (Ty ty, int n, Id bound_vars[], Ty subst[])
 365 {  match (deref(ty))
 366    {  NOty || VARty _: { return ty; }
 367    |  INDty(_,i):
 368       { return subst[i] != NOty ? subst[i] : (subst[i] = mkvar()); }
 369    |  QUALty(q,t):     { return QUALty(q,inst(t,n,bound_vars,subst)); }
 370    |  DEFVALty(t,e):   { return DEFVALty(inst(t,n,bound_vars,subst),e); }
 371    |  NESTEDty(a,b):   { return NESTEDty(inst(a,n,bound_vars,subst),
 372                                          inst(b,n,bound_vars,subst));
 373                        }
 374    |  TYCONty(tycon,   tys):
 375       {  return TYCONty(tycon, inst(tys,n,bound_vars,subst)); }
 376    |  POLYty _: { bug("inst()"); return NOty; }
 377    }
 378 }
 379
 380 /////////////////////////////////////////////////////////////////////////////
 381 //
 382 //  Instantiate a type list
 383 //
 384 /////////////////////////////////////////////////////////////////////////////
 385 Tys inst (Tys tys, int n, Id bound_vars[], Ty subst[])
 386 {  match (tys)
 387    {  #[]:        { return #[]; }
 388    |  #[a ... b]: { return #[ inst(a, n, bound_vars, subst) ...
 389                               inst(b, n, bound_vars, subst) ];
 390                   }
 391    }
 392 }
 393
 394 /////////////////////////////////////////////////////////////////////////////
 395 //
 396 //  Instantiate a polymorphic type scheme
 397 //
 398 /////////////////////////////////////////////////////////////////////////////
 399 Ty inst(Ty polyty)
 400 {  match (polyty)
 401    {  POLYty(ty, n, bound_vars):
 402       {  Ty subst[256];
 403          for (int i = n - 1; i >= 0; i--) subst[i] = NOty;
 404          return inst(ty, n, bound_vars, subst);
 405       }
 406    |  _:  { return polyty; }
 407    }
 408 }
 409
 410 /////////////////////////////////////////////////////////////////////////////
 411 //
 412 //  Construct component types
 413 //
 414 /////////////////////////////////////////////////////////////////////////////
 415 Ty component_ty (Ty datatype_ty, Cons cons)
 416 {  match (deref_all datatype_ty) and (cons)
 417    {  DATATYPEty(_, tys as ! #[]), ONEcons { cons_ty, ty = ! NOty ... }:
 418       {  return apply_ty(cons_ty,tys); }
 419    |  _, ONEcons { ty ... }: { return ty; }
 420    |  _, _:                  { return NOty; }
 421    }
 422 }
 423
 424 /////////////////////////////////////////////////////////////////////////////
 425 //
 426 //  Extract record type component
 427 //
 428 /////////////////////////////////////////////////////////////////////////////
 429 Ty component_ty (Ty record_ty, Id label)
 430 {  match (deref_all record_ty)
 431    {  RECORDty(labels,_,tys):
 432       {  Ids ls; Tys ts;
 433          for (ls = labels, ts = tys; ls && ts; ls = ls->#2, ts = ts->#2)
 434             if (ls->#1 == label) return ts->#1;
 435       }
 436    |  ty as TUPLEty _ | label[0] == '_':
 437       { int i = atol(label+1);
 438         if (i > 0) return component_ty(ty,i);
 439       }
 440    |  _: // skip
 441    }
 442    error("%Ltype %T does not have component %s\n",record_ty,label);
 443    return NOty;
 444 }
 445
 446 /////////////////////////////////////////////////////////////////////////////
 447 //
 448 //  Extract tuple type component
 449 //
 450 /////////////////////////////////////////////////////////////////////////////
 451 Ty component_ty (Ty tuple_ty, int n)
 452 {  match (deref_all tuple_ty)
 453    {  TUPLEty tys:
 454       {  int i; Tys ts;
 455          for (i = 1, ts = tys; ts; ts = ts->#2, i++)
 456             if (i == n) return ts->#1;
 457       }
 458    |  _: // skip
 459    }
 460    error("%Ltype %T does not have component #%i\n",tuple_ty,n);
 461    return NOty;
 462 }
 463
 464 /////////////////////////////////////////////////////////////////////////////
 465 //
 466 //  Apply type arguments to a ty_scheme.
 467 //
 468 /////////////////////////////////////////////////////////////////////////////
 469 Ty apply_ty (Ty cons_ty, Tys tys)
 470 {  match (cons_ty)
 471    {  POLYty(ty, n, bound_vars):
 472       {  Ty subst[256]; int i; Tys ts;
 473          for (i = 0, ts = tys; i < n && ts; i++, ts = ts->#2)
 474             subst[i] = ts->#1;
 475          if (ts != #[])
 476          {error("%Ltoo many arguments %P in instantiation of type scheme %T\n",
 477                 tys, cons_ty);
 478            return NOty;
 479          }
 480          if (i != n)
 481          {error("%Ltoo few arguments %P in instantiation of type scheme %T\n",
 482                 tys, cons_ty);
 483            return NOty;
 484          }
 485          Ty t = inst(ty, n, bound_vars, subst);
 486          match (deref(t))
 487          {  FUNty(a,_):      { return a; }
 488          |  a as TYCONty _:  { return a; }
 489          |  _:           { error ("%Lbad constructor type %T\n",cons_ty);
 490                            return NOty;
 491                          }
 492          }
 493       }
 494    |  TYCONty(FUNtycon,#[ a ... _ ]): { return a; }
 495    |  ty: { return ty; }
 496    }
 497 }
 498
 499 /////////////////////////////////////////////////////////////////////////////
 500 //
 501 //  Unify two type constructors
 502 //
 503 /////////////////////////////////////////////////////////////////////////////
 504 Bool unify(TyCon a, TyCon b)
 505 {  match (a) and (b)
 506    {  POINTERtycon || ARRAYtycon _,
 507       POINTERtycon || ARRAYtycon _:     { return true; }
 508    |  REFtycon,        REFtycon:        { return true; }
 509    |  IDtycon u,       IDtycon v:       { return u == v; }
 510    |  TUPLEtycon,      TUPLEtycon:      { return true; }
 511    |  EXTUPLEtycon,    EXTUPLEtycon:    { return true; }
 512    |  TYPEtycon,       TYPEtycon:       { return true; }
 513    |  FUNtycon,        FUNtycon:        { return true; }
 514    |  DATATYPEtycon _, DATATYPEtycon _: { return a == b; }
 515    |  COLtycon COLdesc{ name = a ... },
 516       COLtycon COLdesc{ name = b ... }: { return a == b; }
 517    |  BITFIELDtycon { width = w1, is_signed = s1 },
 518       BITFIELDtycon { width = w2, is_signed = s2 }:
 519                                         { return w1 == w2 && s1 == s2; }
 520    |  _,               _:               { return false; }
 521    }
 522 }
 523
 524 /////////////////////////////////////////////////////////////////////////////
 525 //
 526 //  Unify two record types
 527 //
 528 /////////////////////////////////////////////////////////////////////////////
 529 Bool unify_record
 530    (Ty u, Ids& x, Tys& a, Bool& f,
 531     Ty v, Ids& y, Tys& b, Bool& g, Bool again = true)
 532 {  Ids i, j;
 533    Tys p, q;
 534    Bool ok = true;
 535
 536    for (i = x, p = a; i; i = i->#2, p = p->#2) {
 537       Bool b_found = false;
 538       for (j = y, q = b; j; j = j->#2, q = q->#2) {
 539          if (i->#1 == j->#1) {
 540             if (b_found) {
 541                error ("%Lduplicated label '%s' in type %T\n", i->#1, v);
 542                ok = false;
 543             }
 544             b_found = true;
 545             if (! unify(p->#1, q->#1)) ok = false;
 546          }
 547       }
 548       if (! b_found && ! g) {
 549          error ("%L%s label '%s' in type %T\n",
 550                 (again ? "missing" : "extra"), i->#1, v);
 551          ok = false;
 552       }
 553    }
 554
 555    // unify in the other direction if not flexible
 556    if (again && ! f) unify_record(v,y,b,g,u,x,a,f,false);
 557
 558    if (! f && g) { y = x; b = a; }
 559    if (! g && f) { x = y; a = b; }
 560
 561    if (! f) g = false;
 562    if (! g) f = false;
 563
 564    return ok;
 565 }
 566
 567 /////////////////////////////////////////////////////////////////////////////
 568 //
 569 //  Occurs check
 570 //
 571 /////////////////////////////////////////////////////////////////////////////
 572 Bool occurs (Ty ty, Ty tyvar)
 573 {  match (deref_all(ty))
 574    {  a as VARty _ | tyvar == a: { return true; }
 575    |  TYCONty(_,tys):
 576       {  for_each(Ty, t, tys) if (occurs(t,tyvar)) return true;
 577          return false;
 578       }
 579    |  _: { return false; }
 580    }
 581 }
 582
 583 /////////////////////////////////////////////////////////////////////////////
 584 //
 585 //  Unify two types.  Returns true iff unification succeeds.
 586 //
 587 /////////////////////////////////////////////////////////////////////////////
 588 Bool unify (Ty t1, Ty t2)
 589 {  match (deref(t1)) and (deref(t2))
 590    {  (NOty, _) || (_, NOty):       { return false; }
 591    |  a,             b  | a == b:   { return true; }
 592    |  a,             v as VARty b:
 593       {  if (occurs(a,v)) {
 594             error ("%Lunification fails occurs check with %T and %T\n",t1,t2);
 595             return false;
 596          } else { b = a; return true; }
 597       }
 598    |  v as VARty a,  b:
 599       {  if (occurs(b,v)) {
 600             error ("%Lunification fails occurs check with %T and %T\n",t1,t2);
 601             return false;
 602          } else { a = b; return true; }
 603       }
 604    |  _,  _:
 605       {  match (deref_all(t1)) and (deref_all(t2))
 606          {  a,             b  | a == b:   { return true; }
 607          |  RECORDty (x,f,a), RECORDty(y,g,b):
 608                { return unify_record(t1,x,a,f,t2,y,b,g); }
 609          |  TYCONty(x,a),  TYCONty(y,b): { return unify(x,y) && unify(a,b); }
 610          |  NESTEDty(a,b), NESTEDty(c,d):{ return unify(a,c) && unify(b,d); }
 611          |  _,             _:            { return false; }
 612          }
 613       }
 614    }
 615 }
 616
 617 /////////////////////////////////////////////////////////////////////////////
 618 //
 619 //  Unify two type lists.
 620 //
 621 /////////////////////////////////////////////////////////////////////////////
 622 Bool unify(Tys xs, Tys ys)
 623 {  Bool ok = true;
 624    match while (xs) and (ys)
 625    {  #[a ... b], #[c ... d]:
 626       {  if (! unify(a, c)) ok = false; xs = b; ys = d; }
 627    }
 628    return ok && xs == #[] && ys == #[];
 629 }
 630
 631 /////////////////////////////////////////////////////////////////////////////
 632 //
 633 //  Unify two types and print error message if fails.
 634 //
 635 /////////////////////////////////////////////////////////////////////////////
 636 Bool unify(Pat p, Ty a, Ty b)
 637 {  if (! unify(a,b))
 638    {  error ("%Ltype mismatch in pattern: %p\n"
 639              "%Lexpecting '%T' but found '%T'\n", p, a, b);
 640       return false;
 641    }
 642    return true;
 643 }
 644
 645 /////////////////////////////////////////////////////////////////////////////
 646 //
 647 //  Infer the type of literals
 648 //
 649 /////////////////////////////////////////////////////////////////////////////
 650 Ty type_of (Literal l)
 651 {  match (l)
 652    {  INTlit  _:   { return integer_ty; }
 653    |  CHARlit _:   { return character_ty; }
 654    |  BOOLlit _:   { return bool_ty; }
 655    |  REALlit _:   { return real_ty; }
 656    |  QUARKlit _:  { return quark_ty; }
 657    |  BIGINTlit _: { return bigint_ty; }
 658    |  STRINGlit _ || REGEXPlit _: { return string_ty; }
 659    }
 660 }
 661
 662 /////////////////////////////////////////////////////////////////////////////
 663 //
 664 //  Additional pattern variable type map.
 665 //
 666 /////////////////////////////////////////////////////////////////////////////
 667 HashTable * patvar_typemap = 0;
 668
 669 /////////////////////////////////////////////////////////////////////////////
 670 //
 671 //  Infer the type of a pattern.
 672 //
 673 /////////////////////////////////////////////////////////////////////////////
 674 Ty type_of (Pat pat)
 675 {  Ty t = NOty;
 676    match (pat)
 677    {  NOpat:               { t = NOty; }
 678    |  WILDpat _:           { t = mkvar(); }
 679    |  INDpat(_,_,v):       { t = v; }
 680    |  IDpat(id,ty,_):
 681       {  t = ty;
 682          // If we have a pattern variable type map
 683          // also use it.
 684          if (patvar_typemap)
 685          {  HashTable::Entry * e = patvar_typemap->lookup(id);
 686             if (e)
 687             {  Ty nonterm_ty = Ty(e->v);
 688                if (!unify(nonterm_ty,ty))
 689                { error("%Lexpecting non-terminal %s to have type %T but found %T\n",
 690                        id, nonterm_ty, ty);
 691                }
 692             }
 693          }
 694       }
 695    |  ASpat(_,p,ty,_):     { t = type_of(p); unify(pat,ty,t); }
 696    |  UNIFYpat(p,_):       { t = type_of(p); }
 697    |  LITERALpat l:        { t = type_of(l); }
 698    |  LEXEMEpat _:         { t = string_ty; }
 699    |  TUPLEpat ps:         { t = mktuplety(type_of(ps)); }
 700    |  EXTUPLEpat ps:       { t = TYCONty(EXTUPLEtycon,type_of(ps)); }
 701    |  GUARDpat (p,_):      { t = type_of(p); }
 702    |  CONTEXTpat (_,p):    { t = type_of(p); }
 703    |  RECORDpat (ps,flex): { t = mkrecordty(labels_of(ps),type_of(ps),flex); }
 704    |  APPENDpat (p1,p2,ty):
 705       {  Ty t1 = type_of(p1);
 706          Ty t2 = type_of(p2);
 707          t = ty = t1;
 708          unify(pat,t1,t2);
 709       }
 710    |  ARRAYpat (ps,_):
 711       {  Ty ty = mkvar();
 712          for_each(Pat,p,ps) unify(pat,ty,type_of(p));
 713          t = mkptrty(QUALty(QUALconst,ty));
 714       }
 715    |  VECTORpat { cons, elements, len, array ...}:
 716       {  Ty arg_ty = mkvar();
 717          for_each(Pat,p,elements) unify(pat,arg_ty,type_of(p));
 718          Ty vec_ty   = type_of(CONSpat(cons));
 719          Ty range_ty = mkvar();
 720          if (len != NOpat)
 721             unify(pat,integer_ty,type_of(len));
 722          if (array != NOpat)
 723             unify(pat,mkptrty(arg_ty),type_of(array));
 724          unify(pat,vec_ty,mkfunty(arg_ty, range_ty));
 725          t = deref(range_ty);
 726       }
 727    |  LOGICALpat(NOTpat,p,_):    { t = type_of(p); }
 728    |  LOGICALpat(_,p1,p2):       { Ty ty1 = type_of(p1);
 729                                    Ty ty2 = type_of(p2);
 730                                    unify(pat,ty1,ty2);
 731                                    t = ty1;
 732                                  }
 733    |  TYPEDpat(p,expected_ty):
 734       {  t = type_of(p); unify(p,expected_ty,t); }
 735    |  MARKEDpat(_,p):           { t = type_of(p); }
 736    |  CONSpat(ONEcons { cons_ty ... }): {  t = inst(cons_ty); }
 737    |  CONSpat(NOcons):                  {  errors++; t = mkvar(); }
 738    |  APPpat(a, b):
 739       {  Ty fun_ty = type_of(a);
 740          Ty range  = mkvar();
 741          unify(pat,fun_ty,mkfunty(type_of(b), range));
 742          t = deref(range);
 743       }
 744    |  LISTpat{ nil, head = #[], tail = NOpat ...}:
 745       {  t = type_of(CONSpat(nil)); }
 746    |  LISTpat{ head = #[], tail ...}:
 747       {  t = type_of(tail); }
 748    |  LISTpat{cons, nil, head = ps, tail = p}:
 749       {  t = type_of(APPpat(CONSpat(cons),
 750                      TUPLEpat(#[ ps->#1, LISTpat(cons,nil, ps->#2, p) ])));
 751       }
 752    |  _:  { bug("type_of(Pat)"); }
 753    }
 754    if (boxed(pat)) pat->ty = t;
 755    return t;
 756 }
 757
 758 /////////////////////////////////////////////////////////////////////////////
 759 //
 760 //  Infer the type of a pattern list.
 761 //
 762 /////////////////////////////////////////////////////////////////////////////
 763 Tys type_of(Pats ps)
 764 {  match (ps)
 765    {  #[]:        { return #[]; }
 766    |  #[a ... b]: { return #[ type_of(a) ... type_of(b) ]; }
 767    }
 768 }
 769
 770 /////////////////////////////////////////////////////////////////////////////
 771 //
 772 //  Infer the type of a labeled pattern list.
 773 //
 774 /////////////////////////////////////////////////////////////////////////////
 775 Tys type_of(LabPats ps)
 776 {  match (ps)
 777    {  #[]:        { return #[]; }
 778    |  #[a ... b]: { return #[ type_of(a.pat) ... type_of(b) ]; }
 779    }
 780 }
 781
 782 /////////////////////////////////////////////////////////////////////////////
 783 //
 784 //  Get the list of labels from a labeled pattern list.
 785 //
 786 /////////////////////////////////////////////////////////////////////////////
 787 Ids labels_of(LabPats ps)
 788 {  match (ps)
 789    {  #[]:        { return #[]; }
 790    |  #[a ... b]: { return #[ a.label ... labels_of(b) ]; }
 791    }
 792 }
 793
 794 /////////////////////////////////////////////////////////////////////////////
 795 //
 796 //  Infer the type of a set of pattern rules.
 797 //
 798 /////////////////////////////////////////////////////////////////////////////
 799 Ty type_match_rules(MatchRules rules)
 800 {  Bool ok = true;
 801    MEM::use_global_pools();
 802    Ty ty = mkvar();
 803    for_each(MatchRule, r, rules)
 804    {  match (r)
 805       {  MATCHrule(_, pat, guard_exp, _, _):
 806          {  r->set_loc();
 807             Ty this_ty = type_of(pat);
 808             if (this_ty == NOty)
 809             {  error ("%!type error in pattern %p: %T\n",
 810                       r->loc(), pat, this_ty);
 811                ok = false;
 812             } else if (! unify(pat,ty,this_ty)) ok = false;
 813          }
 814       }
 815    }
 816    MEM::use_local_pools();
 817    return ok ? ty : NOty;
 818 }
 819
 820 /////////////////////////////////////////////////////////////////////////////
 821 //
 822 //  The type and constructor environments (both are flat for now.)
 823 //
 824 /////////////////////////////////////////////////////////////////////////////
 825 HashTable ty_env(string_hash,string_equal,91);
 826 HashTable cons_env(string_hash,string_equal,129);
 827 HashTable token_env(string_hash,string_equal,129);
 828
 829 /////////////////////////////////////////////////////////////////////////////
 830 //
 831 //  Lookup the type from its name.
 832 //
 833 /////////////////////////////////////////////////////////////////////////////
 834 Ty lookup_ty(Id id)
 835 {  HashTable::Entry * i = ty_env.lookup(id);
 836    return i ? inst(value_of(Ty,ty_env,i)) : NOty;
 837 }
 838
 839 /////////////////////////////////////////////////////////////////////////////
 840 //
 841 //  Lookup the constructor from its name.
 842 //
 843 /////////////////////////////////////////////////////////////////////////////
 844 Cons lookup_cons(Id id)
 845 {  Cons c = find_cons(id);
 846    if (c == NOcons)
 847    {  error ("%Lconstructor '%s' is undefined\n", id);
 848    }
 849    return c;
 850 }
 851
 852 Cons lookup_token (Id id)
 853 {  Cons c = NOcons;
 854    HashTable::Entry * i = token_env.lookup(id);
 855    if (i) return (Cons)i->v;
 856    c = find_cons(id);
 857    if (c == NOcons)
 858    {  if (id[0] == '"')
 859          error ("%Llexeme %s is undefined\n", id);
 860       else
 861          error ("%Lconstructor '%s' is undefined\n", id);
 862    }
 863    return c;
 864 }
 865
 866 Cons find_cons(Id id)
 867 {  HashTable::Entry * i = cons_env.lookup(id);
 868    return i ? value_of(Cons,cons_env,i) : NOcons;
 869 }
 870
 871 /////////////////////////////////////////////////////////////////////////////
 872 //
 873 //  Add a new type to the environment.
 874 //
 875 /////////////////////////////////////////////////////////////////////////////
 876 void add_type(Id id, TyVars tyvars, Ty ty)
 877 {  HashTable::Entry * i = ty_env.lookup(id);
 878    if (i) {
 879       error("%Ltype %s has already been defined as %T\n",
 880             id, value_of(Ty,ty_env,i));
 881    } else {
 882       match (deref_all(ty))
 883       {  IDty (old_name, _) | old_name == id:
 884          {  error("%Lcyclic type definition in type %s%V = %T\n",id,tyvars,ty);
 885          }
 886       |  _: { ty_env.insert(id,mkpolyty(ty,tyvars)); }
 887       }
 888    }
 889 }
 890
 891 /////////////////////////////////////////////////////////////////////////////
 892 //
 893 //  Method to add a new datatype to the environment.
 894 //
 895 /////////////////////////////////////////////////////////////////////////////
 896 void add_datatype( const Loc *     location,
 897                    Id              id,
 898                    TyVars          tyvars,
 899                    Inherits        inherit,
 900                    TyQual          qual,
 901                    Exp             view_match,
 902                    TermDefs        terms,
 903                    Decls           body
 904                  )
 905 {  HashTable::Entry * i = ty_env.lookup(id);
 906    if (i) {
 907       Ty ty = (Ty)ty_env.value(i);
 908       match (deref_all(ty))
 909       {  DATATYPEty ({ location = old_loc ... }, _):
 910          {  error("%Lredefinition of datatype %s\n"
 911                   "%!this is where datatype %s was previously defined\n",
 912                   id, old_loc, id);
 913          }
 914       | ty:
 915          {  error("%Lredefinition of datatype %s\n", id); }
 916       }
 917    } else {
 918       TyCon  tycon      = DATATYPEtycon'{ id         = id,
 919                                           arg        = 0,
 920                                           unit       = 0,
 921                                           terms      = 0,
 922                                           tyvars     = tyvars,
 923                                           polyty     = NOty,
 924                                           inherit    = inherit,
 925                                           qualifiers = qual,
 926                                           opt        = 0,
 927                                           body       = body,
 928                                           location   = location,
 929                                           view_match = view_match
 930                                         };
 931       Ty     this_ty       = TYCONty(tycon, tyvars_to_type_list(0,tyvars));
 932       int    variants      = length(terms);
 933       int    arg_count     = 0;
 934       int    unit_count    = 0;
 935       Cons * all_conses    = (Cons *)mem_pool[variants * sizeof(Cons)];
 936       int    units         = 0;
 937       int    args          = 0;
 938       int    optimizations = 0;
 939       int    arity         = length(tyvars);
 940       Id * bound_vars = (Id *)mem_pool[arity * sizeof(Id)];
 941       {  int i = 0;
 942          for_each (TyVar, tv, tyvars)
 943             bound_vars[i++] = tv;
 944       }
 945
 946       {  for_each(TermDef, t, terms)
 947             match (t)
 948             { TERMdef { ty = NOty ... }: { units++; }
 949             | _:                         { args++; }
 950             }
 951       }
 952
 953       Ty poly = mkpolyty(this_ty, tyvars);
 954
 955       // compute optimizations.
 956       if (args == 1) optimizations |= OPTsubclassless | OPTtagless;
 957       if (args > 1 && args <= options.max_embedded_tags
 958           && (qual & QUALvirtual) == 0
 959           && (options.tagged_pointer || (qual & QUALtaggedpointer)))
 960          optimizations |= OPTtaggedpointer | OPTtagless;
 961       else if (args <= 1)
 962          optimizations |= OPTtagless;
 963
 964       int actual_boxed = 0;
 965       for_each(TermDef, t, terms)
 966       {  match (t)
 967          {  TERMdef {id = cons_name ...} | cons_name == 0:
 968             {  qual |= QUALextensible; }
 969          |  TERMdef {id = cons_name, inherits = local_inherits,
 970                      ty, decls = local_decls, pat = lex_pat,
 971                      qual = this_qual ...}:
 972             {  int tag;
 973                Pat lexeme_pat =
 974                   (qual & QUALlexeme) && cons_name[0] == '"'
 975                    ? LITERALpat(STRINGlit(cons_name)) : lex_pat;
 976                Cons last_cons = find_cons(cons_name);
 977                if (last_cons != NOcons) {
 978                   error ("%!redefinition of constructor '%s'\n"
 979                          "%!this is where '%s' was last defined.\n",
 980                          t->loc(), cons_name, last_cons->location, cons_name);
 981                }
 982                if (ty == NOty) tag = unit_count++; else tag = arg_count++;
 983                if (t->print_formats != #[]) qual |= QUALprintable;
 984                Ty cons_ty = ty == NOty
 985                    ? poly
 986                    : POLYty(mkfunty(ty, this_ty), arity, bound_vars);
 987
 988                // Use unboxed optimization
 989                // only if we are also using the tagged pointer rep.
 990                // Make sure (1) the type is embeddable into 1 word.
 991                //           (2) We are monomorphic.
 992                //           (3) We are not using any inheritance.
 993                int this_opt = OPTnone;
 994                if ((optimizations & OPTtaggedpointer) &&
 995                     tyvars == #[]                     &&
 996                     local_inherits == #[]             &&
 997                     t->opt == OPTunboxed              &&
 998                     (qual & (QUALrewritable | QUALcollectable |
 999                              QUALrelation | QUALpersistent))
1000                        == 0 &&
1001                     is_embeddable_ty(ty))
1002                   this_opt = OPTunboxed;
1003
1004                Exp * view_selectors =
1005                   (qual & QUALview) ?
1006                      (Exp*)mem_pool.c_alloc(arity_of(ty) * sizeof(Exp)) : 0;
1007                Cons cons = ONEcons'{ name           = cons_name,
1008                                      alg_ty         = this_ty,
1009                                      ty             = ty,
1010                                      tag            = tag,
1011                                      print_formats  = t->print_formats,
1012                                      cons_ty        = cons_ty,
1013                                      location       = t->loc(),
1014                                      inherit        = local_inherits,
1015                                      body           = local_decls,
1016                                      view_selectors = view_selectors,
1017                                      view_predicate = t->view_predicate,
1018                                      opt            = this_opt,
1019                                      qual           = this_qual,
1020                                      lexeme_pattern = lexeme_pat
1021                                    };
1022                all_conses[ty == NOty ? tag : tag + units] = cons;
1023                if (ty != NOty && (this_opt & OPTunboxed) == 0)
1024                   actual_boxed++;
1025
1026                // update the constructor environment
1027                cons_env.insert(cons_name, cons);
1028
1029                // update the token environment
1030                match (lexeme_pat)
1031                {  STRINGpat s: { token_env.insert(s, cons); }
1032                |  _: // skip
1033                }
1034             }
1035          }
1036       }
1037
1038       if (actual_boxed <= 1) optimizations |= OPTsubclassless | OPTtagless;
1039
1040       if (tyvars && unit_count > 1)
1041          error("%Lmultiple unit constructors in polymorphic type %s%V"
1042                " is not supported\n",
1043                id, tyvars);
1044
1045       match (tycon)
1046       {  DATATYPEtycon{ unit, arg, terms, polyty, opt, qualifiers ... }:
1047          { unit = unit_count; arg = arg_count; terms = all_conses;
1048            polyty = poly; opt = optimizations; qualifiers = qual;
1049          }
1050       |  _: {}
1051       }
1052
1053       ty_env.insert(id, poly);
1054       if (qual & QUALlexeme) update_lexeme_class(id, terms);
1055
1056       // Create new type hierarchy
1057       new DatatypeHierarchy(id,tyvars,inherit,qual,terms,body);
1058    }
1059 }
1060
1061 /////////////////////////////////////////////////////////////////////////////
1062 //
1063 //  Method to refine the implementation of a datatype.
1064 //
1065 /////////////////////////////////////////////////////////////////////////////
1066 void update_datatype (Id id, TyVars tyvars, Inherits superclasses,
1067                       TyQual qual, Decls decls)
1068 {
1069    match (lookup_ty(id))
1070    {  DATATYPEty ({ hierarchy, qualifiers = q ... }, _) | hierarchy != 0:
1071       {  if (superclasses)
1072            hierarchy->inherited_classes =
1073              append(hierarchy->inherited_classes,superclasses);
1074          hierarchy->qualifiers |= qual;
1075          q |= qual;
1076          if (decls)
1077            hierarchy->class_body = append(hierarchy->class_body,decls);
1078       }
1079    |  NOty: { /* skip */ }
1080    |  ty:   { error ("%Ltype %s = %T is not a datatype\n",id, ty); }
1081    }
1082 }
1083
1084 /////////////////////////////////////////////////////////////////////////////
1085 //
1086 //  Method to refine the implementation of a datatype constructor.
1087 //
1088 /////////////////////////////////////////////////////////////////////////////
1089 void update_constructor
1090    (Id id, Tys ty_args, Inherits inh, PrintFormats pf, Decls decls)
1091 {  match (lookup_cons(id))
1092    {  ONEcons { print_formats,
1093                 alg_ty = DATATYPEty({ qualifiers ... },_),
1094                 class_def ... }:
1095       {  if (pf) {
1096             if (print_formats)
1097                error("%Lconstructor %s already has print formats\n",id);
1098             else
1099                print_formats = pf;
1100             qualifiers |= QUALprintable;
1101          }
1102          if (decls)
1103            class_def->class_body = append(class_def->class_body,decls);
1104          if (inh)
1105            class_def->inherited_classes = append(class_def->inherited_classes,
1106                                                inh);
1107       }
1108    |  _:      { /* skip */ }
1109    }
1110 }
1111
1112 /////////////////////////////////////////////////////////////////////////////
1113 //
1114 //  Hashing function on types
1115 //
1116 /////////////////////////////////////////////////////////////////////////////
1117 unsigned int ty_hash(HashTable::Key k)
1118 {  Ty ty = (Ty)k;
1119    match (deref_all(ty))
1120    {  NOty:               { return 0; }
1121    |  ty as VARty _:      { return (unsigned int)ty; }
1122    |  TYCONty(tycon,tys):
1123       {  unsigned int h;
1124          match (tycon)
1125          {  POINTERtycon:                  { h = 37; }
1126          |  REFtycon:                      { h = 47; }
1127          |  FUNtycon:                      { h = 79; }
1128          |  RECORDtycon _:                 { h = 129; }
1129          |  TUPLEtycon:                    { h = 173; }
1130          |  EXTUPLEtycon:                  { h = 467; }
1131          |  ARRAYtycon _:                  { h = 569; }
1132          |  IDtycon id:                    { h = string_hash(id) + 89; }
1133          |  DATATYPEtycon { id ... }:      { h = string_hash(id) + 431; }
1134          |  BITFIELDtycon { width ... }:   { h = 733 + width; }
1135          |  TYPEtycon:                     { h = 1235; }
1136          |  COLtycon(COLdesc{ name ... }): { h = string_hash(name) + 1345; }
1137          |  GRAPHtycon G:                  { h = (int)G; }
1138          |  NODEtycon n:                   { h = (int)n; }
1139          |  EDGEtycon e:                   { h = (int)e; }
1140          }
1141          return h + tys_hash(tys);
1142       }
1143    |  NESTEDty(a,b):      { return ty_hash(a) + ty_hash(b); }
1144    |  _:                  { return 0; }
1145    }
1146 }
1147
1148 /////////////////////////////////////////////////////////////////////////////
1149 //
1150 //  Hashing function on type list
1151 //
1152 /////////////////////////////////////////////////////////////////////////////
1153 unsigned int tys_hash(HashTable::Key k)
1154 {  Tys tys = (Tys)k;
1155    unsigned int h = 0;
1156    for_each (Ty, t, tys) h += ty_hash(t);
1157    return h;
1158 }
1159
1160 /////////////////////////////////////////////////////////////////////////////
1161 //
1162 //  Equality function on types
1163 //
1164 /////////////////////////////////////////////////////////////////////////////
1165 Bool ty_equal(HashTable::Key a, HashTable::Key b)
1166 {  Ty u = (Ty)a, v = (Ty)b;
1167    match (deref_all u) and (deref_all v)
1168    {  a,               b | a == b:    { return true; }
1169    |  a as VARty _,    b as VARty _:  { return a == b; }
1170    |  GRAPHty a,       GRAPHty b:     { return a == b; }
1171    |  NODEty a,        NODEty b:      { return a == b; }
1172    |  EDGEty a,        EDGEty b:      { return a == b; }
1173    |  RECORDty(a,_,x), RECORDty(b,_,y):
1174       {  Ids i, j; Tys t, u;
1175          if (length(x) != length(y)) return false;
1176          for (i = a, t = x; i; i = i->#2, t = t->#2)
1177          {  Bool found = false;
1178             for (j = b, u = y; j; j = j->#2, u = u->#2)
1179             {  if (i->#1 == j->#1) {
1180                   if (! ty_equal(t->#1, u->#2)) return false;
1181                   found = true; break;
1182                }
1183             }
1184             if (! found) return false;
1185          }
1186          return true;
1187       }
1188    |  TYCONty(x,a), TYCONty(y,b):
1189       {  if (! unify(x,y)) return false;
1190          return tys_equal(a,b);
1191       }
1192    |  NESTEDty(a,b), NESTEDty(c,d):
1193       {  return ty_equal(a,c) && ty_equal(b,d); }
1194    |  _,             _:    { return false; }
1195    }
1196 }
1197
1198 /////////////////////////////////////////////////////////////////////////////
1199 //
1200 //  Equality function on type lists
1201 //
1202 /////////////////////////////////////////////////////////////////////////////
1203 Bool tys_equal(HashTable::Key a, HashTable::Key b)
1204 {  Tys u = (Tys)a, v = (Tys)b;
1205    match while (u) and (v)
1206    {  #[m ... n], #[o ... p]:
1207       {  if (!ty_equal(m,o)) return false; u = n; v = p; }
1208    }
1209    return u == #[] && v == #[];
1210 }
1211
1212 /////////////////////////////////////////////////////////////////////////////
1213 //
1214 //  Equality on qualified identifiers.
1215 //
1216 /////////////////////////////////////////////////////////////////////////////
1217 fun qualid_equal SIMPLEid a,     SIMPLEid b: Bool: { return a == b; }
1218 |   qualid_equal NESTEDid(t1,a), NESTEDid(t2,b):
1219     { return ty_equal(t1,t2) && qualid_equal(a,b); }
1220 |   qualid_equal _,              _:                { return false; }
1221 ;