mirror of
https://github.com/GrammaticalFramework/gf-core.git
synced 2026-04-16 16:29:32 -06:00
118 lines
2.9 KiB
Haskell
118 lines
2.9 KiB
Haskell
module PGF ( PGF2.PGF, readPGF
|
|
, abstractName
|
|
|
|
, CId, mkCId, wildCId, showCId, readCId, pIdent
|
|
|
|
, PGF2.categories, PGF2.categoryContext, PGF2.startCat
|
|
, functions, functionsByCat
|
|
|
|
, PGF2.Expr(..), PGF2.Literal(..), Tree
|
|
, PGF2.readExpr, PGF2.showExpr, pExpr
|
|
, PGF2.mkAbs, PGF2.unAbs
|
|
, PGF2.mkApp, PGF2.unApp, PGF2.unapply
|
|
, PGF2.mkStr, PGF2.unStr
|
|
, PGF2.mkInt, PGF2.unInt
|
|
, PGF2.mkDouble, PGF2.unDouble
|
|
, PGF2.mkFloat, PGF2.unFloat
|
|
, PGF2.mkMeta, PGF2.unMeta
|
|
, PGF2.exprSize, PGF2.exprFunctions
|
|
|
|
, PGF2.Type(..), PGF2.Hypo
|
|
, PGF2.readType, PGF2.showType
|
|
, PGF2.mkType, PGF2.unType
|
|
, PGF2.mkHypo, PGF2.mkDepHypo, PGF2.mkImplHypo
|
|
|
|
, PGF2.PGFError(..)
|
|
) where
|
|
|
|
import PGF2.FFI
|
|
|
|
import Foreign
|
|
import Foreign.C
|
|
import Control.Exception(mask_)
|
|
import Control.Monad
|
|
import qualified PGF2 as PGF2
|
|
import qualified Text.ParserCombinators.ReadP as RP
|
|
import System.IO.Unsafe(unsafePerformIO)
|
|
|
|
#include <pgf/pgf.h>
|
|
|
|
newtype CId = CId String deriving (Show,Read,Eq,Ord)
|
|
|
|
type Language = CId
|
|
|
|
readPGF = PGF2.readPGF
|
|
|
|
|
|
readLanguage = readCId
|
|
showLanguage (CId s) = s
|
|
|
|
|
|
abstractName gr = CId (PGF2.abstractName gr)
|
|
|
|
|
|
categories gr = map CId (PGF2.categories gr)
|
|
|
|
|
|
functions gr = map CId (PGF2.functions gr)
|
|
functionsByCat gr (CId c) = map CId (PGF2.functionsByCat gr c)
|
|
|
|
type Tree = PGF2.Expr
|
|
|
|
|
|
mkCId x = CId x
|
|
wildCId = CId "_"
|
|
showCId (CId x) = x
|
|
readCId s = Just (CId s)
|
|
|
|
|
|
pIdent :: RP.ReadP String
|
|
pIdent =
|
|
liftM2 (:) (RP.satisfy isIdentFirst) (RP.munch isIdentRest)
|
|
`mplus`
|
|
do RP.char '\''
|
|
cs <- RP.many1 insideChar
|
|
RP.char '\''
|
|
return cs
|
|
-- where
|
|
insideChar = RP.readS_to_P $ \s ->
|
|
case s of
|
|
[] -> []
|
|
('\\':'\\':cs) -> [('\\',cs)]
|
|
('\\':'\'':cs) -> [('\'',cs)]
|
|
('\\':cs) -> []
|
|
('\'':cs) -> []
|
|
(c:cs) -> [(c,cs)]
|
|
|
|
isIdentFirst c =
|
|
(c == '_') ||
|
|
(c >= 'a' && c <= 'z') ||
|
|
(c >= 'A' && c <= 'Z') ||
|
|
(c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')
|
|
isIdentRest c =
|
|
(c == '_') ||
|
|
(c == '\'') ||
|
|
(c >= '0' && c <= '9') ||
|
|
(c >= 'a' && c <= 'z') ||
|
|
(c >= 'A' && c <= 'Z') ||
|
|
(c >= '\192' && c <= '\255' && c /= '\247' && c /= '\215')
|
|
|
|
pExpr :: RP.ReadP PGF2.Expr
|
|
pExpr =
|
|
RP.readS_to_P $ \str ->
|
|
unsafePerformIO $
|
|
withText str $ \c_str ->
|
|
alloca $ \c_pos ->
|
|
withForeignPtr unmarshaller $ \u ->
|
|
mask_ $ do
|
|
c_expr <- pgf_read_expr_ex c_str c_pos u
|
|
if c_expr == castPtrToStablePtr nullPtr
|
|
then return []
|
|
else do expr <- deRefStablePtr c_expr
|
|
freeStablePtr c_expr
|
|
pos <- peek c_pos
|
|
size <- ((#peek PgfText, size) c_str) :: IO CSize
|
|
let c_text = castPtr c_str `plusPtr` (#offset PgfText, text)
|
|
s <- peekUtf8CString pos (c_text `plusPtr` fromIntegral size)
|
|
return [(expr,s)]
|