basis/compiler/tree/comparisons/comparisons.factor

   1 ! Copyright (C) 2008, 2009 Slava Pestov.
   2 ! See https://factorcode.org/license.txt for BSD license.
   3 USING: assocs combinators math math.intervals math.order ;
   4 IN: compiler.tree.comparisons
   5
   6 ! Some utilities for working with comparison operations.
   7
   8 CONSTANT: comparison-ops { < > <= >= u< u> u<= u>= }
   9
  10 CONSTANT: generic-comparison-ops { before? after? before=? after=? }
  11
  12 : assumption ( i1 i2 op -- i3 )
  13     {
  14         { \ <   [ assume< ] }
  15         { \ >   [ assume> ] }
  16         { \ <=  [ assume<= ] }
  17         { \ >=  [ assume>= ] }
  18         { \ u<  [ assume< ] }
  19         { \ u>  [ assume> ] }
  20         { \ u<= [ assume<= ] }
  21         { \ u>= [ assume>= ] }
  22     } case ;
  23
  24 : interval-comparison ( i1 i2 op -- result )
  25     {
  26         { \ <   [ interval< ] }
  27         { \ >   [ interval> ] }
  28         { \ <=  [ interval<= ] }
  29         { \ >=  [ interval>= ] }
  30         { \ u<  [ interval< ] }
  31         { \ u>  [ interval> ] }
  32         { \ u<= [ interval<= ] }
  33         { \ u>= [ interval>= ] }
  34     } case ;
  35
  36 : swap-comparison ( op -- op' )
  37     {
  38         { < > }
  39         { > < }
  40         { <= >= }
  41         { >= <= }
  42         { u< u> }
  43         { u> u< }
  44         { u<= u>= }
  45         { u>= u<= }
  46     } at ;
  47
  48 : negate-comparison ( op -- op' )
  49     {
  50         { < >= }
  51         { > <= }
  52         { <= > }
  53         { >= < }
  54         { u< u>= }
  55         { u> u<= }
  56         { u<= u> }
  57         { u>= u< }
  58     } at ;
  59
  60 : specific-comparison ( op -- op' )
  61     {
  62         { before? < }
  63         { after? > }
  64         { before=? <= }
  65         { after=? >= }
  66     } at ;