--  C->Haskell Compiler: interface to C processing routines
--
--  Author : Manuel M. T. Chakravarty
--  Created: 12 August 99
--
--  Version $Revision: 1.3 $ from $Date: 2005/06/22 16:01:20 $
--
--  Copyright (c) 1999 Manuel M. T. Chakravarty
--
--  This file 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 file 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.
--
--- DESCRIPTION ---------------------------------------------------------------
--
--  This modules provides access to the C processing routines for the rest of
--  the compiler.
--
--- DOCU ----------------------------------------------------------------------
--
--  language: Haskell 98
--
--- TODO ----------------------------------------------------------------------
--
--

module C (-- interface to KL for all non-KL modules
          --
          -- stuff from `Common' (reexported)
          --
          Pos(posOf), 
          --          
          -- structure tree
          --
          module CAST,
          --
          -- attributed structure tree with operations (reexported from
          -- `CAttrs')
          --
          AttrC, getCHeader, 
          CObj(..), CTag(..), CDef(..), lookupDefObjC, lookupDefTagC,
          getDefOfIdentC,
          --
          -- support for C structure tree traversals
          --
          module CTrav,
          --
          -- support for pretty printing C abstract trees
          --
          module CPretty,
          --
          loadAttrC,            -- locally defined
          --
          -- misc. reexported stuff
          --
          Ident, Attrs, Attr(..),
          --
          -- misc. own stuff
          --
          csuffix, hsuffix, isuffix)
where

import Position   (Position(..), Pos(posOf))
import Idents     (Ident, lexemeToIdent)
import Attributes (Attrs, Attr(..))

import C2HSState  (CST, IOMode(..),
                   readCST, transCST, runCST, nop,
                   readFileCIO, writeFileCIO, openFileCIO, hCloseCIO,
                   fatal, errorsPresent, showErrors,
                   Traces(..), putTraceStr)
import CAST
import CParser    (parseC)
import CPretty
import CAttrs     (AttrC, attrC, getCHeader, 
                   CObj(..), CTag(..), CDef(..), lookupDefObjC, lookupDefTagC,
                   getDefOfIdentC)
import CNames     (nameAnalysis)
import CTrav


-- suffix for files containing C (EXPORTED)
--
csuffix, hsuffix, isuffix :: String
csuffix :: String
csuffix  = String
".c"
hsuffix :: String
hsuffix  = String
".h"
isuffix :: String
isuffix  = String
".i"

-- given a file name (with suffix), parse that file as a C header and do the
-- static analysis (collect defined names) (EXPORTED)
--
--  * currently, lexical and syntactical errors are reported immediately and 
--   abort the program; others are reported as part of the fatal error message;
--   warnings are returned together with the read unit
--
loadAttrC       :: String -> CST s (AttrC, String)
loadAttrC :: forall s. String -> CST s (AttrC, String)
loadAttrC String
fname  = do
                     -- read file
                     --
                     forall {s}. String -> CST s ()
traceInfoRead String
fname
                     String
contents <- forall e s. String -> PreCST e s String
readFileCIO String
fname

                     -- parse
                     --
                     forall {s}. CST s ()
traceInfoParse
                     CHeader
rawHeader <- forall s s'. String -> Position -> PreCST s s' CHeader
parseC String
contents (String -> Int -> Int -> Position
Position String
fname Int
1 Int
1)
                     let header :: AttrC
header = CHeader -> AttrC
attrC CHeader
rawHeader

                     -- name analysis
                     --
                     forall {s}. CST s ()
traceInfoNA
                     AttrC
headerWithAttrs <- forall s. AttrC -> CST s AttrC
nameAnalysis AttrC
header

                     -- check for errors and finalize
                     --
                     Bool
errs <- forall e s. PreCST e s Bool
errorsPresent
                     if Bool
errs
                       then do
                         forall {s}. CST s ()
traceInfoErr
                         String
errmsgs <- forall e s. PreCST e s String
showErrors
                         forall e s a. String -> PreCST e s a
fatal (String
"C header contains \
                                \errors:\n\n" forall a. [a] -> [a] -> [a]
++ String
errmsgs)   -- fatal error
                       else do
                         forall {s}. CST s ()
traceInfoOK
                         String
warnmsgs <- forall e s. PreCST e s String
showErrors
                         forall (m :: * -> *) a. Monad m => a -> m a
return (AttrC
headerWithAttrs, String
warnmsgs)
                    where
                      traceInfoRead :: String -> CST s ()
traceInfoRead String
fname = forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
tracePhasesSW
                                              (String
"Attempting to read file `"
                                               forall a. [a] -> [a] -> [a]
++ String
fname forall a. [a] -> [a] -> [a]
++ String
"'...\n")
                      traceInfoParse :: CST s ()
traceInfoParse      = forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
tracePhasesSW 
                                              (String
"...parsing `" 
                                               forall a. [a] -> [a] -> [a]
++ String
fname forall a. [a] -> [a] -> [a]
++ String
"'...\n")
                      traceInfoNA :: CST s ()
traceInfoNA         = forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
tracePhasesSW 
                                              (String
"...name analysis of `" 
                                               forall a. [a] -> [a] -> [a]
++ String
fname forall a. [a] -> [a] -> [a]
++ String
"'...\n")
                      traceInfoErr :: CST s ()
traceInfoErr        = forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
tracePhasesSW
                                              (String
"...error(s) detected in `"
                                               forall a. [a] -> [a] -> [a]
++ String
fname forall a. [a] -> [a] -> [a]
++ String
"'.\n")
                      traceInfoOK :: CST s ()
traceInfoOK         = forall s. (Traces -> Bool) -> String -> CST s ()
putTraceStr Traces -> Bool
tracePhasesSW
                                              (String
"...successfully loaded `"
                                               forall a. [a] -> [a] -> [a]
++ String
fname forall a. [a] -> [a] -> [a]
++ String
"'.\n")