diff --git a/src/runtime/c/pgf/expr.cxx b/src/runtime/c/pgf/expr.cxx index dc7714ea3..262c3d074 100644 --- a/src/runtime/c/pgf/expr.cxx +++ b/src/runtime/c/pgf/expr.cxx @@ -1,4 +1,5 @@ #include "pgf/data.h" +#include PgfLiteral PgfDBMarshaller::match_lit(PgfUnmarshaller *u, PgfLiteral l) { @@ -924,6 +925,84 @@ exit: return type; } +PgfExpr PgfExprProbEstimator::eabs(PgfBindType bind_type, PgfText *name, PgfExpr body) +{ + m->match_type(this, body); + return 0; +} + +PgfExpr PgfExprProbEstimator::eapp(PgfExpr fun, PgfExpr arg) +{ + m->match_type(this, fun); + m->match_type(this, arg); + return 0; +} + +PgfExpr PgfExprProbEstimator::elit(PgfLiteral lit) +{ + return 0; +} + +PgfExpr PgfExprProbEstimator::emeta(PgfMetaId meta_id) +{ + return 0; +} + +PgfExpr PgfExprProbEstimator::efun(PgfText *name) +{ + ref absfun = + namespace_lookup(pgf->abstract.funs, name); + if (absfun == 0) + prob = INFINITY; + else + prob += absfun->ep.prob; + + return 0; +} + +PgfExpr PgfExprProbEstimator::evar(int index) +{ + return 0; +} + +PgfExpr PgfExprProbEstimator::etyped(PgfExpr expr, PgfType ty) +{ + m->match_type(this, expr); + return 0; +} + +PgfExpr PgfExprProbEstimator::eimplarg(PgfExpr expr) +{ + m->match_type(this, expr); + return 0; +} + +PgfLiteral PgfExprProbEstimator::lint(size_t size, uintmax_t *val) +{ + return 0; +} + +PgfLiteral PgfExprProbEstimator::lflt(double val) +{ + return 0; +} + +PgfLiteral PgfExprProbEstimator::lstr(PgfText *val) +{ + return 0; +} + +PgfType PgfExprProbEstimator::dtyp(size_t n_hypos, PgfTypeHypo *hypos, + PgfText *cat, + size_t n_exprs, PgfExpr *exprs) +{ + return 0; +} + +void PgfExprProbEstimator::free_ref(object x) +{ +} + PGF_INTERNAL void pgf_literal_free(PgfLiteral literal) { diff --git a/src/runtime/c/pgf/expr.h b/src/runtime/c/pgf/expr.h index e277f421c..e645b61fa 100644 --- a/src/runtime/c/pgf/expr.h +++ b/src/runtime/c/pgf/expr.h @@ -236,6 +236,37 @@ public: const char *get_token_pos() { return token_pos; } }; +class PGF_INTERNAL_DECL PgfExprProbEstimator : public PgfUnmarshaller { + PgfPGF *pgf; + PgfMarshaller *m; + prob_t prob; + +public: + PgfExprProbEstimator(PgfPGF *pgf, PgfMarshaller *marshaller) { + this->pgf = pgf; + this->m = marshaller; + this->prob = 0; + } + + virtual PgfExpr eabs(PgfBindType bind_type, PgfText *name, PgfExpr body); + virtual PgfExpr eapp(PgfExpr fun, PgfExpr arg); + virtual PgfExpr elit(PgfLiteral lit); + virtual PgfExpr emeta(PgfMetaId meta_id); + virtual PgfExpr efun(PgfText *name); + virtual PgfExpr evar(int index); + virtual PgfExpr etyped(PgfExpr expr, PgfType ty); + virtual PgfExpr eimplarg(PgfExpr expr); + virtual PgfLiteral lint(size_t size, uintmax_t *val); + virtual PgfLiteral lflt(double val); + virtual PgfLiteral lstr(PgfText *val); + virtual PgfType dtyp(size_t n_hypos, PgfTypeHypo *hypos, + PgfText *cat, + size_t n_exprs, PgfExpr *exprs); + virtual void free_ref(object x); + + prob_t get_prob() { return prob; }; +}; + PGF_INTERNAL_DECL extern PgfText wildcard; /* The following functions release the memory in the database, diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index 42e40ee03..1c08025a4 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -439,6 +439,24 @@ PgfExpr pgf_read_expr_ex(PgfText *input, const char **end_pos, PgfUnmarshaller * return expr; } +PGF_API +prob_t pgf_expr_prob(PgfDB *db, PgfRevision revision, + PgfExpr e, + PgfMarshaller *m, + PgfExn *err) +{ + PGF_API_BEGIN { + DB_scope scope(db, READER_SCOPE); + ref pgf = PgfDB::revision2pgf(revision); + + PgfExprProbEstimator estimator(pgf, m); + m->match_expr(&estimator, e); + return estimator.get_prob(); + } PGF_API_END + + return 0; +} + PGF_API PgfText *pgf_print_type(PgfType ty, PgfPrintContext *ctxt, int prio, diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index 8af87bbfc..cba765073 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -320,6 +320,12 @@ 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 +prob_t pgf_expr_prob(PgfDB *db, PgfRevision revision, + PgfExpr e, + PgfMarshaller *m, + PgfExn *err); + PGF_API_DECL PgfText *pgf_print_type(PgfType ty, PgfPrintContext *ctxt, int prio, diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index f2a15eab1..c0d8c08fa 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -213,7 +213,13 @@ functionProbability p fun = withPgfExn (pgf_function_prob c_db c_revision c_fun) exprProbability :: PGF -> Expr -> Float -exprProbability = error "TODO: exprProbability" +exprProbability p e = + unsafePerformIO $ + withForeignPtr (a_db p) $ \c_db -> + withForeignPtr (revision p) $ \c_revision -> + bracket (newStablePtr e) freeStablePtr $ \c_e -> + withForeignPtr marshaller $ \m -> + withPgfExn (pgf_expr_prob c_db c_revision c_e m) checkExpr :: PGF -> Expr -> Type -> Either String Expr checkExpr = error "TODO: checkExpr" diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index 767be72a4..d2eb127ce 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -113,6 +113,8 @@ foreign import ccall "pgf_function_is_constructor" foreign import ccall "pgf_function_prob" pgf_function_prob :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (#type prob_t) +foreign import ccall pgf_expr_prob :: Ptr PgfDB -> Ptr PgfRevision -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfExn -> IO (#type prob_t) + foreign import ccall pgf_clone_revision :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr PgfRevision) foreign import ccall pgf_commit_revision :: Ptr PgfDB -> Ptr PgfRevision -> Ptr PgfExn -> IO ()