Ticket #2884: VeryLongModuleName.hs

module VeryLongModuleName

where

data T = Nil
       | Node{val   :: {-# UNPACK #-} !Int,
              left  :: !T,
              right :: !T,
              next  :: !T}

empty :: T
empty = Nil

add :: [Int] -> T -> T
add []       _   = Nil -- the empty clause subsumes all!
                       -- (possible trie prunning)
add l        Nil = foldr (\i st -> Node i Nil Nil st) Nil l
add l@(x:xs) st  = case compare x (val st) of
                       EQ -> if isNil (next st)
                               then st  -- subsumed by current clause
                               else st{next = add xs (next st)}
                       LT -> st{left  = add l  (left  st)}
                       GT -> st{right = add l  (right st)}
subsumes :: T -> [Int] -> Bool
subsumes Nil  _       = False     -- the empty set of clauses subsumes nothing
subsumes _    []      = False
subsumes st  l@(x:xs) = case compare x (val st) of
                          EQ -> or [
                                 isNil (next st),
                                     -- end of branch, subsumed! or

                                  subsumes (next  st) xs,
                                     -- subsumer contains x or

                                  subsumes (right st) xs
                                     -- subsumer does not contains x
                                ]
                          --
                          LT -> or [
                                  subsumes (nodeFor x $ left  st) l,
                                     -- subsumer contains x, or

                                  subsumes st xs
                                     -- subsumer does not contains x
                                ]
                          --
                          GT -> subsumes (right st) l
                                     -- nothing to do here, moving right

isNil :: T -> Bool
isNil Nil = True
isNil _   = False

nodeFor :: Int -> T -> T
nodeFor _ Nil = Nil
nodeFor x st  = case compare x (val st) of
                  EQ -> st
                  LT -> left st
                  GT -> right st