Ticket #2884: VeryLongModuleName.hs

File VeryLongModuleName.hs, 2.1 KB (added by jcpetruzza, 5 years ago)
Line 
1module VeryLongModuleName
2
3where
4
5data T = Nil
6       | Node{val   :: {-# UNPACK #-} !Int,
7              left  :: !T,
8              right :: !T,
9              next  :: !T}
10
11empty :: T
12empty = Nil
13
14add :: [Int] -> T -> T
15add []       _   = Nil -- the empty clause subsumes all!
16                       -- (possible trie prunning)
17add l        Nil = foldr (\i st -> Node i Nil Nil st) Nil l
18add l@(x:xs) st  = case compare x (val st) of
19                       EQ -> if isNil (next st)
20                               then st  -- subsumed by current clause
21                               else st{next = add xs (next st)}
22                       LT -> st{left  = add l  (left  st)}
23                       GT -> st{right = add l  (right st)}
24subsumes :: T -> [Int] -> Bool
25subsumes Nil  _       = False     -- the empty set of clauses subsumes nothing
26subsumes _    []      = False
27subsumes st  l@(x:xs) = case compare x (val st) of
28                          EQ -> or [
29                                 isNil (next st),
30                                     -- end of branch, subsumed! or
31
32                                  subsumes (next  st) xs,
33                                     -- subsumer contains x or
34
35                                  subsumes (right st) xs
36                                     -- subsumer does not contains x
37                                ]
38                          --
39                          LT -> or [
40                                  subsumes (nodeFor x $ left  st) l,
41                                     -- subsumer contains x, or
42
43                                  subsumes st xs
44                                     -- subsumer does not contains x
45                                ]
46                          --
47                          GT -> subsumes (right st) l
48                                     -- nothing to do here, moving right
49
50isNil :: T -> Bool
51isNil Nil = True
52isNil _   = False
53
54nodeFor :: Int -> T -> T
55nodeFor _ Nil = Nil
56nodeFor x st  = case compare x (val st) of
57                  EQ -> st
58                  LT -> left st
59                  GT -> right st
60