4.3BSD - /usr/src/new/B/src/bsmall/B1obj.c

   1: /* Copyright (c) Stichting Mathematisch Centrum, Amsterdam, 1984. */
   2: /* $Header: B1obj.c,v 1.1 84/06/28 00:48:57 timo Exp $ */
   3: 
   4: /* General operations on objects */
   5: 
   6: #include "b.h"
   7: #include "b1obj.h"
   8: #include "B1tlt.h"
   9: 
  10: #define Sgn(d) (d)
  11: 
  12: Visible relation compare(v, w) value v, w; {
  13:     literal vt= v->type, wt= w->type;
  14:     register intlet vlen= Length(v), wlen= Length(w), len, k;
  15:     value message;
  16:     if (v == w) return 0;
  17:     if (!(vt == wt && !(vt == Com && vlen != wlen) ||
  18:                 vt == ELT && (wt == Lis || wt == Tab) ||
  19:                 wt == ELT && (vt == Lis || vt == Tab))) {
  20:         message= concat(mk_text("incompatible types: "),
  21:              concat(convert((value) valtype(v), No, No),
  22:              concat(mk_text(" and "),
  23:              convert((value) valtype(w), No, No))));
  24:         error(Str(message)); /*doesn't return: so can't release message*/
  25:     }
  26:     if (vt != Num && (vlen == 0 || wlen == 0))
  27:         return Sgn(vlen-wlen);
  28:     switch (vt) {
  29:     case Num: return numcomp(v, w);
  30:     case Tex: return strcmp(Str(v), Str(w));
  31: 
  32:     case Com:
  33:     case Lis:
  34:     case Tab:
  35:     case ELT:
  36:         {value *vp= Ats(v), *wp= Ats(w);
  37:          relation c;
  38:             len= vlen < wlen ? vlen : wlen;
  39:             Overall if ((c= compare(*vp++, *wp++)) != 0) return c;
  40:             return Sgn(vlen-wlen);
  41:         }
  42:     default:
  43:         syserr("comparison of unknown types");
  44:         return (intlet) Dummy;
  45:     }
  46: }
  47: 
  48: Visible double hash(v) value v; {
  49:     literal t= v->type; intlet len= Length(v), k; double d= t+.404*len;
  50:     switch (t) {
  51:     case Num: return numhash(v);
  52:     case Tex:
  53:         {string vp= Str(v);
  54:             Overall d= .987*d+.277*(*vp++);
  55:             return d;
  56:         }
  57:     case Com:
  58:     case Lis:
  59:     case Tab:
  60:     case ELT:
  61:         {value *vp= Ats(v);
  62:             if (len == 0) return .909;
  63:             Overall d= .874*d+.310*hash(*vp++);
  64:             return d;
  65:         }
  66:     default:
  67:         syserr("hash called with unknown type");
  68:         return (double) Dummy;
  69:     }
  70: }

Defined functions

Defined macros