modulo 1.8.0 → 1.9.0
raw patch · 3 files changed
+56/−12 lines, 3 files
Files
- modulo.cabal +1/−1
- src/Language/Modulo/C.hs +33/−5
- src/Main.hs +22/−6
modulo.cabal view
@@ -1,6 +1,6 @@ name: modulo-version: 1.8.0+version: 1.9.0 cabal-version: >= 1.6 author: Hans Hoglund maintainer: Hans Hoglund <hans@hanshoglund.se>
src/Language/Modulo/C.hs view
@@ -41,6 +41,7 @@ renderModuleStyle, printModuleComm,+ printModuleStyleComm, ) where import Data.Default@@ -103,8 +104,11 @@ -- Functions and values constMangler :: [String] -> String, -- ^ Mangler for constant values globalMangler :: [String] -> String, -- ^ Mangler for global variables- funcMangler :: [String] -> String -- ^ Mangler for global functions+ funcMangler :: [String] -> String, -- ^ Mangler for global functions + -- TODO second component never used+ funcAttr :: Maybe (String, String)+ -- Options -- Wrap in extern C block -- Add Doxygen stubs (which?)@@ -175,7 +179,8 @@ constMangler = (concatSep "_" . fmap toLowerString), globalMangler = (concatSep "_" . fmap toLowerString),- funcMangler = (concatSep "_" . fmap toLowerString)+ funcMangler = (concatSep "_" . fmap toLowerString),+ funcAttr = Nothing } -- |@@ -207,6 +212,7 @@ (concatSep "_") (concatSep "_") (concatSep "_")+ Nothing -- |@@ -238,6 +244,7 @@ (concatSep "_") (concatSep "_") (concatSep "_")+ Nothing -- | -- Style used in Apple Frameworks.@@ -269,6 +276,8 @@ (withPrefix "k" . capitalCase) (withPrefix "g" . capitalCase) capitalCase+ Nothing+ -- -- | -- Style similar to Haskell conventions.@@ -300,6 +309,7 @@ mixedCase mixedCase mixedCase+ Nothing -------------------------------------------------------------------------------------@@ -562,7 +572,10 @@ declFun st n t = CDecl spec decList defInfo where (typ, decl) = convertFunType st t- spec = [] ++ map CTypeSpec typ+ prefix = case funcAttr st of+ Nothing -> []+ Just (attrName,attrValue) -> [CTypeQual (CAttrQual $ CAttr (ident attrName) [] defInfo)]+ spec = prefix ++ map CTypeSpec typ declr = CDeclr (Just $ identName n) decl Nothing [] defInfo decList = [topLevelDeclr declr] @@ -719,8 +732,8 @@ -- | Used for all NodeInfo values in generated code defInfo :: NodeInfo-defInfo = error "Can not read nodeInfo"--- defInfo = OnlyPos $ Position undefined 0 0+-- defInfo = error "Can not read nodeInfo"+defInfo = OnlyPos nopos (nopos, 0) notSupported x = error $ "Not supported yet: " ++ x @@ -765,4 +778,19 @@ deriving instance Show CStructUnion deriving instance Show CStructTag -}++-- foo = CDecl +-- [+-- -- CStorageSpec (CExtern defInfo),+-- CTypeQual (CAttrQual $ CAttr (ident "foobar") [] defInfo),+-- CTypeSpec (CVoidType defInfo)+-- +-- ] +-- [+-- (+-- Just (CDeclr (Just $ ident "foo") [CFunDeclr (Right ([],False)) [] defInfo] Nothing [] defInfo),+-- Nothing,+-- Nothing+-- )+-- ] defInfo
src/Main.hs view
@@ -43,6 +43,7 @@ | Version | Lang { getLang :: ModLang } | Path { getPath :: [ModulePath] }+ | CFuncAttr { getCFuncAttr :: Maybe (String,String) } | LispPackage { getLispPackage :: Maybe String } | LispPrimBool { getLispPrimBool :: Maybe PrimType } deriving (Eq, Show)@@ -72,8 +73,15 @@ readPrimBool :: Maybe String -> ModOpt readPrimBool = LispPrimBool . (=<<) parsePrimTypeMaybe +readFuncAttr :: Maybe String -> ModOpt+readFuncAttr Nothing = CFuncAttr Nothing+readFuncAttr (Just s) = CFuncAttr $ Just (s, "")+-- readFuncAttr (Just s) = CFuncAttr $ Just (n, v)+-- where+-- n = takeWhile (/= ',') s+-- v = drop 1 $ dropWhile (/= ',') s -version = "modulo-1.8.0"+version = "modulo-1.9.0" header = "Usage: modulo [options]\n" ++ "Usage: modulo [options] files...\n" ++ "\n" ++@@ -86,6 +94,7 @@ (Option ['v'] ["version"] (NoArg Version) "Print version and exit"), (Option ['L'] ["language"] (OptArg readModLang "LANG") "Output language"), (Option ['M'] ["module-path"] (OptArg readModPath "PATH") "Module paths"),+ (Option [] ["c-func-attr"] (OptArg readFuncAttr "VALUE") "Function attribute"), (Option [] ["lisp-package"] (OptArg readPackage "STRING") ("Lisp package (default: " ++ package def ++ ")")), (Option [] ["lisp-primitive-bool"] (OptArg readPrimBool "STRING") ("Optional primitive boolean type (Char|Int|UChar|UInt...)")) ] @@ -122,6 +131,12 @@ where isLispPrimBool (LispPrimBool _) = True isLispPrimBool _ = False++findCFuncAttr :: [ModOpt] -> Maybe (String, String)+findCFuncAttr opts = join $ fmap getCFuncAttr $ find isCFuncAttr opts+ where + isCFuncAttr (CFuncAttr _) = True+ isCFuncAttr _ = False -- | -- Run as a filter from stdin to stdout.@@ -135,11 +150,12 @@ let paths = fromMaybe [] (findPath opts) let lispPackage = findLispPackage opts let lispPrimBool = findLispPrimBool opts+ let cFuncAttr = findCFuncAttr opts s <- hGetContents input let m = unsafeParse s mr <- unsafeRename paths m- let c = printMod lispPackage lispPrimBool lang mr+ let c = printMod cFuncAttr lispPackage lispPrimBool lang mr hPutStr output c return ()@@ -154,13 +170,13 @@ Left e -> error $ "Parse error: " ++ show e Right m -> m - printMod :: Maybe String -> Maybe PrimType -> ModLang -> Module -> String- printMod lp lpm C = printModuleComm- printMod lp lpm Lisp = printModuleLispStyle $ maybeDo setP lp $ setPM lpm $ def+ printMod :: Maybe (String, String) -> Maybe String -> Maybe PrimType -> ModLang -> Module -> String+ printMod fa lp lpm C = printModuleStyleComm (def { funcAttr = fa })+ printMod fa lp lpm Lisp = printModuleLispStyle $ maybeDo setP lp $ setPM lpm $ def where setP p s = s { package = p } setPM pm s = s { primBoolType = pm }- printMod lp lpm Haskell = printModuleHaskell+ printMod fa lp lpm Haskell = printModuleHaskell maybeDo :: (a -> b -> b) -> Maybe a -> b -> b