X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=Text%2FRegex%2FPosix.hsc;h=0f28295dce3814c5362cdd788cb64150307fd1c5;hb=e9e2a5412bb7cda8d13a063ac403d9f18ac97380;hp=08565b57702ea840ac650ee3e28206423cb85e2c;hpb=67ec37f1785a8b51185c9d0151b3e56a130b9852;p=ghc-base.git

diff --git a/Text/Regex/Posix.hsc b/Text/Regex/Posix.hsc
index 08565b5..0f28295 100644
--- a/Text/Regex/Posix.hsc
+++ b/Text/Regex/Posix.hsc
@@ -6,13 +6,19 @@
 -- 
 -- Maintainer  :  libraries@haskell.org
 -- Stability   :  experimental
--- Portability :  non-portable (needs POSIX regexps)
+-- Portability :  portable
 --
 -- Interface to the POSIX regular expression library.
 --
 -----------------------------------------------------------------------------
 
 -- ToDo: should have an interface using PackedStrings.
+#ifndef __NHC__
+#include "HsBaseConfig.h"
+#else
+#define HAVE_REGEX_H 1
+#define HAVE_REGCOMP 1
+#endif
 
 module Text.Regex.Posix (
 	-- * The @Regex@ type
@@ -37,13 +43,27 @@ module Text.Regex.Posix (
   ) where
 
 #include <sys/types.h>
+
+#if HAVE_REGEX_H && HAVE_REGCOMP
 #include "regex.h"
+#else
+#include "regex/regex.h"
+
+-- CFILES stuff is Hugs only
+{-# CFILES cbits/regex/reallocf.c #-}
+{-# CFILES cbits/regex/regcomp.c #-}
+{-# CFILES cbits/regex/regerror.c #-}
+{-# CFILES cbits/regex/regexec.c #-}
+{-# CFILES cbits/regex/regfree.c #-}
+#endif
 
 import Prelude
 
 import Foreign
 import Foreign.C
 
+type CRegex    = ()
+
 -- | A compiled regular expression
 newtype Regex = Regex (ForeignPtr CRegex)
 
@@ -56,20 +76,15 @@ regcomp
   -> Int    	-- ^ Flags (summed together)
   -> IO Regex  	-- ^ Returns: the compiled regular expression
 regcomp pattern flags = do
-  regex_ptr <- mallocBytes (#const sizeof(regex_t))
-  regex_fptr <- newForeignPtr regex_ptr (regfree regex_ptr)
+  regex_fptr <- mallocForeignPtrBytes (#const sizeof(regex_t))
   r <- withCString pattern $ \cstr ->
     	 withForeignPtr regex_fptr $ \p ->
            c_regcomp p cstr (fromIntegral flags)
   if (r == 0)
-     then return (Regex regex_fptr)
+     then do addForeignPtrFinalizer ptr_regfree regex_fptr
+	     return (Regex regex_fptr)
      else error "Text.Regex.Posix.regcomp: error in pattern" -- ToDo
 
-regfree :: Ptr CRegex -> IO ()
-regfree p_regex = do
-  c_regfree p_regex
-  free p_regex
-
 -- -----------------------------------------------------------------------------
 -- regexec
 
@@ -98,31 +113,31 @@ regexec (Regex regex_fptr) str = do
 
         if (r /= 0) then return Nothing else do 
 
-        (before,match,after) <- matched_parts str p_match
+          (before,match,after) <- matched_parts str p_match
 
-        sub_strs <- 
-	  mapM (unpack str) $ take nsub_int $ tail $
-	     iterate (`plusPtr` (#const sizeof(regmatch_t))) p_match
+          sub_strs <- 
+	    mapM (unpack str) $ take nsub_int $ tail $
+	       iterate (`plusPtr` (#const sizeof(regmatch_t))) p_match
 
-        return (Just (before, match, after, sub_strs))
+          return (Just (before, match, after, sub_strs))
 
 matched_parts :: String -> Ptr CRegMatch -> IO (String, String, String)
 matched_parts string p_match = do
-  start <- (#peek regmatch_t, rm_so) p_match :: IO CInt
-  end   <- (#peek regmatch_t, rm_eo) p_match :: IO CInt
+  start <- (#peek regmatch_t, rm_so) p_match :: IO (#type regoff_t)
+  end   <- (#peek regmatch_t, rm_eo) p_match :: IO (#type regoff_t)
   let s = fromIntegral start; e = fromIntegral end
-  return ( take (s-1) string, 
+  return ( take s string, 
 	   take (e-s) (drop s string),
 	   drop e string )  
 
 unpack :: String -> Ptr CRegMatch -> IO (String)
 unpack string p_match = do
-  start <- (#peek regmatch_t, rm_so) p_match :: IO CInt
-  end   <- (#peek regmatch_t, rm_eo) p_match :: IO CInt
+  start <- (#peek regmatch_t, rm_so) p_match :: IO (#type regoff_t)
+  end   <- (#peek regmatch_t, rm_eo) p_match :: IO (#type regoff_t)
   -- the subexpression may not have matched at all, perhaps because it
   -- was optional.  In this case, the offsets are set to -1.
   if (start == -1) then return "" else do
-  return (take (fromIntegral (end-start)) (drop (fromIntegral start) string))
+    return (take (fromIntegral (end-start)) (drop (fromIntegral start) string))
 
 -- -----------------------------------------------------------------------------
 -- The POSIX regex C interface
@@ -130,7 +145,7 @@ unpack string p_match = do
 -- Flags for regexec
 #enum Int,, \
 	REG_NOTBOL, \
-	REG_NOTEOL \
+	REG_NOTEOL
 
 -- Return values from regexec
 #enum Int,, \
@@ -159,15 +174,43 @@ unpack string p_match = do
 	REG_ERANGE, \
 	REG_ESPACE
 
-type CRegex    = ()
 type CRegMatch = ()
 
+-- GHC and Hugs get the appropriate include file from the OPTIONS
+-- pragma generated by hsc2hs from the above #include.
+-- Implementations following the FFI spec have to specify it in the
+-- foreign import, which is awkward because some systems provide
+-- regex.h and the rest of the regex library, but otherwise we
+-- need to use our own copy, regex/regex.h.
+
+#if __GLASGOW_HASKELL__ || __HUGS__
 foreign import ccall unsafe "regcomp"
   c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
 
-foreign import ccall  unsafe "regfree"
-  c_regfree :: Ptr CRegex -> IO ()
+foreign import ccall  unsafe "&regfree"
+  ptr_regfree :: FunPtr (Ptr CRegex -> IO ())
 
 foreign import ccall unsafe "regexec"
   c_regexec :: Ptr CRegex -> CString -> CSize
 	    -> Ptr CRegMatch -> CInt -> IO CInt
+#elif HAVE_REGEX_H && HAVE_REGCOMP
+foreign import ccall unsafe "regex.h regcomp"
+  c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
+
+foreign import ccall  unsafe "regex.h &regfree"
+  ptr_regfree :: FunPtr (Ptr CRegex -> IO ())
+
+foreign import ccall unsafe "regex.h regexec"
+  c_regexec :: Ptr CRegex -> CString -> CSize
+	    -> Ptr CRegMatch -> CInt -> IO CInt
+#else
+foreign import ccall unsafe "regex/regex.h regcomp"
+  c_regcomp :: Ptr CRegex -> CString -> CInt -> IO CInt
+
+foreign import ccall  unsafe "regex/regex.h &regfree"
+  ptr_regfree :: FunPtr (Ptr CRegex -> IO ())
+
+foreign import ccall unsafe "regex/regex.h regexec"
+  c_regexec :: Ptr CRegex -> CString -> CSize
+	    -> Ptr CRegMatch -> CInt -> IO CInt
+#endif