diff --git a/Setup.hs b/Setup.hs deleted file mode 100644 --- a/Setup.hs +++ /dev/null @@ -1,14 +0,0 @@ -{- | -Module : $Id: Setup.hs 13959 2010-08-31 22:15:26Z cprodescu $ -Description : Cabal Setup file -Copyright : (c) DFKI GmbH 2010 -License : GPLv2 or higher, see LICENSE.txt - -Maintainer : Christian.Maeder@dfki.de -Stability : stable -Portability : portable - -a file for Cabal --} -import Distribution.Simple -main = defaultMain diff --git a/aterm.cabal b/aterm.cabal --- a/aterm.cabal +++ b/aterm.cabal @@ -1,18 +1,18 @@ name: aterm -version: 0.1.0.1 +version: 0.1.0.2 license: GPL-2 license-file: LICENSE.txt author: Klaus Luettich, Christian Maeder -maintainer: Christian Maeder -homepage: https://svn-agbkb.informatik.uni-bremen.de/Hets/trunk/atermlib +maintainer: Christian Maeder +homepage: https://github.com/spechub/Hets/tree/master/atermlib description: Efficient serialisation via annotated terms. Typeable Haskell values may be converted to and from aterms. synopsis: serialisation for Haskell values with sharing support category: Data, Parsing stability: provisional build-type: Simple -cabal-version: >= 1.4 -tested-with: GHC ==6.10.4, GHC ==6.12.3, GHC ==7.0.4 +cabal-version: >= 1.10 +tested-with: GHC ==8.6.5 library @@ -30,6 +30,8 @@ , ATerm.SimpPretty , ATerm.Unshared - extensions: MagicHash + other-extensions: CPP, MagicHash + + default-language: Haskell98 ghc-options: -Wall diff --git a/src/ATerm/AbstractSyntax.hs b/src/ATerm/AbstractSyntax.hs --- a/src/ATerm/AbstractSyntax.hs +++ b/src/ATerm/AbstractSyntax.hs @@ -1,6 +1,6 @@ {-# LANGUAGE MagicHash #-} {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/AbstractSyntax.hs 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 @@ -13,7 +13,7 @@ -} module ATerm.AbstractSyntax - (ShATerm(..), + (ShATerm (..), ATermTable, emptyATermTable, addATerm, @@ -27,6 +27,7 @@ import qualified Data.Map as Map import qualified Data.Map as IntMap import Data.Dynamic +import Data.Typeable import Data.Array import System.Mem.StableName import GHC.Prim @@ -35,8 +36,8 @@ data ShATerm = ShAAppl String [Int] [Int] - | ShAList [Int] [Int] - | ShAInt Integer [Int] + | ShAList [Int] [Int] + | ShAInt Integer [Int] deriving (Show, Eq, Ord) data IntMap = @@ -124,9 +125,9 @@ conv' r = case r of [x] -> x ['\\', x] -> case x of - 'n' -> '\n' - 't' -> '\t' - 'r' -> '\r' + 'n' -> '\n' + 't' -> '\t' + 'r' -> '\r' '\"' -> '\"' _ -> error "ATerm.AbstractSyntax: unexpected escape sequence" _ -> error "ATerm.AbstractSyntax: String not convertible to Char" diff --git a/src/ATerm/Base64.hs b/src/ATerm/Base64.hs --- a/src/ATerm/Base64.hs +++ b/src/ATerm/Base64.hs @@ -1,5 +1,5 @@ {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/Base64.hs Description : Base64 character conversions Copyright : (c) Ian Lynagh, 2005, 2007, Christian Maeder, DFKI GmbH 2008 License : GPLv2 or higher, see LICENSE.txt diff --git a/src/ATerm/Conversion.hs b/src/ATerm/Conversion.hs --- a/src/ATerm/Conversion.hs +++ b/src/ATerm/Conversion.hs @@ -1,5 +1,5 @@ {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/Conversion.hs Description : the class ShATermConvertible and basic instances Copyright : (c) Klaus Luettich, C. Maeder, Uni Bremen 2002-2006 License : GPLv2 or higher, see LICENSE.txt @@ -27,9 +27,9 @@ class Typeable t => ShATermConvertible t where -- functions for conversion to an ATermTable - toShATermAux :: ATermTable -> t -> IO (ATermTable, Int) - toShATermList' :: ATermTable -> [t] -> IO (ATermTable, Int) - fromShATermAux :: Int -> ATermTable -> (ATermTable, t) + toShATermAux :: ATermTable -> t -> IO (ATermTable, Int) + toShATermList' :: ATermTable -> [t] -> IO (ATermTable, Int) + fromShATermAux :: Int -> ATermTable -> (ATermTable, t) fromShATermList' :: Int -> ATermTable -> (ATermTable, [t]) -- default functions ignore the Annotation part @@ -97,14 +97,14 @@ instance (ShATermConvertible a, Integral a) => ShATermConvertible (Ratio a) where toShATermAux att0 i = do - (att1,i1') <- toShATerm' att0 $ numerator i - (att2,i2') <- toShATerm' att1 $ denominator i - return $ addATerm (ShAAppl "Ratio" [i1',i2'] []) att2 + (att1, i1') <- toShATerm' att0 $ numerator i + (att2, i2') <- toShATerm' att1 $ denominator i + return $ addATerm (ShAAppl "Ratio" [i1', i2'] []) att2 fromShATermAux ix att0 = case getShATerm ix att0 of - ShAAppl "Ratio" [a,b] _ -> + ShAAppl "Ratio" [a, b] _ -> case fromShATerm' a att0 of { (att1, a') -> case fromShATerm' b att1 of { (att2, b') -> - (att2, a' % b') }} + (att2, a' % b') }} u -> fromShATermError "Prelude.Integral" u instance ShATermConvertible Float where @@ -144,10 +144,10 @@ instance (ShATermConvertible a, ShATermConvertible b) => ShATermConvertible (Either a b) where toShATermAux att0 (Left aa) = do - (att1,aa') <- toShATerm' att0 aa + (att1, aa') <- toShATerm' att0 aa return $ addATerm (ShAAppl "Left" [ aa' ] []) att1 toShATermAux att0 (Right aa) = do - (att1,aa') <- toShATerm' att0 aa + (att1, aa') <- toShATerm' att0 aa return $ addATerm (ShAAppl "Right" [ aa' ] []) att1 fromShATermAux ix att = case getShATerm ix att of ShAAppl "Left" [ aa ] _ -> @@ -164,12 +164,12 @@ instance (ShATermConvertible a, ShATermConvertible b) => ShATermConvertible (a, b) where - toShATermAux att0 (x,y) = do + toShATermAux att0 (x, y) = do (att1, x') <- toShATerm' att0 x (att2, y') <- toShATerm' att1 y - return $ addATerm (ShAAppl "" [x',y'] []) att2 + return $ addATerm (ShAAppl "" [x', y'] []) att2 fromShATermAux ix att0 = case getShATerm ix att0 of - ShAAppl "" [a,b] _ -> + ShAAppl "" [a, b] _ -> case fromShATerm' a att0 of { (att1, a') -> case fromShATerm' b att1 of { (att2, b') -> (att2, (a', b'))}} @@ -177,13 +177,13 @@ instance (ShATermConvertible a, ShATermConvertible b, ShATermConvertible c) => ShATermConvertible (a, b, c) where - toShATermAux att0 (x,y,z) = do + toShATermAux att0 (x, y, z) = do (att1, x') <- toShATerm' att0 x (att2, y') <- toShATerm' att1 y (att3, z') <- toShATerm' att2 z - return $ addATerm (ShAAppl "" [x',y',z'] []) att3 + return $ addATerm (ShAAppl "" [x', y', z'] []) att3 fromShATermAux ix att0 = case getShATerm ix att0 of - ShAAppl "" [a,b,c] _ -> + ShAAppl "" [a, b, c] _ -> case fromShATerm' a att0 of { (att1, a') -> case fromShATerm' b att1 of { (att2, b') -> case fromShATerm' c att2 of { (att3, c') -> @@ -192,14 +192,14 @@ instance (ShATermConvertible a, ShATermConvertible b, ShATermConvertible c, ShATermConvertible d) => ShATermConvertible (a, b, c, d) where - toShATermAux att0 (x,y,z,w) = do + toShATermAux att0 (x, y, z, w) = do (att1, x') <- toShATerm' att0 x (att2, y') <- toShATerm' att1 y (att3, z') <- toShATerm' att2 z (att4, w') <- toShATerm' att3 w - return $ addATerm (ShAAppl "" [x',y',z',w'] []) att4 + return $ addATerm (ShAAppl "" [x', y', z', w'] []) att4 fromShATermAux ix att0 = case getShATerm ix att0 of - ShAAppl "" [a,b,c,d] _ -> + ShAAppl "" [a, b, c, d] _ -> case fromShATerm' a att0 of { (att1, a') -> case fromShATerm' b att1 of { (att2, b') -> case fromShATerm' c att2 of { (att3, c') -> @@ -230,7 +230,7 @@ instance ShATermConvertible a => ShATermConvertible (Set.Set a) where toShATermAux att set = do - (att1, i) <- toShATerm' att $ Set.toList set + (att1, i) <- toShATerm' att $ Set.toList set return $ addATerm (ShAAppl "Set" [i] []) att1 fromShATermAux ix att0 = case getShATerm ix att0 of ShAAppl "Set" [a] _ -> diff --git a/src/ATerm/Diff.hs b/src/ATerm/Diff.hs --- a/src/ATerm/Diff.hs +++ b/src/ATerm/Diff.hs @@ -1,5 +1,5 @@ {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/Diff.hs Description : compute the differences of two unshared ATerms Copyright : (c) Klaus Luettich, Uni Bremen 2005 License : GPLv2 or higher, see LICENSE.txt @@ -16,36 +16,36 @@ import ATerm.Unshared import Data.List --- | all diferences between both terms are replaced by appropiate --- placeholders (in @\<\>@) and the differing terms are added to the --- list of ATerm as arguments to the function symbol @diff@. +{- | all diferences between both terms are replaced by appropiate +placeholders (in @\<\>@) and the differing terms are added to the +list of ATerm as arguments to the function symbol @diff@. -} -- --- /Note: --- this function ignores annotions and the resulting ATerm does not --- contain any annotation!/ +{- /Note: +this function ignores annotions and the resulting ATerm does not +contain any annotation!/ -} atDiff :: ATerm -> ATerm -> (ATerm, [ATerm]) atDiff a1@(AAppl s1 atl1 _) a2@(AAppl s2 atl2 _) - | s1 == s2 && atl1 == atl2 = (AAppl s1 atl1 [],[]) + | s1 == s2 && atl1 == atl2 = (AAppl s1 atl1 [], []) | s1 == s2 && length atl1 == length atl2 = case atDiffL atl1 atl2 of - (diffs,atl) -> (AAppl s1 atl [],diffs) - | otherwise = (AAppl "" [] [], [AAppl "diff" [a1,a2] []]) + (diffs, atl) -> (AAppl s1 atl [], diffs) + | otherwise = (AAppl "" [] [], [AAppl "diff" [a1, a2] []]) atDiff a1@(AInt i1 _) a2@(AInt i2 _) - | i1 == i2 = (AInt i1 [],[]) - | otherwise = (AAppl "" [] [], [AAppl "diff" [a1,a2] []]) + | i1 == i2 = (AInt i1 [], []) + | otherwise = (AAppl "" [] [], [AAppl "diff" [a1, a2] []]) atDiff a1@(AList l1 _) a2@(AList l2 _) - | l1 == l2 = (AList l1 [],[]) + | l1 == l2 = (AList l1 [], []) | length l1 == length l2 = case atDiffL l1 l2 of - (diffs,atl) -> (AList atl [],diffs) + (diffs, atl) -> (AList atl [], diffs) | otherwise = (AList [AAppl "" [] []] [], - [AAppl "diff" [a1,a2] []]) -atDiff a1 a2 = (AAppl "" [] [], [AAppl "diff" [a1,a2] []]) + [AAppl "diff" [a1, a2] []]) +atDiff a1 a2 = (AAppl "" [] [], [AAppl "diff" [a1, a2] []]) atDiffL :: [ATerm] -> [ATerm] -> ([ATerm], [ATerm]) atDiffL atl1 atl2 = mapAccumL (\ acc (ia1, ia2) -> case atDiff ia1 ia2 of - (at, diffs) -> (acc ++ diffs,at)) [] (zip atl1 atl2) + (at, diffs) -> (acc ++ diffs, at)) [] (zip atl1 atl2) diff --git a/src/ATerm/Lib.hs b/src/ATerm/Lib.hs --- a/src/ATerm/Lib.hs +++ b/src/ATerm/Lib.hs @@ -1,5 +1,5 @@ {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/Lib.hs Description : reexports modules needed for ATC generation Copyright : (c) Klaus Luettich, Uni Bremen 2002-2004 License : GPLv2 or higher, see LICENSE.txt @@ -21,7 +21,7 @@ , ATermTable , addATerm , getShATerm - , ShATermConvertible(toShATermAux, fromShATermAux) + , ShATermConvertible (toShATermAux, fromShATermAux) , toShATerm' , fromShATerm' , fromShATermError diff --git a/src/ATerm/ReadWrite.hs b/src/ATerm/ReadWrite.hs --- a/src/ATerm/ReadWrite.hs +++ b/src/ATerm/ReadWrite.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE CPP #-} {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/ReadWrite.hs Description : read and write ATerms to and from strings Copyright : (c) Klaus Luettich, C.Maeder, Uni Bremen 2002-2005 License : GPLv2 or higher, see LICENSE.txt @@ -13,7 +14,7 @@ Indices (following hash marks) are base64 encoded. -} -module ATerm.ReadWrite( +module ATerm.ReadWrite ( -- * read shared or unshared ATerms readATerm , readATermFile @@ -47,6 +48,10 @@ accidental support for the empty aterm: ShAAppl "" [] [] -} +#if __GLASGOW_HASKELL__ >= 803 +import Prelude hiding ((<>)) +#endif + import ATerm.AbstractSyntax import ATerm.SimpPretty import ATerm.Base64 @@ -59,7 +64,7 @@ if null str then error $ "ATerm.readATermFile: empty input file: " ++ fp else return $ readATerm str ---- From String to ATerm ------------------------------------------------------ +-- - From String to ATerm ------------------------------------------------------ data ReadTAFStruct = RTS ATermTable @@ -70,7 +75,7 @@ {- | create an ATerm table from an input string. Shared or unshared ATerms can be read. A string for shared ATerms usually starts with an exclamation mark and contains many hash marks indicating references. Unshared ATerms are plain -constructor terms. -} +constructor terms. -} readATerm :: String -> ATermTable readATerm = readATerm' . dropWhile ( \ c -> case c of '!' -> True @@ -101,7 +106,7 @@ Nothing -> error $ "unknown aterm index " ++ '#' : i Just a -> (RTS at str' tbl $ length i + 1, Left a) '[' : _ -> case readParTAFs '[' ']' at str tbl 0 of - (RTS at' str' tbl' l', kids) -> + (RTS at' str' tbl' l', kids) -> case readAnnTAF at' (dropSpaces str') tbl' l' of (rs, ann) -> (rs, Right $ ShAList kids ann) x : xs | isIntHead x -> case span isDigit xs of @@ -134,7 +139,7 @@ -> (ReadTAFStruct, [Int]) readTAFs1 at par str tbl l = case readTAF at (dropSpaces str) tbl of - (RTS at' str' tbl' l', t) -> + (RTS at' str' tbl' l', t) -> case readTAFs2 at' par (dropSpaces str') tbl' $ l + l' of (RTS at'' str'' tbl'' l'', ts) -> (RTS at'' str'' tbl'' l'', t : ts) @@ -163,7 +168,7 @@ spanNotQuote' :: String -> (String, String) spanNotQuote' str = case str of - q : r | q == '"' -> ([q], r) + q : r | q == '"' -> ([q], r) c : r@(d : s) -> let (e, l) = if c == '\\' then ([c, d], s) else ([c], r) (f, t) = spanNotQuote' l @@ -179,7 +184,7 @@ isIntHead :: Char -> Bool isIntHead c = isDigit c || c == '-' ---- From (shared) ATerms to strings via simple documents with associated length +-- - From (shared) ATerms to strings via simple documents with associated length data DocLen = DocLen SDoc Int @@ -208,13 +213,13 @@ case writeTAF b (toReadonlyATT at) emptyATab of WS _ (DocLen doc _) -> (if b then text "!" else empty) <> doc ---shared (if input is True) +-- shared (if input is True) writeTAF :: Bool -> ATermTable -> AbbrevTable DocLen -> WriteStruct writeTAF b at tbl = let i = getTopIndex at in case lookupATab i tbl of Just s -> if b then WS tbl s else writeTAF' b at tbl - Nothing -> case writeTAF' b at tbl of + Nothing -> case writeTAF' b at tbl of WS tbl' d_len@(DocLen _ len) -> WS (insertATab len i (abbrevD $ sizeATab tbl') tbl') d_len @@ -262,12 +267,12 @@ -- list brackets must not be omitted bracketS :: DocLen -> DocLen -bracketS (DocLen d dl) +bracketS (DocLen d dl) | dl == 0 = docLen "[]" | otherwise = DocLen (brackets d) $ dl + 2 parenthesiseS :: DocLen -> DocLen -parenthesiseS s@(DocLen d dl) +parenthesiseS s@(DocLen d dl) | dl == 0 = s | otherwise = DocLen (parens d) $ dl + 2 @@ -306,18 +311,18 @@ lookupATab :: Int -> AbbrevTable a -> Maybe a lookupATab i (ATab m _ _) = IntMap.lookup i m ---- Intger Read --------------------------------------------------------------- +-- - Intger Read --------------------------------------------------------------- readInteger :: String -> (Integer, Int) readInteger s = case s of - (hd:str) -> if hd == '-' then case conv str of + (hd : str) -> if hd == '-' then case conv str of (m, l) -> (negate m, l + 1) else conv s _ -> error "readInteger" where f (m, l) x = (toInteger (ord x - ord0) + 10 * m, l + 1) conv = foldl f (0, 0) ---- Base 64 encoding ---------------------------------------------------------- +-- - Base 64 encoding ---------------------------------------------------------- abbrevD :: Int -> DocLen abbrevD = docLen . abbrev diff --git a/src/ATerm/SimpPretty.hs b/src/ATerm/SimpPretty.hs --- a/src/ATerm/SimpPretty.hs +++ b/src/ATerm/SimpPretty.hs @@ -1,5 +1,6 @@ +{-# LANGUAGE CPP #-} {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/SimpPretty.hs Description : simple pretty printing combinators Copyright : (c) Klaus Luettich, C. Maeder Uni Bremen 2002-2005 License : GPLv2 or higher, see LICENSE.txt @@ -38,12 +39,16 @@ render, fullRender, writeFileSDoc ) where +#if __GLASGOW_HASKELL__ >= 803 +import Prelude hiding ((<>)) +#endif + import System.IO infixl 6 <> --- --------------------------------------------------------------------------- --- The interface +{- --------------------------------------------------------------------------- +The interface -} -- The primitive SDoc values @@ -78,16 +83,16 @@ render :: SDoc -> String render doc = showSDoc doc "" --- --------------------------------------------------------------------------- --- The SDoc data type +{- --------------------------------------------------------------------------- +The SDoc data type -} -- | The abstract type of documents data SDoc = Text String | Beside SDoc SDoc --- --------------------------------------------------------------------------- --- simple layout +{- --------------------------------------------------------------------------- +simple layout -} writeFileSDoc :: FilePath -> SDoc -> IO () writeFileSDoc fp sd = @@ -99,8 +104,8 @@ showSDoc = fullRender showString (.) fullRender :: (String -> a) -> (a -> a -> a) -> SDoc -> a -fullRender txt comp doc - = lay doc +fullRender txt comp + = lay where lay (Text s) = txt s lay (Beside p q) = lay p `comp` lay q diff --git a/src/ATerm/Unshared.hs b/src/ATerm/Unshared.hs --- a/src/ATerm/Unshared.hs +++ b/src/ATerm/Unshared.hs @@ -1,5 +1,5 @@ {- | -Module : $Header$ +Module : ./atermlib/src/ATerm/Unshared.hs Description : conversion between shared and (basically unused) unshared ATerms Copyright : (c) Klaus Luettich, Uni Bremen 2002-2004 License : GPLv2 or higher, see LICENSE.txt @@ -12,7 +12,7 @@ -} module ATerm.Unshared - (ATerm(..), + (ATerm (..), fromATerm, fromShATerm, getATermFull, @@ -23,9 +23,9 @@ import ATerm.Conversion data ATerm = AAppl String [ATerm] [ATerm] - | AList [ATerm] [ATerm] - | AInt Integer [ATerm] - deriving (Eq,Ord,Show) + | AList [ATerm] [ATerm] + | AInt Integer [ATerm] + deriving (Eq, Ord, Show) fromShATerm :: ShATermConvertible t => ATermTable -> t fromShATerm att = snd $ fromShATerm' (getTopIndex att) att @@ -37,8 +37,8 @@ getATermFull at = let t = getATerm at in case t of - (ShAInt i as) -> AInt i (map conv as) - (ShAList l as) -> AList (map conv l) (map conv as) + (ShAInt i as) -> AInt i (map conv as) + (ShAList l as) -> AList (map conv l) (map conv as) (ShAAppl c l as) -> AAppl c (map conv l) (map conv as) where conv t = getATermFull (getATermByIndex1 t at) @@ -47,19 +47,19 @@ where addToTable :: ATerm -> ATermTable -> (ATermTable, Int) addToTable (AAppl s ats anns) att = - let (att1,ats') = addToTableList ats att - (att2,anns') = addToTableList anns att1 + let (att1, ats') = addToTableList ats att + (att2, anns') = addToTableList anns att1 in addATerm (ShAAppl s ats' anns') att2 - addToTable (AList ats anns) att = - let (att1,ats') = addToTableList ats att - (att2,anns') = addToTableList anns att1 + addToTable (AList ats anns) att = + let (att1, ats') = addToTableList ats att + (att2, anns') = addToTableList anns att1 in addATerm (ShAList ats' anns') att2 - addToTable (AInt i anns) att = - let (att1,anns') = addToTableList anns att + addToTable (AInt i anns) att = + let (att1, anns') = addToTableList anns att in addATerm (ShAInt i anns') att1 addToTableList :: [ATerm] -> ATermTable -> (ATermTable, [Int]) - addToTableList [] att = (att,[]) - addToTableList (at1:ats) att = - let (att1,i) = addToTable at1 att - (att2,is) = addToTableList ats att1 - in (att2,i:is) + addToTableList [] att = (att, []) + addToTableList (at1 : ats) att = + let (att1, i) = addToTable at1 att + (att2, is) = addToTableList ats att1 + in (att2, i : is)