class.diff

*** Class2.hs	2013-07-30 17:30:58.000000000 -0400
--- Class.hs	2013-07-09 13:30:42.000000000 -0400
*************** import System.FilePath 
*** 24,186 ****
  import FFICXX.Generate.Util
  
  -- | C types
! data PrimitiveTypes c = CPTChar
!                       | CPTInt
!                       | CPTLong
!                       | CPTUChar
!                       | CPTUInt
!                       | CPTULong
!                       | CPTLongLong
!                       | CPTULongLong
!                       | CPTDouble
!                       | CPTLongDouble
!                       | CPTBool
!                       | CPTVoid
!                       | CPTClass c   -- String
!                     deriving (Show, Eq)
! nsa
! data CPPType c = Ptr        (CPPType c) -- ^ Pointer to a type
!                | Ref        (CPPType c) -- ^ Reference to a type
!                | Arr        Int       (CPPType c) -- ^ Array of a type
!                | Fun        [CPPType c] (CPPType c) -- ^ A function
!                | QConst     (CPPType c) -- ^ const type
!                | QVolatile  (CPPType c) -- ^ volatile type
!                | QRestrict  (CPPType c) -- ^ restrict type, not supported, will give an error if passed such type
!                | MPtr       c    (CPPType c) -- ^ Member pointer to class
!                | PrimType   PrimitiveTypes -- ^ Primitive c/c++ types
!                deriving (Show, Eq)
! 
! 
! type SimpleCPPType = CPPType String
! 
! type FullCPPType = CPPType Class
! 
! class CPPNameable c where
!   cppname :: c -> String
! 
! cvarToStr :: (CPPNameable c) => CPPType c -> String -> String
! cvarToStr t varname = (ctypToStr t) `connspace` varname 
! 
! ctypToStr :: (CPPNameable c) => CPPType c -> String
! ctypToStr (Ptr t) = ctypToStr t ++ "*"
! ctypToStr (Ref t) = ctypToStr t ++ "&"
! ctypToStr (Arr n t) = ctypToStr t ++ "[" ++ show n ++ "]"
! ctypToStr (Fun ts t) = "(" ++ ctypToStr t ++ "*) (" ++ ((intercalate "," . map ctypToStr) ts)  
! ctypToStr (QConst t) = "const " ++ ctypToStr t 
! ctypToStr (QVolatile t) = "volatile " ++ ctypToStr t
! ctypToStr (QRestrict t) = "restrict " ++ ctypToStr t
! ctypToStr (MPtr s t) = ctypToStr t ++ " " ++ cppname s + "::*r" 
! ctypToStr (PrimiType prim) = 
!   case prim of 
!     CPTChar -> "char"
!     CPTInt -> "int"
!     CPTLong -> "long"
!     CPTUChar -> "unsigned char"
!     CPTUInt -> "unsigned int"
!     CPTULong -> "unsinged long"
!     CPTLongLong -> "long long"
!     CPTDouble -> "double"
!     CPTLongDouble -> "long double"
!     CPTBool -> "bool"
!     CPTVoid -> "void"
!     CPTClass str -> cppname str -- template class may have problem here.
! 
! 
! -- self_ :: Types 
! -- self_ = SelfType
! 
! -- | const char* type
! cstring_ :: CPPType
! cstring_ = QConst (Ptr CPTChar) 
! 
! -- | const int type
! cint_ :: CPPType
! cint_ = QConst CPThInt
! 
! int_ :: CPPType
! int_ = CPTInt
! 
! uint_ :: CPPType
! uint_ = CPTUInt
! 
! ulong_ :: CPPType
! ulong_ = CPTULong 
! 
! long_ :: CPPType
! long_ = CPTLong 
! 
! culong_ :: CPPType
! culong_ = QConst CPTULong
  
! clong_ :: CPPType
! clong_ = QConst CPTLong 
  
! cchar_ :: CPPType
! cchar_ = QConst CPTChar 
  
! char_ :: CPPType
  char_ = CT CTChar NoConst 
  
! -- unimplemented 
! -- short_ :: CPPType
! -- short_ = int_
  
! cdouble_ :: CPPType
! cdouble_ = QConst CPTDouble 
  
! double_ :: CPPType
! double_  = CPTDouble
  
! -- doublep_ :: CPPType
! -- doublep_ = CT CTDoubleStar NoConst
  
! -- not implemented yet
! -- float_ :: CPPType
! -- float_ = double_
  
! bool_ :: CPPType 
! bool_ = CPTBool 
  
! void_ :: CPPType
! void_ = CPTVoid 
  
! -- voidp_ :: CPPType
! -- voidp_ = CT CTVoidStar NoConst
  
! -- intp_ :: CPPType
! -- intp_ = CT CTIntStar NoConst
  
