home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Moscow ML 1.42 / src / !runtime / compare.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-08-18  |  2.5 KB  |  111 lines  |  [TEXT/R*ch]
  1. #include "fail.h"
  2. #include "memory.h"
  3. #include "misc.h"
  4. #include "mlvalues.h"
  5. #include "str.h"
  6.  
  7. /* Structural comparison on trees.
  8.    May loop on cyclic structures. */
  9.  
  10. static long compare_val(v1, v2)
  11.      value v1,v2;
  12. {
  13.   tag_t t1, t2;
  14.  
  15.  tailcall:
  16.   if (v1 == v2) return 0;
  17.   if (Is_long(v1) || Is_long(v2)) return Long_val(v1) - Long_val(v2);
  18.   /* If one of the objects is outside the heap (but is not an atom),
  19.      use address comparison. */
  20.   if (!Is_atom(v1) && !Is_young(v1) && !Is_in_heap(v1) ||
  21.       !Is_atom(v2) && !Is_young(v2) && !Is_in_heap(v2))
  22.     return v1 - v2;
  23.   t1 = Tag_val(v1);
  24.   t2 = Tag_val(v2);
  25.   if (t1 != t2) return (long)t1 - (long)t2;
  26.   switch(t1) {
  27.   case String_tag: {
  28.     mlsize_t len1, len2, len;
  29.     unsigned char * p1, * p2;
  30.     len1 = string_length(v1);
  31.     len2 = string_length(v2);
  32.     for (len = (len1 <= len2 ? len1 : len2),
  33.          p1 = (unsigned char *) String_val(v1),
  34.          p2 = (unsigned char *) String_val(v2);
  35.          len > 0;
  36.          len--, p1++, p2++)
  37.       if (*p1 != *p2) return (long)*p1 - (long)*p2;
  38.     return len1 - len2;
  39.   }
  40.   case Double_tag: {
  41.     double d1 = Double_val(v1);
  42.     double d2 = Double_val(v2);
  43.     if (d1 == d2) return 0; else if (d1 < d2) return -1; else return 1;
  44.   }
  45.   case Abstract_tag:
  46.   case Final_tag:
  47.     invalid_argument("equal: abstract value");
  48.   case Closure_tag:
  49.     invalid_argument("equal: functional value");
  50.   default: {
  51.     mlsize_t sz1 = Wosize_val(v1);
  52.     mlsize_t sz2 = Wosize_val(v2);
  53.     value * p1, * p2;
  54.     long res;
  55.     if (sz1 != sz2) return sz1 - sz2;
  56.     for(p1 = Op_val(v1), p2 = Op_val(v2);
  57.         sz1 > 1;
  58.         sz1--, p1++, p2++) {
  59.       res = compare_val(*p1, *p2);
  60.       if (res != 0) return res;
  61.     }
  62.     v1 = *p1;
  63.     v2 = *p2;
  64.     goto tailcall;
  65.   }
  66.   }
  67. }
  68.  
  69. value compare(v1, v2)           /* ML */
  70.      value v1, v2;
  71. {
  72.   return Val_long(compare_val(v1, v2));
  73. }
  74.  
  75. value equal(v1, v2)            /* ML */
  76.      value v1, v2;
  77. {
  78.   return Atom(compare_val(v1, v2) == 0);
  79. }
  80.  
  81. value notequal(v1, v2)            /* ML */
  82.      value v1, v2;
  83. {
  84.   return Atom(compare_val(v1, v2) != 0);
  85. }
  86.  
  87. value lessthan(v1, v2)            /* ML */
  88.      value v1, v2;
  89. {
  90.   return Atom(compare_val(v1, v2) < 0);
  91. }
  92.  
  93. value lessequal(v1, v2)          /* ML */
  94.      value v1, v2;
  95. {
  96.   return Atom(compare_val(v1, v2) <= 0);
  97. }
  98.  
  99. value greaterthan(v1, v2)        /* ML */
  100.      value v1, v2;
  101. {
  102.   return Atom(compare_val(v1, v2) > 0);
  103. }
  104.  
  105. value greaterequal(v1, v2)       /* ML */
  106.      value v1, v2;
  107. {
  108.   return Atom(compare_val(v1, v2) >= 0);
  109. }
  110.  
  111.