diff options
Diffstat (limited to 'src/runtime/haskell-bind')
| -rw-r--r-- | src/runtime/haskell-bind/CId.hs | 56 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/CRuntimeFFI.hsc | 294 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/Gu.hsc | 122 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/PgfLow.hs | 148 | ||||
| -rw-r--r-- | src/runtime/haskell-bind/README | 32 |
5 files changed, 652 insertions, 0 deletions
diff --git a/src/runtime/haskell-bind/CId.hs b/src/runtime/haskell-bind/CId.hs new file mode 100644 index 000000000..74db63c2c --- /dev/null +++ b/src/runtime/haskell-bind/CId.hs @@ -0,0 +1,56 @@ +module CId (CId(..), + mkCId, wildCId, + readCId, showCId, + + -- utils + pCId, pIdent, ppCId) where + +import Control.Monad +import qualified Data.ByteString.Char8 as BS +import Data.Char +import qualified Text.ParserCombinators.ReadP as RP +import qualified Text.PrettyPrint as PP + + + +-- | An abstract data type that represents +-- identifiers for functions and categories in PGF. +newtype CId = CId BS.ByteString deriving (Eq,Ord) + +wildCId :: CId +wildCId = CId (BS.singleton '_') + +-- | Creates a new identifier from 'String' +mkCId :: String -> CId +mkCId s = CId (BS.pack s) + +-- | Reads an identifier from 'String'. The function returns 'Nothing' if the string is not valid identifier. +readCId :: String -> Maybe CId +readCId s = case [x | (x,cs) <- RP.readP_to_S pCId s, all isSpace cs] of + [x] -> Just x + _ -> Nothing + +-- | Renders the identifier as 'String' +showCId :: CId -> String +showCId (CId x) = BS.unpack x + +instance Show CId where + showsPrec _ = showString . showCId + +instance Read CId where + readsPrec _ = RP.readP_to_S pCId + +pCId :: RP.ReadP CId +pCId = do s <- pIdent + if s == "_" + then RP.pfail + else return (mkCId s) + +pIdent :: RP.ReadP String +pIdent = liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest) + where + isIdentFirst c = c == '_' || isLetter c + isIdentRest c = c == '_' || c == '\'' || isAlphaNum c + +ppCId :: CId -> PP.Doc +ppCId = PP.text . showCId diff --git a/src/runtime/haskell-bind/CRuntimeFFI.hsc b/src/runtime/haskell-bind/CRuntimeFFI.hsc new file mode 100644 index 000000000..f1ee62db5 --- /dev/null +++ b/src/runtime/haskell-bind/CRuntimeFFI.hsc @@ -0,0 +1,294 @@ +{-# LANGUAGE ForeignFunctionInterface, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-} +#include <pgf/pgf.h> +#include <gu/enum.h> +#include <gu/exn.h> + +module CRuntimeFFI where + +import Prelude hiding (fromEnum) +import Control.Monad +import System.IO +import System.IO.Unsafe +import CId (CId(..), + mkCId, wildCId, + readCId, showCId) +import Gu +import PgfLow + +import Foreign hiding ( Pool, newPool, unsafePerformIO ) +import Foreign.C +import Foreign.C.String +import Foreign.Ptr + + +import Data.Char +import qualified Data.ByteString as BS +import Data.IORef + + +----------------------------------------------------------------------------- +-- How to compile +-- hsc2hs Gu.hsc CRuntimeFFI.hsc -v --cflag="-std=c99" && ghc -lpgf -lgu --make CRuntimeFFI +----------------------------------------------------------------------------- +-- Mindless copypasting and translating of the C functions in Gu.hsc and PgfLow.hs +-- More user-friendly functions here + +----------------------------------------------------------------------------- +--Memory management, pools and outs +type Pool = ForeignPtr GuPool +type Out = (Ptr GuStringBuf, Ptr GuOut) + + +newPool :: IO Pool +newPool = + do pl <- gu_new_pool + newForeignPtr_ pl --gu_pool_free_ptr pl + +--when you create a GuOut, you create also a GuStringBuf +--and when you give GuOut to a function that outputs something, +--the result goes into that GuStringBuf +newOut :: Pool -> IO Out +newOut pool = + do sb <- withForeignPtr pool $ \pl -> gu_string_buf pl + out <- gu_string_buf_out sb + return (sb,out) + +----------------------------------------------------------------------------- +-- Functions that take a PGF. +-- PGF has many Concrs. +-- A Concr retains its PGF in a field (memory management reasons?) + +data PGF = PGF {pgfPool :: Pool, pgf :: Ptr PgfPGF} deriving Show +data Concr = Concr {concr :: (Ptr PgfConcr), concrMaster :: PGF} +type Language = CId + +readPGF :: String -> IO PGF +readPGF filepath = + do pool <- newPool + pgf <- withCString filepath $ \file -> + withForeignPtr pool $ \pl -> + pgf_read file pl nullPtr + out <- newOut pool + return PGF {pgfPool = pool, pgf = pgf} + + +getConcr :: PGF -> Language -> Concr +getConcr p (CId lang) = unsafePerformIO $ + BS.useAsCString lang $ \lng -> do + cnc <- pgf_get_language (pgf p) lng + return (Concr cnc p) + + + +-- languages :: PGF -> [Concr] +-- languages p = undefined +--TODO +-- void pgf_iter_languages(PgfPGF* pgf, GuMapItor* fn, GuExn* err) +-- { +-- gu_map_iter(pgf->concretes, fn, err); +-- } + +generateAll :: PGF -> CId -> [(Tree,Float)] +generateAll p (CId cat) = unsafePerformIO $ + do pool <- newPool + (sb,out) <- newOut pool + pgfExprs <- BS.useAsCString cat $ \cat -> + withForeignPtr pool $ \pl -> + pgf_generate_all (pgf p) cat pl + fromPgfExprEnum pgfExprs pool p + +abstractName :: PGF -> Language +abstractName p = unsafePerformIO $ fmap CId (BS.packCString =<< pgf_abstract_name (pgf p)) + +startCat :: PGF -> CId +startCat p = unsafePerformIO $ fmap CId (BS.packCString =<< pgf_start_cat (pgf p)) + +printGrammar :: PGF -> Pool -> String +printGrammar p pool = unsafePerformIO $ + do (sb,out) <- newOut pool + pgf_print (pgf p) out nullPtr + grammar <- withForeignPtr pool $ \pl -> + gu_string_buf_freeze sb pl + peekCString grammar + + +----------------------------------------------------------------------------- +-- Expressions + +--exprMaster is one of the following: +-- * PGF +-- * pool from which the expr is allocated +-- * iterator from generateAll +-- TODO ask more about this design +-- the master of an Expr needs to be retained because of memory management (?) +data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a} + +instance Show Expr where + show = showExpr + +instance Eq Expr where + (Expr e1 m1) == (Expr e2 m2) = e1 == e2 + +type Tree = Expr + + +unApp :: Expr -> Maybe (CId,[Expr]) +unApp (Expr expr master) = unsafePerformIO $ + do pl <- gu_new_pool + pgfAppl <- pgf_expr_unapply expr pl + if pgfAppl == nullPtr + then do + gu_pool_free pl + return Nothing + else do + fun <- peekCString =<< (#peek PgfApplication, fun) pgfAppl + arity <- (#peek PgfApplication, n_args) pgfAppl :: IO CInt + pgfExprs <- ptrToList pgfAppl (fromIntegral arity) --CInt to Int + + --print (arity,fun) + + let args = [Expr a master | a<-pgfExprs] + gu_pool_free pl + return $ Just (mkCId fun, args) + +--Krasimir recommended not to use PgfApplication, but PgfExprApp instead. +--but then we found out that some of those functions don't behave nicely +--with the FFI, so we need to use PgfApplication anyway, unless we do some +--C coding to make the C library nicer. + + + +readExpr :: String -> Maybe Expr +readExpr str = unsafePerformIO $ + do exprPool <- newPool + tmpPool <- newPool + withCString str $ \str -> + withForeignPtr exprPool $ \pool -> + withForeignPtr tmpPool $ \tmppool -> + do guin <- gu_string_in str tmppool + exn <- gu_new_exn nullPtr gu_type__type tmppool + pgfExpr <- pgf_read_expr guin pool exn + status <- gu_exn_is_raised exn + if (status==False && pgfExpr /= nullPtr) + then return $ Just (Expr pgfExpr pool) + else return Nothing + +showExpr :: Expr -> String +showExpr e = unsafePerformIO $ + do pool <- newPool + tmpPool <- newPool + (sb,out) <- newOut pool + let printCtxt = nullPtr + exn <- withForeignPtr tmpPool $ \tmppool -> + gu_new_exn nullPtr gu_type__type tmppool + pgf_print_expr (expr e) printCtxt 1 out exn + abstree <- withForeignPtr pool $ \pl -> + gu_string_buf_freeze sb pl + peekCString abstree + + +----------------------------------------------------------------------------- +-- Functions using Concr +-- Morpho analyses, parsing & linearization + +type MorphoAnalysis = (CId,String,Float) + + +--There is no buildMorpho in the C library, just a lookupMorpho from a Concr +lookupMorpho :: Concr -> String -> [MorphoAnalysis] +lookupMorpho (Concr concr master) sent = unsafePerformIO $ + do ref <- newIORef [] + allocaBytes (#size PgfMorphoCallback) $ \cback -> + do fptr <- wrapLookupMorpho (getAnalysis ref) + (#poke PgfMorphoCallback, callback) cback fptr + withCString sent $ \sent -> + pgf_lookup_morpho concr sent cback nullPtr + + readIORef ref + where + getAnalysis :: IORef [MorphoAnalysis] -> Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO () --IORef [(CId, String, Float)] -> Callback + getAnalysis ref self clemma canal prob exn = do + ans <- readIORef ref + lemma <- fmap CId (BS.packCString clemma) + anal <- peekCString canal + writeIORef ref ((lemma, anal, prob):ans) + + +fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])] +fullFormLexicon lang = + let lexicon = fullformLexicon' lang + analyses = map (lookupMorpho lang) lexicon + in zip lexicon analyses + where fullformLexicon' :: Concr -> [String] + fullformLexicon' lang = unsafePerformIO $ + do pool <- newPool + lexEnum <- withForeignPtr pool $ \pl -> + pgf_fullform_lexicon (concr lang) pl + fromFullFormEntry lexEnum pool (concrMaster lang) + +printLexEntry :: (String, [MorphoAnalysis]) -> String +printLexEntry (lemma, anals) = + "Lemma: " ++ lemma ++ "\nAnalyses: " ++ show anals ++ "\n" -- map show' anals +-- where show' :: MorphoAnalysis -> String +-- show' (id,anal,prob) = showCId id ++ ", " ++ anal ++ ", " ++ show prob ++ "\n" + + +--Note: unlike in Haskell library, we give Concr -> ... and not PGF -> Lang -> ... +--Also this returns a list of tuples (tree,prob) instead of just trees +parse :: Concr -> CId -> String -> [(Tree,Float)] +parse (Concr lang master) (CId cat) sent = unsafePerformIO $ + do inpool <- newPool + outpool <- newPool + treesEnum <- parse_ lang cat sent inpool outpool + fromPgfExprEnum treesEnum inpool master + where + parse_ :: Ptr PgfConcr -> BS.ByteString -> String -> Pool -> Pool -> IO (Ptr PgfExprEnum) + parse_ pgfcnc cat sent inpool outpool = + do BS.useAsCString cat $ \cat -> + withCString sent $ \sent -> + withForeignPtr inpool $ \pl1 -> + withForeignPtr outpool $ \pl2 -> + pgf_parse pgfcnc cat sent nullPtr pl1 pl2 + +--In Haskell library, this function has type signature PGF -> Language -> Tree -> String +--Here we replace PGF -> Language with Concr +linearize :: Concr -> Tree -> String +linearize lang tree = unsafePerformIO $ + do pool <- newPool + (stringbuf,out) <- newOut pool + pgf_linearize (concr lang) (expr tree) out nullPtr --linearization goes to stringbuf + lin <- withForeignPtr pool $ \pl -> + gu_string_buf_freeze stringbuf pl + peekCString lin + + + +----------------------------------------------------------------------------- +-- Helper functions + +-- # syntax: http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/hsc2hs.html +fromPgfExprEnum :: Ptr PgfExprEnum -> Pool -> a -> IO [(Tree, Float)] +fromPgfExprEnum enum pool master = + do pgfExprProb <- alloca $ \ptr -> + withForeignPtr pool $ \pl -> + do gu_enum_next enum ptr pl + peek ptr + if pgfExprProb == nullPtr + then return [] + else do expr <- (#peek PgfExprProb, expr) pgfExprProb + prob <- (#peek PgfExprProb, prob) pgfExprProb + ts <- unsafeInterleaveIO (fromPgfExprEnum enum pool master) + return ((Expr expr master,prob) : ts) + +fromFullFormEntry :: Ptr GuEnum -> Pool -> PGF -> IO [String] +fromFullFormEntry enum pool master = + do ffEntry <- alloca $ \ptr -> + withForeignPtr pool $ \pl -> + do gu_enum_next enum ptr pl + peek ptr +-- ffEntry :: Ptr PgfFullFormEntry + if ffEntry == nullPtr + then return [] + else do tok <- peekCString =<< pgf_fullform_get_string ffEntry + toks <- unsafeInterleaveIO (fromFullFormEntry enum pool master) + return (tok : toks)
\ No newline at end of file diff --git a/src/runtime/haskell-bind/Gu.hsc b/src/runtime/haskell-bind/Gu.hsc new file mode 100644 index 000000000..e9d060c92 --- /dev/null +++ b/src/runtime/haskell-bind/Gu.hsc @@ -0,0 +1,122 @@ +{-# LANGUAGE ForeignFunctionInterface #-} +#include <pgf/pgf.h> +#include <gu/enum.h> +#include <gu/exn.h> + +module Gu where + +import Foreign +import Foreign.C +import Foreign.C.String +import Foreign.Ptr + + +data GuEnum +data GuExn +data GuIn +data GuInStream +data GuKind +data GuString +data GuStringBuf +data GuMapItor +data GuOut +data GuOutStream +data GuPool + +data PgfPGF +data PgfApplication +data PgfConcr +type PgfExpr = Ptr () +data PgfExprEnum +data PgfExprProb +data PgfFullFormEntry +data PgfMorphoCallback +data PgfPrintContext +data PgfType +data PgfLexer + +------------------------------------------------------------------------------ +-- Mindless copypasting and translating of the C functions used in CRuntimeFFI +-- GU stuff + + + +foreign import ccall "gu/mem.h gu_new_pool" + gu_new_pool :: IO (Ptr GuPool) + +foreign import ccall "gu/mem.h gu_pool_free" + gu_pool_free :: Ptr GuPool -> IO () + +foreign import ccall "gu/mem.h &gu_pool_free" + gu_pool_free_ptr :: FunPtr (Ptr GuPool -> IO ()) + +foreign import ccall "gu/exn.h gu_new_exn" + gu_new_exn :: Ptr GuExn -> Ptr GuKind -> Ptr GuPool -> IO (Ptr GuExn) + +foreign import ccall "gu/exn.h gu_exn_is_raised" + gu_exn_is_raised :: Ptr GuExn -> IO Bool +-- gu_ok exn = do +-- state <- (#peek GuExn, state) exn +-- return (state /= GU_EXN_RAISED) + +foreign import ccall "gu/type.h &gu_type__type" + gu_type__type :: Ptr GuKind + + +--GuIn* gu_string_in(GuString string, GuPool* pool); +foreign import ccall "gu/string.h gu_string_in" + gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn) + +--GuStringBuf* gu_string_buf(GuPool* pool); +foreign import ccall "gu/string.h gu_string_buf" + gu_string_buf :: Ptr GuPool -> IO (Ptr GuStringBuf) + +--GuOut* gu_string_buf_out(GuStringBuf* sb); +foreign import ccall "gu/string.h gu_string_buf_out" + gu_string_buf_out :: Ptr GuStringBuf -> IO (Ptr GuOut) + + +--void gu_enum_next(GuEnum* en, void* to, GuPool* pool) +foreign import ccall "gu/enum.h gu_enum_next" + gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO () + + +--GuString gu_string_buf_freeze(GuStringBuf* sb, GuPool* pool); +foreign import ccall "gu/string.h gu_string_buf_freeze" + gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString + +{- +typedef struct PgfMorphoCallback PgfMorphoCallback; +struct PgfMorphoCallback { + void (*callback)(PgfMorphoCallback* self, + PgfCId lemma, GuString analysis, prob_t prob, + GuExn* err); +}; +--allocate this type of structure in haskell +--make a function and do Something +-} + +{- Not used +--GuIn* gu_new_in(GuInStream* stream, GuPool* pool); +foreign import ccall "gu/in.h gu_new_in" + gu_new_in :: Ptr GuInStream -> Ptr GuPool -> Ptr GuIn + +--GuOut* gu_new_out(GuOutStream* stream, GuPool* pool); +foreign import ccall "gu/mem.h gu_new_out" + gu_new_out :: Ptr GuOutStream -> Ptr GuPool -> IO (Ptr GuOut) +--TODO no idea how to get a GuOutStream + +--GuOut* gu_file_out(FILE* file, GuPool* pool); +foreign import ccall "gu/file.h gu_file_out" + gu_file_out :: Ptr CString -> Ptr GuPool -> IO (Ptr GuOut) -} + + +--Pointer magic here, using plusPtr etc. +ptrToList :: Ptr PgfApplication -> Int -> IO [PgfExpr] +ptrToList appl arity = do + let ptr = appl `plusPtr` (#offset PgfApplication, args) --args is not an argument, it's the actual field name + sequence [peek (ptr `plusPtr` (i * (#size PgfExpr))) | i<-[0..arity-1]] + + + + diff --git a/src/runtime/haskell-bind/PgfLow.hs b/src/runtime/haskell-bind/PgfLow.hs new file mode 100644 index 000000000..dc53baeb0 --- /dev/null +++ b/src/runtime/haskell-bind/PgfLow.hs @@ -0,0 +1,148 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module PgfLow where + +import Foreign.C +import Foreign.C.String +import Foreign.Ptr +import Gu + +------------------------------------------------------------------------------ +-- Mindless copypasting and translating of the C functions used in CRuntimeFFI +-- From pgf.h + + + +-- PgfPGF* pgf_read(const char* fpath, GuPool* pool, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_read" + pgf_read :: CString -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfPGF) + +-- GuString pgf_abstract_name(PgfPGF*); +foreign import ccall "pgf/pgf.h pgf_abstract_name" + pgf_abstract_name :: Ptr PgfPGF -> IO CString + +-- void pgf_iter_languages(PgfPGF*, GuMapItor*, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_iter_languages" + pgf_iter_languages :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO () +-- TODO test this function +-- GuMapItor??? +-- implement a fun in haskell, export it to c +-- GuMapItor contains a pointer to a function +-- Ask Koen +-- foreign export + +-- PgfConcr* pgf_get_language(PgfPGF*, PgfCId lang); +foreign import ccall "pgf/pgf.h pgf_get_language" + pgf_get_language :: Ptr PgfPGF -> CString -> IO (Ptr PgfConcr) + + +-- GuString pgf_concrete_name(PgfConcr*); +foreign import ccall "pgf/pgf.h pgf_concrete_name" + pgf_concrete_name :: Ptr PgfConcr -> IO CString + +-- GuString pgf_language_code(PgfConcr* concr); +foreign import ccall "pgf/pgf.h pgf_language_code" + pgf_language_code :: Ptr PgfConcr -> IO CString + + +--void pgf_iter_categories(PgfPGF* pgf, GuMapItor* fn, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_iter_categories" + pgf_iter_categories :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO () +--TODO test this function + +-- PgfCId pgf_start_cat(PgfPGF* pgf, GuPool* pool); +foreign import ccall "pgf/pgf.h pgf_start_cat" + pgf_start_cat :: Ptr PgfPGF -> IO CString + +-- void pgf_iter_functions(PgfPGF* pgf, GuMapItor* fn, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_iter_functions" + pgf_iter_functions :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO () +--TODO test this function + +-- void pgf_iter_functions_by_cat(PgfPGF* pgf, PgfCId catname, +-- GuMapItor* fn, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_iter_functions_by_cat" + pgf_iter_functions_by_cat :: Ptr PgfPGF -> Ptr GuMapItor -> Ptr GuExn -> IO () +--TODO test this function + +-- PgfType* pgf_function_type(PgfPGF* pgf, PgfCId funname); +foreign import ccall "pgf/pgf.h pgf_function_type" + pgf_function_type :: Ptr PgfPGF -> CString -> IO (Ptr PgfType) + +-- GuString pgf_print_name(PgfConcr*, PgfCId id); +foreign import ccall "pgf/pgf.h pgf_print_name" + pgf_print_name :: Ptr PgfConcr -> CString -> IO CString + +--void pgf_linearize(PgfConcr* concr, PgfExpr expr, GuOut* out, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_linearize" + pgf_linearize :: Ptr PgfConcr -> PgfExpr -> Ptr GuOut -> Ptr GuExn -> IO () + +-- PgfExprEnum* pgf_parse(PgfConcr* concr, PgfCId cat, GuString sentence, +-- GuExn* err, GuPool* pool, GuPool* out_pool); +foreign import ccall "pgf/pgf.h pgf_parse" + pgf_parse :: Ptr PgfConcr -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr PgfExprEnum) + +--void pgf_lookup_morpho(PgfConcr *concr, GuString sentence, +-- PgfMorphoCallback* callback, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_lookup_morpho" + pgf_lookup_morpho :: Ptr PgfConcr -> CString -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO () + +type Callback = Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO () + +foreign import ccall "wrapper" + wrapLookupMorpho :: Callback -> IO (FunPtr Callback) + + +--GuEnum* pgf_fullform_lexicon(PgfConcr *concr, GuPool* pool); +foreign import ccall "pgf/pgf.h pgf_fullform_lexicon" + pgf_fullform_lexicon :: Ptr PgfConcr -> Ptr GuPool -> IO (Ptr GuEnum) + +--GuString pgf_fullform_get_string(PgfFullFormEntry* entry); +foreign import ccall "pgf/pgf.h pgf_fullform_get_string" + pgf_fullform_get_string :: Ptr PgfFullFormEntry -> IO CString + +-- void pgf_fullform_get_analyses(PgfFullFormEntry* entry, +-- PgfMorphoCallback* callback, GuExn* err) +foreign import ccall "pgf/pgf.h pgf_fullform_get_analyses" + pgf_fullform_get_analyses :: Ptr PgfFullFormEntry -> Ptr PgfMorphoCallback -> Ptr GuExn -> IO () + + +--PgfApplication* pgf_expr_unapply(PgfExpr expr, GuPool* pool); +foreign import ccall "pgf/pgf.h pgf_expr_unapply" + pgf_expr_unapply :: PgfExpr -> Ptr GuPool -> IO (Ptr PgfApplication) + +--int pgf_expr_arity(PgfExpr expr); +foreign import ccall "pgf/expr.h pgf_expr_arity" + pgf_expr_arity :: PgfExpr -> IO Int +--Not needed anymore, solved the problem with unapply using CInt instead of Int + + +--void pgf_print_expr(PgfExpr expr, PgfPrintContext* ctxt, int prec, +-- GuOut* out, GuExn* err); +foreign import ccall "pgf/expr.h pgf_print_expr" + pgf_print_expr :: PgfExpr -> Ptr PgfPrintContext -> Int -> Ptr GuOut -> Ptr GuExn -> IO () +--PgfExprEnum* pgf_generate_all(PgfPGF* pgf, PgfCId cat, GuPool* pool); +foreign import ccall "pgf/pgf.h pgf_generate_all" + pgf_generate_all :: Ptr PgfPGF -> CString -> Ptr GuPool -> IO (Ptr PgfExprEnum) + +-- void pgf_print(PgfPGF* pgf, GuOut* out, GuExn* err); +foreign import ccall "pgf/pgf.h pgf_print" + pgf_print :: Ptr PgfPGF -> Ptr GuOut -> Ptr GuExn -> IO () + +--PgfExpr pgf_read_expr(GuIn* in, GuPool* pool, GuExn* err); +foreign import ccall "pgf/expr.h pgf_read_expr" + pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr + +--PgfExprEnum* +--pgf_parse_with_heuristics(PgfConcr* concr, PgfCId cat, PgfLexer *lexer, +-- double heuristics, +-- GuPool* pool, GuPool* out_pool); +-- Not needed + +-- GuEnum* pgf_complete(PgfConcr* concr, PgfCId cat, PgfLexer *lexer, +-- GuString prefix, GuPool* pool); +-- TODO + +-- bool pgf_parseval(PgfConcr* concr, PgfExpr expr, PgfCId cat, +-- double *precision, double *recall, double *exact); +-- Not needed diff --git a/src/runtime/haskell-bind/README b/src/runtime/haskell-bind/README new file mode 100644 index 000000000..64b6b7276 --- /dev/null +++ b/src/runtime/haskell-bind/README @@ -0,0 +1,32 @@ +This is a work in progress, but usable as it is now. +Some memory leaks and segfaults to be expected. + + +The files are + +CRuntimeFFI.hsc -- user-friendly functions, almost the same as in the real Haskell PGF library. +Gu.hsc -- mindlessly copypasted functions from various files in gu/ +PgfLow.hs -- mindlessly copypasted functions from various files in pgf/ + +The first two files (.hsc) use some special constructions for accessing C objects from Haskell. +See the syntax here: http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/hsc2hs.html + +HOW TO COMPILE: + +hsc2hs Gu.hsc CRuntimeFFI.hsc -v --cflag="-std=c99" && ghc -lpgf -lgu --make CRuntimeFFI + +HOW TO USE: + +- Symlink or copy the files in this directory to the directory you're working with; these files are not included in any makefiles +- Import CRuntimeFFI to a Haskell program you're writing + + module Main where + import CRuntimeFFI + +- Use the functions in your program + + main = do + pgf <- readPGF "Foo.pgf" + let english = getConcr pgf (mkCId ("FooEng")) + +I haven't managed to make it work in ghci, get errors about unknown symbols (low level C functions). |