aterm (empty) → 0.1.0.0
raw patch · 11 files changed
+1423/−0 lines, 11 filesdep +arraydep +basedep +containerssetup-changed
Dependencies added: array, base, containers, ghc-prim
Files
- LICENSE.txt +339/−0
- Setup.hs +14/−0
- aterm.cabal +35/−0
- src/ATerm/AbstractSyntax.hs +139/−0
- src/ATerm/Base64.hs +66/−0
- src/ATerm/Conversion.hs +239/−0
- src/ATerm/Diff.hs +51/−0
- src/ATerm/Lib.hs +31/−0
- src/ATerm/ReadWrite.hs +338/−0
- src/ATerm/SimpPretty.hs +106/−0
- src/ATerm/Unshared.hs +65/−0
+ LICENSE.txt view
@@ -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.++ <one line to give the program's name and a brief idea of what it does.>+ Copyright (C) <year> <name of author>++ 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.++ <signature of Ty Coon>, 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.
+ Setup.hs view
@@ -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
+ aterm.cabal view
@@ -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 <Christian Maeder@dfki.de>+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
+ src/ATerm/AbstractSyntax.hs view
@@ -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
+ src/ATerm/Base64.hs view
@@ -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
+ src/ATerm/Conversion.hs view
@@ -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
+ src/ATerm/Diff.hs view
@@ -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 "<diff-appls>" [] [], [AAppl "diff" [a1,a2] []])+atDiff a1@(AInt i1 _) a2@(AInt i2 _)+ | i1 == i2 = (AInt i1 [],[])+ | otherwise = (AAppl "<diff-int>" [] [], [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 "<diff-lists>" [] []] [],+ [AAppl "diff" [a1,a2] []])+atDiff a1 a2 = (AAppl "<diff-types>" [] [], [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)
+ src/ATerm/Lib.hs view
@@ -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+<http://www.asfsdf.org>, <http://www.asfsdf.org/Meta-Environment/ATerms>.+-}++module ATerm.Lib+ ( ShATerm (..)+ , ATermTable+ , addATerm+ , getShATerm+ , ShATermConvertible(toShATermAux, fromShATermAux)+ , toShATerm'+ , fromShATerm'+ , fromShATermError+ ) where++import ATerm.AbstractSyntax+import ATerm.Conversion
+ src/ATerm/ReadWrite.hs view
@@ -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
+ src/ATerm/SimpPretty.hs view
@@ -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
@@ -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)