TrieLabel.hs

{-# 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)


-}