From ae08d42d6ec86da7ec6f01da2eb676d2a348b944 Mon Sep 17 00:00:00 2001 From: krangelov Date: Fri, 26 Nov 2021 18:44:17 +0100 Subject: [PATCH] started the linearizer --- src/runtime/c/Makefile.am | 2 + src/runtime/c/pgf/linearizer.cxx | 86 ++++++++++++++++++++++++++++++++ src/runtime/c/pgf/linearizer.h | 60 ++++++++++++++++++++++ src/runtime/c/pgf/pgf.cxx | 22 ++++++++ src/runtime/c/pgf/pgf.h | 5 ++ src/runtime/haskell/PGF2.hsc | 8 ++- src/runtime/haskell/PGF2/FFI.hsc | 2 + 7 files changed, 184 insertions(+), 1 deletion(-) create mode 100644 src/runtime/c/pgf/linearizer.cxx create mode 100644 src/runtime/c/pgf/linearizer.h diff --git a/src/runtime/c/Makefile.am b/src/runtime/c/Makefile.am index 742db1614..2f4721282 100644 --- a/src/runtime/c/Makefile.am +++ b/src/runtime/c/Makefile.am @@ -21,6 +21,8 @@ libpgf_la_SOURCES = \ pgf/printer.h \ pgf/typechecker.cxx \ pgf/typechecker.h \ + pgf/linearizer.cxx \ + pgf/linearizer.h \ pgf/data.cxx \ pgf/data.h \ pgf/expr.cxx \ diff --git a/src/runtime/c/pgf/linearizer.cxx b/src/runtime/c/pgf/linearizer.cxx new file mode 100644 index 000000000..1fc44b5e6 --- /dev/null +++ b/src/runtime/c/pgf/linearizer.cxx @@ -0,0 +1,86 @@ +#include "data.h" +#include "linearizer.h" + +PgfLinearizer::~PgfLinearizer() +{ + while (first != NULL) { + TreeNode *next = first->next; + delete first; + first = next; + } +} + +PgfExpr PgfLinearizer::eabs(PgfBindType btype, PgfText *name, PgfExpr body) +{ + return 0; +} + +PgfExpr PgfLinearizer::eapp(PgfExpr fun, PgfExpr arg) +{ + TreeNode *args = this->args; + this->args = NULL; + TreeNode *node = (TreeNode*) m->match_expr(this, arg); + node->next_arg = args; + this->args = node; + + m->match_expr(this, fun); + return 0; +} + +PgfExpr PgfLinearizer::elit(PgfLiteral lit) +{ + return m->match_lit(this, lit); +} + +PgfExpr PgfLinearizer::emeta(PgfMetaId meta) +{ + return 0; +} + +PgfExpr PgfLinearizer::efun(PgfText *name) +{ + ref lin = namespace_lookup(concr->lins, name); + TreeNode *node = new TreeNode(this, lin); + return (PgfExpr) node; +} + +PgfExpr PgfLinearizer::evar(int index) +{ + return 0; +} + +PgfExpr PgfLinearizer::etyped(PgfExpr expr, PgfType ty) +{ + return m->match_expr(this, expr); +} + +PgfExpr PgfLinearizer::eimplarg(PgfExpr expr) +{ + return m->match_expr(this, expr); +} + +PgfLiteral PgfLinearizer::lint(size_t size, uintmax_t *v) +{ + return 0; +} + +PgfLiteral PgfLinearizer::lflt(double v) +{ + return 0; +} + +PgfLiteral PgfLinearizer::lstr(PgfText *v) +{ + return 0; +} + +PgfType PgfLinearizer::dtyp(size_t n_hypos, PgfTypeHypo *hypos, + PgfText *cat, + size_t n_exprs, PgfExpr *exprs) +{ + return 0; +} + +void PgfLinearizer::free_ref(object x) +{ +} diff --git a/src/runtime/c/pgf/linearizer.h b/src/runtime/c/pgf/linearizer.h new file mode 100644 index 000000000..cc4bd463e --- /dev/null +++ b/src/runtime/c/pgf/linearizer.h @@ -0,0 +1,60 @@ +#ifndef LINEARIZER_H +#define LINEARIZER_H + +class PGF_INTERNAL_DECL PgfLinearizer : public PgfUnmarshaller { + ref concr; + PgfMarshaller *m; + + struct TreeNode { + TreeNode *next; + TreeNode *next_arg; + TreeNode *args; + + ref lin; + + TreeNode(PgfLinearizer *linearizer, ref lin) { + this->next = linearizer->root; + this->next_arg = NULL; + this->args = linearizer->args; + this->lin = lin; + + if (linearizer->first == NULL) + linearizer->first = this; + + linearizer->root = this; + } + }; + + TreeNode *root; + TreeNode *first; + TreeNode *args; + +public: + PgfLinearizer(ref concr, PgfMarshaller *m) { + this->concr = concr; + this->m = m; + this->root = NULL; + this->first = NULL; + this->args = NULL; + }; + + ~PgfLinearizer(); + + virtual PgfExpr eabs(PgfBindType btype, PgfText *name, PgfExpr body); + virtual PgfExpr eapp(PgfExpr fun, PgfExpr arg); + virtual PgfExpr elit(PgfLiteral lit); + virtual PgfExpr emeta(PgfMetaId meta); + virtual PgfExpr efun(PgfText *name); + virtual PgfExpr evar(int index); + virtual PgfExpr etyped(PgfExpr expr, PgfType typ); + virtual PgfExpr eimplarg(PgfExpr expr); + virtual PgfLiteral lint(size_t size, uintmax_t *v); + virtual PgfLiteral lflt(double v); + virtual PgfLiteral lstr(PgfText *v); + virtual PgfType dtyp(size_t n_hypos, PgfTypeHypo *hypos, + PgfText *cat, + size_t n_exprs, PgfExpr *exprs); + virtual void free_ref(object x); +}; + +#endif diff --git a/src/runtime/c/pgf/pgf.cxx b/src/runtime/c/pgf/pgf.cxx index c62b01b4e..eecd5fca1 100644 --- a/src/runtime/c/pgf/pgf.cxx +++ b/src/runtime/c/pgf/pgf.cxx @@ -10,6 +10,7 @@ #include "writer.h" #include "printer.h" #include "typechecker.h" +#include "linearizer.h" static void pgf_exn_clear(PgfExn* err) @@ -1846,6 +1847,27 @@ int pgf_has_linearization(PgfDB *db, PgfConcrRevision revision, return 0; } +PGF_API +PgfText *pgf_linearize(PgfDB *db, PgfConcrRevision revision, + PgfExpr expr, PgfMarshaller *m, + PgfExn* err) +{ + PGF_API_BEGIN { + DB_scope scope(db, READER_SCOPE); + + ref concr = PgfDB::revision2concr(revision); + PgfLinearizer linearizer(concr, m); + m->match_expr(&linearizer, expr); + + PgfText *res = (PgfText*) malloc(sizeof(PgfText)+1); + res->size = 0; + res->text[0] = 0; + return res; + } PGF_API_END + + return NULL; +} + PGF_API PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision, PgfText *name, diff --git a/src/runtime/c/pgf/pgf.h b/src/runtime/c/pgf/pgf.h index 13accd30d..af44e2b8d 100644 --- a/src/runtime/c/pgf/pgf.h +++ b/src/runtime/c/pgf/pgf.h @@ -569,6 +569,11 @@ PGF_API_DECL int pgf_has_linearization(PgfDB *db, PgfConcrRevision revision, PgfText *name, PgfExn *err); +PGF_API_DECL +PgfText *pgf_linearize(PgfDB *db, PgfConcrRevision revision, + PgfExpr expr, PgfMarshaller *m, + PgfExn* err); + PGF_API_DECL PgfLiteral pgf_get_global_flag(PgfDB *db, PgfRevision revision, PgfText *name, diff --git a/src/runtime/haskell/PGF2.hsc b/src/runtime/haskell/PGF2.hsc index 7667062c6..2ca6f3053 100644 --- a/src/runtime/haskell/PGF2.hsc +++ b/src/runtime/haskell/PGF2.hsc @@ -578,7 +578,13 @@ hasLinearization c name = -- | Linearizes an expression as a string in the language linearize :: Concr -> Expr -> String -linearize lang e = error "TODO: linearize" +linearize c e = + unsafePerformIO $ + withForeignPtr (c_revision c) $ \c_revision -> + bracket (newStablePtr e) freeStablePtr $ \c_e -> + withForeignPtr marshaller $ \m -> + bracket (withPgfExn "linearize" (pgf_linearize (c_db c) c_revision c_e m)) free $ \c_text -> + peekText c_text -- | Generates all possible linearizations of an expression linearizeAll :: Concr -> Expr -> [String] diff --git a/src/runtime/haskell/PGF2/FFI.hsc b/src/runtime/haskell/PGF2/FFI.hsc index f3bd82365..a068f459c 100644 --- a/src/runtime/haskell/PGF2/FFI.hsc +++ b/src/runtime/haskell/PGF2/FFI.hsc @@ -197,6 +197,8 @@ foreign import ccall pgf_drop_lin :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Pt foreign import ccall pgf_has_linearization :: Ptr PgfDB -> Ptr Concr -> Ptr PgfText -> Ptr PgfExn -> IO CInt +foreign import ccall pgf_linearize :: Ptr PgfDB -> Ptr Concr -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfExn -> IO (Ptr PgfText) + foreign import ccall pgf_get_global_flag :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Literal) foreign import ccall pgf_set_global_flag :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Literal -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()