implemented readExpr & readType

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<PgfText> ctor;
     PgfVector<PgfPatt> 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;

src/runtime/c/pgf/db.h

@@ -12,7 +12,7 @@ typedef moffset variant;
 
 struct malloc_state;
 
-template<class A> class ref {
+template<class A> class PGF_INTERNAL_DECL ref {
 private:
     moffset offset;
 

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<PgfText> cid;
 	ref<PgfType> type;
 };
 
-struct PgfType {
+struct PGF_INTERNAL_DECL PgfType {
 	ref<PgfVector<PgfHypo>> hypos;
     ref<PgfVector<PgfExpr>> 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<PgfType> 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_ */

src/runtime/c/pgf/namespace.h

@@ -10,7 +10,7 @@ template <class V>
 using Namespace = ref<Node<V>>;
 
 template <class V>
-class Node {
+class PGF_INTERNAL_DECL Node {
 public:
     size_t sz;
     ref<V> value;

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;
+}

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_

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

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
 

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"