WriteLibDefn.hs revision 4047bc6525bff257ee8434866cdba2924561a2e4
e9458b1a7a19a63aa4c179f9ab20f4d50681c168Jens ElknerModule : $Header$
7895bc4f90d3ea250877c02a897f5dcca4590a89Christian MaederDescription : Writing out a HetCASL library
f799084b320209cdd71a29e74fff1be054c1d342Christian MaederCopyright : (c) Klaus Luettich, C.Maeder, Uni Bremen 2002-2006
98890889ffb2e8f6f722b00e265a211f13b5a861Corneliu-Claudiu ProdescuLicense : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt
3f69b6948966979163bdfe8331c38833d5d90ecdChristian MaederMaintainer : Christian.Maeder@dfki.de
f799084b320209cdd71a29e74fff1be054c1d342Christian MaederStability : provisional
f799084b320209cdd71a29e74fff1be054c1d342Christian MaederPortability : non-portable(DevGraph)
e6d40133bc9f858308654afb1262b8b483ec5922Till MossakowskiWriting out HetCASL env files as much as is needed for
f799084b320209cdd71a29e74fff1be054c1d342Christian Maederthe static analysis
8adae8b1eb0dd8562f0d1541b9ecb2fd80bda7e7Christian Maeder ( getFilePrefix
8adae8b1eb0dd8562f0d1541b9ecb2fd80bda7e7Christian Maeder , write_LIB_DEFN
8adae8b1eb0dd8562f0d1541b9ecb2fd80bda7e7Christian Maeder , write_casl_asc
ab0274ab68a174d3e92235b4c4ca865c03901583Christian Maeder , write_casl_latex
8adae8b1eb0dd8562f0d1541b9ecb2fd80bda7e7Christian Maeder , toShATermString
9ba43c9323dc1a4bb1e684d87370b43468ab9096Christian Maeder , writeShATermFile
cbe26e1cedf1e305b077afa82cb5f46850cdb8b1Christian Maeder , writeFileInfo
941254a2daaf605bda18be25358f4e1322e94ec9Christian Maederimport Common.GlobalAnnotations (GlobalAnnos)
7d6fdc539541f38639e20b45bba29e39bd201c3fChristian Maederimport Common.SimpPretty (writeFileSDoc)
b2542911be8b16ffb988c3abe09ee63be98e119fChristian Maederimport Syntax.AS_Library (LIB_DEFN())
3ab1e7a18f3fc3eb004464bc54b7df4483f1f060Christian Maeder-- | compute the prefix for files to be written out
c438c79d00fc438f99627e612498744bdc0d0c89Christian MaedergetFilePrefix :: HetcatsOpts -> FilePath -> (FilePath, FilePath)
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun WanggetFilePrefix opts file =
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wang let odir' = outdir opts
f799084b320209cdd71a29e74fff1be054c1d342Christian Maeder (base, path, _) = fileparse (envSuffix : downloadExtensions) file
f799084b320209cdd71a29e74fff1be054c1d342Christian Maeder odir = if null odir' then path else odir'
f799084b320209cdd71a29e74fff1be054c1d342Christian Maeder in (odir, pathAndBase odir base)
8c4c53f1d84490c7eac208905e92964c6508c1d6Christian Maeder Write the given LIB_DEFN in every format that HetcatsOpts includes.
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder Filenames are determined by the output formats.
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maederwrite_LIB_DEFN :: GlobalAnnos -> FilePath -> HetcatsOpts -> LIB_DEFN -> IO ()
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wangwrite_LIB_DEFN ga file opts ld = do
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder let (odir, filePrefix) = getFilePrefix opts file
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wang filename ty = filePrefix ++ "." ++ show ty
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder verbMesg ty = putIfVerbose opts 2 $ "Writing file: " ++ filename ty
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder printAscii ty = do
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maeder write_casl_asc opts ga (filename ty) ld
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maeder write_type :: OutType -> IO ()
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maeder write_type t = case t of
9ba43c9323dc1a4bb1e684d87370b43468ab9096Christian Maeder PrettyOut PrettyAscii -> printAscii t
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maeder PrettyOut PrettyLatex -> do
1aee531e3fe5a94300ddc7933c1983a38a76316eChristian Maeder write_casl_latex opts ga (filename t) ld
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder _ -> return () -- implemented elsewhere
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder putIfVerbose opts 3 ("Current OutDir: " ++ odir)
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maeder mapM_ write_type $ outtypes opts
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wangwrite_casl_asc :: HetcatsOpts -> GlobalAnnos -> FilePath -> LIB_DEFN -> IO ()
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maederwrite_casl_asc _ ga oup ld = writeFile oup $
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder shows (useGlobalAnnos ga $ pretty ld) "\n"
c7f5076658d72ea340d7fd8a648908f961af682dChristian Maederdebug_latex_filename :: FilePath -> FilePath
eab576044505ba1fbc64610323053490fbd9e82cChristian Maederdebug_latex_filename =
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder ( \ (b, p, _) -> p ++ b ++ ".debug.tex") . fileparse [".pp.tex"]
941254a2daaf605bda18be25358f4e1322e94ec9Christian Maederwrite_casl_latex :: HetcatsOpts -> GlobalAnnos -> FilePath -> LIB_DEFN -> IO ()
b65890a7645b96eb0d5c334c81ba9dca86d556bfChristian Maederwrite_casl_latex opts ga oup ld =
941254a2daaf605bda18be25358f4e1322e94ec9Christian Maeder do let ldoc = toLatex ga $ pretty ld
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder writeFile oup $ renderLatex Nothing ldoc
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder doDump opts "DebugLatex" $
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wang writeFile (debug_latex_filename oup) $
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wang debugRenderLatex Nothing ldoc
ccd28c25c1aee73a195053e677eca17e20917d84Christian MaedertoShATermString :: (ShATermConvertible a) => a -> IO String
842a6d146e8d1023c9cc54e9064ae93be2daf831Christian MaedertoShATermString atcon = fmap writeSharedATerm $ versionedATermTable atcon
842a6d146e8d1023c9cc54e9064ae93be2daf831Christian MaederwriteShATermFile :: (ShATermConvertible a) => FilePath -> a -> IO ()
a571b691ac0da91a895c33f250509622004dcf03Christian MaederwriteShATermFile fp atcon = toShATermString atcon >>= writeFile fp
ccd28c25c1aee73a195053e677eca17e20917d84Christian MaederversionedATermTable :: (ShATermConvertible a) => a -> IO ATermTable
ccd28c25c1aee73a195053e677eca17e20917d84Christian MaederversionedATermTable atcon = do
5be2fb5bcfaa6abbb6043d679a1d536b4878b789Jian Chun Wang att0 <- newATermTable
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder (att1, versionnr) <- toShATermAux att0 hetsVersion
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder (att2, aterm) <- toShATermAux att1 atcon
4d4ec273e5cb1f17985c6edcf90a295a8b612cefChristian Maeder return $ fst $ addATerm (ShAAppl "hets" [versionnr,aterm] []) att2
4d4ec273e5cb1f17985c6edcf90a295a8b612cefChristian MaederwriteShATermFileSDoc :: (ShATermConvertible a) => FilePath -> a -> IO ()
ccd28c25c1aee73a195053e677eca17e20917d84Christian MaederwriteShATermFileSDoc fp atcon = do
b65890a7645b96eb0d5c334c81ba9dca86d556bfChristian Maeder att <- versionedATermTable atcon
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder writeFileSDoc fp $ writeSharedATermSDoc att
4674b607529c8eab497240da6da1ef9ae786611cChristian MaederwriteFileInfo :: (ShATermConvertible a) => HetcatsOpts -> LIB_NAME
a571b691ac0da91a895c33f250509622004dcf03Christian Maeder -> FilePath -> LIB_DEFN -> a -> IO ()
842a6d146e8d1023c9cc54e9064ae93be2daf831Christian MaederwriteFileInfo opts ln file ld gctx =
a571b691ac0da91a895c33f250509622004dcf03Christian Maeder let envFile = snd (getFilePrefix opts file) ++ envSuffix in
4674b607529c8eab497240da6da1ef9ae786611cChristian Maeder case analysis opts of
eab576044505ba1fbc64610323053490fbd9e82cChristian Maeder putIfVerbose opts 2 ("Writing file: " ++ envFile)
ccd28c25c1aee73a195053e677eca17e20917d84Christian Maeder catch (writeShATermFileSDoc envFile (ln, (ld, gctx))) $ \ err -> do
4674b607529c8eab497240da6da1ef9ae786611cChristian Maeder putIfVerbose opts 2 (envFile ++ " not written")
842a6d146e8d1023c9cc54e9064ae93be2daf831Christian Maeder putIfVerbose opts 3 ("see following error description:\n"
4674b607529c8eab497240da6da1ef9ae786611cChristian Maeder ++ shows err "\n")
842a6d146e8d1023c9cc54e9064ae93be2daf831Christian Maeder _ -> putIfVerbose opts 2 ("Not writing " ++ envFile)