GitHub/gf-core
1
0
Fork 1
mirror of https://github.com/GrammaticalFramework/gf-core.git synced 2026-05-20 00:22:51 -06:00
Code Issues Packages Projects Releases Wiki Activity

correctly distinguish between fun and data judgements

Browse Source
This commit is contained in:
krangelov
2021-11-18 13:50:09 +01:00
parent 7ff38bfcbe
commit 06980404a9
27 changed files with 59 additions and 332 deletions
Download Patch File Download Diff File Expand all files Collapse all files

14
src/runtime/c/pgf/data.cxx
View File

@@ -9,18 +9,8 @@ void PgfAbsFun::release(ref<PgfAbsFun> absfun)
{
pgf_type_free(absfun->type);
if (absfun->defns != 0) {
for (size_t i = 0; i < absfun->defns->len; i++) {
ref<PgfEquation> eq = *vector_elem(absfun->defns, i);
pgf_expr_free(eq->body);
for (size_t j = 0; j < eq->patts.len; j++) {
PgfPatt patt = *vector_elem(ref<Vector<PgfPatt>>::from_ptr(&eq->patts), j);
pgf_patt_free(patt);
}
}
PgfDB::free(absfun->defns);
if (absfun->bytecode != 0) {
PgfDB::free(absfun->bytecode);
}
}

2
src/runtime/c/pgf/data.h
View File

@@ -84,7 +84,7 @@ struct PGF_INTERNAL_DECL PgfAbsFun {
ref<PgfDTyp> type;
int arity;
ref<Vector<ref<PgfEquation>>> defns;
ref<char> bytecode;
PgfExprProb ep;
PgfText name;

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

@@ -533,7 +533,7 @@ int pgf_function_is_constructor(PgfDB *db, PgfRevision revision,
if (absfun == 0)
return false;
return (absfun->defns == 0);
return (absfun->bytecode == 0);
} PGF_API_END
return false;
@@ -753,7 +753,7 @@ PgfText *pgf_print_function_internal(object o)
PgfInternalMarshaller m;
PgfPrinter printer(NULL,0,&m);
printer.puts("fun ");
printer.puts(absfun->bytecode != 0 ? "fun " : "data ");
printer.efun(&absfun->name);
printer.puts(" : ");
m.match_type(&printer, absfun->type.as_object());
@@ -955,7 +955,8 @@ PgfRevision pgf_checkout_revision(PgfDB *db, PgfText *name,
PGF_API
void pgf_create_function(PgfDB *db, PgfRevision revision,
PgfText *name,
PgfType ty, size_t arity, prob_t prob,
PgfType ty, size_t arity, char *bytecode,
prob_t prob,
PgfMarshaller *m,
PgfExn *err)
{
@@ -969,7 +970,7 @@ void pgf_create_function(PgfDB *db, PgfRevision revision,
absfun->ref_count = 1;
absfun->type = m->match_type(&u, ty);
absfun->arity = arity;
absfun->defns = 0;
absfun->bytecode = bytecode ? PgfDB::malloc<char>(0) : 0;
absfun->ep.prob = prob;
ref<PgfExprFun> efun =
ref<PgfExprFun>::from_ptr((PgfExprFun*) &absfun->name);

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

@@ -419,7 +419,8 @@ PgfRevision pgf_checkout_revision(PgfDB *db, PgfText *name,
PGF_API_DECL
void pgf_create_function(PgfDB *db, PgfRevision revision,
PgfText *name,
PgfType ty, size_t arity, prob_t prob,
PgfType ty, size_t arity, char *bytecode,
prob_t prob,
PgfMarshaller *m,
PgfExn *err);

72
src/runtime/c/pgf/reader.cxx
View File

@@ -317,69 +317,6 @@ ref<PgfDTyp> PgfReader::read_type()
return tp;
}
PgfPatt PgfReader::read_patt()
{
PgfPatt patt = 0;
uint8_t tag = read_tag();
switch (tag) {
case PgfPattApp::tag: {
ref<PgfText> ctor = read_name();
ref<PgfPattApp> papp =
read_vector<PgfPattApp,PgfPatt>(&PgfPattApp::args,&PgfReader::read_patt2);
papp->ctor = ctor;
patt = ref<PgfPattApp>::tagged(papp);
break;
}
case PgfPattVar::tag: {
ref<PgfPattVar> pvar = read_name<PgfPattVar>(&PgfPattVar::name);
patt = ref<PgfPattVar>::tagged(pvar);
break;
}
case PgfPattAs::tag: {
ref<PgfPattAs> pas = read_name<PgfPattAs>(&PgfPattAs::name);
pas->patt = read_patt();
patt = ref<PgfPattAs>::tagged(pas);
break;
}
case PgfPattWild::tag: {
ref<PgfPattWild> pwild = PgfDB::malloc<PgfPattWild>();
patt = ref<PgfPattWild>::tagged(pwild);
break;
}
case PgfPattLit::tag: {
ref<PgfPattLit> plit = PgfDB::malloc<PgfPattLit>();
plit->lit = read_literal();
patt = ref<PgfPattLit>::tagged(plit);
break;
}
case PgfPattImplArg::tag: {
ref<PgfPattImplArg> pimpl = PgfDB::malloc<PgfPattImplArg>();
pimpl->patt = read_patt();
patt = ref<PgfPattImplArg>::tagged(pimpl);
break;
}
case PgfPattTilde::tag: {
ref<PgfPattTilde> ptilde = PgfDB::malloc<PgfPattTilde>();
ptilde->expr = read_expr();
patt = ref<PgfPattTilde>::tagged(ptilde);
break;
}
default:
throw pgf_error("Unknown pattern tag");
}
return patt;
}
void PgfReader::read_defn(ref<ref<PgfEquation>> defn)
{
ref<PgfEquation> eq = read_vector(&PgfEquation::patts,&PgfReader::read_patt2);
eq->body = read_expr();
*defn = eq;
}
ref<PgfAbsFun> PgfReader::read_absfun()
{
ref<PgfAbsFun> absfun =
@@ -394,12 +331,13 @@ ref<PgfAbsFun> PgfReader::read_absfun()
uint8_t tag = read_tag();
switch (tag) {
case 0:
absfun->defns = 0;
absfun->bytecode = 0;
break;
case 1:
absfun->defns =
read_vector<ref<PgfEquation>>(&PgfReader::read_defn);
case 1: {
read_len();
absfun->bytecode = PgfDB::malloc<char>(0);
break;
}
default:
throw pgf_error("Unknown tag, 0 or 1 expected");
}

4
src/runtime/c/pgf/reader.h
View File

@@ -59,9 +59,6 @@ public:
ref<PgfFlag> read_flag();
PgfPatt read_patt();
void read_defn(ref<ref<PgfEquation>> defn);
ref<PgfAbsFun> read_absfun();
ref<PgfAbsCat> read_abscat();
void read_abstract(ref<PgfAbstr> abstract);
@@ -84,7 +81,6 @@ private:
object read_name_internal(size_t struct_size);
object read_text_internal(size_t struct_size);
void read_patt2(ref<PgfPatt> r) { *r = read_patt(); };
void read_text2(ref<ref<PgfText>> r) { *r = read_text(); };
void read_lparam(ref<ref<PgfLParam>> r) { *r = read_lparam(); };
void read_symbol2(ref<PgfSymbol> r) { *r = read_symbol(); };

59
src/runtime/c/pgf/writer.cxx
View File

@@ -253,61 +253,6 @@ void PgfWriter::write_type(ref<PgfDTyp> ty)
write_vector<PgfExpr>(ty->exprs, &PgfWriter::write_expr);
}
void PgfWriter::write_patt(PgfPatt patt)
{
auto tag = ref<PgfPatt>::get_tag(patt);
write_tag(tag);
switch (tag) {
case PgfPattApp::tag: {
auto papp = ref<PgfPattApp>::untagged(patt);
write_name(papp->ctor);
write_vector(ref<Vector<PgfPatt>>::from_ptr(&papp->args), &PgfWriter::write_patt);
break;
}
case PgfPattVar::tag: {
auto pvar = ref<PgfPattVar>::untagged(patt);
write_name(&pvar->name);
break;
}
case PgfPattAs::tag: {
auto pas = ref<PgfPattAs>::untagged(patt);
write_name(&pas->name);
write_patt(pas->patt);
break;
}
case PgfPattWild::tag: {
auto pwild = ref<PgfPattWild>::untagged(patt);
break;
}
case PgfPattLit::tag: {
auto plit = ref<PgfPattLit>::untagged(patt);
write_literal(plit->lit);
break;
}
case PgfPattImplArg::tag: {
auto pimpl = ref<PgfPattImplArg>::untagged(patt);
write_patt(pimpl->patt);
break;
}
case PgfPattTilde::tag: {
auto ptilde = ref<PgfPattTilde>::untagged(patt);
write_expr(ptilde->expr);
break;
}
default:
throw pgf_error("Unknown pattern tag");
}
}
void PgfWriter::write_defn(ref<ref<PgfEquation>> r)
{
ref<PgfEquation> equ = *r;
write_vector(ref<Vector<PgfPatt>>::from_ptr(&equ->patts), &PgfWriter::write_patt);
write_expr(equ->body);
}
void PgfWriter::write_flag(ref<PgfFlag> flag)
{
write_name(&flag->name);
@@ -319,11 +264,11 @@ void PgfWriter::write_absfun(ref<PgfAbsFun> absfun)
write_name(&absfun->name);
write_type(absfun->type);
write_int(absfun->arity);
if (absfun->defns == 0)
if (absfun->bytecode == 0)
write_tag(0);
else {
write_tag(1);
write_vector<ref<PgfEquation>>(absfun->defns, &PgfWriter::write_defn);
write_len(0);
}
write_double(exp(-absfun->ep.prob));
}

3
src/runtime/c/pgf/writer.h
View File

@@ -32,9 +32,6 @@ public:
void write_hypo(ref<PgfHypo> hypo);
void write_type(ref<PgfDTyp> ty);
void write_patt(PgfPatt patt);
void write_defn(ref<ref<PgfEquation>> r);
void write_flag(ref<PgfFlag> flag);
void write_absfun(ref<PgfAbsFun> absfun);

29
src/runtime/haskell/PGF2/Internal.hsc → src/runtime/haskell/PGF2/ByteCode.hs
View File

@@ -1,30 +1,9 @@
{-# LANGUAGE ImplicitParams, RankNTypes #-}
module PGF2.Internal(-- * Access the internal structures
FId,isPredefFId,
fidString,fidInt,fidFloat,fidVar,fidStart,
-- * Byte code
module PGF2.ByteCode(-- * Byte code
CodeLabel, Instr(..), IVal(..), TailInfo(..),
unionPGF, writeConcr
) where
import PGF2.FFI
import PGF2.Expr
type FId = Int
fidString, fidInt, fidFloat, fidVar, fidStart :: FId
fidString = (-1)
fidInt = (-2)
fidFloat = (-3)
fidVar = (-4)
fidStart = (-5)
isPredefFId :: FId -> Bool
isPredefFId = (`elem` [fidString, fidInt, fidFloat, fidVar])
type CodeLabel = Int
data Instr
@@ -60,9 +39,3 @@ data TailInfo
= RecCall
| TailCall {-# UNPACK #-} !Int
| UpdateCall
unionPGF :: PGF -> PGF -> Maybe PGF
unionPGF = error "TODO: unionPGF"
writeConcr :: FilePath -> Concr -> IO ()
writeConcr = error "TODO: writeConcr"

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

@@ -151,7 +151,7 @@ foreign import ccall pgf_commit_revision :: Ptr PgfDB -> Ptr PGF -> Ptr PgfExn -
foreign import ccall pgf_checkout_revision :: Ptr PgfDB -> Ptr PgfText -> Ptr PgfExn -> IO (Ptr PGF)
foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Type -> CSize -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
foreign import ccall pgf_create_function :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> StablePtr Type -> CSize -> Ptr CChar -> (#type prob_t) -> Ptr PgfMarshaller -> Ptr PgfExn -> IO ()
foreign import ccall pgf_drop_function :: Ptr PgfDB -> Ptr PGF -> Ptr PgfText -> Ptr PgfExn -> IO ()

8
src/runtime/haskell/PGF2/Transactions.hsc
View File

@@ -28,6 +28,7 @@ module PGF2.Transactions
import PGF2.FFI
import PGF2.Expr
import PGF2.ByteCode
import Foreign
import Foreign.C
@@ -123,12 +124,13 @@ checkoutPGF p name =
langs <- getConcretes (a_db p) fptr
return (Just (PGF (a_db p) fptr langs))
createFunction :: Fun -> Type -> Int -> Float -> Transaction PGF ()
createFunction name ty arity prob = Transaction $ \c_db _ c_revision c_exn ->
createFunction :: Fun -> Type -> Int -> [[Instr]] -> Float -> Transaction PGF ()
createFunction name ty arity bytecode prob = Transaction $ \c_db _ c_revision c_exn ->
withText name $ \c_name ->
bracket (newStablePtr ty) freeStablePtr $ \c_ty ->
(if null bytecode then (\f -> f nullPtr) else (allocaBytes 0)) $ \c_bytecode ->
withForeignPtr marshaller $ \m -> do
pgf_create_function c_db c_revision c_name c_ty (fromIntegral arity) prob m c_exn
pgf_create_function c_db c_revision c_name c_ty (fromIntegral arity) c_bytecode prob m c_exn
dropFunction :: Fun -> Transaction PGF ()
dropFunction name = Transaction $ \c_db _ c_revision c_exn ->

2
src/runtime/haskell/pgf2.cabal
View File

@@ -23,7 +23,7 @@ library
exposed-modules:
PGF2,
PGF2.Transactions,
PGF2.Internal,
PGF2.ByteCode,
-- backwards compatibility API:
PGF
other-modules:

BIN
src/runtime/haskell/tests/basic.pgf
View File

Binary file not shown.

19
src/runtime/haskell/tests/basic_cnc.gf Normal file
View File

@@ -0,0 +1,19 @@
concrete basic_cnc of basic = open Prelude in {
lincat N = {s : Str; is_zero : Bool} ;
lincat S = Str ;
lin z = {s="0"; is_zero=True} ;
s n = {
s = case n.is_zero of {
True => "1" ;
False => n.s ++ "+" ++ "1"
} ;
is_zero = False
} ;
lin c n = n.s ;
lincat P = {};
}

8
src/runtime/haskell/tests/transactions.hs
View File

@@ -9,9 +9,9 @@ main = do
gr1 <- readPGF "tests/basic.pgf"
let Just ty = readType "(N -> N) -> P (s z)"
gr2 <- modifyPGF gr1 (createFunction "foo" ty 0 pi >>
gr2 <- modifyPGF gr1 (createFunction "foo" ty 0 [] pi >>
createCategory "Q" [(Explicit,"x",ty)] pi)
gr3 <- branchPGF gr1 "bar_branch" (createFunction "bar" ty 0 pi >>
gr3 <- branchPGF gr1 "bar_branch" (createFunction "bar" ty 0 [] pi >>
createCategory "R" [(Explicit,"x",ty)] pi)
Just gr4 <- checkoutPGF gr1 "master"
@@ -44,8 +44,8 @@ main = do
,TestCase (assertEqual "new function prob" pi (functionProbability gr2 "foo"))
,TestCase (assertEqual "old category prob" (-log 0) (categoryProbability gr1 "Q"))
,TestCase (assertEqual "new category prob" pi (categoryProbability gr2 "Q"))
,TestCase (assertEqual "empty concretes" [] (Map.keys (languages gr1)))
,TestCase (assertEqual "extended concretes" ["basic_eng"] (Map.keys (languages gr7)))
,TestCase (assertEqual "empty concretes" ["basic_cnc"] (Map.keys (languages gr1)))
,TestCase (assertEqual "extended concretes" ["basic_cnc","basic_eng"] (Map.keys (languages gr7)))
,TestCase (assertEqual "added concrete flag" (Just (LStr "test")) (concreteFlag cnc "test_flag"))
]

2
src/runtime/python/transactions.c
View File

@@ -149,7 +149,7 @@ Transaction_createFunction(TransactionObject *self, PyObject *args)
PgfText *funname = CString_AsPgfText(s, size);
PgfExn err;
pgf_create_function(self->pgf->db, self->revision, funname, (PgfType) type, arity, prob, &marshaller, &err);
pgf_create_function(self->pgf->db, self->revision, funname, (PgfType) type, arity, NULL, prob, &marshaller, &err);
FreePgfText(funname);
if (handleError(err) != PGF_EXN_NONE) {
return NULL;