! -- charpp_ :: CPPType
! -- charpp_ = CT CTCharStarStar NoConst
  
  
! -- star_ :: CTypes -> Types 
! -- star_ t = CT (CPointer t) NoConst
  
! -- cstar_ :: CTypes -> Types 
! -- cstar_ t = CT (CPointer t) Cons
! s
! -- self :: String -> (Types, String)
! -- self var = (self_, var)
  
! makeTypVar :: CPPType -> String -> (CPPType,String) 
  
! -- voidp :: String -> (CPPType,String) 
! -- voidp = makeTypVar void
  
! cstring :: String -> (CPPType,String)
! cstring = makeTypeVar cstring_ 
  
! cint :: String -> (CPPType,String)
! cint = makeTypeVar cint_   
  
! int :: String -> (CPPType,String)
! int = makeTypeVar int_  
  
! uint :: String -> (CPPType,String)
! uint = makeTypeVar uint_ 
  
- {-
  long :: String -> (Types,String)
  long var = (long_, var)
  
--- 24,171 ----
  import FFICXX.Generate.Util
  
  -- | C types
! data CTypes = CTString 
!             | CTChar 
!             | CTInt 
!             | CTUInt
!             | CTLong
!             | CTULong
!             | CTDouble 
!             | CTBool 
!             | CTDoubleStar 
!             | CTVoidStar 
!             | CTIntStar 
!             | CTCharStarStar 
!             | CPointer CTypes 
!             deriving Show 
! 
! -- | C++ types 
! data CPPTypes = CPTClass Class 
!               | CPTClassRef Class 
!               deriving Show
! 
! -- | const flag
! data IsConst = Const | NoConst
!              deriving Show
! 
! data Types = Void 
!            | SelfType
!            | CT  CTypes IsConst 
!            | CPT CPPTypes IsConst
!            deriving Show
! 
! cvarToStr :: CTypes -> IsConst -> String -> String
! cvarToStr ctyp isconst varname = (ctypToStr ctyp isconst) `connspace` varname 
! 
! ctypToStr :: CTypes -> IsConst -> String
! ctypToStr ctyp isconst = 
!   let typword = case ctyp of 
!         CTString -> "char*"
!         CTChar   -> "char" 
!         CTInt    -> "int" 
!         CTUInt   -> "unsigned int"
!         CTLong   -> "signed long"
!         CTULong  -> "long unsigned int"
!         CTDouble -> "double" 
!         CTBool   -> "int"              -- Currently available solution
!         CTDoubleStar -> "double *"
!         CTVoidStar -> "void*"
!         CTIntStar -> "int*"
!         CTCharStarStar -> "char**"
!         CPointer s -> ctypToStr s NoConst ++ "*"  
!   in case isconst of 
!         Const   -> "const" `connspace` typword 
!         NoConst -> typword 
! 
! 
! self_ :: Types 
! self_ = SelfType
! 
! cstring_ :: Types
! cstring_ = CT CTString Const 
! 
! cint_ :: Types
! cint_    = CT CTInt    Const
! 
! int_ :: Types 
! int_     = CT CTInt    NoConst
! 
! uint_ :: Types
! uint_ = CT CTUInt NoConst
! 
! ulong_ :: Types
! ulong_ = CT CTULong NoConst
! 
! long_ :: Types
! long_ = CT CTLong NoConst
! 
! culong_ :: Types
! culong_ = CT CTULong Const
  
! clong_ :: Types
! clong_ = CT CTLong Const
  
! cchar_ :: Types 
! cchar_ = CT CTChar Const
  
! char_ :: Types
  char_ = CT CTChar NoConst 
  
! short_ :: Types
! short_ = int_
  
! cdouble_ :: Types
! cdouble_ = CT CTDouble Const
  
! double_ :: Types
! double_  = CT CTDouble NoConst
  
! doublep_ :: Types
! doublep_ = CT CTDoubleStar NoConst
  
! float_ :: Types
! float_ = double_
  
! bool_ :: Types 
! bool_    = CT CTBool   NoConst 
  
! void_ :: Types
! void_ = Void 
  
! voidp_ :: Types 
! voidp_ = CT CTVoidStar NoConst
  
! intp_ :: Types 
! intp_ = CT CTIntStar NoConst
  
! charpp_ :: Types
! charpp_ = CT CTCharStarStar NoConst
  
  
! star_ :: CTypes -> Types 
! star_ t = CT (CPointer t) NoConst
  
! cstar_ :: CTypes -> Types 
! cstar_ t = CT (CPointer t) Const  
  
! self :: String -> (Types, String)
! self var = (self_, var)
  
! voidp :: String -> (Types,String) 
! voidp var = (voidp_ , var)
  
! cstring :: String -> (Types,String)
! cstring var = (cstring_ , var)
  
! cint :: String -> (Types,String)
! cint    var = (cint_    , var) 
  
! int :: String -> (Types,String)
! int     var = (int_     , var)
  
! uint :: String -> (Types,String)
! uint var = (uint_ , var)
  
  long :: String -> (Types,String)
  long var = (long_, var)
  
*************** culong var = (culong_ , var)
*** 195,201 ****
  
  cchar :: String -> (Types,String)
  cchar var = (cchar_ , var) 
! aIio
  char :: String -> (Types,String)
  char var = (char_ , var)
  
--- 180,186 ----
  
  cchar :: String -> (Types,String)
  cchar var = (cchar_ , var) 
! 
  char :: String -> (Types,String)
  char var = (char_ , var)
  
*************** star t var = (star_ t, var) 
*** 228,236 ****
  
  cstar :: CTypes -> String -> (Types, String)
  cstar t var = (cstar_ t, var) 
- -}
  
