diff options
| author | odanoburu <bcclaro@gmail.com> | 2018-06-20 12:33:05 -0300 |
|---|---|---|
| committer | odanoburu <bcclaro@gmail.com> | 2018-06-20 12:33:05 -0300 |
| commit | f0672679535e59c53ed68729bbb5a201ce507b02 (patch) | |
| tree | 839216d85c207fc4d8fc0565466899ff4a41d5b1 /src/tools/gftest/FMap.hs | |
| parent | 8b05ed9469a970590e1b11cc4e83320d8b94e846 (diff) | |
| parent | 427f8d84788fc3757fb4dacda931c878bf253fa1 (diff) | |
Merge remote-tracking branch 'upstream/master' into por
Diffstat (limited to 'src/tools/gftest/FMap.hs')
| -rw-r--r-- | src/tools/gftest/FMap.hs | 62 |
1 files changed, 0 insertions, 62 deletions
diff --git a/src/tools/gftest/FMap.hs b/src/tools/gftest/FMap.hs deleted file mode 100644 index f3a511706..000000000 --- a/src/tools/gftest/FMap.hs +++ /dev/null @@ -1,62 +0,0 @@ -module FMap where - --------------------------------------------------------------------------------- --- implementation - -data FMap a b = Ask a (FMap a b) (FMap a b) | Nil | Answer b - deriving ( Eq, Ord, Show ) - -toList :: FMap a b -> [([a],b)] -toList t = go [([],t)] - where - go [] = [] - go ((xs,Ask x yes no):xts) = go ((x:xs,yes):(xs,no):xts) - go ((_ ,Nil) :xts) = go xts - go ((xs,Answer z) :xts) = (reverse xs,z) : go xts - -isNil :: FMap a b -> Bool -isNil = null . toList - -nil :: FMap a b -nil = Nil - -unit :: [a] -> b -> FMap a b -unit [] y = Answer y -unit (x:xs) y = Ask x (unit xs y) Nil - -covers :: Ord a => FMap a b -> [a] -> Bool -Nil `covers` _ = False -_ `covers` [] = True -Answer _ `covers` _ = False -Ask x yes no `covers` zs@(y:ys) = - case x `compare` y of - LT -> (yes `covers` zs) || (no `covers` zs) - EQ -> yes `covers` ys - GT -> False - -ask :: a -> FMap a b -> FMap a b -> FMap a b -ask x Nil Nil = Nil -ask x s t = Ask x s t - -del :: Ord a => [a] -> FMap a b -> FMap a b -del _ Nil = Nil -del _ (Answer _) = Nil -del [] (Ask x yes no) = ask x yes (del [] no) -del (x:xs) t@(Ask y yes no) = - case x `compare` y of - LT -> del xs t - EQ -> ask y (del xs yes) (del xs no) - GT -> ask y yes (del (x:xs) no) - -add :: Ord a => [a] -> b -> FMap a b -> FMap a b -add [] y Nil = Answer y -add (x:xs) y Nil = Ask x (add xs y Nil) Nil -add xs@(_:_) y (Answer _) = add xs y Nil -add (x:xs) y t@(Ask z yes no) = - case x `compare` z of - LT -> Ask x (add xs y Nil) (del xs t) - EQ -> Ask x (add xs y yes) (del xs no) - GT -> Ask z yes (add (x:xs) y no) - --------------------------------------------------------------------------------- - |
