diff --git a/modulo.cabal b/modulo.cabal --- a/modulo.cabal +++ b/modulo.cabal @@ -1,6 +1,6 @@ name: modulo -version: 1.7.2 +version: 1.7.3 cabal-version: >= 1.6 author: Hans Hoglund maintainer: Hans Hoglund diff --git a/src/Language/Modulo.hs b/src/Language/Modulo.hs --- a/src/Language/Modulo.hs +++ b/src/Language/Modulo.hs @@ -81,6 +81,7 @@ module Language.Modulo ( -- ** Modules Module(..), + ModuleOptions(..), ModuleName(..), toModuleName, getModuleNameList, @@ -106,6 +107,7 @@ ) where import Data.Ord +import Data.Default import Data.String import Numeric.Natural import Foreign.C.Types @@ -119,6 +121,15 @@ newtype Doc = Doc { getDoc :: String } deriving (Eq, Ord, Show, IsString) +data ModuleOptions = ModuleOptions { + optTransient :: Bool -- ^ If true, this module does not incur any C prefix. + } + deriving (Eq, Ord, Show) + +instance Default ModuleOptions where + def = ModuleOptions { optTransient = False } + + -- | -- A module is a named container of imports and declarations. -- @@ -131,8 +142,9 @@ -- TODO properties: -- transient :: Bool (ignore last component in name for mangling) -- visibility :: Public | Internal - modDoc :: Doc, modName :: ModuleName, -- ^ Name of module + modOptions :: ModuleOptions, -- ^ Module options. + modDoc :: Doc, -- ^ Module documentation. modImports :: [(ModuleName, Maybe String)], -- ^ Imports with optional import conventions modDecls :: [(Doc, Decl)] -- ^ List of declarations } diff --git a/src/Language/Modulo/C.hs b/src/Language/Modulo/C.hs --- a/src/Language/Modulo/C.hs +++ b/src/Language/Modulo/C.hs @@ -452,7 +452,7 @@ -- The module returned from this function will have no QName constructors. -- flattenModule :: CStyle -> Module -> Module -flattenModule st (Module doc n is ds) = Module doc n is (map (fmap $ flattenDecl st) ds) +flattenModule st (Module n opt doc is ds) = Module n opt doc is (map (fmap $ flattenDecl st) ds) flattenDecl :: CStyle -> Decl -> Decl flattenDecl st (TypeDecl n t) = TypeDecl (translType st n) (fmap (flattenType st) t) @@ -512,12 +512,12 @@ -- TODO use doc convertTopLevel :: CStyle -> Module -> CTranslUnit -convertTopLevel st (Module doc n is ds) = CTranslUnit cds defInfo +convertTopLevel st (Module n opt doc is ds) = CTranslUnit cds defInfo where cds = map (CDeclExt . convertDecl st . snd) ds convertTopLevelComm :: CStyle -> Module -> [(String, CDecl)] -convertTopLevelComm st (Module doc n is ds) = fmap (first getDoc . second (convertDecl st)) ds +convertTopLevelComm st (Module n opt doc is ds) = fmap (first getDoc . second (convertDecl st)) ds where first f = swap . fmap f . swap second = fmap diff --git a/src/Language/Modulo/Haskell.hs b/src/Language/Modulo/Haskell.hs --- a/src/Language/Modulo/Haskell.hs +++ b/src/Language/Modulo/Haskell.hs @@ -100,7 +100,7 @@ renderModuleHaskellStyle st = convertTopLevel st convertTopLevel :: HaskellStyle -> Module -> HsModule -convertTopLevel st (Module doc n is ds) = +convertTopLevel st (Module n opt doc is ds) = -- TODO docs -- TODO nice export spec (excluding opaque struct types etc) HsModule def (convertModule n) Nothing imps decls diff --git a/src/Language/Modulo/Lisp.hs b/src/Language/Modulo/Lisp.hs --- a/src/Language/Modulo/Lisp.hs +++ b/src/Language/Modulo/Lisp.hs @@ -104,7 +104,7 @@ convertPackage st = [list [symbol "in-package", keyword (package st)]] convertTopLevel :: LispStyle -> Module -> [Lisp] -convertTopLevel st (Module doc n is ds) = cds +convertTopLevel st (Module n opt doc is ds) = cds where cds = concatMap (convertDecl st . snd) ds diff --git a/src/Language/Modulo/Parse.hs b/src/Language/Modulo/Parse.hs --- a/src/Language/Modulo/Parse.hs +++ b/src/Language/Modulo/Parse.hs @@ -25,7 +25,9 @@ import Control.Monad import Control.Arrow import Data.Monoid +import Data.Default import Data.Maybe +import qualified Data.List as List import Control.Applicative hiding ((<|>), optional, many) import Text.Parsec hiding (parse) @@ -90,13 +92,18 @@ optional lspace reserved lexer "module" + optStr <- optionMaybe lstr name <- modNameParser llex $ char '{' imps <- many impParser docDecls <- many docDeclParser llex $ char '}' - - return $ Module doc name imps docDecls + + -- TODO use opts + let opt = def { + optTransient = List.isInfixOf "transient" (fromMaybe "" optStr) + } + return $ Module name opt doc imps docDecls modNameParser :: Parser ModuleName modNameParser = do diff --git a/src/Language/Modulo/Rename.hs b/src/Language/Modulo/Rename.hs --- a/src/Language/Modulo/Rename.hs +++ b/src/Language/Modulo/Rename.hs @@ -41,7 +41,7 @@ -- * Returned module has no Name constructors -- rename :: [Module] -> Module -> Module -rename deps mod@(Module doc n is ds) = Module doc n is (map (fmap renameDecl) ds) +rename deps mod@(Module n opt doc is ds) = Module n opt doc is (map (fmap renameDecl) ds) where renameDecl (TypeDecl n t) = TypeDecl (simplify $ qualify mod n) (fmap renameType t) renameDecl (FunctionDecl n t) = FunctionDecl (simplify $ qualify mod n) (renameFunType t) @@ -69,9 +69,14 @@ renameCompType (BitField ns) = notSupported "Bit-fields" qualify :: Module -> Name -> Name -qualify m (Name n) = QName (modName m) n qualify _ (QName _ _) = error "Name already qualified" +qualify m (Name n) = if isTrans m then QName (modNameInit $ modName m) n else QName (modName m) n + where + -- TODO consolidate (see below) + modNameInit = toModuleName . init . getModuleNameList + isTrans = optTransient . modOptions +-- | Search for a name among modules, fail if not found. resolveName :: Module -> [Module] -> Name -> Name resolveName errorMsgMod deps (QName m n) = QName m n resolveName errorMsgMod deps n@(Name n') = case findName deps n of @@ -84,9 +89,11 @@ findName :: [Module] -> Name -> Maybe ModuleName findName [] n = Nothing findName (m:ms) n - | n `elem` mNs = Just $ modName m + | n `elem` mNs = if isTrans m then Just (modNameInit $ modName m) else Just (modName m) | otherwise = findName ms n - where + where + modNameInit = toModuleName . init . getModuleNameList + isTrans = optTransient . modOptions mNs = catMaybes . map (getDeclName . snd) . modDecls $ m diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -73,7 +73,7 @@ readPrimBool = LispPrimBool . (=<<) parsePrimTypeMaybe -version = "modulo-1.7.2" +version = "modulo-1.7.3" header = "Usage: modulo [options]\n" ++ "Usage: modulo [options] files...\n" ++ "\n" ++