{-# LANGUAGE ForeignFunctionInterface #-}

-- |
-- Copyright   : Anders Claesson 2013
-- Maintainer  : Anders Claesson <anders.claesson@gmail.com>
--

module Sym.Perm.Sort
    (
      stackSort
    , bubbleSort
    ) where

import Sym.Perm
import Foreign
import Foreign.C.Types
import System.IO.Unsafe

foreign import ccall unsafe "sortop.h stacksort" c_stacksort
    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()

foreign import ccall unsafe "sortop.h bubblesort" c_bubblesort
    :: Ptr CLong -> Ptr CLong -> CLong -> IO ()

marshal :: (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm
marshal :: (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm
marshal Ptr CLong -> Ptr CLong -> CLong -> IO ()
op Perm
w =
    IO Perm -> Perm
forall a. IO a -> a
unsafePerformIO (IO Perm -> Perm)
-> ((Ptr CLong -> IO Perm) -> IO Perm)
-> (Ptr CLong -> IO Perm)
-> Perm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Perm -> (Ptr CLong -> IO Perm) -> IO Perm
forall a. Perm -> (Ptr CLong -> IO a) -> IO a
unsafeWith Perm
w ((Ptr CLong -> IO Perm) -> Perm) -> (Ptr CLong -> IO Perm) -> Perm
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
p -> do
      let n :: Int
n = Perm -> Int
forall a. Size a => a -> Int
size Perm
w
      Int -> (Ptr CLong -> IO ()) -> IO Perm
unsafeNew Int
n ((Ptr CLong -> IO ()) -> IO Perm)
-> (Ptr CLong -> IO ()) -> IO Perm
forall a b. (a -> b) -> a -> b
$ \Ptr CLong
q -> Ptr CLong -> Ptr CLong -> CLong -> IO ()
op Ptr CLong
q Ptr CLong
p (Int -> CLong
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n)
{-# INLINE marshal #-}

-- | One pass of stack-sort.
stackSort :: Perm -> Perm
stackSort :: Perm -> Perm
stackSort = (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm
marshal Ptr CLong -> Ptr CLong -> CLong -> IO ()
c_stacksort
{-# INLINE stackSort #-}

-- | One pass of bubble-sort.
bubbleSort :: Perm -> Perm
bubbleSort :: Perm -> Perm
bubbleSort = (Ptr CLong -> Ptr CLong -> CLong -> IO ()) -> Perm -> Perm
marshal Ptr CLong -> Ptr CLong -> CLong -> IO ()
c_bubblesort
{-# INLINE bubbleSort #-}