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

started on the typechecker

Browse Source
This commit is contained in:
krangelov
2021-11-19 10:39:06 +01:00
parent 1107b245da
commit fa1d7cf859
7 changed files with 212 additions and 2 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
src/runtime/c/Makefile.am
View File

@@ -19,6 +19,8 @@ libpgf_la_SOURCES = \
pgf/writer.h \
pgf/printer.cxx \
pgf/printer.h \
pgf/typechecker.cxx \
pgf/typechecker.h \
pgf/data.cxx \
pgf/data.h \
pgf/expr.cxx \

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

@@ -9,6 +9,7 @@
#include "reader.h"
#include "writer.h"
#include "printer.h"
#include "typechecker.h"
static void
pgf_exn_clear(PgfExn* err)
@@ -861,6 +862,60 @@ PgfText *pgf_print_lin_seq_internal(object o, size_t i, size_t j)
return printer.get_text();
}
PGF_API
void pgf_check_expr(PgfDB *db, PgfRevision revision,
PgfExpr* pe, PgfType ty,
PgfMarshaller *m, PgfUnmarshaller *u,
PgfExn *err)
{
PGF_API_BEGIN {
DB_scope scope(db, READER_SCOPE);
ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
PgfTypechecker checker(pgf,u);
*pe = m->match_expr(&checker, *pe);
} PGF_API_END
}
PGF_API
PgfType pgf_infer_expr(PgfDB *db, PgfRevision revision,
PgfExpr* pe,
PgfMarshaller *m, PgfUnmarshaller *u,
PgfExn *err)
{
PGF_API_BEGIN {
DB_scope scope(db, READER_SCOPE);
ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
PgfTypechecker checker(pgf,u);
*pe = m->match_expr(&checker, *pe);
} PGF_API_END
PgfText *cat = (PgfText *) alloca(sizeof(PgfText)+2);
cat->size = 1;
cat->text[0] = 'S';
cat->text[1] = 0;
return u->dtyp(0,NULL,cat,0,NULL);
}
PGF_API
void pgf_check_type(PgfDB *db, PgfRevision revision,
PgfType* pty,
PgfMarshaller *m, PgfUnmarshaller *u,
PgfExn *err)
{
PGF_API_BEGIN {
DB_scope scope(db, READER_SCOPE);
ref<PgfPGF> pgf = PgfDB::revision2pgf(revision);
PgfTypechecker checker(pgf,u);
*pty = m->match_type(&checker, *pty);
} PGF_API_END
}
PGF_API
PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
PgfText *name,

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

