module ATerm.Utilities
(
app
, foldr
, foldl
, foldl'
, foldM
, mapM
, mapM_
, map
, concatMap
, CheckM
, appM
, currentTerm
, withCurrentTerm
, childrenM
, satisfy
, inSubtree
, inSubtree_
, everywhere
, everywhere_
, extractString
, extractInteger
, extractFileInfo
, isNamed
, showATerm
, children
, readATerm
, writeSharedATerm
, getATermFromTable
) where
import ATerm.ReadWrite
import ATerm.SimpPretty
import ATerm.AbstractSyntax
import Control.Monad.Trans.RWS.Strict
import Control.Monad ( liftM )
import qualified Control.Monad as M
import Data.Monoid
import qualified Data.List as L ( foldl' )
import Prelude hiding (foldr, foldl, map, mapM_, mapM, concatMap)
import qualified Prelude as P
app :: (ATermTable -> a) -> ATermTable -> Int -> a
app f t i = f (getATermByIndex1 i t)
foldr :: (ATermTable -> a -> a) -> a -> ATermTable -> a
foldr k z at = go at
where
go t = t `k` P.foldr k' z (children t)
k' i acc = app (foldr k acc) at i
foldl :: (a -> ATermTable -> a) -> a -> ATermTable -> a
foldl k z at = go at
where
go t = k (P.foldl k' z (children t)) t
k' acc i = app (foldl k acc) at i
foldl' :: (a -> ATermTable -> a) -> a -> ATermTable -> a
foldl' k z at = go at
where
go t = let z' = L.foldl' k' z (children t) in z' `seq` k z' t
k' acc i = app (foldl' k acc) at i
foldM :: (Monad m) => (a -> ATermTable -> m a) -> a -> ATermTable -> m a
foldM k z at = go at
where
go t = k z t >>= \a -> M.foldM k' a (children t)
k' acc i = app (foldM k acc) at i
mapM :: (Monad m) => (ATermTable -> m b) -> ATermTable -> m [b]
mapM f = foldM action []
where
action acc x = do
x' <- f x
return (x' : acc)
mapM_ :: (Monad m) => (ATermTable -> m b) -> ATermTable -> m ()
mapM_ f = foldM action ()
where
action _ x = do
_ <- f x
return ()
map :: (ATermTable -> a) -> ATermTable -> [a]
map f at = foldr ((:) . f) [] at
concatMap :: (ATermTable -> [a]) -> ATermTable -> [a]
concatMap f at = foldr ((++) . f) [] at
type CheckM log state m a = RWST ATermTable log state m a
appM :: (Monoid log, Monad m) => (ATermTable -> a) -> Int -> CheckM log state m a
appM f i = do
t <- currentTerm
return (f (getATermByIndex1 i t))
currentTerm :: (Monoid log, Monad m) => CheckM log state m ATermTable
currentTerm = ask
withCurrentTerm :: (Monoid log, Monad m)
=> ATermTable -> CheckM log state m a -> CheckM log state m a
withCurrentTerm t = local (const t)
childrenM :: (Monad m, Monoid log) => CheckM log state m [Int]
childrenM = children `liftM` currentTerm
satisfy :: (Monad m, Monoid log)
=> (ATermTable -> Bool) -> CheckM log st m a -> CheckM log st m (Maybe a)
satisfy p m = do
t <- currentTerm
case p t of
True -> Just `liftM` m
False -> return Nothing
inSubtree :: (Monad m, Monoid log) => CheckM log state m a -> CheckM log state m [[a]]
inSubtree c = do
ks <- childrenM
at <- currentTerm
let kids = P.map (`getATermByIndex1` at) ks
P.mapM (`withCurrentTerm` (everywhere c)) kids
inSubtree_ :: (Monad m, Monoid log) => CheckM log state m a -> CheckM log state m ()
inSubtree_ c = do
ks <- childrenM
at <- currentTerm
let kids = P.map (`getATermByIndex1` at) ks
P.mapM_ (`withCurrentTerm` (everywhere c)) kids
everywhere :: (Monad m, Monoid log) => CheckM log state m a -> CheckM log state m [a]
everywhere c = currentTerm >>= mapM (\at -> withCurrentTerm at c)
everywhere_ :: (Monad m, Monoid log) => CheckM log state m a -> CheckM log state m ()
everywhere_ c = currentTerm >>= mapM_ (\at -> withCurrentTerm at c)
extractString :: ATermTable -> Maybe String
extractString at =
case getATerm at of
ShAAppl s _ _ -> Just s
_ -> Nothing
extractInteger :: ATermTable -> Maybe Integer
extractInteger at =
case getATerm at of
ShAInt i _ -> Just i
_ -> Nothing
extractFileInfo :: ATermTable -> Maybe (String, Integer, Integer)
extractFileInfo at =
case getATerm at of
ShAAppl s [fp,line,col] _
| s == "file_info"
, Just f <- extractString (getATermByIndex1 fp at)
, Just l <- extractInteger (getATermByIndex1 line at)
, Just c <- extractInteger (getATermByIndex1 col at) -> Just (f,l,c)
_ -> Nothing
isNamed :: String -> ATermTable -> Bool
isNamed name t =
case getATerm t of
ShAAppl s _ _ -> s == name
_ -> False
showATerm :: ATermTable -> String
showATerm = render . writeSharedATermSDoc
children :: ATermTable -> [Int]
children t =
case getATerm t of
ShAAppl _ l _ -> l
ShAList l _ -> l
ShAInt _ _ -> []
getATermFromTable :: ATermTable -> Int -> ATermTable
getATermFromTable = flip getATermByIndex1