the Haskell binding should be more careful with the matching types in C

4 files changed, 42 insertions, 31 deletions

diff --git a/src/runtime/haskell-bind/PGF2/FFI.hs b/src/runtime/haskell-bind/PGF2/FFI.hsc
index 9d73ea9c3..d69722bf7 100644
--- a/src/runtime/haskell-bind/PGF2/FFI.hs
+++ b/src/runtime/haskell-bind/PGF2/FFI.hsc
@@ -2,14 +2,19 @@
 
 module PGF2.FFI where
 
+#include <gu/defs.h>
+#include <gu/hash.h>
+#include <gu/utf8.h>
+#include <pgf/pgf.h>
+
 import Foreign ( alloca, peek, poke )
 import Foreign.C
 import Foreign.Ptr
 import Foreign.ForeignPtr
 import Control.Exception
 import GHC.Ptr
-import Data.Int(Int32)
-import Data.Word(Word,Word8)
+import Data.Int
+import Data.Word
 
 type Touch = IO ()
 
@@ -34,6 +39,11 @@ data GuOut
 data GuSeq
 data GuPool
 type GuVariant = Ptr ()
+type GuHash = (#type GuHash)
+type GuUCS = (#type GuUCS)
+
+type CSizeT = (#type size_t)
+type CUInt8 = (#type uint8_t)
 
 foreign import ccall unsafe fopen :: CString -> CString -> IO (Ptr ())
 
@@ -41,10 +51,10 @@ foreign import ccall unsafe "gu/mem.h gu_new_pool"
   gu_new_pool :: IO (Ptr GuPool)
 
 foreign import ccall unsafe "gu/mem.h gu_malloc"
-  gu_malloc :: Ptr GuPool -> CInt -> IO (Ptr a)
+  gu_malloc :: Ptr GuPool -> CSizeT -> IO (Ptr a)
 
 foreign import ccall unsafe "gu/mem.h gu_malloc_aligned"
-  gu_malloc_aligned :: Ptr GuPool -> CInt -> CInt -> IO (Ptr a)
+  gu_malloc_aligned :: Ptr GuPool -> CSizeT -> CSizeT -> IO (Ptr a)
 
 foreign import ccall unsafe "gu/mem.h gu_pool_free"
   gu_pool_free :: Ptr GuPool -> IO ()
@@ -64,15 +74,15 @@ foreign import ccall unsafe "gu/exn.h gu_exn_caught_"
 foreign import ccall unsafe "gu/exn.h gu_exn_raise_"
   gu_exn_raise :: Ptr GuExn -> CString -> IO (Ptr ())
 
-gu_exn_type_GuErrno = Ptr "GuErrno"# :: CString
+gu_exn_type_GuErrno = Ptr "GuErrno"## :: CString
 
-gu_exn_type_PgfLinNonExist = Ptr "PgfLinNonExist"# :: CString
+gu_exn_type_PgfLinNonExist = Ptr "PgfLinNonExist"## :: CString
 
-gu_exn_type_PgfExn = Ptr "PgfExn"# :: CString
+gu_exn_type_PgfExn = Ptr "PgfExn"## :: CString
 
-gu_exn_type_PgfParseError = Ptr "PgfParseError"# :: CString
+gu_exn_type_PgfParseError = Ptr "PgfParseError"## :: CString
 
-gu_exn_type_PgfTypeError = Ptr "PgfTypeError"# :: CString
+gu_exn_type_PgfTypeError = Ptr "PgfTypeError"## :: CString
 
 foreign import ccall unsafe "gu/string.h gu_string_in"
   gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn)
@@ -93,13 +103,13 @@ foreign import ccall unsafe "gu/string.h gu_string_buf_freeze"
   gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
 
 foreign import ccall unsafe "gu/utf8.h gu_utf8_decode"
-  gu_utf8_decode :: Ptr CString -> IO Int32
+  gu_utf8_decode :: Ptr CString -> IO GuUCS
 
 foreign import ccall unsafe "gu/utf8.h gu_utf8_encode"
-  gu_utf8_encode :: Int32 -> Ptr CString -> IO ()
+  gu_utf8_encode :: GuUCS -> Ptr CString -> IO ()
 
 foreign import ccall unsafe "gu/seq.h gu_make_seq"
-  gu_make_seq :: CInt -> CInt -> Ptr GuPool -> IO (Ptr GuSeq)
+  gu_make_seq :: CSizeT -> CSizeT -> Ptr GuPool -> IO (Ptr GuSeq)
 
 foreign import ccall unsafe "gu/map.h gu_map_find_default"
   gu_map_find_default :: Ptr GuMap -> Ptr a -> IO (Ptr b)
@@ -114,7 +124,7 @@ foreign import ccall unsafe "gu/variant.h gu_variant_data"
   gu_variant_data :: GuVariant -> IO (Ptr a)
 
 foreign import ccall unsafe "gu/variant.h gu_alloc_variant"
-  gu_alloc_variant :: Word8 -> CInt -> CInt -> Ptr GuVariant -> Ptr GuPool -> IO (Ptr a)
+  gu_alloc_variant :: CUInt8 -> CSizeT -> CSizeT -> Ptr GuVariant -> Ptr GuPool -> IO (Ptr a)
 
 
 withGuPool :: (Ptr GuPool -> IO a) -> IO a
@@ -198,6 +208,7 @@ data PgfOracleCallback
 data PgfCncTree
 data PgfLinFuncs
 data PgfGraphvizOptions
+type PgfBindType = (#type PgfBindType)
 
 foreign import ccall "pgf/pgf.h pgf_read"
   pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF)
@@ -254,16 +265,16 @@ foreign import ccall "pgf/pgf.h pgf_lzr_wrap_linref"
   pgf_lzr_wrap_linref :: Ptr PgfCncTree -> Ptr GuPool -> IO (Ptr PgfCncTree)
 
 foreign import ccall "pgf/pgf.h pgf_lzr_linearize_simple"
-  pgf_lzr_linearize_simple :: Ptr PgfConcr -> Ptr PgfCncTree -> CInt -> Ptr GuOut -> Ptr GuExn -> Ptr GuPool -> IO ()
+  pgf_lzr_linearize_simple :: Ptr PgfConcr -> Ptr PgfCncTree -> CSizeT -> Ptr GuOut -> Ptr GuExn -> Ptr GuPool -> IO ()
 
 foreign import ccall "pgf/pgf.h pgf_lzr_linearize"
-  pgf_lzr_linearize :: Ptr PgfConcr -> Ptr PgfCncTree -> CInt -> Ptr (Ptr PgfLinFuncs) -> Ptr GuPool -> IO ()
+  pgf_lzr_linearize :: Ptr PgfConcr -> Ptr PgfCncTree -> CSizeT -> Ptr (Ptr PgfLinFuncs) -> Ptr GuPool -> IO ()
 
 foreign import ccall "pgf/pgf.h pgf_lzr_get_table"
-  pgf_lzr_get_table :: Ptr PgfConcr -> Ptr PgfCncTree -> Ptr CInt -> Ptr (Ptr CString) -> IO ()
+  pgf_lzr_get_table :: Ptr PgfConcr -> Ptr PgfCncTree -> Ptr CSizeT -> Ptr (Ptr CString) -> IO ()
 
 type SymbolTokenCallback = Ptr (Ptr PgfLinFuncs) -> CString -> IO ()
-type PhraseCallback = Ptr (Ptr PgfLinFuncs) -> CString -> CInt -> CInt -> CString -> IO ()
+type PhraseCallback = Ptr (Ptr PgfLinFuncs) -> CString -> CInt -> CSizeT -> CString -> IO ()
 type NonExistCallback = Ptr (Ptr PgfLinFuncs) -> IO ()
 type MetaCallback = Ptr (Ptr PgfLinFuncs) -> CInt -> IO ()
 
@@ -288,12 +299,12 @@ foreign import ccall "pgf/pgf.h pgf_parse_with_heuristics"
 foreign import ccall "pgf/pgf.h pgf_lookup_sentence"
   pgf_lookup_sentence :: Ptr PgfConcr -> PgfType -> CString -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
 
-type LiteralMatchCallback = CInt -> Ptr CInt -> Ptr GuPool -> IO (Ptr PgfExprProb)
+type LiteralMatchCallback = CSizeT -> Ptr CSizeT -> Ptr GuPool -> IO (Ptr PgfExprProb)
 
 foreign import ccall "wrapper"
   wrapLiteralMatchCallback :: LiteralMatchCallback -> IO (FunPtr LiteralMatchCallback)
 
-type LiteralPredictCallback = CInt -> CString -> Ptr GuPool -> IO (Ptr PgfExprProb)
+type LiteralPredictCallback = CSizeT -> CString -> Ptr GuPool -> IO (Ptr PgfExprProb)
 
 foreign import ccall "wrapper"
   wrapLiteralPredictCallback :: LiteralPredictCallback -> IO (FunPtr LiteralPredictCallback)
@@ -304,8 +315,8 @@ foreign import ccall "pgf/pgf.h pgf_new_callbacks_map"
 foreign import ccall
   hspgf_callbacks_map_add_literal :: Ptr PgfConcr -> Ptr PgfCallbacksMap -> CString -> FunPtr LiteralMatchCallback -> FunPtr LiteralPredictCallback -> Ptr GuPool -> IO ()
 
-type OracleCallback = CString -> CString -> CInt -> IO Bool
-type OracleLiteralCallback = CString -> CString -> Ptr CInt -> Ptr GuPool -> IO (Ptr PgfExprProb)
+type OracleCallback = CString -> CString -> CSizeT -> IO Bool
+type OracleLiteralCallback = CString -> CString -> Ptr CSizeT -> Ptr GuPool -> IO (Ptr PgfExprProb)
 
 foreign import ccall "wrapper"
   wrapOracleCallback :: OracleCallback -> IO (FunPtr OracleCallback)
@@ -348,7 +359,7 @@ foreign import ccall "pgf/pgf.h pgf_expr_unapply"
   pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication)
 
 foreign import ccall "pgf/pgf.h pgf_expr_abs"
-  pgf_expr_abs :: CInt -> CString -> PgfExpr -> Ptr GuPool -> IO PgfExpr
+  pgf_expr_abs :: PgfBindType -> CString -> PgfExpr -> Ptr GuPool -> IO PgfExpr
 
 foreign import ccall "pgf/pgf.h pgf_expr_unabs"
   pgf_expr_unabs :: PgfExpr -> IO (Ptr a)
@@ -378,7 +389,7 @@ foreign import ccall "pgf/expr.h pgf_expr_eq"
   pgf_expr_eq :: PgfExpr -> PgfExpr -> IO CInt
 
 foreign import ccall "pgf/expr.h pgf_expr_hash"
-  pgf_expr_hash :: Word -> PgfExpr -> IO Word
+  pgf_expr_hash :: GuHash -> PgfExpr -> IO GuHash
 
 foreign import ccall "pgf/expr.h pgf_expr_size"
   pgf_expr_size :: PgfExpr -> IO CInt
@@ -405,7 +416,7 @@ foreign import ccall "pgf/expr.h pgf_print_expr"
   pgf_print_expr :: PgfExpr -> Ptr PgfPrintContext -> CInt -> Ptr GuOut -> Ptr GuExn -> IO ()
 
 foreign import ccall "pgf/expr.h pgf_print_expr_tuple"
-  pgf_print_expr_tuple :: CInt -> Ptr PgfExpr -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO ()
+  pgf_print_expr_tuple :: CSizeT -> Ptr PgfExpr -> Ptr PgfPrintContext -> Ptr GuOut -> Ptr GuExn -> IO ()
 
 foreign import ccall "pgf/expr.h pgf_print_category"
   pgf_print_category :: Ptr PgfPGF -> CString -> Ptr GuOut -> Ptr GuExn -> IO ()
@@ -423,10 +434,10 @@ foreign import ccall "pgf/expr.h pgf_read_expr"
   pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr
 
 foreign import ccall "pgf/expr.h pgf_read_expr_tuple"
-  pgf_read_expr_tuple :: Ptr GuIn -> CInt -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt
+  pgf_read_expr_tuple :: Ptr GuIn -> CSizeT -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt
 
 foreign import ccall "pgf/expr.h pgf_read_expr_matrix"
-  pgf_read_expr_matrix :: Ptr GuIn -> CInt -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq)
+  pgf_read_expr_matrix :: Ptr GuIn -> CSizeT -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq)
 
 foreign import ccall "pgf/expr.h pgf_read_type"
   pgf_read_type :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfType
