{- |

Module : $Header$

Description : reading and parsing ATerms, CASL, HetCASL files

Copyright : (c) Klaus L�ttich, C. Maeder, Uni Bremen 2002-2006

License : similar to LGPL, see HetCATS/LICENSE.txt or LIZENZ.txt

Maintainer : luettich@tzi.de

Stability : provisional

Portability : non-portable(DevGraph)

reading and parsing ATerms, CASL, HetCASL files

-}

module Driver.ReadFn where

import Logic.Logic

import Logic.Grothendieck

import Syntax.AS_Library

import Syntax.Parse_AS_Library

import Syntax.Print_AS_Library()

import Static.DevGraph

import Proofs.EdgeUtils

import ATC.AS_Library()

import ATC.DevGraph()

import ATC.GlobalAnnotations()

import ATC.Sml_cats

import Common.ATerm.Lib

import Common.ATerm.ReadWrite

import qualified Data.Map as Map

import Common.AnnoState

import Common.Id

import Common.Result

import Common.DocUtils

import Text.ParserCombinators.Parsec

import Driver.Options

import System.Directory

import Control.Monad

import Data.List

import System.Posix.Files

read_LIB_DEFN_M :: Monad m => LogicGraph -> AnyLogic -> HetcatsOpts

-> FilePath -> String -> m LIB_DEFN

read_LIB_DEFN_M lgraph defl opts file input =

if null input then fail ("empty input file: " ++ file) else

case intype opts of

ATermIn _ -> return $ from_sml_ATermString input

ASTreeIn _ -> fail "Abstract Syntax Trees aren't implemented yet"

_ -> case runParser (library (defl, lgraph)) (emptyAnnos defl)

file input of

Left err -> fail (showErr err)

Right ast -> return $ setFilePath "" ast

{- if I try to store the filenname in the LIB_DEFN, then open,

save-as does no longer work -}

readShATermFile :: ShATermConvertible a => FilePath -> IO (Result a)

readShATermFile fp = do

str <- readFile fp

r <- return $ fromShATermString str

case r of

Result _ Nothing -> removeFile fp

_ -> return ()

return r

fromVersionedATT :: ShATermConvertible a => ATermTable -> Result a

fromVersionedATT att =

case getATerm att of

ShAAppl "hets" [versionnr,aterm] [] ->

if hetsVersion == snd (fromShATermAux versionnr att)

then Result [] (Just $ snd $ fromShATermAux aterm att)

else Result [Diag Warning

"Wrong version number ... re-analyzing"

nullRange] Nothing

_ -> Result [Diag Warning

"Couldn't convert ShATerm back from ATermTable"

nullRange] Nothing

fromShATermString :: ShATermConvertible a => String -> Result a

fromShATermString str = if null str then

Result [Diag Warning "got empty string from file" nullRange] Nothing

else fromVersionedATT $ readATerm str

readVerbose :: ShATermConvertible a => HetcatsOpts -> LIB_NAME -> FilePath

-> IO (Maybe a)

readVerbose opts ln file = do

putIfVerbose opts 1 $ "Reading " ++ file

Result ds mgc <- readShATermFile file

showDiags opts ds

case mgc of

Nothing -> return Nothing

Just (ln2, a) -> do

unless (ln2 == ln) $

putIfVerbose opts 0 $ "incompatible library names: "

++ showDoc ln " (requested) vs. "

++ showDoc ln2 " (found)"

return $ Just a

-- | create a file name without suffix from a library name

libNameToFile :: HetcatsOpts -> LIB_NAME -> FilePath

libNameToFile opts ln =

case getLIB_ID ln of

Indirect_link file _ ofile _ ->

let path = libdir opts

-- add trailing "/" if necessary

in if null ofile then pathAndBase path file else ofile

Direct_link _ _ -> error "libNameToFile"

-- | convert a file name that may have a suffix to a library name

fileToLibName :: HetcatsOpts -> FilePath -> IO LIB_NAME

fileToLibName opts efile = do

fs <- getFileStatus efile

let path = libdir opts

file = rmSuffix efile -- cut of extension

nfile = dropWhile (== '/') $ -- cut off leading slashes

if isPrefixOf path file

then drop (length path) file -- cut off libdir prefix

else file

modTime = read (show $ modificationTime fs) :: Integer

return (Lib_id $ Indirect_link nfile nullRange "" modTime)

readPrfFile :: HetcatsOpts -> LibEnv -> LIB_NAME -> IO LibEnv

readPrfFile opts ps ln = do

let fname = libNameToFile opts ln

prfFile = fname ++ prfSuffix

recent <- checkRecentEnv opts prfFile fname

h <- if recent then

fmap (maybe [emptyHistory] id) $ readVerbose opts ln prfFile

else return [emptyHistory]

return $ Map.update (Just . applyProofHistory h) ln ps

readPrfFiles :: HetcatsOpts -> LibEnv -> IO LibEnv

readPrfFiles opts le = do

foldM (readPrfFile opts) le $ Map.keys le