home *** CD-ROM | disk | FTP | other *** search
/ ftp.cs.arizona.edu / ftp.cs.arizona.edu.tar / ftp.cs.arizona.edu / icon / historic / v941.tgz / icon.v941src.tar / icon.v941src / src / runtime / ocomp.r < prev    next >
Text File  |  2001-12-12  |  4KB  |  178 lines
  1. /*
  2.  * File: ocomp.r
  3.  *  Contents: lexeq, lexge, lexgt, lexle, lexlt, lexne, numeq, numge,
  4.  *        numgt, numle, numlt, numne, eqv, neqv
  5.  */
  6.  
  7. /*
  8.  * NumComp is a macro that defines the form of a numeric comparisons.
  9.  */
  10. #begdef NumComp(icon_op, func_name, c_op, descript)
  11. "x " #icon_op " y - test if x is numerically " #descript " y."
  12.    operator{0,1} icon_op func_name(x,y)
  13.  
  14.    arith_case (x, y) of {
  15.       C_integer: {
  16.          abstract {
  17.             return integer
  18.             }
  19.          inline {
  20.             if c_op(x, y)
  21.                return C_integer y;
  22.             fail;
  23.             }
  24.          }
  25.       integer: { /* large integers only */
  26.          abstract {
  27.             return integer
  28.             }
  29.          inline {
  30.             if (big_ ## c_op (x,y))
  31.                return y;
  32.             fail;
  33.             }
  34.          }
  35.       C_double: {
  36.          abstract {
  37.             return real
  38.             }
  39.          inline {
  40.             if c_op (x, y)
  41.                return C_double y;
  42.             fail;
  43.             }
  44.          }
  45.       }
  46. end
  47.  
  48. #enddef
  49.  
  50. /*
  51.  * x = y
  52.  */
  53. #define NumEq(x,y) (x == y)
  54. #define big_NumEq(x,y) (bigcmp(&x,&y) == 0)
  55. NumComp( = , numeq, NumEq, equal to)
  56.  
  57. /*
  58.  * x >= y
  59.  */
  60. #define NumGe(x,y) (x >= y)
  61. #define big_NumGe(x,y) (bigcmp(&x,&y) >= 0)
  62. NumComp( >=, numge, NumGe, greater than or equal to)
  63.  
  64. /*
  65.  * x > y
  66.  */
  67. #define NumGt(x,y) (x > y)
  68. #define big_NumGt(x,y) (bigcmp(&x,&y) > 0)
  69. NumComp( > , numgt, NumGt,  greater than)
  70.  
  71. /*
  72.  * x <= y
  73.  */
  74. #define NumLe(x,y) (x <= y)
  75. #define big_NumLe(x,y) (bigcmp(&x,&y) <= 0)
  76. NumComp( <=, numle, NumLe, less than or equal to)
  77.  
  78. /*
  79.  * x < y
  80.  */
  81. #define NumLt(x,y) (x < y)
  82. #define big_NumLt(x,y) (bigcmp(&x,&y) < 0)
  83. NumComp( < , numlt, NumLt,  less than)
  84.  
  85. /*
  86.  * x ~= y
  87.  */
  88. #define NumNe(x,y) (x != y)
  89. #define big_NumNe(x,y) (bigcmp(&x,&y) != 0)
  90. NumComp( ~=, numne, NumNe, not equal to)
  91.  
  92. /*
  93.  * StrComp is a macro that defines the form of a string comparisons.
  94.  */
  95. #begdef StrComp(icon_op, func_name, special_test, c_comp, comp_value, descript)
  96. "x " #icon_op " y - test if x is lexically " #descript " y."
  97. operator{0,1} icon_op func_name(x,y)
  98.    declare {
  99.       int temp_str = 0;
  100.       }
  101.    abstract {
  102.       return string
  103.       }
  104.    if !cnv:tmp_string(x) then
  105.       runerr(103,x)
  106.    if !is:string(y) then
  107.       if cnv:tmp_string(y) then
  108.           inline {
  109.              temp_str = 1;
  110.              }
  111.       else
  112.          runerr(103,y)
  113.  
  114.    body {
  115.  
  116.       /*
  117.        * lexcmp does the work.
  118.        */
  119.       if (special_test (lexcmp(&x, &y) c_comp comp_value)) {
  120.          /*
  121.           * Return y as the result of the comparison.  If y was converted to
  122.           *  a string, a copy of it is allocated.
  123.           */
  124.          result = y;
  125.          if (temp_str)
  126.             Protect(StrLoc(result) = alcstr(StrLoc(result), StrLen(result)), runerr(0));
  127.          return result;
  128.          }
  129.       else
  130.          fail;
  131.       }
  132. end
  133. #enddef
  134.  
  135. StrComp(==,  lexeq, (StrLen(x) == StrLen(y)) &&, ==, Equal, equal to)
  136. StrComp(~==, lexne, (StrLen(x) != StrLen(y)) ||, !=, Equal, not equal to)
  137.  
  138. StrComp(>>=, lexge, , !=, Less,    greater than or equal to)
  139. StrComp(>>,  lexgt, , ==, Greater, greater than)
  140. StrComp(<<=, lexle, , !=, Greater, less than or equal to)
  141. StrComp(<<,  lexlt, , ==, Less,    less than)
  142.  
  143.  
  144. "x === y - test equivalence of x and y."
  145.  
  146. operator{0,1} === eqv(x,y)
  147.    abstract {
  148.       return type(y)
  149.       }
  150.    inline {
  151.       /*
  152.        * Let equiv do all the work, failing if equiv indicates non-equivalence.
  153.        */
  154.       if (equiv(&x, &y))
  155.          return y;
  156.       else
  157.          fail;
  158.    }
  159. end
  160.  
  161.  
  162. "x ~=== y - test inequivalence of x and y."
  163.  
  164. operator{0,1} ~=== neqv(x,y)
  165.    abstract {
  166.       return type(y)
  167.       }
  168.    inline {
  169.       /*
  170.        * equiv does all the work.
  171.        */
  172.       if (!equiv(&x, &y))
  173.          return y;
  174.       else
  175.          fail;
  176.    }
  177. end
  178.