[hoc-cvs] hoc/HOC/HOC SelectorMarshaller.hs,1.9,1.10

[Wolfgang T. <wth...@us...>]

Update of /cvsroot/hoc/hoc/HOC/HOC
In directory sc8-pr-cvs1.sourceforge.net:/tmp/cvs-serv30770/HOC/HOC

Modified Files:
	SelectorMarshaller.hs 
Log Message:
Add an evil {-# RULES #-} pragma to make the code smaller
(removes unpackCString# from code generated for selectors)


Index: SelectorMarshaller.hs
===================================================================
RCS file: /cvsroot/hoc/hoc/HOC/HOC/SelectorMarshaller.hs,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -d -r1.9 -r1.10
--- SelectorMarshaller.hs	26 Jul 2005 03:11:43 -0000	1.9
+++ SelectorMarshaller.hs	26 Jul 2005 05:23:48 -0000	1.10
@@ -17,6 +17,7 @@
 
 import Foreign                      ( withArray, Ptr, nullPtr )
 import System.IO.Unsafe             ( unsafePerformIO )
+import GHC.Base						( unpackCString# )
 
 import HOC.TH
 
@@ -27,9 +28,24 @@
         selectorInfoSel :: !SEL
     }
 
+{-# NOINLINE mkSelectorInfo #-}
 mkSelectorInfo objCName hsName cif
 	= SelectorInfo objCName hsName cif (getSelectorForName objCName)
 
+{-# NOINLINE mkSelectorInfo# #-}
+mkSelectorInfo# objCName# hsName# cif
+	-- NOTE: Don't call mkSelectorInfo here, the rule would apply!
+	= SelectorInfo objCName hsName cif (getSelectorForName objCName)
+	where
+		objCName = unpackCString# objCName#
+		hsName   = unpackCString# hsName#
+
+{-# RULES
+"litstr" forall s1 s2 cif.
+	mkSelectorInfo (unpackCString# s1) (unpackCString# s2) cif
+	= mkSelectorInfo# s1 s2 cif
+  #-}
+
 makeMarshaller maybeInfoName haskellName nArgs isUnit isPure isRetained =
             funD haskellName [
                 clause (map varP $ infoArgument ++ map mkName arguments