diff --git a/LICENSE.txt b/LICENSE.txt new file mode 100644 --- /dev/null +++ b/LICENSE.txt @@ -0,0 +1,339 @@ + GNU GENERAL PUBLIC LICENSE + Version 2, June 1991 + + Copyright (C) 1989, 1991 Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +License is intended to guarantee your freedom to share and change free +software--to make sure the software is free for all its users. This +General Public License applies to most of the Free Software +Foundation's software and to any other program whose authors commit to +using it. (Some other Free Software Foundation software is covered by +the GNU Lesser General Public License instead.) You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +this service if you wish), that you receive source code or can get it +if you want it, that you can change the software or use pieces of it +in new free programs; and that you know you can do these things. + + To protect your rights, we need to make restrictions that forbid +anyone to deny you these rights or to ask you to surrender the rights. +These restrictions translate to certain responsibilities for you if you +distribute copies of the software, or if you modify it. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must give the recipients all the rights that +you have. You must make sure that they, too, receive or can get the +source code. And you must show them these terms so they know their +rights. + + We protect your rights with two steps: (1) copyright the software, and +(2) offer you this license which gives you legal permission to copy, +distribute and/or modify the software. + + Also, for each author's protection and ours, we want to make certain +that everyone understands that there is no warranty for this free +software. If the software is modified by someone else and passed on, we +want its recipients to know that what they have is not the original, so +that any problems introduced by others will not reflect on the original +authors' reputations. + + Finally, any free program is threatened constantly by software +patents. We wish to avoid the danger that redistributors of a free +program will individually obtain patent licenses, in effect making the +program proprietary. To prevent this, we have made it clear that any +patent must be licensed for everyone's free use or not licensed at all. + + The precise terms and conditions for copying, distribution and +modification follow. + + GNU GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License applies to any program or other work which contains +a notice placed by the copyright holder saying it may be distributed +under the terms of this General Public License. The "Program", below, +refers to any such program or work, and a "work based on the Program" +means either the Program or any derivative work under copyright law: +that is to say, a work containing the Program or a portion of it, +either verbatim or with modifications and/or translated into another +language. (Hereinafter, translation is included without limitation in +the term "modification".) Each licensee is addressed as "you". + +Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running the Program is not restricted, and the output from the Program +is covered only if its contents constitute a work based on the +Program (independent of having been made by running the Program). +Whether that is true depends on what the Program does. + + 1. You may copy and distribute verbatim copies of the Program's +source code as you receive it, in any medium, provided that you +conspicuously and appropriately publish on each copy an appropriate +copyright notice and disclaimer of warranty; keep intact all the +notices that refer to this License and to the absence of any warranty; +and give any other recipients of the Program a copy of this License +along with the Program. + +You may charge a fee for the physical act of transferring a copy, and +you may at your option offer warranty protection in exchange for a fee. + + 2. You may modify your copy or copies of the Program or any portion +of it, thus forming a work based on the Program, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) You must cause the modified files to carry prominent notices + stating that you changed the files and the date of any change. + + b) You must cause any work that you distribute or publish, that in + whole or in part contains or is derived from the Program or any + part thereof, to be licensed as a whole at no charge to all third + parties under the terms of this License. + + c) If the modified program normally reads commands interactively + when run, you must cause it, when started running for such + interactive use in the most ordinary way, to print or display an + announcement including an appropriate copyright notice and a + notice that there is no warranty (or else, saying that you provide + a warranty) and that users may redistribute the program under + these conditions, and telling the user how to view a copy of this + License. (Exception: if the Program itself is interactive but + does not normally print such an announcement, your work based on + the Program is not required to print an announcement.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Program, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Program, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Program. + +In addition, mere aggregation of another work not based on the Program +with the Program (or with a work based on the Program) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may copy and distribute the Program (or a work based on it, +under Section 2) in object code or executable form under the terms of +Sections 1 and 2 above provided that you also do one of the following: + + a) Accompany it with the complete corresponding machine-readable + source code, which must be distributed under the terms of Sections + 1 and 2 above on a medium customarily used for software interchange; or, + + b) Accompany it with a written offer, valid for at least three + years, to give any third party, for a charge no more than your + cost of physically performing source distribution, a complete + machine-readable copy of the corresponding source code, to be + distributed under the terms of Sections 1 and 2 above on a medium + customarily used for software interchange; or, + + c) Accompany it with the information you received as to the offer + to distribute corresponding source code. (This alternative is + allowed only for noncommercial distribution and only if you + received the program in object code or executable form with such + an offer, in accord with Subsection b above.) + +The source code for a work means the preferred form of the work for +making modifications to it. For an executable work, complete source +code means all the source code for all modules it contains, plus any +associated interface definition files, plus the scripts used to +control compilation and installation of the executable. However, as a +special exception, the source code distributed need not include +anything that is normally distributed (in either source or binary +form) with the major components (compiler, kernel, and so on) of the +operating system on which the executable runs, unless that component +itself accompanies the executable. + +If distribution of executable or object code is made by offering +access to copy from a designated place, then offering equivalent +access to copy the source code from the same place counts as +distribution of the source code, even though third parties are not +compelled to copy the source along with the object code. + + 4. You may not copy, modify, sublicense, or distribute the Program +except as expressly provided under this License. Any attempt +otherwise to copy, modify, sublicense or distribute the Program is +void, and will automatically terminate your rights under this License. +However, parties who have received copies, or rights, from you under +this License will not have their licenses terminated so long as such +parties remain in full compliance. + + 5. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Program or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Program (or any work based on the +Program), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Program or works based on it. + + 6. Each time you redistribute the Program (or any work based on the +Program), the recipient automatically receives a license from the +original licensor to copy, distribute or modify the Program subject to +these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties to +this License. + + 7. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Program at all. For example, if a patent +license would not permit royalty-free redistribution of the Program by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Program. + +If any portion of this section is held invalid or unenforceable under +any particular circumstance, the balance of the section is intended to +apply and the section as a whole is intended to apply in other +circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system, which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 8. If the distribution and/or use of the Program is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Program under this License +may add an explicit geographical distribution limitation excluding +those countries, so that distribution is permitted only in or among +countries not thus excluded. In such case, this License incorporates +the limitation as if written in the body of this License. + + 9. The Free Software Foundation may publish revised and/or new versions +of the General Public License from time to time. Such new versions will +be similar in spirit to the present version, but may differ in detail to +address new problems or concerns. + +Each version is given a distinguishing version number. If the Program +specifies a version number of this License which applies to it and "any +later version", you have the option of following the terms and conditions +either of that version or of any later version published by the Free +Software Foundation. If the Program does not specify a version number of +this License, you may choose any version ever published by the Free Software +Foundation. + + 10. If you wish to incorporate parts of the Program into other free +programs whose distribution conditions are different, write to the author +to ask for permission. For software which is copyrighted by the Free +Software Foundation, write to the Free Software Foundation; we sometimes +make exceptions for this. Our decision will be guided by the two goals +of preserving the free status of all derivatives of our free software and +of promoting the sharing and reuse of software generally. + + NO WARRANTY + + 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY +FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN +OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES +PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED +OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF +MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS +TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE +PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, +REPAIR OR CORRECTION. + + 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING +WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR +REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, +INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING +OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED +TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY +YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER +PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE +POSSIBILITY OF SUCH DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Programs + + If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least +the "copyright" line and a pointer to where the full notice is found. + + + Copyright (C) + + This program is free software; you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation; either version 2 of the License, or + (at your option) any later version. + + This program is distributed in the hope that it will be useful, + but WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + GNU General Public License for more details. + + You should have received a copy of the GNU General Public License along + with this program; if not, write to the Free Software Foundation, Inc., + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +Also add information on how to contact you by electronic and paper mail. + +If the program is interactive, make it output a short notice like this +when it starts in an interactive mode: + + Gnomovision version 69, Copyright (C) year name of author + Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. + This is free software, and you are welcome to redistribute it + under certain conditions; type `show c' for details. + +The hypothetical commands `show w' and `show c' should show the appropriate +parts of the General Public License. Of course, the commands you use may +be called something other than `show w' and `show c'; they could even be +mouse-clicks or menu items--whatever suits your program. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the program, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the program + `Gnomovision' (which makes passes at compilers) written by James Hacker. + + , 1 April 1989 + Ty Coon, President of Vice + +This General Public License does not permit incorporating your program into +proprietary programs. If your program is a subroutine library, you may +consider it more useful to permit linking proprietary applications with the +library. If this is what you want to do, use the GNU Lesser General +Public License instead of this License. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,14 @@ +{- | +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 new file mode 100644 --- /dev/null +++ b/aterm.cabal @@ -0,0 +1,35 @@ +name: aterm +version: 0.1.0.0 +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 +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 + +library + + build-depends: base >= 4.0 && < 5, ghc-prim, containers, array + + hs-source-dirs: src + + exposed-modules: + ATerm.AbstractSyntax + , ATerm.Base64 + , ATerm.Conversion + , ATerm.Diff + , ATerm.Lib + , ATerm.ReadWrite + , ATerm.SimpPretty + , ATerm.Unshared + + extensions: MagicHash + + ghc-options: -Wall diff --git a/src/ATerm/AbstractSyntax.hs b/src/ATerm/AbstractSyntax.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/AbstractSyntax.hs @@ -0,0 +1,139 @@ +{-# 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 diff --git a/src/ATerm/Base64.hs b/src/ATerm/Base64.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/Base64.hs @@ -0,0 +1,66 @@ +{- | +Module : $Header$ +Description : Base64 character conversions +Copyright : (c) Ian Lynagh, 2005, 2007, Christian Maeder, DFKI GmbH 2008 +License : GPLv2 or higher, see LICENSE.txt + +Maintainer : Christian.Maeder@dfki.de +Stability : provisional +Portability : portable + +base64 character conversions +-} + +module ATerm.Base64 + ( toBase64Int + , toBase64Char + , isBase64Char + , ord0 + ) where + +import Data.Char + +{- +toBase64 :: [Char] +toBase64 = + [ 'A','B','C','D','E','F','G','H','I','J','K','L','M','N','O','P', + 'Q','R','S','T','U','V','W','X','Y','Z','a','b','c','d','e','f', + 'g','h','i','j','k','l','m','n','o','p','q','r','s','t','u','v', + 'w','x','y','z','0','1','2','3','4','5','6','7','8','9','+','/' + ] +-} + +toBase64Int :: Char -> Int +toBase64Int c + | isUpper c = ord c - ordA + | isLower c = ord c - i71 + | isDigit c = ord c + i4 + | c == '+' = 62 + | c == '/' = 63 + | otherwise = error "toBase64Int" + +toBase64Char :: Int -> Char +toBase64Char i + | i < 26 = chr (ordA + i) + | i < 52 = chr (i71 + i) + | i < 62 = chr (i - i4) + | i == 62 = '+' + | i == 63 = '/' + | otherwise = error "toBase64Char" + +isBase64Char :: Char -> Bool +isBase64Char c = isAscii c && (isAlphaNum c || c == '+' || c == '/') + +-- a couple of constants + +ordA :: Int +ordA = ord 'A' + +i71 :: Int +i71 = ord 'a' - 26 + +ord0 :: Int +ord0 = ord '0' + +i4 :: Int +i4 = 52 - ord0 diff --git a/src/ATerm/Conversion.hs b/src/ATerm/Conversion.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/Conversion.hs @@ -0,0 +1,239 @@ +{- | +Module : $Header$ +Description : the class ShATermConvertible and basic instances +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 ATerm.AbstractSyntax) + +the class 'ShATermConvertible' depending on the class 'Typeable' for +converting datatypes to and from 'ShATerm's in 'ATermTable's, plus a +couple of basic instances and utilities +-} + +module ATerm.Conversion where + +import ATerm.AbstractSyntax +import qualified Data.Map as Map +import qualified Data.IntMap as IntMap +import qualified Data.Set as Set +import Data.Typeable +import Data.List (mapAccumL) +import Data.Ratio +import Data.Word +import Control.Monad + +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) + fromShATermList' :: Int -> ATermTable -> (ATermTable, [t]) + + -- default functions ignore the Annotation part + toShATermList' att ts = do + (att2, inds) <- foldM (\ (att0, l) t -> do + (att1, i) <- toShATerm' att0 t + return (att1, i : l)) (att, []) ts + return $ addATerm (ShAList (reverse inds) []) att2 + + fromShATermList' ix att0 = + case getShATerm ix att0 of + ShAList ats _ -> + mapAccumL (flip fromShATerm') att0 ats + u -> fromShATermError "[]" u + +toShATerm' :: ShATermConvertible t => ATermTable -> t -> IO (ATermTable, Int) +toShATerm' att t = do + k <- mkKey t + m <- getKey k att + case m of + Nothing -> do + (att1, i) <- toShATermAux att t + setKey k i att1 + Just i -> return (att, i) + +fromShATerm' :: ShATermConvertible t => Int -> ATermTable -> (ATermTable, t) +fromShATerm' i att = case getATerm' i att of + Just d -> (att, d) + _ -> case fromShATermAux i att of + (attN, t) -> (setATerm' i t attN, t) + +fromShATermError :: String -> ShATerm -> a +fromShATermError t u = + error $ "Cannot convert ShATerm to " ++ t ++ ": !" ++ show u + +-- some instances ----------------------------------------------- +instance ShATermConvertible Bool where + toShATermAux att b = return + $ addATerm (ShAAppl (if b then "T" else "F") [] []) att + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "T" [] _ -> (att0, True) + ShAAppl "F" [] _ -> (att0, False) + u -> fromShATermError "Prelude.Bool" u + +instance ShATermConvertible Integer where + toShATermAux att x = return $ addATerm (ShAInt x []) att + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAInt x _ -> (att0, x) + u -> fromShATermError "Prelude.Integer" u + +instance ShATermConvertible Int where + toShATermAux att = toShATermAux att . toInteger + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAInt x _ -> (att0, integer2Int x) + u -> fromShATermError "Prelude.Int" u + +instance ShATermConvertible Word8 where + toShATermAux att = toShATermAux att . toInteger + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAInt x _ | x <= toInteger (maxBound :: Word8) + && x >= toInteger (minBound :: Word8) + -> (att0, fromIntegral x) + u -> fromShATermError "Data.Word8" u + +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 + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "Ratio" [a,b] _ -> + case fromShATerm' a att0 of { (att1, a') -> + case fromShATerm' b att1 of { (att2, b') -> + (att2, a' % b') }} + u -> fromShATermError "Prelude.Integral" u + +instance ShATermConvertible Float where + toShATermAux att = toShATermAux att . toRational + fromShATermAux ix att0 = case fromShATermAux ix att0 of + (att, r) -> (att, fromRational r) + +instance ShATermConvertible Char where + toShATermAux att c = return $ addATerm (ShAAppl (show [c]) [] []) att + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl s [] _ -> (att0, str2Char s) + u -> fromShATermError "Prelude.Char" u + toShATermList' att s = return $ addATerm (ShAAppl (show s) [] []) att + fromShATermList' ix att0 = case getShATerm ix att0 of + ShAAppl s [] _ -> (att0, read s) + u -> fromShATermError "Prelude.String" u + +instance ShATermConvertible () where + toShATermAux att _ = return $ addATerm (ShAAppl "U" [] []) att + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "U" [] _ -> (att0, ()) + u -> fromShATermError "()" u + +instance (ShATermConvertible a) => ShATermConvertible (Maybe a) where + toShATermAux att mb = case mb of + Nothing -> return $ addATerm (ShAAppl "N" [] []) att + Just x -> do + (att1, x') <- toShATerm' att x + return $ addATerm (ShAAppl "J" [x'] []) att1 + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "N" [] _ -> (att0, Nothing) + ShAAppl "J" [a] _ -> + case fromShATerm' a att0 of { (att1, a') -> + (att1, Just a') } + u -> fromShATermError "Prelude.Maybe" u + +instance (ShATermConvertible a, ShATermConvertible b) + => ShATermConvertible (Either a b) where + toShATermAux att0 (Left aa) = do + (att1,aa') <- toShATerm' att0 aa + return $ addATerm (ShAAppl "Left" [ aa' ] []) att1 + toShATermAux att0 (Right aa) = do + (att1,aa') <- toShATerm' att0 aa + return $ addATerm (ShAAppl "Right" [ aa' ] []) att1 + fromShATermAux ix att = case getShATerm ix att of + ShAAppl "Left" [ aa ] _ -> + case fromShATerm' aa att of { (att2, aa') -> + (att2, Left aa') } + ShAAppl "Right" [ aa ] _ -> + case fromShATerm' aa att of { (att2, aa') -> + (att2, Right aa') } + u -> fromShATermError "Either" u + +instance ShATermConvertible a => ShATermConvertible [a] where + toShATermAux = toShATermList' + fromShATermAux = fromShATermList' + +instance (ShATermConvertible a, ShATermConvertible b) + => ShATermConvertible (a, b) where + toShATermAux att0 (x,y) = do + (att1, x') <- toShATerm' att0 x + (att2, y') <- toShATerm' att1 y + return $ addATerm (ShAAppl "" [x',y'] []) att2 + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "" [a,b] _ -> + case fromShATerm' a att0 of { (att1, a') -> + case fromShATerm' b att1 of { (att2, b') -> + (att2, (a', b'))}} + u -> fromShATermError "(,)" u + +instance (ShATermConvertible a, ShATermConvertible b, ShATermConvertible c) + => ShATermConvertible (a, b, c) where + 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 + fromShATermAux ix att0 = case getShATerm ix att0 of + 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') -> + (att3, (a', b', c'))}}} + u -> fromShATermError "(,,)" u + +instance (ShATermConvertible a, ShATermConvertible b, ShATermConvertible c, + ShATermConvertible d) => ShATermConvertible (a, b, c, d) where + 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 + fromShATermAux ix att0 = case getShATerm ix att0 of + 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') -> + case fromShATerm' d att3 of { (att4, d') -> + (att4, (a', b', c', d'))}}}} + u -> fromShATermError "(,,,)" u + +instance (Ord a, ShATermConvertible a, ShATermConvertible b) + => ShATermConvertible (Map.Map a b) where + toShATermAux att fm = do + (att1, i) <- toShATerm' att $ Map.toList fm + return $ addATerm (ShAAppl "Map" [i] []) att1 + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "Map" [a] _ -> + case fromShATerm' a att0 of { (att1, a') -> + (att1, Map.fromDistinctAscList a') } + u -> fromShATermError "Map.Map" u + +instance ShATermConvertible a => ShATermConvertible (IntMap.IntMap a) where + toShATermAux att fm = do + (att1, i) <- toShATerm' att $ IntMap.toList fm + return $ addATerm (ShAAppl "IntMap" [i] []) att1 + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "IntMap" [a] _ -> + case fromShATerm' a att0 of { (att1, a') -> + (att1, IntMap.fromDistinctAscList a') } + u -> fromShATermError "IntMap.IntMap" u + +instance (Ord a, ShATermConvertible a) => ShATermConvertible (Set.Set a) where + toShATermAux att set = do + (att1, i) <- toShATerm' att $ Set.toList set + return $ addATerm (ShAAppl "Set" [i] []) att1 + fromShATermAux ix att0 = case getShATerm ix att0 of + ShAAppl "Set" [a] _ -> + case fromShATerm' a att0 of { (att1, a') -> + (att1, Set.fromDistinctAscList a') } + u -> fromShATermError "Set.Set" u diff --git a/src/ATerm/Diff.hs b/src/ATerm/Diff.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/Diff.hs @@ -0,0 +1,51 @@ +{- | +Module : $Header$ +Description : compute the differences of two unshared ATerms +Copyright : (c) Klaus Luettich, Uni Bremen 2005 +License : GPLv2 or higher, see LICENSE.txt + +Maintainer : Christian.Maeder@dfki.de +Stability : provisional +Portability : non-portable (imports ATerm.Unshared) + +Provides functions that calculate differences in unshared 'ATerm's. +-} + +module ATerm.Diff (atDiff) where + +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@. +-- +-- /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 && + length atl1 == length atl2 = + case atDiffL atl1 atl2 of + (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] []]) +atDiff a1@(AList l1 _) a2@(AList l2 _) + | l1 == l2 = (AList l1 [],[]) + | length l1 == length l2 = + case atDiffL l1 l2 of + (diffs,atl) -> (AList atl [],diffs) + | otherwise = (AList [AAppl "" [] []] [], + [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) diff --git a/src/ATerm/Lib.hs b/src/ATerm/Lib.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/Lib.hs @@ -0,0 +1,31 @@ +{- | +Module : $Header$ +Description : reexports modules needed for ATC generation +Copyright : (c) Klaus Luettich, Uni Bremen 2002-2004 +License : GPLv2 or higher, see LICENSE.txt + +Maintainer : Christian.Maeder@dfki.de +Stability : provisional +Portability : non-portable (via imports) + +reexports the names needed for many 'ShATermConvertible' +instances. For converting 'ShATerm's to and from 'String's you'll need +the module "ATerm.ReadWrite". + +For more information on ATerms look under +, . +-} + +module ATerm.Lib + ( ShATerm (..) + , ATermTable + , addATerm + , getShATerm + , ShATermConvertible(toShATermAux, fromShATermAux) + , toShATerm' + , fromShATerm' + , fromShATermError + ) where + +import ATerm.AbstractSyntax +import ATerm.Conversion diff --git a/src/ATerm/ReadWrite.hs b/src/ATerm/ReadWrite.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/ReadWrite.hs @@ -0,0 +1,338 @@ +{- | +Module : $Header$ +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 + +Maintainer : Christian.Maeder@dfki.de +Stability : provisional +Portability : non-portable (imports ATerm.AbstractSyntax) + +convert 'ATermTable's (created by 'ATerm.Conversion.toATermTable') from + 'String's and to 'SDoc's as shared (TAF format) or unshared (AT format). + Indices (following hash marks) are base64 encoded. +-} + +module ATerm.ReadWrite( + -- * read shared or unshared ATerms + readATerm + , readATermFile + -- * writing out shared ATerms (use these functions for serialization) + , writeSharedATerm + , writeSharedATermFile + -- * writing out unshared ATerms (just for compatibility purposes) + , writeATerm + , writeATermFile + -- * support different renderings via 'ATerm.SimpPretty.SDoc' + , writeSharedATermSDoc + , writeATermSDoc + ) where + +{- + Author: Joost Visser, CWI, 2002 + Changed by: Klaus Luettich & Felix Reckers, 2002-2003, C. Maeder 2005 + + This module contains functions for reading and writing ATerms + from and to Strings. Two ATerm formats are supported: + + AT: plain (non-shared) textual ATerms + TAF: shared textual ATerms + + The binary ATerm format (BAF) is not supported. + + Current limitations: + + BLOBS and place-holders are not supported. + + accidental support for the empty aterm: ShAAppl "" [] [] +-} + +import ATerm.AbstractSyntax +import ATerm.SimpPretty +import ATerm.Base64 +import Data.Char +import qualified Data.IntMap as IntMap + +readATermFile :: FilePath -> IO ATermTable +readATermFile fp = do + str <- readFile fp + if null str then error $ "ATerm.readATermFile: empty input file: " ++ fp + else return $ readATerm str + +--- From String to ATerm ------------------------------------------------------ + +data ReadTAFStruct = RTS + ATermTable + String -- remaing string + (AbbrevTable Int) + Int -- string length of last ATerm read + +{- | 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. -} +readATerm :: String -> ATermTable +readATerm = readATerm' . dropWhile ( \ c -> case c of + '!' -> True + _ -> isSpace c) + +readATerm' :: String -> ATermTable +readATerm' str = + case readTAF emptyATermTable str emptyATab of + (RTS at rt _ _, _) -> case dropSpaces rt of + [] -> toReadonlyATT at + s -> error $ "garbage following aterm: " ++ take 10 s + +-- non-shared is a special case of shared (but could be made more fool proof) + +readTAF :: ATermTable -> String -> AbbrevTable Int -> (ReadTAFStruct, Int) +readTAF at str tbl = case readTAF' at str tbl of + (rs@(RTS at' str' tbl' l'), eith) -> case eith of + Left i -> (rs, i) + Right a -> case addATerm a at' of + (at'', i) -> + (RTS at'' str' (insertATab l' (sizeATab tbl') i tbl') l', i) + +readTAF' :: ATermTable -> String -> AbbrevTable Int + -> (ReadTAFStruct, Either Int ShATerm) +readTAF' at str tbl = case str of + '#' : xs -> case spanAbbrevChar xs of + (i, str') -> case lookupATab (deAbbrev i) tbl of + 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) -> + case readAnnTAF at' (dropSpaces str') tbl' l' of + (rs, ann) -> (rs, Right $ ShAList kids ann) + x : xs | isIntHead x -> case span isDigit xs of + (i, str') -> let (intl, l') = readInteger $ x : i in + case readAnnTAF at (dropSpaces str') tbl l' of + (rs, ann) -> (rs, Right $ ShAInt intl ann) + _ -> case readAFun str of + (c, str') -> case readParenTAFs at (dropSpaces str') tbl $ length c of + (RTS at' str'' tbl' l', kids) -> + case readAnnTAF at' (dropSpaces str'') tbl' l' of + (rs, ann) -> (rs, Right $ ShAAppl c kids ann) + +readParenTAFs :: ATermTable -> String -> AbbrevTable Int -> Int + -> (ReadTAFStruct, [Int]) +readParenTAFs = readParTAFs '(' ')' + +readParTAFs :: Char -> Char -> ATermTable -> String -> AbbrevTable Int -> Int + -> (ReadTAFStruct, [Int]) +readParTAFs op cp at str tbl l = case str of + p : r | op == p -> readTAFs0 at cp (dropSpaces r) tbl $ l + 1 + _ -> (RTS at str tbl l, []) + +readTAFs0 :: ATermTable -> Char -> String -> AbbrevTable Int -> Int + -> (ReadTAFStruct, [Int]) +readTAFs0 at par str tbl l = case str of + p : r | par == p -> (RTS at r tbl $ l + 1, []) + _ -> readTAFs1 at par str tbl l + +readTAFs1 :: ATermTable -> Char -> String -> AbbrevTable Int -> Int + -> (ReadTAFStruct, [Int]) +readTAFs1 at par str tbl l = + case readTAF at (dropSpaces str) tbl of + (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) + +readTAFs2 :: ATermTable -> Char -> String -> AbbrevTable Int -> Int + -> (ReadTAFStruct, [Int]) +readTAFs2 at par str tbl l = case str of + ',' : r -> readTAFs1 at par (dropSpaces r) tbl $ l + 1 + p : r | par == p -> (RTS at r tbl $ l + 1, []) + _ -> error $ "expecting ',' or '" ++ [par] ++ "' in aterm but found: " + ++ take 10 str + +readAnnTAF :: ATermTable -> String -> AbbrevTable Int -> Int + -> (ReadTAFStruct, [Int]) +readAnnTAF = readParTAFs '{' '}' + +-- helpers -- + +dropSpaces :: String -> String +dropSpaces = dropWhile isSpace + +readAFun :: String -> (String, String) +readAFun str = case str of + q : r | q == '"' -> let (c, s) = spanNotQuote' r in (q : c, s) + _ -> span isAFunChar str + +spanNotQuote' :: String -> (String, String) +spanNotQuote' str = case str of + 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 + in (e ++ f, t) + _ -> error $ "wrongly terminated aterm string: " ++ take 10 str + +isAFunChar :: Char -> Bool +isAFunChar c = isAlphaNum c || c `elem` "_*+-." + +spanAbbrevChar :: String -> (String, String) +spanAbbrevChar = span isBase64Char + +isIntHead :: Char -> Bool +isIntHead c = isDigit c || c == '-' + +--- From (shared) ATerms to strings via simple documents with associated length + +data DocLen = DocLen SDoc Int + +data WriteStruct = WS (AbbrevTable DocLen) DocLen + +writeATermSDoc :: ATermTable -> SDoc +writeATermSDoc = writeSharedATermSDoc' False + +writeATerm :: ATermTable -> String +writeATerm = render . writeATermSDoc + +writeATermFile :: FilePath -> ATermTable -> IO () +writeATermFile fp = writeFileSDoc fp . writeATermSDoc + +writeSharedATermSDoc :: ATermTable -> SDoc +writeSharedATermSDoc = writeSharedATermSDoc' True + +writeSharedATerm :: ATermTable -> String +writeSharedATerm = render . writeSharedATermSDoc + +writeSharedATermFile :: FilePath -> ATermTable -> IO () +writeSharedATermFile fp = writeFileSDoc fp . writeSharedATermSDoc + +writeSharedATermSDoc' :: Bool -> ATermTable -> SDoc +writeSharedATermSDoc' b at = + case writeTAF b (toReadonlyATT at) emptyATab of + WS _ (DocLen doc _) -> (if b then text "!" else empty) <> doc + +--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 + WS tbl' d_len@(DocLen _ len) -> + WS (insertATab len i (abbrevD $ sizeATab tbl') tbl') d_len + +writeTAF' :: Bool -> ATermTable -> AbbrevTable DocLen -> WriteStruct +writeTAF' b at tbl = case getATerm at of + ShAAppl c ts anns -> case writeTAFs b at ts tbl of + WS tbl' kids -> case writeTAFs b at anns tbl' of + WS tbl'' kidsAnn -> WS tbl'' $ dlConcat (writeATermAuxS c kids) + $ parenthesiseAnnS kidsAnn + ShAList ts anns -> case writeTAFs b at ts tbl of + WS tbl' kids -> case writeTAFs b at anns tbl' of + WS tbl'' kidsAnn -> WS tbl'' $ dlConcat (bracketS kids) + $ parenthesiseAnnS kidsAnn + ShAInt i anns -> case writeTAFs b at anns tbl of + WS tbl' kidsAnn -> WS tbl' $ dlConcat (integerDoc i) + $ parenthesiseAnnS kidsAnn + +dlConcat :: DocLen -> DocLen -> DocLen +dlConcat s1@(DocLen sf1 sl1) s2@(DocLen sf2 sl2) + | sl1 == 0 = s2 + | sl2 == 0 = s1 + | otherwise = DocLen (sf1 <> sf2) $ sl1 + sl2 + +dlConcatComma :: DocLen -> DocLen -> DocLen +dlConcatComma (DocLen sf1 sl1) (DocLen sf2 sl2) = + DocLen (sf1 <> comma <> sf2) $ sl1 + sl2 + 1 + +-- produce comma seperated output from aterm indices +writeTAFs :: Bool -> ATermTable -> [Int] -> AbbrevTable DocLen -> WriteStruct +writeTAFs b at inds tbl = case inds of + [] -> WS tbl $ DocLen empty 0 + i : is -> case writeTAF b (getATermByIndex1 i at) tbl of + ws@(WS t1 s1) -> if null is then ws + else case writeTAFs b at is t1 of + WS t2 s2 -> WS t2 $ dlConcatComma s1 s2 + +docLen :: String -> DocLen +docLen s = DocLen (text s) $ length s + +integerDoc :: Integer -> DocLen +integerDoc = docLen . show + +writeATermAuxS :: String -> DocLen -> DocLen +writeATermAuxS s = dlConcat (docLen s) . parenthesiseS + +-- list brackets must not be omitted +bracketS :: DocLen -> DocLen +bracketS (DocLen d dl) + | dl == 0 = docLen "[]" + | otherwise = DocLen (brackets d) $ dl + 2 + +parenthesiseS :: DocLen -> DocLen +parenthesiseS s@(DocLen d dl) + | dl == 0 = s + | otherwise = DocLen (parens d) $ dl + 2 + +parenthesiseAnnS :: DocLen -> DocLen +parenthesiseAnnS s@(DocLen d dl) + | dl == 0 = s + | otherwise = DocLen (braces d) $ dl + 2 + +{- | This abbreviation table maps abbreviation ints to aterm indices for + reading and aterm indices to abbreviation docs during writing. -} +data AbbrevTable a = ATab !(IntMap.IntMap a) !(Int, Int) !Int + +{- The last component is the current maximal abbreviation int that +serves as a key when reading and as a value when writing. The pair +stores the size of this component and the maximal power of 64 +that is less than it, in order to simplify the computation of the size +of the next abbreviation int. -} + +-- | initial table +emptyATab :: AbbrevTable a +emptyATab = ATab IntMap.empty (2, 64) 0 + +-- | only insert if the first argument is greater than the abbreviation size +insertATab :: Int -> Int -> a -> AbbrevTable a -> AbbrevTable a +insertATab dl i a t@(ATab m p@(sl, b) s) = + if dl > sl then let n = s + 1 in + ATab (IntMap.insert i a m) + (if rem n b == 0 then (sl + 1, 64 * b) else p) n + else t + +-- | get current abbreviation size +sizeATab :: AbbrevTable a -> Int +sizeATab (ATab _ _ s) = s + +-- | lookup map value +lookupATab :: Int -> AbbrevTable a -> Maybe a +lookupATab i (ATab m _ _) = IntMap.lookup i m + +--- Intger Read --------------------------------------------------------------- + +readInteger :: String -> (Integer, Int) +readInteger s = case s 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 ---------------------------------------------------------- + +abbrevD :: Int -> DocLen +abbrevD = docLen . abbrev + +abbrev :: Int -> String +abbrev i = '#' : mkAbbrev i + +mkAbbrev :: Int -> String +mkAbbrev x = if x > 0 then mkAbbrevAux x "" else "A" + +mkAbbrevAux :: Int -> String -> String +mkAbbrevAux x str = + if x > 0 then case quotRem x 64 of + (d, m) -> mkAbbrevAux d $ toBase64Char m : str + else str + +deAbbrev :: String -> Int +deAbbrev = let f m c = 64 * m + toBase64Int c in foldl f 0 diff --git a/src/ATerm/SimpPretty.hs b/src/ATerm/SimpPretty.hs new file mode 100644 --- /dev/null +++ b/src/ATerm/SimpPretty.hs @@ -0,0 +1,106 @@ +{- | +Module : $Header$ +Description : simple pretty printing combinators +Copyright : (c) Klaus Luettich, C. Maeder Uni Bremen 2002-2005 +License : GPLv2 or higher, see LICENSE.txt + +Maintainer : Christian.Maeder@dfki.de +Stability : provisional +Portability : portable + +Rather than using (slow, sequential) strings create (fast, tree-like) +documents and render them later as text for IO. + +A very simplified version of John Hughes's + and Simon Peyton Jones's Pretty Printer Combinators. Only catenable + string sequences are left over. +-} + +module ATerm.SimpPretty ( + + -- * The document type + SDoc, -- Abstract + + -- * Primitive documents + empty, comma, + + -- * Converting values into documents + text, + + -- * Wrapping documents in delimiters + parens, brackets, braces, + + -- * Combining documents + (<>), + + -- * Rendering documents + + render, fullRender, writeFileSDoc + ) where + +import System.IO + +infixl 6 <> + +-- --------------------------------------------------------------------------- +-- The interface + +-- The primitive SDoc values + +text :: String -> SDoc +text = Text + +empty :: SDoc -- ^ An empty document +empty = text "" + +comma :: SDoc -- ^ A ',' character +comma = text "," + +parens :: SDoc -> SDoc -- ^ Wrap document in @(...)@ +parens p = text "(" <> p <> text ")" + +braces :: SDoc -> SDoc -- ^ Wrap document in @{...}@ +braces p = text "{" <> p <> text "}" + +brackets :: SDoc -> SDoc -- ^ Wrap document in @[...]@ +brackets p = text "[" <> p <> text "]" + +-- Horizontal composition @<>@ +(<>) :: SDoc -> SDoc -> SDoc -- ^Beside +(<>) = Beside + +-- Displaying @SDoc@ values. + +instance Show SDoc where + showsPrec = const showSDoc + +-- | Renders the document as a string using the default style +render :: SDoc -> String +render doc = showSDoc doc "" + +-- --------------------------------------------------------------------------- +-- The SDoc data type + +-- | The abstract type of documents +data SDoc + = Text String + | Beside SDoc SDoc + +-- --------------------------------------------------------------------------- +-- simple layout + +writeFileSDoc :: FilePath -> SDoc -> IO () +writeFileSDoc fp sd = + do h <- openFile fp WriteMode + fullRender (hPutStr h) (>>) sd + hClose h + +showSDoc :: SDoc -> String -> String +showSDoc = fullRender showString (.) + +fullRender :: (String -> a) -> (a -> a -> a) -> SDoc -> a +fullRender txt comp doc + = lay doc + 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 new file mode 100644 --- /dev/null +++ b/src/ATerm/Unshared.hs @@ -0,0 +1,65 @@ +{- | +Module : $Header$ +Description : conversion between shared and (basically unused) unshared ATerms +Copyright : (c) Klaus Luettich, Uni Bremen 2002-2004 +License : GPLv2 or higher, see LICENSE.txt + +Maintainer : Christian.Maeder@dfki.de +Stability : provisional +Portability : non-portable (imports ATerm.AbstractSyntax) + +conversion between shared and (basically unused) unshared 'ATerm's +-} + +module ATerm.Unshared + (ATerm(..), + fromATerm, + fromShATerm, + getATermFull, + toATermTable) + where + +import ATerm.AbstractSyntax +import ATerm.Conversion + +data ATerm = AAppl String [ATerm] [ATerm] + | AList [ATerm] [ATerm] + | AInt Integer [ATerm] + deriving (Eq,Ord,Show) + +fromShATerm :: ShATermConvertible t => ATermTable -> t +fromShATerm att = snd $ fromShATerm' (getTopIndex att) att + +fromATerm :: ShATermConvertible t => ATerm -> t +fromATerm = fromShATerm . toATermTable + +getATermFull :: ATermTable -> ATerm +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) + (ShAAppl c l as) -> AAppl c (map conv l) (map conv as) + where conv t = getATermFull (getATermByIndex1 t at) + +toATermTable :: ATerm -> ATermTable +toATermTable at = fst $ addToTable at emptyATermTable + where + addToTable :: ATerm -> ATermTable -> (ATermTable, Int) + addToTable (AAppl s ats anns) att = + 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 + in addATerm (ShAList ats' anns') att2 + 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)