Update of /cvsroot/hoc/hoc/InterfaceGenerator
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv5525/InterfaceGenerator
Modified Files:
CTypeToHaskell.hs Enums.hs ExportModule.hs
PrepareDeclarations.hs
Removed Files:
NameCaseChange.hs
Log Message:
Improve Enum support (mostly untested)
Index: ExportModule.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/ExportModule.hs,v
retrieving revision 1.6
retrieving revision 1.7
diff -u -d -r1.6 -r1.7
--- ExportModule.hs 26 Jul 2005 01:29:58 -0000 1.6
+++ ExportModule.hs 29 Jul 2005 03:39:44 -0000 1.7
@@ -11,7 +11,8 @@
import Utils(groupByFirst)
import Headers(ModuleName)
import Enums(enumName, pprEnumType)
-import NameCaseChange
+
+import HOC.NameCaseChange
import Data.Set(setToList, unionManySets, mkSet, intersect)
import qualified Data.HashTable as HashTable
Index: PrepareDeclarations.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/PrepareDeclarations.hs,v
retrieving revision 1.11
retrieving revision 1.12
diff -u -d -r1.11 -r1.12
--- PrepareDeclarations.hs 31 Mar 2005 20:48:56 -0000 1.11
+++ PrepareDeclarations.hs 29 Jul 2005 03:39:44 -0000 1.12
@@ -12,8 +12,8 @@
import CTypeToHaskell
import Headers(HeaderInfo(..), ModuleName)
import Enums
-import NameCaseChange
+import HOC.NameCaseChange
import HOC.SelectorNameMangling(mangleSelectorName)
import Control.Monad(when)
--- NameCaseChange.hs DELETED ---
Index: CTypeToHaskell.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/CTypeToHaskell.hs,v
retrieving revision 1.5
retrieving revision 1.6
diff -u -d -r1.5 -r1.6
--- CTypeToHaskell.hs 31 Mar 2005 20:46:13 -0000 1.5
+++ CTypeToHaskell.hs 29 Jul 2005 03:39:44 -0000 1.6
@@ -11,9 +11,10 @@
mentionedTypes) where
import SyntaxTree
-import NameCaseChange
import Headers(ModuleName)
+import HOC.NameCaseChange
+
import Control.Monad(when)
import Data.FiniteMap
import Data.Maybe(mapMaybe)
Index: Enums.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/InterfaceGenerator/Enums.hs,v
retrieving revision 1.3
retrieving revision 1.4
diff -u -d -r1.3 -r1.4
--- Enums.hs 5 Apr 2004 00:04:46 -0000 1.3
+++ Enums.hs 29 Jul 2005 03:39:44 -0000 1.4
@@ -7,9 +7,10 @@
import Headers(HeaderInfo(..), ModuleName)
import SyntaxTree
-import NameCaseChange
import BindingScript ( BindingScript(bsHiddenEnums) )
+import HOC.NameCaseChange
+
import Data.Char ( toUpper )
import Data.Maybe ( mapMaybe )
import Data.FiniteMap ( FiniteMap, listToFM )
@@ -60,38 +61,16 @@
| otherwise = Just tag
handleCType _ = Nothing
-pprEnumType (EnumType (Just cname) constants) =
- dataDeclaration $+$ instanceDeclaration
- where
- name = nameToUppercase cname
-
- dataDeclaration = text "data" <+> text name
- <+> conDecls
- conDecls = vcat $ zipWith (<+>) (equals : repeat (char '|'))
- (map text constructors)
-
-
- constructors = map (nameToUppercase . fst) constants
- values = map snd constants
-
-
- instanceDeclaration =
- hang (text "instance ObjCArgument"
- <+> text name <+> text "CInt where")
- 4
- (exports $$ imports $$ typestr)
-
- exports = vcat [ text "exportArgument" <+> text con <+> text "= return" <+> hInteger val
- | (con,val) <- zip constructors values ]
- imports = vcat [ text "importArgument" <+> hInteger val <+> text "= return" <+> text con
- | (con,val) <- zip constructors values ]
-
- hInteger i | i < 0 = parens (integer i)
- | otherwise = integer i
-
- typestr = text "objCTypeString _ = \"i\""
-
-pprEnumType (EnumType Nothing constants) =
- text "{- ### anonymous enum!"
- $$ nest 4 (pprEnumType $ EnumType (Just "Anon") constants)
- $$ text "### -}"
+pprEnumType (EnumType name constants) =
+ char '$' <> parens (
+ declare
+ <+> brackets (
+ hcat $ punctuate comma $ map pprAssoc constants
+ )
+ )
+ where
+ declare = case name of
+ Just cname -> text "declareCEnum" <+> doubleQuotes (text cname)
+ Nothing -> text "declareAnonymousCEnum"
+ pprAssoc (n, v)
+ = parens (doubleQuotes (text n) <> comma <+> integer v)
|
