module FString(FString, hmkFString, getFString, StrTable, emptyStrTable, getFStrNo,
	       tmpFString, isTmpFString) where
-- Fast strings may be represented by a number and the real string, or just by 
-- a string (not so fast).  The fast strings are made by using a hash table
-- were old strings are kept.
import Hash
import Error(internalError)
import qualified IntMap as I
import PPrint
import Util(mkSet)

data FString = N !Int !Hash String		-- unique number, hash value, actual string

instance Eq FString where
    N n _ _ == N n' _ _ = n == n'
    x       /= y        = not (x==y)
instance Ord FString where
    N _ _ s <= N _ _ s' = s <= s'

instance Show FString where
--    showsType _ = showString "FString"
    showsPrec p (N n _ s) = showsPrec p s

instance Hashable FString where
    hash (N _ h _) = h

instance PPrint FString where
    pPrint _ _ x = text (show x)

hashStr :: String -> Hash
hashStr s = hash (f s 0)
	where f "" r = r
	      f (c:cs) r = f cs (r*16+r+fromEnum c)

getFString (N n _ s) = s	-- ++":"++show n

getFStrNo (N n _ _) = n

startNo :: Int
startNo = 100		-- just some start number

data StrTable = T !Int (I.IntMap [FString]) deriving (Show)
emptyStrTable = T startNo I.empty

hmkFString :: StrTable -> String -> (StrTable, FString)
hmkFString tbl@(T k ht) s =
    let h = hashStr s
        hi = hashToInt maxBound h
    in  case I.lookup hi ht of
	    Just fss -> loc fss
	    	where loc [] = let fs = N k h s in (T (k+1) (I.add (hi, fs:fss) ht), fs)
		      loc (fs@(N _ _ s'):fss) = if s == s' then (tbl, fs) else loc fss
	    Nothing -> let fs = N k h s in (T (k+1) (I.add (hi, [fs]) ht), fs)
instance Eq StrTable
	where _ == _  =  True
	-- Just for convenience

tmpOffs = 1000000 :: Int

tmpFString :: Int -> String -> FString
tmpFString n s = N (n+tmpOffs) (hashStr s) s

isTmpFString :: FString -> Bool
isTmpFString (N n _ _) = n >= tmpOffs