basis/compiler/cfg/comparisons/comparisons.factor

   1 ! Copyright (C) 2009, 2010 Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs math.order sequences ;
   4 IN: compiler.cfg.comparisons
   5
   6 SYMBOL: +unordered+
   7
   8 SYMBOLS:
   9     cc<  cc<=  cc=  cc>  cc>=  cc<>  cc<>=
  10     cc/< cc/<= cc/= cc/> cc/>= cc/<> cc/<>= ;
  11
  12 SYMBOLS:
  13     vcc-all vcc-notall vcc-any vcc-none ;
  14
  15 SYMBOLS: cc-o cc/o ;
  16
  17 : negate-cc ( cc -- cc' )
  18     H{
  19         { cc<    cc/<   }
  20         { cc<=   cc/<=  }
  21         { cc>    cc/>   }
  22         { cc>=   cc/>=  }
  23         { cc=    cc/=   }
  24         { cc<>   cc/<>  }
  25         { cc<>=  cc/<>= }
  26         { cc/<   cc<    }
  27         { cc/<=  cc<=   }
  28         { cc/>   cc>    }
  29         { cc/>=  cc>=   }
  30         { cc/=   cc=    }
  31         { cc/<>  cc<>   }
  32         { cc/<>= cc<>=  }
  33         { cc-o   cc/o   }
  34         { cc/o   cc-o   }
  35     } at ;
  36
  37 : negate-vcc ( cc -- cc' )
  38     H{
  39         { vcc-all vcc-notall }
  40         { vcc-any vcc-none }
  41         { vcc-none vcc-any }
  42         { vcc-notall vcc-all }
  43     } at ;
  44
  45 : swap-cc ( cc -- cc' )
  46     H{
  47         { cc<   cc> }
  48         { cc<=  cc>= }
  49         { cc>   cc< }
  50         { cc>=  cc<= }
  51         { cc=   cc= }
  52         { cc<>  cc<> }
  53         { cc<>= cc<>= }
  54         { cc/<   cc/> }
  55         { cc/<=  cc/>= }
  56         { cc/>   cc/< }
  57         { cc/>=  cc/<= }
  58         { cc/=   cc/= }
  59         { cc/<>  cc/<> }
  60         { cc/<>= cc/<>= }
  61     } at ;
  62
  63 : order-cc ( cc -- cc' )
  64     H{
  65         { cc<    cc<  }
  66         { cc<=   cc<= }
  67         { cc>    cc>  }
  68         { cc>=   cc>= }
  69         { cc=    cc=  }
  70         { cc<>   cc/= }
  71         { cc<>=  t    }
  72         { cc/<   cc>= }
  73         { cc/<=  cc>  }
  74         { cc/>   cc<= }
  75         { cc/>=  cc<  }
  76         { cc/=   cc/= }
  77         { cc/<>  cc=  }
  78         { cc/<>= f    }
  79     } at ;
  80
  81 : evaluate-cc ( result cc -- ? )
  82     H{
  83         { cc<    { +lt+                       } }
  84         { cc<=   { +lt+ +eq+                  } }
  85         { cc=    {      +eq+                  } }
  86         { cc>=   {      +eq+ +gt+             } }
  87         { cc>    {           +gt+             } }
  88         { cc<>   { +lt+      +gt+             } }
  89         { cc<>=  { +lt+ +eq+ +gt+             } }
  90         { cc/<   {      +eq+ +gt+ +unordered+ } }
  91         { cc/<=  {           +gt+ +unordered+ } }
  92         { cc/=   { +lt+      +gt+ +unordered+ } }
  93         { cc/>=  { +lt+           +unordered+ } }
  94         { cc/>   { +lt+ +eq+      +unordered+ } }
  95         { cc/<>  {      +eq+      +unordered+ } }
  96         { cc/<>= {                +unordered+ } }
  97     } at member-eq? ;