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