gtk2hs-buildtools 0.12.4 → 0.12.5.0
raw patch · 8 files changed
+57/−48 lines, 8 filesdep +hashtablesdep ~basenew-uploader
Dependencies added: hashtables
Dependency ranges changed: base
Files
- c2hs/base/general/Binary.hs +16/−1
- c2hs/gen/GenBind.hs +25/−33
- c2hs/toplevel/Version.hs +1/−1
- dist/build/gtk2hsC2hs/gtk2hsC2hs-tmp/CLexer.hs +1/−0
- dist/build/gtk2hsC2hs/gtk2hsC2hs-tmp/CParser.hs +2/−1
- gtk2hs-buildtools.cabal +5/−3
- hierarchyGen/Hierarchy.chs.template +6/−2
- hierarchyGen/TypeGen.hs +1/−7
c2hs/base/general/Binary.hs view
@@ -60,9 +60,16 @@ import Map (Map) import qualified Map as Map-# if __GLASGOW_HASKELL__>=602+#if __GLASGOW_HASKELL__>=602+# if __GLASGOW_HASKELL__>=707+import Data.HashTable.Class as HashTable+ (HashTable)+import Data.HashTable.IO as HashTable+ (BasicHashTable, toList, new, insert, lookup)+# else import Data.HashTable as HashTable # endif+#endif import Data.Array.IO import Data.Array import Data.Bits@@ -697,7 +704,11 @@ -- The next two fields are only used when writing ud_next :: IORef Int, -- The next index to use #if __GLASGOW_HASKELL__>=602+# if __GLASGOW_HASKELL__>=707+ ud_map :: BasicHashTable String Int -- The index of each string+# else ud_map :: HashTable String Int -- The index of each string+# endif #else ud_map :: IORef (Map String Int) #endif@@ -714,7 +725,11 @@ newWriteState = do j_r <- newIORef 0 #if __GLASGOW_HASKELL__>=602+# if __GLASGOW_HASKELL__>=707+ out_r <- HashTable.new+# else out_r <- HashTable.new (==) HashTable.hashString+# endif #else out_r <- newIORef Map.empty #endif
c2hs/gen/GenBind.hs view
@@ -113,7 +113,7 @@ -- standard libraries import Data.Char (toUpper, toLower, isSpace)-import Data.List (deleteBy, intersperse, isPrefixOf, find)+import Data.List (deleteBy, intersperse, isPrefixOf, find, nubBy) import Data.Maybe (isNothing, isJust, fromJust, fromMaybe) import Control.Monad (when, unless, liftM, mapAndUnzipM) @@ -419,12 +419,9 @@ -- convert the translation table and generate data type definition code -- gprefix <- getPrefix- let prefix = case oprefix of- Nothing -> gprefix- Just pref -> pref-- let trans = transTabToTransFun prefix chsTrans- hide = identToLexeme . fromMaybe cide $ oalias+ let prefix = fromMaybe gprefix oprefix+ trans = transTabToTransFun prefix chsTrans+ hide = identToLexeme . fromMaybe cide $ oalias enumDef enum hide trans (map identToLexeme derive) expandHook hook@(CHSCall isPure isUns isNol ide oalias pos) = do@@ -629,39 +626,34 @@ -- enumInst :: String -> [(String, Maybe CExpr)] -> String enumInst ident list =- "instance Enum " ++ ident ++ " where\n" - ++ fromDef list 0 ++ "\n" ++ toDef list 0 ++ "\n"+ "instance Enum " ++ ident ++ " where\n"+ ++ fromDef flatList ++ "\n" ++ toDef flatList ++ "\n" ++ succDef names ++ "\n" ++ predDef names ++ "\n" ++ enumFromToDef names where names = map fst list- fromDef [] _ = ""- fromDef ((ide, exp):list) n = - " fromEnum " ++ ide ++ " = " ++ show' val ++ "\n" - ++ fromDef list (val + 1)+ flatList = flatten list 0++ flatten [] n = []+ flatten ((ide, exp):list) n = (ide, val) : flatten list (val + 1) where val = case exp of- Nothing -> n- Just (CConst (CIntConst m _) _) -> m- Just _ -> - interr "GenBind.enumInst: Integer constant expected!"- --- show' x = if x < 0 then "(" ++ show x ++ ")" else show x- --- toDef [] _ = - " toEnum unmatched = error (\"" ++ ident + Nothing -> n+ Just (CConst (CIntConst m _) _) -> m+ Just _ -> interr "GenBind.enumInst: Integer constant expected!"++ show' x = if x < 0 then "(" ++ show x ++ ")" else show x+ fromDef list = concat+ [ " fromEnum " ++ ide ++ " = " ++ show' val ++ "\n"+ | (ide, val) <- list+ ]+ toDef list = concat+ [ " toEnum " ++ show' val ++ " = " ++ ide ++ "\n"+ | (ide, val) <- nubBy (\x y -> snd x == snd y) list+ ]+ ++ " toEnum unmatched = error (\"" ++ ident ++ ".toEnum: Cannot match \" ++ show unmatched)\n"- toDef ((ide, exp):list) n = - " toEnum " ++ show' val ++ " = " ++ ide ++ "\n" - ++ toDef list (val + 1)- where- val = case exp of- Nothing -> n- Just (CConst (CIntConst m _) _) -> m- Just _ -> - interr "GenBind.enumInst: Integer constant expected!"- --- show' x = if x < 0 then "(" ++ show x ++ ")" else show x+ succDef [] = " succ _ = undefined\n" succDef [x] = " succ _ = undefined\n" succDef (x:x':xs) =
c2hs/toplevel/Version.hs view
@@ -6,7 +6,7 @@ -- idstr = "$Id: Version.hs,v 1.1 2012/05/27 16:49:07 dmwit Exp $" name = "C->Haskell Compiler"-versnum = "0.13.6 (gtk2hs branch)"+versnum = "0.13.8 (gtk2hs branch)" versnick = "\"Bin IO\"" date = "27 May 2012" version = name ++ ", version " ++ versnum ++ " " ++ versnick ++ ", " ++ date
dist/build/gtk2hsC2hs/gtk2hsC2hs-tmp/CLexer.hs view
@@ -323,6 +323,7 @@ alex_action_58 = token_ CTokEllipsis {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- -----------------------------------------------------------------------------
dist/build/gtk2hsC2hs/gtk2hsC2hs-tmp/CParser.hs view
@@ -27,7 +27,7 @@ import qualified Data.Array as Happy_Data_Array import qualified GHC.Exts as Happy_GHC_Exts --- parser produced by Happy Version 1.18.10+-- parser produced by Happy Version 1.18.9 newtype HappyAbsSyn = HappyAbsSyn HappyAny #if __GLASGOW_HASKELL__ >= 607@@ -5450,6 +5450,7 @@ position message {-# LINE 1 "templates/GenericTemplate.hs" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-}+{-# LINE 1 "<built-in>" #-} {-# LINE 1 "<command-line>" #-} {-# LINE 1 "templates/GenericTemplate.hs" #-} -- Id: GenericTemplate.hs,v 1.26 2005/01/14 14:47:22 simonmar Exp
gtk2hs-buildtools.cabal view
@@ -1,5 +1,5 @@ Name: gtk2hs-buildtools-Version: 0.12.4+Version: 0.12.5.0 License: GPL-2 License-file: COPYING Copyright: (c) 2001-2010 The Gtk2Hs Team@@ -27,8 +27,8 @@ Extra-Source-Files: c2hs/toplevel/c2hs_config.h Source-Repository head- type: darcs- location: http://code.haskell.org/gtk2hs/+ type: git+ location: https://github.com/gtk2hs/gtk2hs subdir: tools Flag ClosureSignals@@ -115,3 +115,5 @@ cpp-options: -D_C2HS_CPP_LANG_SINGLE extensions: ForeignFunctionInterface BangPatterns+ if impl(ghc >= 7.7)+ build-depends: hashtables
hierarchyGen/Hierarchy.chs.template view
@@ -1,5 +1,4 @@ {-# OPTIONS_HADDOCK hide #-}-{-# LANGUAGE CPP #-} -- -*-haskell-*- -- -------------------- automatically generated file - do not edit ---------- -- Object hierarchy for the GIMP Toolkit (GTK) Binding for Haskell@@ -37,7 +36,12 @@ @MODULE_EXPORTS@ ) where -import Foreign.ForeignPtr (ForeignPtr, castForeignPtr, unsafeForeignPtrToPtr)+import Foreign.ForeignPtr (ForeignPtr, castForeignPtr)+#if __GLASGOW_HASKELL__ >= 707+import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)+#else+import Foreign.ForeignPtr (unsafeForeignPtrToPtr)+#endif import Foreign.C.Types (CULong(..), CUInt(..)) import System.Glib.GType (GType, typeInstanceIsA) @MODULE_IMPORTS@
hierarchyGen/TypeGen.hs view
@@ -279,13 +279,7 @@ indent 0. indent 0.ss "{#pointer *". (case lookup name table of- (Just TypeInfo { tiQueryFunction = cname })- | stripPrefix cname == name -> ss name- | otherwise -> ss cname.ss " as ".ss name- where stripPrefix s = if uCasePrefix `isPrefixOf` s- then drop (length prefix) s- else s- uCasePrefix = toUpper (head prefix) : tail prefix -- gtk -> Gtk+ (Just TypeInfo { tiQueryFunction = cname }) -> ss cname.ss " as ".ss name ). ss " foreign newtype #}". (case lookup name table of