home *** CD-ROM | disk | FTP | other *** search
/ APDL Public Domain 1 / APDL_PD1A.iso / program / language / icon / Source / Iconx / C / Ocomp < prev    next >
Encoding:
Text File  |  1990-07-19  |  7.5 KB  |  385 lines
  1. /*
  2.  * File: ocomp.c
  3.  *  Contents: lexeq, lexge, lexgt, lexle, lexlt, lexne, numeq, numge,
  4.  *        numgt, numle, numlt, numne, eqv, neqv
  5.  */
  6.  
  7. #include "../h/config.h"
  8. #include "../h/rt.h"
  9. #include "rproto.h"
  10.  
  11.  
  12. /*
  13.  * x == y - test if x is lexically equal to y.
  14.  */
  15.  
  16. OpDcl(lexeq,2,"==")
  17.    {
  18.    register int t;
  19.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  20.  
  21.    /*
  22.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  23.     *  because Arg2 is the result (if any).
  24.     */
  25.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  26.       RunErr(103, &Arg1);
  27.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  28.       RunErr(103, &Arg2);
  29.  
  30.  
  31.    /*
  32.     * If the strings have different lengths they cannot be equal.
  33.     */
  34.    if (StrLen(Arg1) != StrLen(Arg2))
  35.       Fail;
  36.  
  37.    /*
  38.     * lexcmp does the work.
  39.     */
  40.    if (lexcmp(&Arg1, &Arg2) != Equal)
  41.       Fail;
  42.  
  43.    /*
  44.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  45.     *  a string, a copy of it is allocated.
  46.     */
  47.    Arg0 = Arg2;
  48.    if (t == Cvt) {
  49.       if (strreq(StrLen(Arg0)) == Error) 
  50.          RunErr(0, NULL);
  51.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  52.       }
  53.    Return;
  54.    }
  55.  
  56. /*
  57.  * x >>= y - test if x is lexically greater than or equal to y.
  58.  */
  59.  
  60. OpDcl(lexge,2,">>=")
  61.    {
  62.    register int t;
  63.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  64.  
  65.    /*
  66.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  67.     *  because Arg2 is the result (if any).
  68.     */
  69.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  70.       RunErr(103, &Arg1);
  71.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  72.       RunErr(103, &Arg2);
  73.  
  74.    /*
  75.     * lexcmp does the work.
  76.     */
  77.    if (lexcmp(&Arg1, &Arg2) == Less)
  78.       Fail;
  79.  
  80.    /*
  81.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  82.     *  a string, a copy of it is allocated.
  83.     */
  84.    Arg0 = Arg2;
  85.    if (t == Cvt) {
  86.       if (strreq(StrLen(Arg0)) == Error) 
  87.          RunErr(0, NULL);
  88.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  89.       }
  90.    Return;
  91.    }
  92.  
  93. /*
  94.  * x >> y - test if x is lexically greater than y.
  95.  */
  96.  
  97. OpDcl(lexgt,2,">>")
  98.    {
  99.    register int t;
  100.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  101.  
  102.    /*
  103.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  104.     *  because Arg2 is the result (if any).
  105.     */
  106.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  107.       RunErr(103, &Arg1);
  108.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  109.       RunErr(103, &Arg2);
  110.  
  111.    /*
  112.     * lexcmp does the work.
  113.     */
  114.    if (lexcmp(&Arg1, &Arg2) != Greater)
  115.       Fail;
  116.  
  117.    /*
  118.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  119.     *  a string, a copy of it is allocated.
  120.     */
  121.    Arg0 = Arg2;
  122.    if (t == Cvt) {
  123.       if (strreq(StrLen(Arg0)) == Error) 
  124.          RunErr(0, NULL);
  125.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  126.       }
  127.    Return;
  128.    }
  129.  
  130. /*
  131.  * x <<= y - test if x is lexically less than or equal to y.
  132.  */
  133.  
  134. OpDcl(lexle,2,"<<=")
  135.    {
  136.    register int t;
  137.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  138.  
  139.    /*
  140.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  141.     *  because Arg2 is the result (if any).
  142.     */
  143.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  144.       RunErr(103, &Arg1);
  145.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  146.       RunErr(103, &Arg2);
  147.  
  148.    /*
  149.     * lexcmp does the work.
  150.     */
  151.    if (lexcmp(&Arg1, &Arg2) == Greater)
  152.       Fail;
  153.  
  154.    /*
  155.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  156.     *  a string, a copy of it is allocated.
  157.     */
  158.    Arg0 = Arg2;
  159.    if (t == Cvt) {
  160.       if (strreq(StrLen(Arg0)) == Error) 
  161.          RunErr(0, NULL);
  162.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  163.       }
  164.    Return;
  165.    }
  166.  
  167. /*
  168.  * x << y - test if x is lexically less than y.
  169.  */
  170.  
  171. OpDcl(lexlt,2,"<<")
  172.    {
  173.    register int t;
  174.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  175.  
  176.    /*
  177.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  178.     *  because Arg2 is the result (if any).
  179.     */
  180.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  181.       RunErr(103, &Arg1);
  182.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  183.       RunErr(103, &Arg2);
  184.  
  185.    /*
  186.     * lexcmp does the work.
  187.     */
  188.    if (lexcmp(&Arg1, &Arg2) != Less)
  189.       Fail;
  190.  
  191.    /*
  192.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  193.     *  a string, a copy of it is allocated.
  194.     */
  195.    Arg0 = Arg2;
  196.    if (t == Cvt) {        /* string needs to be allocated */
  197.       if (strreq(StrLen(Arg0)) == Error) 
  198.          RunErr(0, NULL);
  199.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  200.       }
  201.    Return;
  202.    }
  203.  
  204. /*
  205.  * x ~== y - test if x is lexically not equal to y.
  206.  */
  207.  
  208. OpDcl(lexne,2,"~==")
  209.    {
  210.    register int t;
  211.    char sbuf1[MaxCvtLen], sbuf2[MaxCvtLen];
  212.  
  213.    /*
  214.     * Arg1 and Arg2 must be strings.  Save the cvstr return value for Arg2
  215.     *  because Arg2 is the result (if any).
  216.     */
  217.    if (cvstr(&Arg1, sbuf1) == CvtFail) 
  218.       RunErr(103, &Arg1);
  219.    if ((t = cvstr(&Arg2, sbuf2)) == CvtFail) 
  220.       RunErr(103, &Arg2);
  221.  
  222.  
  223.    /*
  224.     * If the strings have different lengths they are not equal.
  225.     * If lengths are the same, let lexcmp do the work.
  226.     */
  227.    if (StrLen(Arg1) == StrLen(Arg2) && lexcmp(&Arg1, &Arg2) == Equal)
  228.       Fail;
  229.  
  230.    /*
  231.     * Return Arg2 as the result of the comparison.  If Arg2 was converted to
  232.     *  a string, a copy of it is allocated.
  233.     */
  234.    Arg0 = Arg2;
  235.    if (t == Cvt) {        /* string needs to be allocated */
  236.       if (strreq(StrLen(Arg0)) == Error) 
  237.          RunErr(0, NULL);
  238.       StrLoc(Arg0) = alcstr(StrLoc(Arg0), StrLen(Arg0));
  239.       }
  240.    Return;
  241.    }
  242.  
  243. /*
  244.  * x = y - test if x is numerically equal to y.
  245.  */
  246.  
  247. OpDcl(numeq,2,"=")
  248.    {
  249.  
  250.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  251.       case Equal:
  252.          Return;
  253.       case Greater:
  254.       case Less:
  255.          Fail;
  256.       case Error: 
  257.          RunErr(0, NULL);
  258.       }
  259.    }
  260.  
  261. /*
  262.  * x >= y - test if x is numerically greater or equal to y.
  263.  */
  264.  
  265. OpDcl(numge,2,">=")
  266.    {
  267.  
  268.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  269.       case Greater:
  270.       case Equal:
  271.          Return;
  272.       case Less:
  273.          Fail;
  274.       case Error: 
  275.          RunErr(0, NULL);
  276.       }
  277.    }
  278.  
  279. /*
  280.  * x > y - test if x is numerically greater than y.
  281.  */
  282.  
  283. OpDcl(numgt,2,">")
  284.    {
  285.  
  286.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  287.       case Greater:
  288.          Return;
  289.       case Less:
  290.       case Equal:
  291.          Fail;
  292.       case Error: 
  293.          RunErr(0, NULL);
  294.       }
  295.    }
  296.  
  297. /*
  298.  * x <= y - test if x is numerically less than or equal to y.
  299.  */
  300.  
  301. OpDcl(numle,2,"<=")
  302.    {
  303.  
  304.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  305.       case Less:
  306.       case Equal:
  307.          Return;
  308.       case Greater:
  309.          Fail;
  310.       case Error: 
  311.          RunErr(0, NULL);
  312.       }
  313.    }
  314.  
  315. /*
  316.  * x < y - test if x is numerically less than y.
  317.  */
  318.  
  319. OpDcl(numlt,2,"<")
  320.    {
  321.  
  322.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  323.       case Less:
  324.          Return;
  325.       case Greater:
  326.       case Equal:
  327.          Fail;
  328.       case Error: 
  329.          RunErr(0, NULL);
  330.       }
  331.    }
  332.  
  333. /*
  334.  * x ~= y - test if x is numerically not equal to y.
  335.  */
  336.  
  337. OpDcl(numne,2,"~=")
  338.  
  339.    {
  340.  
  341.    switch (numcmp(&Arg1, &Arg2, &Arg0)) {
  342.       case Less:
  343.       case Greater:
  344.          Return;
  345.       case Equal:
  346.          Fail;
  347.       case Error: 
  348.          RunErr(0, NULL);
  349.       }
  350.    Return;
  351.    }
  352.  
  353. /*
  354.  * x === y - test equivalence of Arg1 and Arg2.
  355.  */
  356.  
  357. OpDcl(eqv,2,"===")
  358.    {
  359.  
  360.    /*
  361.     * Let equiv do all the work, failing if equiv indicates non-equivalence.
  362.     */
  363.    if (!equiv(&Arg1, &Arg2))
  364.       Fail;
  365.  
  366.    Arg0 = Arg2;
  367.    Return;
  368.    }
  369.  
  370. /*
  371.  * x ~=== y - test inequivalence of Arg1 and Arg2.
  372.  */
  373.  
  374. OpDcl(neqv,2,"~===")
  375.    {
  376.  
  377.    /*
  378.     * equiv does all the work.
  379.     */
  380.    if (equiv(&Arg1, &Arg2))
  381.       Fail;
  382.    Arg0 = Arg2;
  383.    Return;
  384.    }
  385.