basis/compiler/cfg/comparisons/comparisons.factor

   1 ! Copyright (C) 2009 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 : negate-cc ( cc -- cc' )
  16     H{
  17         { cc<    cc/<   }
  18         { cc<=   cc/<=  }
  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     } at ;
  32
  33 : negate-vcc ( cc -- cc' )
  34     H{
  35         { vcc-all vcc-notall }
  36         { vcc-any vcc-none }
  37         { vcc-none vcc-any }
  38         { vcc-notall vcc-all }
  39     } at ;
  40
  41 : swap-cc ( cc -- cc' )
  42     H{
  43         { cc<   cc> }
  44         { cc<=  cc>= }
  45         { cc>   cc< }
  46         { cc>=  cc<= }
  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     } at ;
  58
  59 : order-cc ( cc -- cc' )
  60     H{
  61         { cc<    cc<  }
  62         { cc<=   cc<= }
  63         { cc>    cc>  }
  64         { cc>=   cc>= }
  65         { cc=    cc=  }
  66         { cc<>   cc/= }
  67         { cc<>=  t    }
  68         { cc/<   cc>= }
  69         { cc/<=  cc>  }
  70         { cc/>   cc<= }
  71         { cc/>=  cc<  }
  72         { cc/=   cc/= }
  73         { cc/<>  cc=  }
  74         { cc/<>= f    }
  75     } at ;
  76
  77 : evaluate-cc ( result cc -- ? )
  78     H{
  79         { cc<    { +lt+                       } }
  80         { cc<=   { +lt+ +eq+                  } }
  81         { cc=    {      +eq+                  } }
  82         { cc>=   {      +eq+ +gt+             } }
  83         { cc>    {           +gt+             } }
  84         { cc<>   { +lt+      +gt+             } }
  85         { cc<>=  { +lt+ +eq+ +gt+             } }
  86         { cc/<   {      +eq+ +gt+ +unordered+ } }
  87         { cc/<=  {           +gt+ +unordered+ } }
  88         { cc/=   { +lt+      +gt+ +unordered+ } }
  89         { cc/>=  { +lt+           +unordered+ } }
  90         { cc/>   { +lt+ +eq+      +unordered+ } }
  91         { cc/<>  {      +eq+      +unordered+ } }
  92         { cc/<>= {                +unordered+ } }
  93     } at memq? ;
  94