From 1652e49e17e4f4dead4bd23694a2b99a06048023 Mon Sep 17 00:00:00 2001
From: Jed Barber <jjbarber@y7mail.com>
Date: Sun, 8 Jan 2017 22:46:29 +1100
Subject: Moved nonworking code to the side
---
src/Storage.hs | 73 ---------------------------
src/Storage.hs.old | 73 +++++++++++++++++++++++++++
src/preference_arrays.adb | 114 ------------------------------------------
src/preference_arrays.adb.old | 114 ++++++++++++++++++++++++++++++++++++++++++
src/preference_arrays.ads | 38 --------------
src/preference_arrays.ads.old | 38 ++++++++++++++
src/testmain.hs | 21 --------
src/testmain.hs.old | 21 ++++++++
8 files changed, 246 insertions(+), 246 deletions(-)
delete mode 100644 src/Storage.hs
create mode 100644 src/Storage.hs.old
delete mode 100644 src/preference_arrays.adb
create mode 100644 src/preference_arrays.adb.old
delete mode 100644 src/preference_arrays.ads
create mode 100644 src/preference_arrays.ads.old
delete mode 100644 src/testmain.hs
create mode 100644 src/testmain.hs.old
(limited to 'src')
diff --git a/src/Storage.hs b/src/Storage.hs
deleted file mode 100644
index 2697c39..0000000
--- a/src/Storage.hs
+++ /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/Storage.hs.old b/src/Storage.hs.old
new file mode 100644
index 0000000..2697c39
--- /dev/null
+++ b/src/Storage.hs.old
@@ -0,0 +1,73 @@
+{-# 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 b/src/preference_arrays.adb
deleted file mode 100644
index 0b1218a..0000000
--- a/src/preference_arrays.adb
+++ /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.adb.old b/src/preference_arrays.adb.old
new file mode 100644
index 0000000..0b1218a
--- /dev/null
+++ b/src/preference_arrays.adb.old
@@ -0,0 +1,114 @@
+
+
+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 b/src/preference_arrays.ads
deleted file mode 100644
index c8245e0..0000000
--- a/src/preference_arrays.ads
+++ /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/preference_arrays.ads.old b/src/preference_arrays.ads.old
new file mode 100644
index 0000000..c8245e0
--- /dev/null
+++ b/src/preference_arrays.ads.old
@@ -0,0 +1,38 @@
+
+
+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 b/src/testmain.hs
deleted file mode 100644
index 3f340c2..0000000
--- a/src/testmain.hs
+++ /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
-
diff --git a/src/testmain.hs.old b/src/testmain.hs.old
new file mode 100644
index 0000000..3f340c2
--- /dev/null
+++ b/src/testmain.hs.old
@@ -0,0 +1,21 @@
+{-# 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