{-# LANGUAGE MagicHash, UnboxedTuples #-} module Data.Queue.TrieQueue.TrieLabel where import Data.Sequence (Seq, ViewL(..), viewl, (><), (<|), (|>)) import qualified Data.Sequence as Seq import qualified Data.Foldable as Fold type Split e x = Label e -- common prefix -> e -> Label e -- truncated suffix of xs -> e -> Label e -- truncated suffix of xs -> x -- split trie type Tail e x = e -> Label e -- left over suffix -> x -- trie {-# INLINE merging #-} -- | Performs partial matching of two labels and applies an appropriate function upon completing a partial match. merging :: Eq e => Label e -- A label, @xs@. -> Label e -- A label, @ys@. -> Split e x -- A function to be applied when the two strings share some (possibly empty) common prefix and mismatchng tails. -> Tail e x -- A function to be applied when @xs@ is a prefix of @ys@. -> Tail e x -- A function to be applied when @ys@ is a prefix of @xs@. -> x -- A value to be returned when @xs == ys@. -> x cons :: e -> Label e -> Label e {-# INLINE uncons #-} uncons :: Label e -> Maybe (e, Label e) labelToList :: Label e -> [e] labelFromList :: [e] -> Label e merging xs0 ys0 split xEnd yEnd xy = merging' 0 xs0 ys0 where merging' n xs ys = let pfx = take n xs0 in case (xs, ys) of (x:xs, y:ys) | x == y -> merging' (n+1) xs ys | otherwise -> split pfx x xs y ys (x:xs, []) -> yEnd x xs ([], y:ys) -> xEnd y ys ([], []) -> xy type Label e = [e] cons = (:) uncons [] = Nothing uncons (x:xs) = Just (x,xs) labelToList = id labelFromList = id {- type Label e = Seq e merging xs0 ys0 split xEnd yEnd xy = merging' 0 (Fold.toList xs0) (Fold.toList ys0) where merging' n xs ys = let n' = n + 1; (pfx, xT0) = Seq.splitAt n xs0; _ :< xT = viewl xT0; yT = Seq.drop n' ys0 in case (xs, ys) of (x:xs, y:ys) | x == y -> merging' n' xs ys | otherwise -> split pfx x xT y yT (x:xs, []) -> yEnd x xT ([], y:ys) -> xEnd y yT ([], []) -> xy uncons xs = case viewl xs of x :< xs -> Just (x, xs) EmptyL -> Nothing cons = (<|) labelToList = Fold.toList labelFromList = Seq.fromList testMerging :: (Eq e, Show e) => Label e -> Label e -> String testMerging xs0 ys0 = merging xs0 ys0 (\ pfx x xs y ys -> "Split " ++ show pfx ++ " (" ++ show x ++ " -> " ++ show xs ++ ") (" ++ show y ++ " -> " ++ show ys ++ ")") (\ y ys -> "Break " ++ show xs0 ++ " = " ++ show y ++ " -> " ++ show ys) (\ x xs -> "Break " ++ show ys0 ++ " = " ++ show x ++ " -> " ++ show xs) ("Equal " ++ show xs0) -}