From 0851308099f625bb451f80e62e33137df199322f Mon Sep 17 00:00:00 2001 From: "kr.angelov" Date: Tue, 10 Dec 2013 16:11:47 +0000 Subject: move src/runtime/haskell/CRuntimeFFI to src/runtime/haskell-bind. Don't mess up with the stable Haskell runtime! --- src/runtime/haskell-bind/CId.hs | 56 +++++ src/runtime/haskell-bind/CRuntimeFFI.hsc | 294 ++++++++++++++++++++++++ src/runtime/haskell-bind/Gu.hsc | 122 ++++++++++ src/runtime/haskell-bind/PgfLow.hs | 148 ++++++++++++ src/runtime/haskell-bind/README | 32 +++ src/runtime/haskell/CRuntimeFFI/CId.hs | 56 ----- src/runtime/haskell/CRuntimeFFI/CRuntimeFFI.hsc | 294 ------------------------ src/runtime/haskell/CRuntimeFFI/Gu.hsc | 122 ---------- src/runtime/haskell/CRuntimeFFI/PgfLow.hs | 148 ------------ src/runtime/haskell/CRuntimeFFI/README | 32 --- 10 files changed, 652 insertions(+), 652 deletions(-) create mode 100644 src/runtime/haskell-bind/CId.hs create mode 100644 src/runtime/haskell-bind/CRuntimeFFI.hsc create mode 100644 src/runtime/haskell-bind/Gu.hsc create mode 100644 src/runtime/haskell-bind/PgfLow.hs create mode 100644 src/runtime/haskell-bind/README delete mode 100644 src/runtime/haskell/CRuntimeFFI/CId.hs delete mode 100644 src/runtime/haskell/CRuntimeFFI/CRuntimeFFI.hsc delete mode 100644 src/runtime/haskell/CRuntimeFFI/Gu.hsc delete mode 100644 src/runtime/haskell/CRuntimeFFI/PgfLow.hs delete mode 100644 src/runtime/haskell/CRuntimeFFI/README (limited to 'src/runtime') 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 +#include +#include + +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 +#include +#include + +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). diff --git a/src/runtime/haskell/CRuntimeFFI/CId.hs b/src/runtime/haskell/CRuntimeFFI/CId.hs deleted file mode 100644 index 74db63c2c..000000000 --- a/src/runtime/haskell/CRuntimeFFI/CId.hs +++ /dev/null @@ -1,56 +0,0 @@ -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/CRuntimeFFI/CRuntimeFFI.hsc b/src/runtime/haskell/CRuntimeFFI/CRuntimeFFI.hsc deleted file mode 100644 index f1ee62db5..000000000 --- a/src/runtime/haskell/CRuntimeFFI/CRuntimeFFI.hsc +++ /dev/null @@ -1,294 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-} -#include -#include -#include - -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/CRuntimeFFI/Gu.hsc b/src/runtime/haskell/CRuntimeFFI/Gu.hsc deleted file mode 100644 index e9d060c92..000000000 --- a/src/runtime/haskell/CRuntimeFFI/Gu.hsc +++ /dev/null @@ -1,122 +0,0 @@ -{-# LANGUAGE ForeignFunctionInterface #-} -#include -#include -#include - -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/CRuntimeFFI/PgfLow.hs b/src/runtime/haskell/CRuntimeFFI/PgfLow.hs deleted file mode 100644 index dc53baeb0..000000000 --- a/src/runtime/haskell/CRuntimeFFI/PgfLow.hs +++ /dev/null @@ -1,148 +0,0 @@ -{-# 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/CRuntimeFFI/README b/src/runtime/haskell/CRuntimeFFI/README deleted file mode 100644 index 64b6b7276..000000000 --- a/src/runtime/haskell/CRuntimeFFI/README +++ /dev/null @@ -1,32 +0,0 @@ -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). -- cgit v1.2.3