@@ -438,4 +449,4 @@ foreign import ccall "pgf/graphviz.h pgf_graphviz_parse_tree"
   pgf_graphviz_parse_tree :: Ptr PgfConcr -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()
 
 foreign import ccall "pgf/graphviz.h pgf_graphviz_word_alignment"
-  pgf_graphviz_word_alignment :: Ptr (Ptr PgfConcr) -> CInt -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()
+  pgf_graphviz_word_alignment :: Ptr (Ptr PgfConcr) -> CSizeT -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()
diff --git a/src/runtime/haskell-bind/PGF2/Internal.hsc b/src/runtime/haskell-bind/PGF2/Internal.hsc
index bd64c358e..f9b4c5331 100644
--- a/src/runtime/haskell-bind/PGF2/Internal.hsc
+++ b/src/runtime/haskell-bind/PGF2/Internal.hsc
@@ -376,7 +376,7 @@ dTyp hypos cat es =
     return (B (Type ptr touch))
   where
     (Builder pool touch) = ?builder
-    n_exprs = fromIntegral (length es) :: CInt
+    n_exprs = fromIntegral (length es) :: CSizeT
 
     pokeHypos ptr []                                    = return ()
     pokeHypos ptr ((bind_type,var,B (Type ty _)):hypos) = do
