msyds/gf-core
1
0
Fork 0
forked from GitHub/gf-core
Code Pull Requests Activity

added PGF(pIdent,pExpr)

Browse Source
This commit is contained in:
krangelov
2021-09-14 09:34:00 +02:00
parent cf7673525f
commit 22f62be511
9 changed files with 166 additions and 91 deletions
Download Patch File Download Diff File Expand all files Collapse all files

10
src/compiler/GF/Command/Parse.hs
View File

@@ -1,6 +1,6 @@
module GF.Command.Parse(readCommandLine, pCommand) where
import PGF2(pExpr,pIdent)
import PGF(pExpr,pIdent)
import GF.Grammar.Parser(runPartial,pTerm)
import GF.Command.Abstract
@@ -22,7 +22,7 @@ pCommandLine =
pPipe = sepBy1 (skipSpaces >> pCommand) (skipSpaces >> char '|')
pCommand = (do
cmd <- readS_to_P pIdent <++ (char '%' >> fmap ('%':) (readS_to_P pIdent))
cmd <- pIdent <++ (char '%' >> fmap ('%':) pIdent)
skipSpaces
opts <- sepBy pOption skipSpaces
arg <- if getCommandOp cmd == "cc" then pArgTerm else pArgument
@@ -37,7 +37,7 @@ pCommand = (do
pOption = do
char '-'
flg <- readS_to_P pIdent
flg <- pIdent
option (OOpt flg) (fmap (OFlag flg) (char '=' >> pValue))
pValue = do
@@ -52,9 +52,9 @@ pFilename = liftM2 (:) (satisfy isFileFirst) (munch (not . isSpace)) where
pArgument =
option ANoArg
(fmap AExpr (readS_to_P pExpr)
(fmap AExpr pExpr
<++
(skipSpaces >> char '%' >> fmap AMacro (readS_to_P pIdent)))
(skipSpaces >> char '%' >> fmap AMacro pIdent))
pArgTerm = ATerm `fmap` readS_to_P sTerm
where

12
src/runtime/c/pgf/expr.cxx
View File

@@ -227,6 +227,7 @@ PgfExprParser::PgfExprParser(PgfText *input, PgfUnmarshaller *unmarshaller)
pos = (const char*) &inp->text;
ch = ' ';
u = unmarshaller;
token_pos = NULL;
token_value = NULL;
token();
@@ -347,16 +348,18 @@ void PgfExprParser::str_char()
void PgfExprParser::token()
{
while (isspace(ch)) {
ch = getc();
}
if (token_value != NULL)
free(token_value);
token_tag = PGF_TOKEN_UNKNOWN;
token_pos = pos;
token_value = NULL;
while (isspace(ch)) {
token_pos = pos;
ch = getc();
}
switch (ch) {
case EOF:
ch = getc();
@@ -921,7 +924,6 @@ exit:
return type;
}
PGF_INTERNAL
void pgf_literal_free(PgfLiteral literal)
{

5
src/runtime/c/pgf/expr.h
View File

@@ -207,7 +207,7 @@ class PGF_INTERNAL_DECL PgfExprParser {
PGF_TOKEN_TAG token_tag;
PgfText *token_value;
PgfText *inp;
const char *pos;
const char *token_pos, *pos;
uint32_t ch;
uint32_t getc();
@@ -224,7 +224,6 @@ public:
PgfBind *parse_bind(PgfBind *next);
PgfBind *parse_binds(PgfBind *next);
PgfExpr parse_arg();
PgfExpr parse_term();
PgfExpr parse_expr();
@@ -233,6 +232,8 @@ public:
PgfType parse_type();
bool eof();
const char *get_token_pos() { return token_pos; }
};
PGF_INTERNAL_DECL extern PgfText wildcard;

13
src/runtime/c/pgf/pgf.cxx
View File

@@ -418,8 +418,8 @@ PgfText *pgf_print_expr(PgfExpr e,
return printer.get_text();
}
PGF_API PgfExpr
pgf_read_expr(PgfText *input, PgfUnmarshaller *u)
PGF_API
PgfExpr pgf_read_expr(PgfText *input, PgfUnmarshaller *u)
{
PgfExprParser parser(input, u);
PgfExpr res = parser.parse_expr();
@@ -430,6 +430,15 @@ pgf_read_expr(PgfText *input, PgfUnmarshaller *u)
return res;
}
PGF_API
PgfExpr pgf_read_expr_ex(PgfText *input, const char **end_pos, PgfUnmarshaller *u)
{
PgfExprParser parser(input, u);
PgfExpr expr = parser.parse_expr();
*end_pos = parser.get_token_pos();
return expr;
}
PGF_API
PgfText *pgf_print_type(PgfType ty,
PgfPrintContext *ctxt, int prio,

3
src/runtime/c/pgf/pgf.h
View File

@@ -317,6 +317,9 @@ PgfText *pgf_print_expr(PgfExpr e,
PGF_API_DECL
PgfExpr pgf_read_expr(PgfText *input, PgfUnmarshaller *u);
PGF_API_DECL
PgfExpr pgf_read_expr_ex(PgfText *input, const char **end_pos, PgfUnmarshaller *u);
PGF_API_DECL
PgfText *pgf_print_type(PgfType ty,
PgfPrintContext *ctxt, int prio,

56
src/runtime/haskell/PGF.hs
View File

@@ -1,56 +0,0 @@
module PGF ( PGF2.PGF, readPGF
, abstractName
, CId, mkCId, wildCId, showCId, readCId
, PGF2.categories, PGF2.categoryContext, PGF2.startCat
, functions, functionsByCat
, PGF2.Expr(..), PGF2.Literal(..), Tree
, PGF2.readExpr, PGF2.showExpr
, 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 qualified PGF2 as PGF2
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)

117
src/runtime/haskell/PGF.hsc Normal file
View File

@@ -0,0 +1,117 @@
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)]

8
src/runtime/haskell/PGF2.hsc
View File

@@ -27,7 +27,7 @@ module PGF2 (-- * PGF
functionType, functionIsConstructor, functionProbability,
-- ** Expressions
Expr(..), Literal(..), showExpr, readExpr, pExpr, pIdent,
Expr(..), Literal(..), showExpr, readExpr,
mkAbs, unAbs,
mkApp, unApp, unapply,
mkStr, unStr,
@@ -892,12 +892,6 @@ readExpr str =
freeStablePtr c_expr
return (Just expr)
pIdent :: ReadS String
pIdent = error "TODO: pIdent"
pExpr :: ReadS Expr
pExpr = error "TODO: pExpr"
-- | renders a type as a 'String'. The list
-- of identifiers is the list of all free variables
-- in the type in order reverse to the order

33
src/runtime/haskell/PGF2/FFI.hsc
View File

@@ -73,6 +73,8 @@ foreign import ccall "pgf_print_expr"
foreign import ccall "pgf_read_expr"
pgf_read_expr :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Expr)
foreign import ccall pgf_read_expr_ex :: Ptr PgfText -> Ptr CString -> Ptr PgfUnmarshaller -> IO (StablePtr Expr)
foreign import ccall "pgf_print_type"
pgf_print_type :: StablePtr Type -> Ptr PgfPrintContext -> CInt -> Ptr PgfMarshaller -> IO (Ptr PgfText)
@@ -137,20 +139,10 @@ foreign import ccall pgf_set_abstract_flag :: Ptr PgfDB -> Ptr PgfRevision -> Pt
-- Texts
peekText :: Ptr PgfText -> IO String
peekText ptr =
alloca $ \pptr -> do
size <- ((#peek PgfText, size) ptr) :: IO CSize
let c_text = castPtr ptr `plusPtr` (#offset PgfText, text)
poke pptr c_text
decode pptr (c_text `plusPtr` fromIntegral size)
where
decode pptr end = do
ptr <- peek pptr
if ptr >= end
then return []
else do x <- pgf_utf8_decode pptr
cs <- decode pptr end
return (((toEnum . fromEnum) x) : cs)
peekText ptr = do
size <- ((#peek PgfText, size) ptr) :: IO CSize
let c_text = castPtr ptr `plusPtr` (#offset PgfText, text)
peekUtf8CString c_text (c_text `plusPtr` fromIntegral size)
newTextEx :: Int -> String -> IO (Ptr a)
newTextEx offs s = do
@@ -180,6 +172,19 @@ withText s fn =
where
size = utf8Length s
peekUtf8CString c_start c_end =
alloca $ \pptr -> do
poke pptr c_start
decode pptr c_end
where
decode pptr end = do
ptr <- peek pptr
if ptr >= end
then return []
else do x <- pgf_utf8_decode pptr
cs <- decode pptr end
return (((toEnum . fromEnum) x) : cs)
pokeUtf8CString s ptr =
alloca $ \pptr ->
poke pptr ptr >> encode s pptr