Parse C declarations.

OpenGLRaw.cabal

@@ -33,6 +33,7 @@ extra-source-files:
   RegistryProcessor/LICENSE
   RegistryProcessor/RegistryProcessor.cabal
   RegistryProcessor/Setup.hs
+  RegistryProcessor/src/DeclarationParser.hs
   RegistryProcessor/src/Main.hs
   RegistryProcessor/src/MangledRegistry.hs
   RegistryProcessor/src/Registry.hs

RegistryProcessor/src/DeclarationParser.hs

@@ -0,0 +1,80 @@
+-- A very simple-minded parser for C declarations of the following syntax:
+--   "const"? type-specifier ("*" "const"?)* identifier ("[" number "]")?
+module DeclarationParser ( parse ) where
+
+import Control.Monad
+import Data.Char
+import Text.ParserCombinators.ReadP
+
+parse :: String -> Either String (String, Int)
+parse s =
+  case readP_to_S parseDeclaration s of
+    [(x, "")] -> Right x
+    _ -> Left $ "could not parse \"" ++ s ++ "\""
+
+parseDeclaration :: ReadP (String, Int)
+parseDeclaration = do
+  optionalConst
+  typeSpec <- parseTypeSpecifier
+  pointers <- many' (token "*" >> optionalConst)
+  _ <- parseIdentifier
+  a <- parseArray
+  skipSpaces
+  return (typeSpec, length pointers + a)
+
+optionalConst :: ReadP ()
+optionalConst = option' () (token "const" >> return ())
+
+parseTypeSpecifier :: ReadP String
+parseTypeSpecifier = choice' [
+  token "void" >> return "()",
+  token "float" >> return "CFloat",
+  token "double" >> return "CDouble",
+  do c <- option' "CChar" (token "signed" >> return "CSChar")
+     choice' [
+       token "char" >> return c,
+       token "short" >> return "CShort",
+       token "int" >> return "CInt",
+       token "long" >> choice' [token "long" >> return "CLLong",
+                                return "CLong"]],
+  do _ <- token "unsigned"
+     choice' [
+       token "char" >> return "CUChar",
+       token "short" >> return "CUShort",
+       token "int" >> return "CUInt",
+       token "long" >> choice' [token "long" >> return "CULLong",
+                                return "CULong"]],
+  parseIdentifier ]
+
+parseIdentifier :: ReadP String
+parseIdentifier = do
+  skipSpaces
+  x <- satisfy (\c -> isAlpha c || c == '_')
+  xs <- munch (\c ->isAlphaNum c || c == '_')
+  return (x:xs)
+
+parseArray :: ReadP Int
+parseArray = choice' [
+  do _ <- token "["
+     skipSpaces
+     _ <- munch1 isDigit
+     _ <- token "]"
+     return 1,
+  return 0 ]
+
+token :: String -> ReadP String
+token s = skipSpaces >> string s
+
+-- deterministic versions
+
+choice' :: [ReadP a] -> ReadP a
+choice' = foldr (<++) pfail
+
+option' :: a -> ReadP a -> ReadP a
+option' x p = choice' [p, return x]
+
+many' :: ReadP a -> ReadP [a]
+many' = option' [] . many1'
+
+many1' :: ReadP a -> ReadP [a]
+many1' p = liftM2 (:) p (many' p)

RegistryProcessor/src/MangledRegistry.hs

@@ -10,7 +10,9 @@ module MangledRegistry (
   Extension(..)
 ) where
 
+import Data.List
 import Data.Maybe
+import qualified DeclarationParser as D
 import qualified Data.Set as S
 import qualified Registry as R
 
@@ -139,16 +141,22 @@ toCommand c = Command {
         ps = map R.paramProto (R.commandParams c)
 
 toCType :: R.Proto -> CType
-toCType p = CType {
-  baseType = maybe (R.TypeName "NOCLUE") id $ R.protoPtype p,
-  numPointer = 99 }
+toCType p =
+  either error (\(b,n) -> CType { baseType = R.TypeName b, numPointer = n }) $
+  D.parse $
+  intercalate " " $
+  map ($ p) [
+    R.protoText1,
+    maybe "" R.unTypeName . R.protoPtype,
+    R.protoText2,
+    R.protoName,
+    R.protoText3 ]
 
 data CType = CType {
   baseType :: R.TypeName,
   numPointer :: Int
   } deriving (Eq, Ord, Show)
 
-
 data Feature = Feature
   deriving (Eq, Ord, Show)