diff --git a/src/runtime/c/pgf/data.h b/src/runtime/c/pgf/data.h index 658f74d88..2dce3d063 100644 --- a/src/runtime/c/pgf/data.h +++ b/src/runtime/c/pgf/data.h @@ -39,43 +39,43 @@ struct PGF_INTERNAL_DECL PgfFlag { typedef variant PgfPatt; -struct PgfPattApp { +struct PGF_INTERNAL_DECL PgfPattApp { static const uint8_t tag = 0; ref ctor; PgfVector args; }; -struct PgfPattVar { +struct PGF_INTERNAL_DECL PgfPattVar { static const uint8_t tag = 1; PgfText name; }; -struct PgfPattAs { +struct PGF_INTERNAL_DECL PgfPattAs { static const uint8_t tag = 2; PgfPatt patt; PgfText name; }; -struct PgfPattWild { +struct PGF_INTERNAL_DECL PgfPattWild { static const uint8_t tag = 3; }; -struct PgfPattLit { +struct PGF_INTERNAL_DECL PgfPattLit { static const uint8_t tag = 4; PgfLiteral lit; }; -struct PgfPattImplArg { +struct PGF_INTERNAL_DECL PgfPattImplArg { static const uint8_t tag = 5; PgfPatt patt; }; -struct PgfPattTilde { +struct PGF_INTERNAL_DECL PgfPattTilde { static const uint8_t tag = 6; PgfExpr expr; diff --git a/src/runtime/c/pgf/db.h b/src/runtime/c/pgf/db.h index 5c4466c74..1d27d637d 100644 --- a/src/runtime/c/pgf/db.h +++ b/src/runtime/c/pgf/db.h @@ -12,7 +12,7 @@ typedef moffset variant; struct malloc_state; -template class ref { +template class PGF_INTERNAL_DECL ref { private: moffset offset; diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h index 203ee473a..67ef5b4cb 100644 --- a/src/runtime/c/pgf/expr.h +++ b/src/runtime/c/pgf/expr.h @@ -10,37 +10,37 @@ struct PgfType; /// A literal for an abstract syntax tree typedef variant PgfLiteral; -struct PgfLiteralStr { +struct PGF_INTERNAL_DECL PgfLiteralStr { static const uint8_t tag = 0; PgfText val; } ; -struct PgfLiteralInt { +struct PGF_INTERNAL_DECL PgfLiteralInt { static const uint8_t tag = 1; int val; } ; -struct PgfLiteralFlt { +struct PGF_INTERNAL_DECL PgfLiteralFlt { static const uint8_t tag = 2; double val; }; -struct PgfHypo { +struct PGF_INTERNAL_DECL PgfHypo { PgfBindType bind_type; ref cid; ref type; }; -struct PgfType { +struct PGF_INTERNAL_DECL PgfType { ref> hypos; ref> exprs; PgfText name; }; -struct PgfExprAbs { +struct PGF_INTERNAL_DECL PgfExprAbs { static const uint8_t tag = 0; PgfBindType bind_type; @@ -48,45 +48,45 @@ struct PgfExprAbs { PgfText name; }; -struct PgfExprApp { +struct PGF_INTERNAL_DECL PgfExprApp { static const uint8_t tag = 1; PgfExpr fun; PgfExpr arg; }; -struct PgfExprLit { +struct PGF_INTERNAL_DECL PgfExprLit { static const uint8_t tag = 2; PgfLiteral lit; }; -struct PgfExprMeta { +struct PGF_INTERNAL_DECL PgfExprMeta { static const uint8_t tag = 3; PgfMetaId id; }; -struct PgfExprFun { +struct PGF_INTERNAL_DECL PgfExprFun { static const uint8_t tag = 4; PgfText name; }; -struct PgfExprVar { +struct PGF_INTERNAL_DECL PgfExprVar { static const uint8_t tag = 5; int var; }; -struct PgfExprTyped { +struct PGF_INTERNAL_DECL PgfExprTyped { static const uint8_t tag = 6; PgfExpr expr; ref type; }; -struct PgfExprImplArg { +struct PGF_INTERNAL_DECL PgfExprImplArg { static const uint8_t tag = 7; PgfExpr expr; @@ -108,4 +108,65 @@ uintptr_t pgf_unmarshall_expr(PgfUnmarshaller *u, PgfExpr e); PGF_INTERNAL_DECL uintptr_t pgf_unmarshall_type(PgfUnmarshaller *u, PgfType *tp); +typedef struct PgfBind { + PgfBindType bind_type; + struct PgfBind *next; + PgfText var; +} PgfBind; + +class PGF_INTERNAL_DECL PgfExprParser { + enum PGF_TOKEN_TAG { + PGF_TOKEN_LPAR, + PGF_TOKEN_RPAR, + PGF_TOKEN_LCURLY, + PGF_TOKEN_RCURLY, + PGF_TOKEN_QUESTION, + PGF_TOKEN_LAMBDA, + PGF_TOKEN_RARROW, + PGF_TOKEN_LTRIANGLE, + PGF_TOKEN_RTRIANGLE, + PGF_TOKEN_COMMA, + PGF_TOKEN_COLON, + PGF_TOKEN_SEMI, + PGF_TOKEN_WILD, + PGF_TOKEN_IDENT, + PGF_TOKEN_INT, + PGF_TOKEN_FLT, + PGF_TOKEN_STR, + PGF_TOKEN_UNKNOWN, + PGF_TOKEN_EOF, + }; + + PgfUnmarshaller *u; + PGF_TOKEN_TAG token_tag; + PgfText *token_value; + PgfText *inp; + const char *pos; + uint32_t ch; + + uint32_t getc(); + void putc(uint32_t ch); + +public: + PgfExprParser(PgfText* input, PgfUnmarshaller *unmarshaller); + ~PgfExprParser(); + + void str_char(); + void token(); + bool lookahead(int ch); + + PgfBind *parse_bind(PgfBind *next); + PgfBind *parse_binds(PgfBind *next); + + + uintptr_t parse_arg(); + uintptr_t parse_term(); + uintptr_t parse_expr(); + + bool parse_hypos(size_t *n_hypos, PgfTypeHypo **hypos); + uintptr_t parse_type(); + + bool eof(); +}; + #endif /* EXPR_H_ */ diff --git a/src/runtime/c/pgf/namespace.h b/src/runtime/c/pgf/namespace.h index f8d3f7635..38243fb29 100644 --- a/src/runtime/c/pgf/namespace.h +++ b/src/runtime/c/pgf/namespace.h @@ -10,7 +10,7 @@ template using Namespace = ref>; template -class Node { +class PGF_INTERNAL_DECL Node { public: size_t sz; ref value; diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index f00a1c4f6..cf44844d8 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -214,3 +214,27 @@ pgf_function_type(PgfPGF* pgf, PgfText *funname) return pgf_unmarshall_type(pgf->u, absfun->type); } + +PGF_API uintptr_t +pgf_read_expr(PgfText *input, PgfUnmarshaller *u) +{ + PgfExprParser parser(input, u); + uintptr_t res = parser.parse_expr(); + if (!parser.eof()) { + u->free_ref(res); + return 0; + } + return res; +} + +PGF_API uintptr_t +pgf_read_type(PgfText *input, PgfUnmarshaller *u) +{ + PgfExprParser parser(input, u); + uintptr_t res = parser.parse_type(); + if (!parser.eof()) { + u->free_ref(res); + return 0; + } + return res; +} diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index 654053991..e93ee1a3a 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -166,4 +166,10 @@ void pgf_iter_functions(PgfPGF* pgf, PgfItor* itor); PGF_API void pgf_iter_functions_by_cat(PgfPGF* pgf, PgfText* cat, PgfItor* itor); +PGF_API uintptr_t +pgf_read_expr(PgfText *input, PgfUnmarshaller *u); + +PGF_API uintptr_t +pgf_read_type(PgfText *input, PgfUnmarshaller *u); + #endif // PGF_H_ diff --git a/src/runtime/c/pgf/text.h b/src/runtime/c/pgf/text.h index 7442cce0d..67005d363 100644 --- a/src/runtime/c/pgf/text.h +++ b/src/runtime/c/pgf/text.h @@ -10,4 +10,7 @@ PgfText* textdup(PgfText *t1); PGF_API uint32_t pgf_utf8_decode(const uint8_t** src_inout); +PGF_API void +pgf_utf8_encode(uint32_t ucs, uint8_t** buf); + #endif diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 5ad1eca04..46aff9ce9 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -25,8 +25,10 @@ module PGF2 (-- * PGF functionType, -- ** Expressions Expr(..), Literal(..), + readExpr, -- ** Types Type(..), Hypo, BindType(..), + readType, -- * Concrete syntax ConcName ) where @@ -200,6 +202,33 @@ functionsByCat p cat = name <- peekText key writeIORef ref $ (name : names) +----------------------------------------------------------------------- +-- Expressions & types + +-- | parses a 'String' as an expression +readExpr :: String -> Maybe Expr +readExpr str = + unsafePerformIO $ + withText str $ \c_str -> + bracket mkUnmarshaller freeUnmarshaller $ \u -> do + c_expr <- pgf_read_expr c_str u + if c_expr == castPtrToStablePtr nullPtr + then return Nothing + else do expr <- deRefStablePtr c_expr + return (Just expr) + +-- | parses a 'String' as a type +readType :: String -> Maybe Type +readType str = + unsafePerformIO $ + withText str $ \c_str -> + bracket mkUnmarshaller freeUnmarshaller $ \u -> do + c_type <- pgf_read_type c_str u + if c_type == castPtrToStablePtr nullPtr + then return Nothing + else do tp <- deRefStablePtr c_type + return (Just tp) + ----------------------------------------------------------------------- -- Exceptions diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 3bb061a82..0496bfd10 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -49,6 +49,12 @@ foreign import ccall "&pgf_free" foreign import ccall "pgf_abstract_name" pgf_abstract_name :: Ptr PgfPGF -> IO (Ptr PgfText) +foreign import ccall "pgf/expr.h pgf_read_expr" + pgf_read_expr :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Expr) + +foreign import ccall "pgf/expr.h pgf_read_type" + pgf_read_type :: Ptr PgfText -> Ptr PgfUnmarshaller -> IO (StablePtr Type) + type ItorCallback = Ptr PgfItor -> Ptr PgfText -> IO () foreign import ccall "wrapper"