mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-09 04:59:31 -06:00
cleanup the code for the FFI binding. The API is now more uniform with the Python and the Java bindings. Fixed a lot of memory leaks.
This commit is contained in:
kr.angelov
@@ -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
|
||||
@@ -1,310 +0,0 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-}
|
||||
#include <pgf/pgf.h>
|
||||
#include <gu/enum.h>
|
||||
#include <gu/exn.h>
|
||||
|
||||
module CRuntimeFFI(-- * PGF
|
||||
PGF,readPGF,abstractName,startCat,
|
||||
-- * Concrete syntax
|
||||
Concr,Language,languages,getConcr,parse,linearize,
|
||||
-- * Trees
|
||||
Expr,Tree,readExpr,showExpr,unApp,
|
||||
-- * Morphology
|
||||
MorphoAnalysis,lookupMorpho,fullFormLexicon,
|
||||
printLexEntry,
|
||||
) where
|
||||
|
||||
import Prelude hiding (fromEnum)
|
||||
import Control.Exception
|
||||
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 Data.Map (Map, empty, insert)
|
||||
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)
|
||||
|
||||
|
||||
--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 :: Ptr GuPool -> IO Out
|
||||
newOut pool =
|
||||
do sb <- gu_string_buf pool
|
||||
out <- gu_string_buf_out sb
|
||||
return (sb,out)
|
||||
--Don't create newOut using withGuPool inside
|
||||
--Rather do like this:
|
||||
{-
|
||||
withGuPool $ \pl ->
|
||||
do out <- newOut pl
|
||||
<other stuff>
|
||||
-}
|
||||
-- withGuPool $ \pl ->
|
||||
-- do sb <- 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 :: Ptr GuPool, pgf :: Ptr PgfPGF} deriving Show
|
||||
data Concr = Concr {concr :: (Ptr PgfConcr), concrMaster :: PGF}
|
||||
type Language = CId
|
||||
|
||||
readPGF :: FilePath -> IO PGF
|
||||
readPGF filepath =
|
||||
do pl <- gu_new_pool
|
||||
pgf <- withCString filepath $ \file ->
|
||||
pgf_read file pl nullPtr
|
||||
return PGF {pgfPool = pl, pgf = pgf}
|
||||
|
||||
|
||||
getConcr :: PGF -> Language -> Maybe Concr
|
||||
getConcr p (CId lang) = unsafePerformIO $
|
||||
BS.useAsCString lang $ \lng -> do
|
||||
cnc <- pgf_get_language (pgf p) lng
|
||||
return (if cnc==nullPtr then Nothing else Just (Concr cnc p))
|
||||
|
||||
|
||||
languages :: PGF -> Map Language Concr
|
||||
languages p = unsafePerformIO $
|
||||
do ref <- newIORef empty
|
||||
allocaBytes (#size GuMapItor) $ \itor ->
|
||||
do fptr <- wrapLanguages (getLanguages ref)
|
||||
(#poke GuMapItor, fn) itor fptr
|
||||
pgf_iter_languages (pgf p) itor nullPtr
|
||||
readIORef ref
|
||||
where
|
||||
getLanguages :: IORef (Map Language Concr) -> Languages
|
||||
getLanguages ref itor key value exn = do
|
||||
langs <- readIORef ref
|
||||
key' <- fmap CId $ BS.packCString (castPtr key)
|
||||
value' <- fmap (\ptr -> Concr ptr p) $ peek (castPtr value)
|
||||
writeIORef ref (insert key' value' langs)
|
||||
--type Languages = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO (
|
||||
|
||||
|
||||
generateAll :: PGF -> CId -> [(Tree,Float)]
|
||||
generateAll p (CId cat) = unsafePerformIO $
|
||||
withGuPool $ \iterPl ->
|
||||
-- withGuPool $ \exprPl -> --segfaults if I use this
|
||||
do exprPl <- gu_new_pool
|
||||
pgfExprs <- BS.useAsCString cat $ \cat ->
|
||||
pgf_generate_all (pgf p) cat exprPl --this pool isn't freed. segfaults if I try.
|
||||
fromPgfExprEnum pgfExprs iterPl p --this pool is freed afterwards. it's used in fromPgfExprEnum, and I imagine it makes more sense to give a pool as an argument, rather than in that function create and free new pools in its body (it calls itself recursively)
|
||||
|
||||
|
||||
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 -> String
|
||||
printGrammar p = unsafePerformIO $
|
||||
withGuPool $ \outPl ->
|
||||
withGuPool $ \printPl ->
|
||||
do (sb,out) <- newOut outPl
|
||||
pgf_print (pgf p) out nullPtr --nullPtr is for exception
|
||||
grammar <- gu_string_buf_freeze sb printPl
|
||||
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 $
|
||||
withGuPool $ \pl -> do
|
||||
pgfAppl <- pgf_expr_unapply expr pl
|
||||
if pgfAppl == nullPtr
|
||||
then 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]
|
||||
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 exprPl <- gu_new_pool --we return this pool with the Expr
|
||||
withGuPool $ \inPl -> --these pools are freed right after
|
||||
withGuPool $ \exnPl ->
|
||||
withCString str $ \str ->
|
||||
do guin <- gu_string_in str inPl
|
||||
exn <- gu_new_exn nullPtr gu_type__type exnPl
|
||||
pgfExpr <- pgf_read_expr guin exprPl exn
|
||||
status <- gu_exn_is_raised exn
|
||||
if (status==False && pgfExpr /= nullPtr)
|
||||
then return $ Just (Expr pgfExpr exprPl)
|
||||
else do
|
||||
gu_pool_free exprPl --if Expr is not returned, free pool
|
||||
return Nothing
|
||||
|
||||
-- TODO: do we need 3 different pools for this?
|
||||
showExpr :: Expr -> String
|
||||
showExpr e = unsafePerformIO $
|
||||
withGuPool $ \pl ->
|
||||
do (sb,out) <- newOut pl
|
||||
let printCtxt = nullPtr
|
||||
exn <- gu_new_exn nullPtr gu_type__type pl
|
||||
pgf_print_expr (expr e) printCtxt 1 out exn
|
||||
abstree <- 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 pl <- gu_new_pool
|
||||
lexEnum <- pgf_fullform_lexicon (concr lang) pl
|
||||
fromFullFormEntry lexEnum pl (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 $
|
||||
withGuPool $ \iterPl -> -- this pool will get freed eventually
|
||||
do inpool <- gu_new_pool
|
||||
outpool <- gu_new_pool
|
||||
treesEnum <- parse_ lang cat sent inpool outpool
|
||||
outpoolFPtr <- newForeignPtr gu_pool_free_ptr outpool
|
||||
fromPgfExprEnum treesEnum iterPl (master,outpoolFPtr)
|
||||
where
|
||||
parse_ :: Ptr PgfConcr -> BS.ByteString -> String -> Ptr GuPool -> Ptr GuPool -> IO (Ptr PgfExprEnum)
|
||||
parse_ pgfcnc cat sent inpool outpool =
|
||||
do BS.useAsCString cat $ \cat ->
|
||||
withCString sent $ \sent ->
|
||||
pgf_parse pgfcnc cat sent nullPtr inpool outpool
|
||||
|
||||
|
||||
--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 $
|
||||
withGuPool $ \outPl ->
|
||||
withGuPool $ \linPl ->
|
||||
do (sb,out) <- newOut outPl
|
||||
pgf_linearize (concr lang) (expr tree) out nullPtr --linearization goes to stringbuf
|
||||
lin <- gu_string_buf_freeze sb linPl
|
||||
peekCString lin
|
||||
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Helper functions
|
||||
|
||||
-- # syntax: http://www.haskell.org/ghc/docs/7.2.1/html/users_guide/hsc2hs.html
|
||||
fromPgfExprEnum :: Ptr PgfExprEnum -> Ptr GuPool -> a -> IO [(Tree, Float)]
|
||||
fromPgfExprEnum enum pl master =
|
||||
do pgfExprProb <- alloca $ \ptr ->
|
||||
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 pl master)
|
||||
return ((Expr expr master,prob) : ts)
|
||||
|
||||
|
||||
fromFullFormEntry :: Ptr GuEnum -> Ptr GuPool -> PGF -> IO [String]
|
||||
fromFullFormEntry enum pl master =
|
||||
do ffEntry <- alloca $ \ptr ->
|
||||
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 pl master)
|
||||
return (tok : toks)
|
||||
@@ -1,127 +0,0 @@
|
||||
{-# 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
|
||||
import Control.Exception
|
||||
|
||||
|
||||
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]]
|
||||
|
||||
withGuPool :: (Ptr GuPool -> IO a) -> IO a
|
||||
withGuPool f = do
|
||||
pl <- gu_new_pool
|
||||
f pl `finally` gu_pool_free pl
|
||||
-- for true haskell persons
|
||||
-- withGuPool f = bracket gu_new_pool gu_pool_free f
|
||||
|
||||
232
src/runtime/haskell-bind/PGF2.hsc
Normal file
232
src/runtime/haskell-bind/PGF2.hsc
Normal file
@@ -0,0 +1,232 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
#include <pgf/pgf.h>
|
||||
#include <gu/enum.h>
|
||||
#include <gu/exn.h>
|
||||
|
||||
module PGF2 (-- * PGF
|
||||
PGF,readPGF,abstractName,startCat,
|
||||
-- * Concrete syntax
|
||||
Concr,languages,parse,linearize,
|
||||
-- * Trees
|
||||
Expr,readExpr,showExpr,unApp,
|
||||
-- * Morphology
|
||||
MorphoAnalysis, lookupMorpho, fullFormLexicon,
|
||||
) where
|
||||
|
||||
import Prelude hiding (fromEnum)
|
||||
import Control.Exception
|
||||
import System.IO
|
||||
import System.IO.Unsafe
|
||||
import PGF2.FFI
|
||||
|
||||
import Foreign hiding ( Pool, newPool, unsafePerformIO )
|
||||
import Foreign.C
|
||||
import Foreign.C.String
|
||||
import Foreign.Ptr
|
||||
import Data.Char
|
||||
import qualified Data.Map as Map
|
||||
import qualified Data.ByteString as BS
|
||||
import Data.IORef
|
||||
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Functions that take a PGF.
|
||||
-- PGF has many Concrs.
|
||||
--
|
||||
-- A Concr retains its PGF in a field in order to retain a reference to
|
||||
-- the foreign pointer in case if the application still has a reference
|
||||
-- to Concr but has lost its reference to PGF.
|
||||
|
||||
data PGF = PGF {pgf :: Ptr PgfPGF, pgfMaster :: ForeignPtr GuPool}
|
||||
data Concr = Concr {concr :: Ptr PgfConcr, concrMaster :: PGF}
|
||||
|
||||
readPGF :: FilePath -> IO PGF
|
||||
readPGF fpath =
|
||||
do pool <- gu_new_pool
|
||||
pgf <- withCString fpath $ \c_fpath ->
|
||||
pgf_read c_fpath pool nullPtr
|
||||
master <- newForeignPtr gu_pool_finalizer pool
|
||||
return PGF {pgf = pgf, pgfMaster = master}
|
||||
|
||||
languages :: PGF -> Map.Map String Concr
|
||||
languages p =
|
||||
unsafePerformIO $
|
||||
do ref <- newIORef Map.empty
|
||||
allocaBytes (#size GuMapItor) $ \itor ->
|
||||
do fptr <- wrapMapItorCallback (getLanguages ref)
|
||||
(#poke GuMapItor, fn) itor fptr
|
||||
pgf_iter_languages (pgf p) itor nullPtr
|
||||
readIORef ref
|
||||
where
|
||||
getLanguages :: IORef (Map.Map String Concr) -> MapItorCallback
|
||||
getLanguages ref itor key value exn = do
|
||||
langs <- readIORef ref
|
||||
name <- peekCString (castPtr key)
|
||||
concr <- fmap (\ptr -> Concr ptr p) $ peek (castPtr value)
|
||||
writeIORef ref $! Map.insert name concr langs
|
||||
|
||||
generateAll :: PGF -> String -> [(Expr,Float)]
|
||||
generateAll p cat =
|
||||
unsafePerformIO $
|
||||
do genPl <- gu_new_pool
|
||||
exprPl <- gu_new_pool
|
||||
enum <- withCString cat $ \cat ->
|
||||
pgf_generate_all (pgf p) cat genPl
|
||||
genFPl <- newForeignPtr gu_pool_finalizer genPl
|
||||
exprFPl <- newForeignPtr gu_pool_finalizer exprPl
|
||||
fromPgfExprEnum enum genFPl (p,exprFPl)
|
||||
|
||||
abstractName :: PGF -> String
|
||||
abstractName p = unsafePerformIO (peekCString =<< pgf_abstract_name (pgf p))
|
||||
|
||||
startCat :: PGF -> String
|
||||
startCat p = unsafePerformIO (peekCString =<< pgf_start_cat (pgf p))
|
||||
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Expressions
|
||||
|
||||
-- The C structure for the expression may point to other structures
|
||||
-- which are allocated from other pools. In order to ensure that
|
||||
-- they are not released prematurely we use the exprMaster to
|
||||
-- store references to other Haskell objects
|
||||
|
||||
data Expr = forall a . Expr {expr :: PgfExpr, exprMaster :: a}
|
||||
|
||||
instance Show Expr where
|
||||
show = showExpr
|
||||
|
||||
unApp :: Expr -> Maybe (String,[Expr])
|
||||
unApp (Expr expr master) =
|
||||
unsafePerformIO $
|
||||
withGuPool $ \pl -> do
|
||||
appl <- pgf_expr_unapply expr pl
|
||||
if appl == nullPtr
|
||||
then return Nothing
|
||||
else do
|
||||
fun <- peekCString =<< (#peek PgfApplication, fun) appl
|
||||
arity <- (#peek PgfApplication, n_args) appl :: IO CInt
|
||||
c_args <- peekArray (fromIntegral arity) (appl `plusPtr` (#offset PgfApplication, args))
|
||||
return $ Just (fun, [Expr c_arg master | c_arg <- c_args])
|
||||
|
||||
readExpr :: String -> Maybe Expr
|
||||
readExpr str =
|
||||
unsafePerformIO $
|
||||
do exprPl <- gu_new_pool
|
||||
withGuPool $ \tmpPl ->
|
||||
withCString str $ \c_str ->
|
||||
do guin <- gu_string_in c_str tmpPl
|
||||
exn <- gu_new_exn nullPtr gu_type__type tmpPl
|
||||
c_expr <- pgf_read_expr guin exprPl exn
|
||||
status <- gu_exn_is_raised exn
|
||||
if (not status && c_expr /= nullPtr)
|
||||
then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
|
||||
return $ Just (Expr c_expr exprFPl)
|
||||
else do gu_pool_free exprPl
|
||||
return Nothing
|
||||
|
||||
showExpr :: Expr -> String
|
||||
showExpr e =
|
||||
unsafePerformIO $
|
||||
withGuPool $ \tmpPl ->
|
||||
do (sb,out) <- newOut tmpPl
|
||||
let printCtxt = nullPtr
|
||||
exn <- gu_new_exn nullPtr gu_type__type tmpPl
|
||||
pgf_print_expr (expr e) printCtxt 1 out exn
|
||||
s <- gu_string_buf_freeze sb tmpPl
|
||||
peekCString s
|
||||
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Functions using Concr
|
||||
-- Morpho analyses, parsing & linearization
|
||||
|
||||
type MorphoAnalysis = (String,String,Float)
|
||||
|
||||
lookupMorpho :: Concr -> String -> [MorphoAnalysis]
|
||||
lookupMorpho (Concr concr master) sent = unsafePerformIO $
|
||||
do ref <- newIORef []
|
||||
allocaBytes (#size PgfMorphoCallback) $ \cback ->
|
||||
do fptr <- wrapLookupMorphoCallback (getAnalysis ref)
|
||||
(#poke PgfMorphoCallback, callback) cback fptr
|
||||
withCString sent $ \c_sent ->
|
||||
pgf_lookup_morpho concr c_sent cback nullPtr
|
||||
readIORef ref
|
||||
|
||||
fullFormLexicon :: Concr -> [(String, [MorphoAnalysis])]
|
||||
fullFormLexicon lang =
|
||||
unsafePerformIO $
|
||||
do pl <- gu_new_pool
|
||||
enum <- pgf_fullform_lexicon (concr lang) pl
|
||||
fpl <- newForeignPtr gu_pool_finalizer pl
|
||||
fromFullFormEntry enum fpl
|
||||
where
|
||||
fromFullFormEntry :: Ptr GuEnum -> ForeignPtr GuPool -> IO [(String, [MorphoAnalysis])]
|
||||
fromFullFormEntry enum fpl =
|
||||
do ffEntry <- alloca $ \ptr ->
|
||||
withForeignPtr fpl $ \pl ->
|
||||
do gu_enum_next enum ptr pl
|
||||
peek ptr
|
||||
if ffEntry == nullPtr
|
||||
then do finalizeForeignPtr fpl
|
||||
return []
|
||||
else do tok <- peekCString =<< pgf_fullform_get_string ffEntry
|
||||
ref <- newIORef []
|
||||
allocaBytes (#size PgfMorphoCallback) $ \cback ->
|
||||
do fptr <- wrapLookupMorphoCallback (getAnalysis ref)
|
||||
(#poke PgfMorphoCallback, callback) cback fptr
|
||||
pgf_fullform_get_analyses ffEntry cback nullPtr
|
||||
ans <- readIORef ref
|
||||
toks <- unsafeInterleaveIO (fromFullFormEntry enum fpl)
|
||||
return ((tok,ans) : toks)
|
||||
|
||||
getAnalysis :: IORef [MorphoAnalysis] -> LookupMorphoCallback
|
||||
getAnalysis ref self c_lemma c_anal prob exn = do
|
||||
ans <- readIORef ref
|
||||
lemma <- peekCString c_lemma
|
||||
anal <- peekCString c_anal
|
||||
writeIORef ref ((lemma, anal, prob):ans)
|
||||
|
||||
parse :: Concr -> String -> String -> [(Expr,Float)]
|
||||
parse lang cat sent =
|
||||
unsafePerformIO $
|
||||
do parsePl <- gu_new_pool
|
||||
exprPl <- gu_new_pool
|
||||
enum <- withCString cat $ \cat ->
|
||||
withCString sent $ \sent ->
|
||||
pgf_parse (concr lang) cat sent nullPtr parsePl exprPl
|
||||
parseFPl <- newForeignPtr gu_pool_finalizer parsePl
|
||||
exprFPl <- newForeignPtr gu_pool_finalizer exprPl
|
||||
fromPgfExprEnum enum parseFPl (lang,exprFPl)
|
||||
|
||||
linearize :: Concr -> Expr -> String
|
||||
linearize lang e = unsafePerformIO $
|
||||
withGuPool $ \pl ->
|
||||
do (sb,out) <- newOut pl
|
||||
pgf_linearize (concr lang) (expr e) out nullPtr
|
||||
lin <- gu_string_buf_freeze sb pl
|
||||
peekCString lin
|
||||
|
||||
|
||||
-----------------------------------------------------------------------------
|
||||
-- Helper functions
|
||||
|
||||
newOut :: Ptr GuPool -> IO (Ptr GuStringBuf, Ptr GuOut)
|
||||
newOut pool =
|
||||
do sb <- gu_string_buf pool
|
||||
out <- gu_string_buf_out sb
|
||||
return (sb,out)
|
||||
|
||||
fromPgfExprEnum :: Ptr GuEnum -> ForeignPtr GuPool -> a -> IO [(Expr, Float)]
|
||||
fromPgfExprEnum enum fpl master =
|
||||
do pgfExprProb <- alloca $ \ptr ->
|
||||
withForeignPtr fpl $ \pl ->
|
||||
do gu_enum_next enum ptr pl
|
||||
peek ptr
|
||||
if pgfExprProb == nullPtr
|
||||
then do finalizeForeignPtr fpl
|
||||
return []
|
||||
else do expr <- (#peek PgfExprProb, expr) pgfExprProb
|
||||
ts <- unsafeInterleaveIO (fromPgfExprEnum enum fpl master)
|
||||
prob <- (#peek PgfExprProb, prob) pgfExprProb
|
||||
return ((Expr expr master,prob) : ts)
|
||||
@@ -1,152 +1,154 @@
|
||||
{-# LANGUAGE ForeignFunctionInterface #-}
|
||||
|
||||
module PgfLow where
|
||||
module PGF2.FFI where
|
||||
|
||||
import Foreign.C
|
||||
import Foreign.C.String
|
||||
import Foreign.Ptr
|
||||
import Gu
|
||||
import Foreign.ForeignPtr
|
||||
import Control.Exception
|
||||
|
||||
------------------------------------------------------------------------------
|
||||
-- Mindless copypasting and translating of the C functions used in CRuntimeFFI
|
||||
-- From pgf.h
|
||||
------------------------------------------------------------------
|
||||
-- libgu API
|
||||
|
||||
data GuEnum
|
||||
data GuExn
|
||||
data GuIn
|
||||
data GuKind
|
||||
data GuString
|
||||
data GuStringBuf
|
||||
data GuMapItor
|
||||
data GuOut
|
||||
data GuPool
|
||||
|
||||
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_finalizer :: FinalizerPtr GuPool
|
||||
|
||||
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
|
||||
|
||||
foreign import ccall "gu/type.h &gu_type__type"
|
||||
gu_type__type :: Ptr GuKind
|
||||
|
||||
foreign import ccall "gu/string.h gu_string_in"
|
||||
gu_string_in :: CString -> Ptr GuPool -> IO (Ptr GuIn)
|
||||
|
||||
foreign import ccall "gu/string.h gu_string_buf"
|
||||
gu_string_buf :: Ptr GuPool -> IO (Ptr GuStringBuf)
|
||||
|
||||
foreign import ccall "gu/string.h gu_string_buf_out"
|
||||
gu_string_buf_out :: Ptr GuStringBuf -> IO (Ptr GuOut)
|
||||
|
||||
foreign import ccall "gu/enum.h gu_enum_next"
|
||||
gu_enum_next :: Ptr a -> Ptr (Ptr b) -> Ptr GuPool -> IO ()
|
||||
|
||||
foreign import ccall "gu/string.h gu_string_buf_freeze"
|
||||
gu_string_buf_freeze :: Ptr GuStringBuf -> Ptr GuPool -> IO CString
|
||||
|
||||
withGuPool :: (Ptr GuPool -> IO a) -> IO a
|
||||
withGuPool f = bracket gu_new_pool gu_pool_free f
|
||||
|
||||
|
||||
------------------------------------------------------------------
|
||||
-- libpgf API
|
||||
|
||||
data PgfPGF
|
||||
data PgfApplication
|
||||
data PgfConcr
|
||||
type PgfExpr = Ptr ()
|
||||
data PgfExprProb
|
||||
data PgfFullFormEntry
|
||||
data PgfMorphoCallback
|
||||
data PgfPrintContext
|
||||
data PgfType
|
||||
|
||||
-- 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)
|
||||
pgf_parse :: Ptr PgfConcr -> CString -> CString -> Ptr GuExn -> Ptr GuPool -> Ptr GuPool -> IO (Ptr GuEnum)
|
||||
|
||||
--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 ()
|
||||
type LookupMorphoCallback = Ptr PgfMorphoCallback -> CString -> CString -> Float -> Ptr GuExn -> IO ()
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLookupMorpho :: Callback -> IO (FunPtr Callback)
|
||||
wrapLookupMorphoCallback :: LookupMorphoCallback -> IO (FunPtr LookupMorphoCallback)
|
||||
|
||||
type Languages = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO ()
|
||||
type MapItorCallback = Ptr GuMapItor -> Ptr () -> Ptr () -> Ptr GuExn -> IO ()
|
||||
|
||||
foreign import ccall "wrapper"
|
||||
wrapLanguages :: Languages -> IO (FunPtr Languages)
|
||||
wrapMapItorCallback :: MapItorCallback -> IO (FunPtr MapItorCallback)
|
||||
|
||||
--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_generate_all"
|
||||
pgf_generate_all :: Ptr PgfPGF -> CString -> Ptr GuPool -> IO (Ptr GuEnum)
|
||||
|
||||
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
|
||||
@@ -13,9 +13,9 @@ import qualified Data.Map as M
|
||||
import System.IO(hFlush,stdout)
|
||||
import System.IO.Error(catchIOError)
|
||||
import System.Environment
|
||||
import CRuntimeFFI
|
||||
import CId
|
||||
import PGF2
|
||||
import System.Mem(performGC)
|
||||
import qualified Data.Map as Map
|
||||
|
||||
main = getPGF =<< getArgs
|
||||
|
||||
@@ -42,13 +42,13 @@ execute pgf cmd =
|
||||
|
||||
getConcr' pgf lang =
|
||||
maybe (fail $ "Concrete syntax not found: "++show lang) return $
|
||||
getConcr pgf lang
|
||||
Map.lookup lang (languages pgf)
|
||||
|
||||
printl xs = putl $ map show xs
|
||||
putl = putStr . unlines
|
||||
|
||||
-- | Abstracy syntax of shell commands
|
||||
data Command = P CId String | L CId Tree | T CId CId String deriving Show
|
||||
data Command = P String String | L String Expr | T String String String deriving Show
|
||||
|
||||
-- | Shell command parser
|
||||
instance Read Command where
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
-- Initial haskell-bind.cabal generated by cabal init. For further
|
||||
-- documentation, see http://haskell.org/cabal/users-guide/
|
||||
|
||||
name: haskell-bind
|
||||
name: pgf2-bind
|
||||
version: 0.1.0.0
|
||||
-- synopsis:
|
||||
-- description:
|
||||
@@ -9,7 +9,7 @@ homepage: http://www.grammaticalframework.org
|
||||
license: LGPL-3
|
||||
--license-file: LICENSE
|
||||
author: Inari
|
||||
-- maintainer:
|
||||
maintainer: Krasimir Angelov
|
||||
-- copyright:
|
||||
category: Language
|
||||
build-type: Simple
|
||||
@@ -17,10 +17,10 @@ extra-source-files: README
|
||||
cabal-version: >=1.10
|
||||
|
||||
library
|
||||
exposed-modules: CId, CRuntimeFFI
|
||||
other-modules: Gu, PgfLow
|
||||
exposed-modules: PGF2
|
||||
other-modules: PGF2.FFI
|
||||
build-depends: base >=4.5 && <4.7, bytestring >=0.9 && <0.11,
|
||||
pretty >=1.1 && <1.2, containers
|
||||
containers
|
||||
-- hs-source-dirs:
|
||||
build-tools: hsc2hs
|
||||
extra-libraries: gu pgf
|
||||
Reference in New Issue
Block a user