0N/A{-# LANGUAGE MagicHash #-}

0N/A{- |

0N/AModule : $Header$

0N/ADescription : the abstract syntax of shared ATerms and their lookup table

0N/ACopyright : (c) Klaus Luettich, C. Maeder, Uni Bremen 2002-2006

0N/ALicense : GPLv2 or higher

0N/A

0N/AMaintainer : Christian.Maeder@dfki.de

0N/AStability : provisional

0N/APortability : non-portable(imports System.Mem.StableName and GHC.Prim)

0N/A

0N/Athe data types 'ShATerm' and 'ATermTable' plus some utilities

0N/A-}

0N/A

0N/Amodule ATerm.AbstractSyntax

0N/A (ShATerm(..),

0N/A ATermTable,

0N/A emptyATermTable,

0N/A addATerm,

0N/A getATerm, toReadonlyATT,

0N/A getTopIndex,

0N/A getATerm', setATerm', getShATerm,

0N/A Key, getKey, setKey, mkKey,

0N/A getATermByIndex1, str2Char, integer2Int

0N/A ) where

0N/A

0N/Aimport qualified Data.Map as Map

0N/Aimport qualified Data.Map as IntMap

0N/Aimport Data.Dynamic

0N/Aimport Data.Array

0N/Aimport System.Mem.StableName

0N/Aimport GHC.Prim

0N/Aimport qualified Data.List as List

0N/Aimport Data.Maybe

0N/A

0N/Adata ShATerm =

0N/A ShAAppl String [Int] [Int]

0N/A | ShAList [Int] [Int]

0N/A | ShAInt Integer [Int]

0N/A deriving (Show, Eq, Ord)

0N/A

0N/Adata IntMap =

0N/A Updateable !(IntMap.Map Int ShATerm)

0N/A | Readonly !(Array Int ShATerm)

0N/A

0N/Aempty :: IntMap

0N/Aempty = Updateable IntMap.empty

0N/A

0N/Ainsert :: Int -> ShATerm -> IntMap -> IntMap

0N/Ainsert i s t = case t of

0N/A Updateable m -> Updateable $ IntMap.insert i s m

0N/A _ -> error "ATerm.insert"

0N/A

0N/Afind :: Int -> IntMap -> ShATerm

0N/Afind i t = case t of

0N/A Updateable m -> IntMap.findWithDefault (ShAInt (-1) []) i m

0N/A Readonly a -> a ! i

0N/A

0N/Adata EqKey = EqKey (StableName ()) TypeRep deriving Eq

0N/A

0N/Adata Key = Key Int EqKey

0N/A

0N/AmkKey :: Typeable a => a -> IO Key

0N/AmkKey t = do

0N/A s <- makeStableName t

0N/A return $ Key (hashStableName s) $ EqKey (unsafeCoerce# s) $ typeOf t

0N/A

0N/Adata ATermTable = ATT

0N/A (IntMap.Map Int [(EqKey, Int)])

0N/A !(Map.Map ShATerm Int) !IntMap Int

0N/A !(IntMap.Map Int [Dynamic])

0N/A

0N/AtoReadonlyATT :: ATermTable -> ATermTable

0N/AtoReadonlyATT (ATT h s t i dM) = ATT h s

0N/A (case t of

0N/A Updateable m -> Readonly $ listArray (0, i) $ IntMap.elems m

0N/A _ -> t ) i dM

0N/A

0N/AemptyATermTable :: ATermTable

0N/AemptyATermTable = ATT IntMap.empty Map.empty empty (-1) IntMap.empty

0N/A

0N/AaddATermNoFullSharing :: ShATerm -> ATermTable -> (ATermTable, Int)

0N/AaddATermNoFullSharing t (ATT h a_iDFM i_aDFM i1 dM) = let j = i1 + 1 in

0N/A (ATT h (Map.insert t j a_iDFM) (insert j t i_aDFM) j dM, j)

0N/A

0N/AaddATerm :: ShATerm -> ATermTable -> (ATermTable, Int)

0N/AaddATerm t at@(ATT _ a_iDFM _ _ _) =

0N/A case Map.lookup t a_iDFM of

0N/A Nothing -> addATermNoFullSharing t at

0N/A Just i -> (at, i)

0N/A

0N/AsetKey :: Key -> Int -> ATermTable -> IO (ATermTable, Int)

0N/AsetKey (Key h e) i (ATT t s l m d) =

0N/A return (ATT (IntMap.insertWith (++) h [(e, i)] t) s l m d, i)

0N/A

0N/AgetKey :: Key -> ATermTable -> IO (Maybe Int)

0N/AgetKey (Key h k) (ATT t _ _ _ _) =

0N/A return $ List.lookup k $ IntMap.findWithDefault [] h t

0N/A

0N/AgetATerm :: ATermTable -> ShATerm

0N/AgetATerm (ATT _ _ i_aFM i _) = find i i_aFM

0N/A

0N/AgetShATerm :: Int -> ATermTable -> ShATerm

0N/AgetShATerm i (ATT _ _ i_aFM _ _) = find i i_aFM

0N/A

0N/AgetTopIndex :: ATermTable -> Int

0N/AgetTopIndex (ATT _ _ _ i _) = i

0N/A

0N/AgetATermByIndex1 :: Int -> ATermTable -> ATermTable

0N/AgetATermByIndex1 i (ATT h a_iDFM i_aDFM _ dM) = ATT h a_iDFM i_aDFM i dM

0N/A

0N/AgetATerm' :: Typeable t => Int -> ATermTable -> Maybe t

0N/AgetATerm' i (ATT _ _ _ _ dM) =

0N/A listToMaybe $ mapMaybe fromDynamic $ IntMap.findWithDefault [] i dM

0N/A

0N/AsetATerm' :: Typeable t => Int -> t -> ATermTable -> ATermTable

0N/AsetATerm' i t (ATT h a_iDFM i_aDFM m dM) =

0N/A ATT h a_iDFM i_aDFM m $ IntMap.insertWith (++) i [toDyn t] dM

0N/A

0N/A-- | conversion of a string in double quotes to a character

0N/Astr2Char :: String -> Char

str2Char str = case str of

'\"' : sr@(_ : _) -> conv' (init sr) where

conv' r = case r of

[x] -> x

['\\', x] -> case x of

'n' -> '\n'

't' -> '\t'

'r' -> '\r'

'\"' -> '\"'

_ -> error "ATerm.AbstractSyntax: unexpected escape sequence"

_ -> error "ATerm.AbstractSyntax: String not convertible to Char"

_ -> error "ATerm.AbstractSyntax: String doesn't begin with '\"'"

-- | conversion of an unlimited integer to a machine int

integer2Int :: Integer -> Int

integer2Int x = if toInteger ((fromInteger :: Integer -> Int) x) == x

then fromInteger x else

error $ "ATerm.AbstractSyntax: Integer to big for Int: " ++ show x