! {-
  cppclass_ :: Class -> Types
  cppclass_ c =  CPT (CPTClass c) NoConst
  
--- 213,220 ----
  
  cstar :: CTypes -> String -> (Types, String)
  cstar t var = (cstar_ t, var) 
  
! 
  cppclass_ :: Class -> Types
  cppclass_ c =  CPT (CPTClass c) NoConst
  
*************** cppclassref_ c = CPT (CPTClassRef c) NoC
*** 245,280 ****
  
  cppclassref :: Class -> String -> (Types, String) 
  cppclassref c vname = (cppclassref_ c, vname)
- -}
- 
- -- | haskell representation of C++ types
- hsCPPTypeName :: CPPType Class -> String 
- hsCPPTypeName (PrimType prim) = 
-   case prim of 
-     CPTChar -> "CChar"
-     CPTInt -> "CInt"
-     CPTLong -> "CLong"
-     CPTUChar -> "CUChar"
-     CPTUInt -> "CUInt"
-     CPTULong -> "CULong"
-     CPTLongLong -> "CLLong"
-     CPTDouble -> "CDouble"
-     CPTLongDouble -> "CDouble" -- not long double.. maybe problematic 
-     CPTBool -> "CInt"
-     CPTVoid -> "()"
-     CPTClass c -> "(Ptr "++rawname++")"  where rawname = snd (hsClassName c)
-     
- mkFullCPPType :: SomeGlobalNameMap -> CPPType String -> FFICXXMONAD (CPPType Class)
- 
-     
-     strTy -- template class may have problem here.                             
- 
- hsCppTypeName :: CPPTypes -> String
- hsCppTypeName (CPTClass c) =  
- hsCppTypeName (CPTClassRef c) = "(Ptr "++rawname++")" where rawname = snd (hsClassName c)
  
  
! {-
  hsCTypeName CTString = "CString" 
  hsCTypeName CTChar   = "CChar" 
  hsCTypeName CTInt    = "CInt"
--- 229,237 ----
  
  cppclassref :: Class -> String -> (Types, String) 
  cppclassref c vname = (cppclassref_ c, vname)
  
  
! hsCTypeName :: CTypes -> String 
  hsCTypeName CTString = "CString" 
  hsCTypeName CTChar   = "CChar" 
  hsCTypeName CTInt    = "CInt"
*************** hsCTypeName CTVoidStar = "(Ptr ())"
*** 288,296 ****
  hsCTypeName CTIntStar = "(Ptr CInt)"
  hsCTypeName CTCharStarStar = "(Ptr (CString))"
  hsCTypeName (CPointer t) = "(Ptr " ++ hsCTypeName t ++ ")" 
- -}
  
  
  -------------
  
  type Args = [(Types,String)]
--- 245,256 ----
  hsCTypeName CTIntStar = "(Ptr CInt)"
  hsCTypeName CTCharStarStar = "(Ptr (CString))"
  hsCTypeName (CPointer t) = "(Ptr " ++ hsCTypeName t ++ ")" 
  
  
+ hsCppTypeName :: CPPTypes -> String
+ hsCppTypeName (CPTClass c) =  "(Ptr "++rawname++")"  where rawname = snd (hsClassName c)
+ hsCppTypeName (CPTClassRef c) = "(Ptr "++rawname++")" where rawname = snd (hsClassName c)
+ 
  -------------
  
  type Args = [(Types,String)]
*************** data Function = Constructor { func_args 
*** 303,309 ****
                          , func_args :: Args 
                          , func_alias :: Maybe String 
                          } 
!               | NonVirtual { func_ret :: Types hicic
                             , func_name :: String
                             , func_args :: Args 
                             , func_alias :: Maybe String 
--- 263,269 ----
                          , func_args :: Args 
                          , func_alias :: Maybe String 
                          } 
!               | NonVirtual { func_ret :: Types 
                             , func_name :: String
                             , func_args :: Args 
                             , func_alias :: Maybe String