{-# LANGUAGE MagicHash #-}

{- |

Module : $Header$

Description : the abstract syntax of shared ATerms and their lookup table

Copyright : (c) Klaus Luettich, C. Maeder, Uni Bremen 2002-2006

License : GPLv2 or higher, see LICENSE.txt

Maintainer : Christian.Maeder@dfki.de

Stability : provisional

Portability : non-portable(imports System.Mem.StableName and GHC.Prim)

the data types 'ShATerm' and 'ATermTable' plus some utilities

-}

module ATerm.AbstractSyntax

(ShATerm(..),

ATermTable,

emptyATermTable,

addATerm,

getATerm, toReadonlyATT,

getTopIndex,

getATerm', setATerm', getShATerm,

Key, getKey, setKey, mkKey,

getATermByIndex1, str2Char, integer2Int

) where

import qualified Data.Map as Map

import qualified Data.Map as IntMap

import Data.Dynamic

import Data.Array

import System.Mem.StableName

import GHC.Prim

import qualified Data.List as List

import Data.Maybe

data ShATerm =

ShAAppl String [Int] [Int]

| ShAList [Int] [Int]

| ShAInt Integer [Int]

deriving (Show, Eq, Ord)

data IntMap =

Updateable !(IntMap.Map Int ShATerm)

| Readonly !(Array Int ShATerm)

empty :: IntMap

empty = Updateable IntMap.empty

insert :: Int -> ShATerm -> IntMap -> IntMap

insert i s t = case t of

Updateable m -> Updateable $ IntMap.insert i s m

_ -> error "ATerm.insert"

find :: Int -> IntMap -> ShATerm

find i t = case t of

Updateable m -> IntMap.findWithDefault (ShAInt (-1) []) i m

Readonly a -> a ! i

data EqKey = EqKey (StableName ()) TypeRep deriving Eq

data Key = Key Int EqKey

mkKey :: Typeable a => a -> IO Key

mkKey t = do

s <- makeStableName t

return $ Key (hashStableName s) $ EqKey (unsafeCoerce# s) $ typeOf t

data ATermTable = ATT

(IntMap.Map Int [(EqKey, Int)])

!(Map.Map ShATerm Int) !IntMap Int

!(IntMap.Map Int [Dynamic])

toReadonlyATT :: ATermTable -> ATermTable

toReadonlyATT (ATT h s t i dM) = ATT h s

(case t of

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

_ -> t ) i dM

emptyATermTable :: ATermTable

emptyATermTable = ATT IntMap.empty Map.empty empty (-1) IntMap.empty

addATermNoFullSharing :: ShATerm -> ATermTable -> (ATermTable, Int)

addATermNoFullSharing t (ATT h a_iDFM i_aDFM i1 dM) = let j = i1 + 1 in

(ATT h (Map.insert t j a_iDFM) (insert j t i_aDFM) j dM, j)

addATerm :: ShATerm -> ATermTable -> (ATermTable, Int)

addATerm t at@(ATT _ a_iDFM _ _ _) =

case Map.lookup t a_iDFM of

Nothing -> addATermNoFullSharing t at

Just i -> (at, i)

setKey :: Key -> Int -> ATermTable -> IO (ATermTable, Int)

setKey (Key h e) i (ATT t s l m d) =

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

getKey :: Key -> ATermTable -> IO (Maybe Int)

getKey (Key h k) (ATT t _ _ _ _) =

return $ List.lookup k $ IntMap.findWithDefault [] h t

getATerm :: ATermTable -> ShATerm

getATerm (ATT _ _ i_aFM i _) = find i i_aFM

getShATerm :: Int -> ATermTable -> ShATerm

getShATerm i (ATT _ _ i_aFM _ _) = find i i_aFM

getTopIndex :: ATermTable -> Int

getTopIndex (ATT _ _ _ i _) = i

getATermByIndex1 :: Int -> ATermTable -> ATermTable

getATermByIndex1 i (ATT h a_iDFM i_aDFM _ dM) = ATT h a_iDFM i_aDFM i dM

getATerm' :: Typeable t => Int -> ATermTable -> Maybe t

getATerm' i (ATT _ _ _ _ dM) =

listToMaybe $ mapMaybe fromDynamic $ IntMap.findWithDefault [] i dM

setATerm' :: Typeable t => Int -> t -> ATermTable -> ATermTable

setATerm' i t (ATT h a_iDFM i_aDFM m dM) =

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

-- | conversion of a string in double quotes to a character

str2Char :: 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