GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-04-16 16:29:32 -06:00
Code Issues Packages Projects Releases Wiki Activity

the parser for abstract expressions in the C runtime now supports partial parses

Browse Source
This commit is contained in:
Krasimir Angelov
2017-09-28 13:57:13 +02:00
parent 06ec6b3e92
commit 1c04fa4897
12 changed files with 202 additions and 144 deletions
Download Patch File Download Diff File Expand all files Collapse all files

6
src/runtime/haskell-bind/PGF2.hsc
View File

@@ -31,7 +31,7 @@ module PGF2 (-- * PGF
-- ** Functions
Fun,functions, functionsByCat, functionType, hasLinearization,
-- ** Expressions
Expr,showExpr,readExpr,
Expr,showExpr,readExpr,pExpr,
mkAbs,unAbs,
mkApp,unApp,
mkStr,unStr,
@@ -583,7 +583,7 @@ mkCallbacksMap concr callbacks pool = do
c_str <- gu_string_buf_freeze sb tmpPl
guin <- gu_string_in c_str tmpPl
pgf_read_expr guin out_pool exn
pgf_read_expr guin out_pool tmpPl exn
ep <- gu_malloc out_pool (#size PgfExprProb)
(#poke PgfExprProb, expr) ep c_e
@@ -690,7 +690,7 @@ parseWithOracle lang cat sent (predict,complete,literal) =
c_str <- gu_string_buf_freeze sb tmpPl
guin <- gu_string_in c_str tmpPl
pgf_read_expr guin out_pool exn
pgf_read_expr guin out_pool tmpPl exn
ep <- gu_malloc out_pool (#size PgfExprProb)
(#poke PgfExprProb, expr) ep c_e

45
src/runtime/haskell-bind/PGF2/Expr.hsc
View File

@@ -5,6 +5,7 @@ module PGF2.Expr where
import System.IO.Unsafe(unsafePerformIO)
import Foreign hiding (unsafePerformIO)
import Foreign.C
import Data.IORef
import PGF2.FFI
-- | An data type that represents
@@ -195,7 +196,7 @@ readExpr str =
do c_str <- newUtf8CString str tmpPl
guin <- gu_string_in c_str tmpPl
exn <- gu_new_exn tmpPl
c_expr <- pgf_read_expr guin exprPl exn
c_expr <- pgf_read_expr guin exprPl tmpPl exn
status <- gu_exn_is_raised exn
if (not status && c_expr /= nullPtr)
then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
@@ -203,6 +204,48 @@ readExpr str =
else do gu_pool_free exprPl
return Nothing
pExpr :: ReadS Expr
pExpr str =
unsafePerformIO $
do exprPl <- gu_new_pool
withGuPool $ \tmpPl ->
do ref <- newIORef (str,str,str)
exn <- gu_new_exn tmpPl
c_fetch_char <- wrapParserGetc (fetch_char ref)
c_parser <- pgf_new_parser nullPtr c_fetch_char exprPl tmpPl exn
c_expr <- pgf_expr_parser_expr c_parser 1
status <- gu_exn_is_raised exn
if (not status && c_expr /= nullPtr)
then do exprFPl <- newForeignPtr gu_pool_finalizer exprPl
(str,_,_) <- readIORef ref
return [(Expr c_expr (touchForeignPtr exprFPl),str)]
else do gu_pool_free exprPl
return []
where
fetch_char :: IORef (String,String,String) -> Ptr () -> (#type bool) -> Ptr GuExn -> IO (#type GuUCS)
fetch_char ref _ mark exn = do
(str1,str2,str3) <- readIORef ref
let str1' = if mark /= 0
then str2
else str1
case str3 of
[] -> do writeIORef ref (str1',str3,[])
gu_exn_raise exn gu_exn_type_GuEOF
return (-1)
(c:cs) -> do writeIORef ref (str1',str3,cs)
return ((fromIntegral . fromEnum) c)
foreign import ccall "pgf/expr.h pgf_new_parser"
pgf_new_parser :: Ptr () -> (FunPtr ParserGetc) -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO (Ptr PgfExprParser)
foreign import ccall "pgf/expr.h pgf_expr_parser_expr"
pgf_expr_parser_expr :: Ptr PgfExprParser -> (#type bool) -> IO PgfExpr
type ParserGetc = Ptr () -> (#type bool) -> Ptr GuExn -> IO (#type GuUCS)
foreign import ccall "wrapper"
wrapParserGetc :: ParserGetc -> IO (FunPtr ParserGetc)
-- | renders an expression as a 'String'. The list
-- of identifiers is the list of all free variables
-- in the expression in order reverse to the order

7
src/runtime/haskell-bind/PGF2/FFI.hsc
View File

@@ -78,6 +78,8 @@ foreign import ccall unsafe "gu/exn.h gu_exn_raise_"
gu_exn_type_GuErrno = Ptr "GuErrno"## :: CString
gu_exn_type_GuEOF = Ptr "GuEOF"## :: CString
gu_exn_type_PgfLinNonExist = Ptr "PgfLinNonExist"## :: CString
gu_exn_type_PgfExn = Ptr "PgfExn"## :: CString
@@ -222,6 +224,7 @@ data PgfApplication
data PgfConcr
type PgfExpr = Ptr ()
data PgfExprProb
data PgfExprParser
data PgfFullFormEntry
data PgfMorphoCallback
data PgfPrintContext
@@ -462,7 +465,7 @@ foreign import ccall "pgf/pgf.h pgf_print"
pgf_print :: Ptr PgfPGF -> Ptr GuOut -> Ptr GuExn -> IO ()
foreign import ccall "pgf/expr.h pgf_read_expr"
pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr
pgf_read_expr :: Ptr GuIn -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO PgfExpr
foreign import ccall "pgf/expr.h pgf_read_expr_tuple"
pgf_read_expr_tuple :: Ptr GuIn -> CSizeT -> Ptr PgfExpr -> Ptr GuPool -> Ptr GuExn -> IO CInt
@@ -471,7 +474,7 @@ foreign import ccall "pgf/expr.h pgf_read_expr_matrix"
pgf_read_expr_matrix :: Ptr GuIn -> CSizeT -> Ptr GuPool -> Ptr GuExn -> IO (Ptr GuSeq)
foreign import ccall "pgf/expr.h pgf_read_type"
pgf_read_type :: Ptr GuIn -> Ptr GuPool -> Ptr GuExn -> IO PgfType
pgf_read_type :: Ptr GuIn -> Ptr GuPool -> Ptr GuPool -> Ptr GuExn -> IO PgfType
foreign import ccall "pgf/graphviz.h pgf_graphviz_abstract_tree"
pgf_graphviz_abstract_tree :: Ptr PgfPGF -> PgfExpr -> Ptr PgfGraphvizOptions -> Ptr GuOut -> Ptr GuExn -> IO ()

2
src/runtime/haskell-bind/PGF2/Type.hsc
View File

@@ -31,7 +31,7 @@ readType str =
do c_str <- newUtf8CString str tmpPl
guin <- gu_string_in c_str tmpPl
exn <- gu_new_exn tmpPl
c_type <- pgf_read_type guin typPl exn
c_type <- pgf_read_type guin typPl tmpPl exn
status <- gu_exn_is_raised exn
if (not status && c_type /= nullPtr)
then do typFPl <- newForeignPtr gu_pool_finalizer typPl