logo       
Google Custom Search
    AddThis Social Bookmark Button

darcs patch: fix type of foreign calls in FastPackedString.: msg#00127

Subject: darcs patch: fix type of foreign calls in FastPackedString.
Tue Sep 20 08:58:00 EDT 2005  David Roundy <droundy@xxxxxxxxx>
  * fix type of foreign calls in FastPackedString.
New patches:

[fix type of foreign calls in FastPackedString.
David Roundy <droundy@xxxxxxxxx>**20050920125800] 
<
> {
hunk ./FastPackedString.hs 228
    (==) = eqPS
 
 foreign import ccall unsafe "static string.h memcmp" c_memcmp
-    :: Ptr Word8 -> Ptr Word8 -> Int -> IO Int
+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO CInt
 
 {-# INLINE eqPS #-}
 eqPS :: PackedString -> PackedString -> Bool
hunk ./FastPackedString.hs 243
 comparePS (PS x1 s1 l1) (PS x2 s2 l2) = unsafePerformIO $ 
     withForeignPtr x1 $ \p1 -> 
         withForeignPtr x2 $ \p2 -> do 
-            i <- c_memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2) (min l1 l2)
+            i <- c_memcmp (p1 `plusPtr` s1) (p2 `plusPtr` s2)
+                 (fromIntegral $ min l1 l2)
             return $ case i `compare` 0 of
                 EQ  -> l1 `compare` l2
                 x   -> x
hunk ./FastPackedString.hs 336
 unpackPSfromUTF8 (PS x s l) =
     unsafePerformIO $ withForeignPtr x $ \p->
     do outbuf <- mallocArray l
-       lout <- utf8_to_ints outbuf (p `plusPtr` s) l
+       lout <- fromIntegral `liftM`
+               utf8_to_ints outbuf (p `plusPtr` s) (fromIntegral l)
        when (lout < 0) $ error "Bad UTF8!"
hunk ./FastPackedString.hs 339
-       str <- (map chr) `liftM` peekArray lout outbuf
+       str <- (map (chr . fromIntegral)) `liftM` peekArray lout outbuf
        free outbuf
        return str
 
hunk ./FastPackedString.hs 344
 foreign import ccall unsafe "static fpstring.h utf8_to_ints" utf8_to_ints
-    :: Ptr Int -> Ptr Word8 -> Int -> IO Int
+    :: Ptr CInt -> Ptr Word8 -> CInt -> IO CInt
 
 -- 
-----------------------------------------------------------------------------
 -- List-mimicking functions for PackedStrings
hunk ./FastPackedString.hs 485
 dropWhitePS :: PackedString -> PackedString
 dropWhitePS (PS x s l) =
     unsafePerformIO $ withForeignPtr x $ \p->
-    do i <- first_nonwhite (p `plusPtr` s) l
+    do i <- fromIntegral `liftM`
+            first_nonwhite (p `plusPtr` s) (fromIntegral l)
        return $ if i == l then nilPS
                 else PS x (s+i) (l-i)
 
hunk ./FastPackedString.hs 491
 foreign import ccall unsafe "fpstring.h first_nonwhite" first_nonwhite
-    :: Ptr Word8 -> Int -> IO Int
+    :: Ptr Word8 -> CInt -> IO CInt
 foreign import ccall unsafe "fpstring.h first_white" first_white
hunk ./FastPackedString.hs 493
-    :: Ptr Word8 -> Int -> IO Int
+    :: Ptr Word8 -> CInt -> IO CInt
 
 {-# INLINE is_funky #-}
 is_funky :: PackedString -> Bool
hunk ./FastPackedString.hs 497
-is_funky (PS x s l) = unsafePerformIO $ withForeignPtr x $ \p->
-                      (/=0) `liftM` has_funky_char (p `plusPtr` s) l
+is_funky (PS x s l) =
+    unsafePerformIO $ withForeignPtr x $ \p->
+    (/=0) `liftM` has_funky_char (p `plusPtr` s) (fromIntegral l)
 
 foreign import ccall unsafe "fpstring.h has_funky_char" has_funky_char
hunk ./FastPackedString.hs 502
-    :: Ptr Word8 -> Int -> IO Int
+    :: Ptr Word8 -> CInt -> IO CInt
 
 
 elemPS :: Char -> PackedString -> Bool
hunk ./FastPackedString.hs 553
 breakWhitePS :: PackedString -> (PackedString,PackedString)
 breakWhitePS (PS x s l) =
     unsafePerformIO $ withForeignPtr x $ \p->
-    do i <- first_white (p `plusPtr` s) l
+    do i <- fromIntegral `liftM` first_white (p `plusPtr` s) (fromIntegral l)
        if i == 0 then return (nilPS, PS x s l)
                  else if i == l
                       then return (PS x s l, nilPS)
hunk ./FastPackedString.hs 600
 reversePS ps = packString (reverse (unpackPS ps))
 
 foreign import ccall unsafe "static string.h memcpy" c_memcpy
-    :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
+    :: Ptr Word8 -> Ptr Word8 -> CSize -> IO ()
 
 concatPS :: [PackedString] -> PackedString
 concatPS [] = nilPS
hunk ./FastPackedString.hs 616
           f ptr len to_go pss@(PS p s l:pss')
            | l <= to_go = do withForeignPtr p $ \pf ->
                                  c_memcpy (ptr `advancePtr` len)
-                                          (pf `advancePtr` s) l
+                                          (pf `advancePtr` s) (fromIntegral l)
                              f ptr (len + l) (to_go - l) pss'
            | otherwise = do let new_total = ((len + to_go) * 2) `max` (len + l)
                             ptr' <- reallocArray ptr new_total
hunk ./FastPackedString.hs 633
 concatLenPS _ [ps] = ps
 concatLenPS total_length pss = createPS total_length $ \p-> cpPSs p pss
     where cpPSs :: Ptr Word8 -> [PackedString] -> IO ()
-          cpPSs p (PS x s l:rest) = do withForeignPtr x $ \pf ->
-                                          c_memcpy p (pf `plusPtr` s) l
-                                       cpPSs (p `plusPtr` l) rest
+          cpPSs p (PS x s l:rest) =
+              do withForeignPtr x $ \pf ->
+                     c_memcpy p (pf `plusPtr` s) (fromIntegral l)
+                 cpPSs (p `plusPtr` l) rest
           cpPSs _ [] = return ()
 
 {-# INLINE findPS #-}
hunk ./FastPackedString.hs 647
 wfindPS :: Word8 -> PackedString -> Maybe Int
 wfindPS c (PS x s l) =
     unsafePerformIO $ withForeignPtr x $ \p->
-    let p' = p `plusPtr` s
-        q = memchr p' (fromIntegral c) (fromIntegral l)
-    in return $ if q == nullPtr then Nothing
+    do let p' = p `plusPtr` s
+       q <- memchr p' (fromIntegral c) (fromIntegral l)
+       return $ if q == nullPtr then Nothing
                                 else Just (q `minusPtr` p')
 
 foreign import ccall unsafe "string.h memchr" memchr
hunk ./FastPackedString.hs 653
-    :: Ptr Word8 -> CInt -> CSize -> Ptr Word8
+    :: Ptr Word8 -> CInt -> CSize -> IO (Ptr Word8)
 
 {-# INLINE findLastPS #-}
 findLastPS :: Char -> PackedString -> Maybe Int
hunk ./FastPackedString.hs 799
 foreign import ccall unsafe "static zlib.h gzclose" c_gzclose
     :: Ptr () -> IO ()
 foreign import ccall unsafe "static zlib.h gzread" c_gzread
-    :: Ptr () -> Ptr Word8 -> Int -> IO Int
+    :: Ptr () -> Ptr Word8 -> CInt -> IO CInt
 foreign import ccall unsafe "static zlib.h gzwrite" c_gzwrite
hunk ./FastPackedString.hs 801
-    :: Ptr () -> Ptr Word8 -> Int -> IO Int
+    :: Ptr () -> Ptr Word8 -> CInt -> IO CInt
 
 gzReadFilePS :: FilePath -> IO PackedString
 gzReadFilePS f = do
hunk ./FastPackedString.hs 818
                  when (gzf == nullPtr) $ fail $ "problem opening file "++f
                  fp <- mallocForeignPtr len
                  debugForeignPtr fp $ "gzReadFilePS "++f
-                 lread <- withForeignPtr fp $ \p -> c_gzread gzf p len
+                 lread <- withForeignPtr fp $ \p ->
+                          c_gzread gzf p (fromIntegral len)
                  c_gzclose gzf
hunk ./FastPackedString.hs 821
-                 when (lread /= len) $ fail $ "problem gzreading file "++f
+                 when (fromIntegral lread /= len) $
+                      fail $ "problem gzreading file "++f
                  return $ PS fp 0 len
 
 data LazyFile = LazyString String
hunk ./FastPackedString.hs 844
                        fp <- mallocForeignPtr blocksize
                        debugForeignPtr fp $ "gzReadFileLazily "++f
                        lread <- withForeignPtr fp
-                              $ \p -> c_gzread gzf p blocksize
-                       case lread of
+                              $ \p -> c_gzread gzf p (fromIntegral blocksize)
+                       case fromIntegral lread of
                            0 -> do c_gzclose gzf
                                    return []
                            -1 -> fail $ "problem gzreading file "++f
hunk ./FastPackedString.hs 909
 
 gzWriteToGzf :: Ptr () -> PackedString -> IO ()
 gzWriteToGzf gzf (PS x s l) = do
-    lw <- withForeignPtr x $ \p -> c_gzwrite gzf (p `plusPtr` s) l
-    when (lw /= l) $ fail $ "problem in gzWriteToGzf"
+    lw <- withForeignPtr x $ \p -> c_gzwrite gzf (p `plusPtr` s)
+                                                 (fromIntegral l)
+    when (fromIntegral lw /= l) $ fail $ "problem in gzWriteToGzf"
 
 -- 
-----------------------------------------------------------------------------
 -- mmapFilePS
hunk ./FastPackedString.hs 935
 
 #if defined(__GLASGOW_HASKELL__)
 foreign import ccall unsafe "static fpstring.h my_mmap" my_mmap
-    :: Int -> Int -> IO (Ptr Word8)
+    :: CInt -> CInt -> IO (Ptr Word8)
 foreign import ccall unsafe "static sys/mman.h munmap" c_munmap
hunk ./FastPackedString.hs 937
-    :: Ptr Word8 -> Int -> IO Int
+    :: Ptr Word8 -> CInt -> IO CInt
 foreign import ccall unsafe "static unistd.h close" c_close
hunk ./FastPackedString.hs 939
-    :: Int -> IO Int
+    :: CInt -> IO CInt
 #endif
 
 mmap :: FilePath -> IO (ForeignPtr Word8, Int)
hunk ./FastPackedString.hs 957
        else do
 #if defined(__GLASGOW_HASKELL__)
                fd <- fromIntegral `liftM` handleToFd h
-               p <- my_mmap l fd
+               p <- my_mmap (fromIntegral l) fd
                fp <- if p == nullPtr
                      then
 #else
hunk ./FastPackedString.hs 969
                              return thefp
 #if defined(__GLASGOW_HASKELL__)
                      else do
-                             fp <- FC.newForeignPtr p (do {c_munmap p l; 
return (); })
+                             fp <- FC.newForeignPtr p
+                                   (do {c_munmap p $ fromIntegral l;
+                                        return (); })
                              debugForeignPtr fp $ "mmap "++f
                              return fp
                c_close fd
hunk ./FastPackedString.hs 992
 -- library function strtol.
 
 foreign import ccall unsafe "static stdlib.h strtol" c_strtol
-    :: Ptr Word8 -> Ptr (Ptr Word8) -> Int -> IO CLong
+    :: Ptr Word8 -> Ptr (Ptr Word8) -> CInt -> IO CLong
 
 readIntPS :: PackedString -> Maybe (Int, PackedString)
 readIntPS (PS x s l) =
hunk ./FastPackedString.hs 1008
 -- fromPS2Hex
 
 foreign import ccall unsafe "static fpstring.h conv_to_hex" conv_to_hex
-    :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
+    :: Ptr Word8 -> Ptr Word8 -> CInt -> IO ()
 
 fromPS2Hex :: PackedString -> PackedString
 fromPS2Hex (PS x s l) = createPS (2*l) $ \p -> withForeignPtr x $ \f ->
hunk ./FastPackedString.hs 1012
-           conv_to_hex p (f `plusPtr` s) l
+           conv_to_hex p (f `plusPtr` s) $ fromIntegral l
 
 -- -------------------------------------------------------------------------
 -- fromHex2PS
hunk ./FastPackedString.hs 1018
 
 foreign import ccall unsafe "static fpstring.h conv_from_hex" conv_from_hex
-    :: Ptr Word8 -> Ptr Word8 -> Int -> IO ()
+    :: Ptr Word8 -> Ptr Word8 -> CInt -> IO ()
 
 fromHex2PS :: PackedString -> PackedString
 fromHex2PS (PS x s l) = createPS (l `div` 2) $ \p -> withForeignPtr x $ \f ->
hunk ./FastPackedString.hs 1022
-           conv_from_hex p (f `plusPtr` s) (l `div` 2)
+           conv_from_hex p (f `plusPtr` s) (fromIntegral $ l `div` 2)
 
 -- -------------------------------------------------------------------------
 -- betweenLinesPS
}

Context:

[RemoteApply no longer depends on cd, use --repodir instead.
vborja@xxxxxxxxxxxxxx**20051110140430
 
 This is a minor change to make darcs no longer use cd
 before applying patches to a remote repository. 
 Now the --repodir option for the apply command is used.
 
 This patch came from a hack to rssh[http://sf.net/projects/rssh]
 to allow using darcs as a restricted command without depending
 on the cd binary.
 
http://sf.net/tracker/index.php?func=detail&aid=1351939&group_id=65349&atid=510643
] 
[Support signed push
Esa Ilari Vuokko <ei@xxxxxxxxxxx>**20051129082159] 
[Fix typo in multirepo pull.
Juliusz Chroboczek <jch@xxxxxxxxxxxxxx>**20051217201918] 
[Fix merge conflicts.
Juliusz Chroboczek <jch@xxxxxxxxxxxxxx>**20051217201903] 
[Use POSIX-style option for 'head', instead of obsolescent syntax
Marnix Klooster <marnix.klooster@xxxxxxxxx>**20051216111731] 
[Clarify wording for changes that can't be unreverted
me@xxxxxxxxxxxxxxx**20051216151120] 
[Set attachment filename when sending a patch bundle by e-mail.
Zachary P. Landau <kapheine@xxxxxxxxxxxxxxxxxx>**20051217195009] 
[save long comment file if a test fails during record
Zachary P. Landau <kapheine@xxxxxxxxxxxxxxxxxx>**20051216023948] 
[properly quote paths so that paths with spaces in them are okay
zooko@xxxxxxxxx**20051121195057] 
[fix up debug printouts in cygwin-wrapper.bash
zooko@xxxxxxxxx**20051115011712] 
[smoother invocation of cygwin-wrapper.bash -- it detects fully-qualified path 
to itself by leading /
zooko@xxxxxxxxx**20051115011702] 
[modernize amend-record.pl to be more portable.
Mark Stosberg <mark@xxxxxxxxxxxxxxx>**20050402133417
 
 This depends on the new "echo_to_darcs()" function in Test::Darcs
] 
[add changelog entry for multirepo pull.
David Roundy <droundy@xxxxxxxxx>**20051215122808] 
[implementation of --set-scripts-executable on local darcs get
kow@xxxxxxxx**20051210215122
 proposed fix for issue38
 
 The --set-scripts-executable flag is normally evaluated when you apply
 patches.  But when you do a local darcs get, no patches are applied.
 So as a solution, we traverse the directory on local darcs get , and set
 any script files to be executable. 
 
 Note: one flaw in this patch is that it duplicates the definition of
 what a script is -- a file that starts with #! -- in PatchApply.lhs and
 Get.lhs.  It might be good to refactor these somehow.
 
] 
[extended set-scripts-executable test
kow@xxxxxxxx**20051210200615
 added check for local darcs get (issue 38) as well as initial sanity check
  
] 
[Fix merge conflicts.
Juliusz Chroboczek <jch@xxxxxxxxxxxxxx>**20051214223217] 
[Add --subject flag to 'darcs send'
Joeri van Ruth <jvr@xxxxxxxx>**20051205120301] 
[print out the patch name when a test fails.
Zachary P. Landau <kapheine@xxxxxxxxxxxxxxxxxx>**20051205055109] 
[Fix mistyped /dev/null, fixes --sendmail-command in Windows
Esa Ilari Vuokko <ei@xxxxxxxxxxx>**20051129160120] 
[Use \ as path separator for GnuPG in Windows -- makes apply --verify work
Esa Ilari Vuokko <ei@xxxxxxxxxxx>**20051129164533] 
[make dangers and recommended use of "Amend" clearer in the docs.
Mark Stosberg <mark@xxxxxxxxxxxxxxx>**20051213140523
 
 I think it's important to be clearer about when it's appropriate to use 
'amend',
 so I moved some notes into the short and mid-length help texts.
] 
[update web page to reflect 1.0.5 as latest stable source.
Tommy Pettersson <ptp@xxxxxxxxxxxxxx>**20051213111137] 
[fix handling of absolute paths containing drive letters
Will <will@xxxxxxxxxx>**20051208054737
 This fixes issue 47 where paths containing drive letters (i.e. on windows)
 are not treated as absolute paths.
] 
[bump version to 1.0.6pre1
Tommy Pettersson <ptp@xxxxxxxxxxxxxx>**20051208092839] 
[revert maybe_relink and atomic_create to original C code.
David Roundy <droundy@xxxxxxxxx>**20051208131213] 
[resolve conflicts between stable and unstable.
David Roundy <droundy@xxxxxxxxx>**20051206134818] 
[Merge changes
Ian Lynagh <igloo@xxxxxxxx>**20051008225210] 
[add support for pulling from multiple repositories simultaneously.
David Roundy <droundy@xxxxxxxxx>**20050919125012] 
[fix mkstemp implementation for win32
Peter Strand <peter@xxxxxxxxxx>**20050810211303] 
[Implement parts of System.Posix.(IO|Files) for win32
peter@xxxxxxxxxx**20050809200433] 
[implement RawMode with library functions instead of ffi
peter@xxxxxxxxxx**20050809200148] 
[call hsc2hs without output filename argument
peter@xxxxxxxxxx**20050808220444] 
[Rename compat.c to c_compat.c to avoid object filename conflict with Compat.hs
peter@xxxxxxxxxx**20050731114011] 
[Move atomic_create/sloppy_atomic_create to Compat
Ian Lynagh <igloo@xxxxxxxx>**20050730141703] 
[Split the raw mode stuff out into its own .hsc file. Windows needs some TLC
Ian Lynagh <igloo@xxxxxxxx>**20050730134030] 
[Move maybe_relink out of compat.c
Ian Lynagh <igloo@xxxxxxxx>**20050730131205] 
[Remove is_symlink
Ian Lynagh <igloo@xxxxxxxx>**20050730122255] 
[Move mkstemp to Compat.hs
Ian Lynagh <igloo@xxxxxxxx>**20050730020918] 
[Start Compat.hs, and move stdout_is_a_pipe from compat.c
Ian Lynagh <igloo@xxxxxxxx>**20050730004829] 
[TAG 1.0.5
Tommy Pettersson <ptp@xxxxxxxxxxxxxx>**20051207112730] 
Patch bundle hash:
a2d27672af4cfbfdbcdaf5a6ea3459f9b017353e
_______________________________________________
darcs-devel mailing list
darcs-devel@xxxxxxxxx
http://www.abridgegame.org/cgi-bin/mailman/listinfo/darcs-devel

Try Searching:
servers, voip, java, networking, microsoft ...
<Prev in Thread] Current Thread [Next in Thread>