diff --git a/src/runtime/haskell-bind/PGF2/Type.hsc b/src/runtime/haskell-bind/PGF2/Type.hsc
index ada2b5e03..61e46b4ef 100644
--- a/src/runtime/haskell-bind/PGF2/Type.hsc
+++ b/src/runtime/haskell-bind/PGF2/Type.hsc
@@ -62,7 +62,7 @@ showType scope (Type ty touch) =
 mkType :: [Hypo] -> CId -> [Expr] -> Type
 mkType hypos cat exprs = unsafePerformIO $ do
   typPl  <- gu_new_pool
-  let n_exprs = fromIntegral (length exprs) :: CInt
+  let n_exprs = fromIntegral (length exprs) :: CSizeT
   c_type <- gu_malloc typPl ((#size PgfType) + n_exprs * (#size PgfExpr))
   c_hypos <- gu_make_seq (#size PgfHypo) (fromIntegral (length hypos)) typPl
   hs <- pokeHypos (c_hypos `plusPtr` (#offset GuSeq, data)) hypos typPl
diff --git a/src/runtime/haskell-bind/SG/FFI.hs b/src/runtime/haskell-bind/SG/FFI.hs
index 833e9aab3..ef1b06de8 100644
--- a/src/runtime/haskell-bind/SG/FFI.hs
+++ b/src/runtime/haskell-bind/SG/FFI.hs
@@ -65,10 +65,10 @@ foreign import ccall "sg/sg.h sg_triple_result_close"
   sg_triple_result_close :: Ptr SgTripleResult -> Ptr GuExn -> IO ()
 
 foreign import ccall "sg/sg.h sg_query"
-  sg_query :: Ptr SgSG -> CInt -> Ptr PgfExpr -> Ptr GuExn -> IO (Ptr SgQueryResult)
+  sg_query :: Ptr SgSG -> CSizeT -> Ptr PgfExpr -> Ptr GuExn -> IO (Ptr SgQueryResult)
 
 foreign import ccall "sg/sg.h sg_query_result_columns"
-  sg_query_result_columns :: Ptr SgQueryResult -> IO CInt
+  sg_query_result_columns :: Ptr SgQueryResult -> IO CSizeT
 
 foreign import ccall "sg/sg.h sg_query_result_fetch"
   sg_query_result_fetch :: Ptr SgQueryResult -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt