From 50adbf5cdf9ef6924c47b6738dfd6139d19a0438 Mon Sep 17 00:00:00 2001 From: Jed Barber Date: Mon, 9 Jan 2017 19:55:12 +1100 Subject: Moved old code to separate directory --- src/Storage.hs.old | 73 --------------------------- src/preference_arrays.adb.old | 114 ------------------------------------------ src/preference_arrays.ads.old | 38 -------------- src/testmain.hs.old | 21 -------- 4 files changed, 246 deletions(-) delete mode 100644 src/Storage.hs.old delete mode 100644 src/preference_arrays.adb.old delete mode 100644 src/preference_arrays.ads.old delete mode 100644 src/testmain.hs.old (limited to 'src') diff --git a/src/Storage.hs.old b/src/Storage.hs.old deleted file mode 100644 index 2697c39..0000000 --- a/src/Storage.hs.old +++ /dev/null @@ -1,73 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - -module Storage( - PrefStorage, - createStorage, - pokePref, - peekPref - ) where - - - - -import Foreign -import Foreign.C - - - - -foreign import ccall "create_pref_array" - c_createPrefArray :: CInt -> CInt -> IO (Ptr PrefArray) - -foreign import ccall "free_pref_array" - c_freePrefArray :: CInt -> CInt -> Ptr PrefArray -> IO () - -foreign import ccall "wrapper" - wrap :: (Ptr PrefArray -> IO ()) -> IO (FunPtr (Ptr PrefArray -> IO ())) - -foreign import ccall "poke_pref_array" - c_pokePrefArray :: CInt -> CInt -> Ptr PrefArray -> CInt -> CInt -> CInt -> IO () - -foreign import ccall "peek_pref_array" - c_peekPrefArray :: CInt -> CInt -> Ptr PrefArray -> CInt -> CInt -> CInt -> IO CInt - - - - -newtype PrefArray = PrefArray (Ptr PrefArray) - -data PrefStorage = PrefStorage { pointer :: ForeignPtr PrefArray - , numBallots :: Int - , sizeOfBallot :: Int } - - - - -createStorage :: Int -> Int -> IO PrefStorage -createStorage n s = do - x <- c_createPrefArray (fromIntegral n) (fromIntegral s) - f <- wrap (c_freePrefArray (fromIntegral n) (fromIntegral s)) - y <- newForeignPtr f x - return (PrefStorage y n s) - - - - -pokePref :: PrefStorage -> Int -> Int -> Int -> IO () -pokePref p n s r = do - let numBal = fromIntegral (numBallots p) - sizeBal = fromIntegral (sizeOfBallot p) - func a = c_pokePrefArray numBal sizeBal a (fromIntegral n) (fromIntegral s) (fromIntegral r) - withForeignPtr (pointer p) func - - - - -peekPref :: PrefStorage -> Int -> Int -> Int -> IO Bool -peekPref p n s r = do - let numBal = fromIntegral (numBallots p) - sizeBal = fromIntegral (sizeOfBallot p) - func a = c_peekPrefArray numBal sizeBal a (fromIntegral n) (fromIntegral s) (fromIntegral r) - result <- withForeignPtr (pointer p) func - return (result /= 0) - diff --git a/src/preference_arrays.adb.old b/src/preference_arrays.adb.old deleted file mode 100644 index 0b1218a..0000000 --- a/src/preference_arrays.adb.old +++ /dev/null @@ -1,114 +0,0 @@ - - -with Ada.Unchecked_Deallocation; -with System.Address_To_Access_Conversions; - - -package body Preference_Arrays is - - - type Ranking is range 1 .. 255; - - type Preference_Array is array (Positive range <>, Positive range <>) of Ranking; - pragma Pack (Preference_Array); - - - - - -- these following functions would be a lot smaller and neater - -- if the FFI could make use of fat pointers - - - - - function Create_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int) - return System.Address - is - subtype Constrained is Preference_Array - (1 .. Positive (Number_Of_Ballots), - 1 .. Positive (Size_Of_Ballot)); - - package Convert is new System.Address_To_Access_Conversions - (Object => Constrained); - - Pref_Array : Convert.Object_Pointer; - begin - Pref_Array := new Preference_Array - (1 .. Positive (Number_Of_Ballots), - 1 .. Positive (Size_Of_Ballot)); - return Convert.To_Address (Pref_Array); - end Create_Preference_Array; - - - - - procedure Free_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int; - Pref_Array_Address : in System.Address) - is - subtype Constrained is Preference_Array - (1 .. Positive (Number_Of_Ballots), - 1 .. Positive (Size_Of_Ballot)); - - package Convert is new System.Address_To_Access_Conversions - (Object => Constrained); - procedure Free_Pref_Array is new Ada.Unchecked_Deallocation - (Object => Constrained, Name => Convert.Object_Pointer); - - Pref_Array : Convert.Object_Pointer; - begin - Pref_Array := Convert.To_Pointer (Pref_Array_Address); - Free_Pref_Array (Pref_Array); - end Free_Preference_Array; - - - - - procedure Poke_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int; - Pref_Array_Address : in System.Address; - Ballot_Index, Box_Number, Rank : in Interfaces.C.int) - is - subtype Constrained is Preference_Array - (1 .. Positive (Number_Of_Ballots), - 1 .. Positive (Size_Of_Ballot)); - - package Convert is new System.Address_To_Access_Conversions - (Object => Constrained); - - Pref_Array : Convert.Object_Pointer; - begin - Pref_Array := Convert.To_Pointer (Pref_Array_Address); - Pref_Array (Positive (Ballot_Index), Positive (Box_Number)) := Ranking (Rank); - end Poke_Preference_Array; - - - - - function Peek_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int; - Pref_Array_Address : in System.Address; - Ballot_Index, Box_Number, Rank : in Interfaces.C.int) - return Interfaces.C.int - is - subtype Constrained is Preference_Array - (1 .. Positive (Number_Of_Ballots), - 1 .. Positive (Size_Of_Ballot)); - - package Convert is new System.Address_To_Access_Conversions - (Object => Constrained); - - Pref_Array : Convert.Object_Pointer; - begin - Pref_Array := Convert.To_Pointer (Pref_Array_Address); - if Pref_Array (Positive (Ballot_Index), Positive (Box_Number)) = Ranking (Rank) then - return 1; - else - return 0; - end if; - end Peek_Preference_Array; - - -end Preference_Arrays; - diff --git a/src/preference_arrays.ads.old b/src/preference_arrays.ads.old deleted file mode 100644 index c8245e0..0000000 --- a/src/preference_arrays.ads.old +++ /dev/null @@ -1,38 +0,0 @@ - - -with Interfaces.C; -with System; - - -package Preference_Arrays is - - - function Create_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int) - return System.Address; - pragma Export (C, Create_Preference_Array, "create_pref_array"); - - - procedure Free_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int; - Pref_Array_Address : in System.Address); - pragma Export (C, Free_Preference_Array, "free_pref_array"); - - - procedure Poke_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int; - Pref_Array_Address : in System.Address; - Ballot_Index, Box_Number, Rank : in Interfaces.C.int); - pragma Export (C, Poke_Preference_Array, "poke_pref_array"); - - - function Peek_Preference_Array - (Number_Of_Ballots, Size_Of_Ballot : in Interfaces.C.int; - Pref_Array_Address : in System.Address; - Ballot_Index, Box_Number, Rank : in Interfaces.C.int) - return Interfaces.C.int; - pragma Export (C, Peek_Preference_Array, "peek_pref_array"); - - -end Preference_Arrays; - diff --git a/src/testmain.hs.old b/src/testmain.hs.old deleted file mode 100644 index 3f340c2..0000000 --- a/src/testmain.hs.old +++ /dev/null @@ -1,21 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} - - - -import qualified Storage as Store - - - -foreign import ccall adainit :: IO Int -foreign import ccall adafinal :: IO Int - - - -main = do - adainit - s <- Store.createStorage 10 5 - Store.pokePref s 1 2 3 - r <- Store.peekPref s 1 2 3 - putStrLn (show r) - adafinal - -- cgit