@@ -403,6 +403,24 @@ PgfText *pgf_print_lin_sig_internal(object o, size_t i);
PGF_API_DECL
PgfText *pgf_print_lin_seq_internal(object o, size_t i, size_t j);
PGF_API_DECL
void pgf_check_expr(PgfDB *db, PgfRevision revision,
PgfExpr* pe, PgfType ty,
PgfMarshaller *m, PgfUnmarshaller *u,
PgfExn *err);
PGF_API_DECL
PgfType pgf_infer_expr(PgfDB *db, PgfRevision revision,
PgfExpr* pe,
PgfMarshaller *m, PgfUnmarshaller *u,
PgfExn *err);
PGF_API_DECL
void pgf_check_type(PgfDB *db, PgfRevision revision,
PgfType* pty,
PgfMarshaller *m, PgfUnmarshaller *u,
PgfExn *err);
PGF_API_DECL
PgfRevision pgf_clone_revision(PgfDB *db, PgfRevision revision,
PgfText *name,

69
src/runtime/c/pgf/typechecker.cxx Normal file
View File

@@ -0,0 +1,69 @@
#include "data.h"
#include "typechecker.h"
PgfExpr PgfTypechecker::eabs(PgfBindType btype, PgfText *name, PgfExpr body)
{
return u->eabs(btype,name,body);
}
PgfExpr PgfTypechecker::eapp(PgfExpr fun, PgfExpr arg)
{
return u->eapp(fun, arg);
}
PgfExpr PgfTypechecker::elit(PgfLiteral lit)
{
return u->elit(lit);
}
PgfExpr PgfTypechecker::emeta(PgfMetaId meta)
{
return u->emeta(meta);
}
PgfExpr PgfTypechecker::efun(PgfText *name)
{
return u->efun(name);
}
PgfExpr PgfTypechecker::evar(int index)
{
return u->evar(index);
}
PgfExpr PgfTypechecker::etyped(PgfExpr expr, PgfType ty)
{
return u->etyped(expr,ty);
}
PgfExpr PgfTypechecker::eimplarg(PgfExpr expr)
{
return u->eimplarg(expr);
}
PgfLiteral PgfTypechecker::lint(size_t size, uintmax_t *v)
{
return u->lint(size,v);
}
PgfLiteral PgfTypechecker::lflt(double v)
{
return u->lflt(v);
}
PgfLiteral PgfTypechecker::lstr(PgfText *v)
{
return u->lstr(v);
}
PgfType PgfTypechecker::dtyp(size_t n_hypos, PgfTypeHypo *hypos,
PgfText *cat,
size_t n_exprs, PgfExpr *exprs)
{
return u->dtyp(n_hypos, hypos, cat, n_exprs, exprs);
}
void PgfTypechecker::free_ref(object x)
{
u->free_ref(x);
}

31
src/runtime/c/pgf/typechecker.h Normal file
View File

@@ -0,0 +1,31 @@
#ifndef TYPECHECKER_H
#define TYPECHECKER_H
class PGF_INTERNAL_DECL PgfTypechecker : public PgfUnmarshaller {
ref<PgfPGF> gr;
PgfUnmarshaller *u;
public:
PgfTypechecker(ref<PgfPGF> gr, PgfUnmarshaller *u) {
this->gr = gr;
this->u = u;
};
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

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

@@ -94,7 +94,7 @@ import PGF2.FFI
import Foreign
import Foreign.C
import Control.Monad(forM,forM_)
import Control.Exception(mask_,bracket)
import Control.Exception(bracket,mask_,throwIO)
import System.IO.Unsafe(unsafePerformIO)
import System.Random
import qualified Data.Map as Map
@@ -345,7 +345,36 @@ checkExpr = error "TODO: checkExpr"
-- possible to infer its type in the GF type system.
-- In this case the function returns an error.
inferExpr :: PGF -> Expr -> Either String (Expr, Type)
inferExpr = error "TODO: inferExpr"
inferExpr p e =
unsafePerformIO $
withForeignPtr marshaller $ \m ->
withForeignPtr unmarshaller $ \u ->
withForeignPtr (a_revision p) $ \c_revision ->
bracket (newStablePtr e) freeStablePtr $ \c_e ->
alloca $ \p_e ->
allocaBytes (#size PgfExn) $ \c_exn -> do
poke p_e c_e
c_ty <- pgf_infer_expr (a_db p) c_revision p_e m u c_exn
ex_type <- (#peek PgfExn, type) c_exn :: IO (#type PgfExnType)
case ex_type of
(#const PGF_EXN_NONE) -> do
c_e <- peek p_e
e <- deRefStablePtr c_e
ty <- deRefStablePtr c_ty
return (Right (e,ty))
(#const PGF_EXN_SYSTEM_ERROR) -> do
errno <- (#peek PgfExn, code) c_exn
c_msg <- (#peek PgfExn, msg) c_exn
mb_fpath <- if c_msg == nullPtr
then return Nothing
else fmap Just (peekCString c_msg)
ioError (errnoToIOError "inferExpr" (Errno errno) Nothing mb_fpath)
(#const PGF_EXN_PGF_ERROR) -> do
c_msg <- (#peek PgfExn, msg) c_exn
msg <- peekCString c_msg
free c_msg
return (Left msg)
_ -> throwIO (PGFError "inferExpr" "An unidentified error occurred")
-- | Check whether a type is consistent with the abstract
-- syntax of the grammar.

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

@@ -145,6 +145,12 @@ foreign import ccall pgf_concrete_language_code :: Ptr PgfDB -> Ptr Concr -> Ptr
foreign import ccall pgf_expr_prob :: Ptr PgfDB -> Ptr PGF -> StablePtr Expr -> Ptr PgfMarshaller -> Ptr PgfExn -> IO (#type prob_t)
foreign import ccall pgf_check_expr :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Expr) -> StablePtr Type -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO ()
foreign import ccall pgf_infer_expr :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Expr) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO (StablePtr Type)
foreign import ccall pgf_check_type :: Ptr PgfDB -> Ptr PGF -> Ptr (StablePtr Type) -> Ptr PgfMarshaller -> Ptr PgfUnmarshaller -> Ptr PgfExn -> IO ()
foreign import ccall pgf_clone_revision :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr PGF)
foreign import ccall pgf_commit_revision :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -> IO ()