xo-interpreter2 stack: modularize nth() primitive setup/install
This commit is contained in:
parent
481d0e73e3
commit
a3aa582eb9
19 changed files with 216 additions and 49 deletions
|
|
@ -280,7 +280,7 @@ namespace xo {
|
|||
obj<AExpression> expr_;
|
||||
|
||||
/** environment pointer. Maintains bindings
|
||||
* for global variables.
|
||||
* for global variables. Obtained from reader
|
||||
**/
|
||||
DGlobalEnv * global_env_ = nullptr;
|
||||
|
||||
|
|
|
|||
|
|
@ -86,7 +86,7 @@ namespace xo {
|
|||
this->error_mm_.adopt(obj<AAllocator,DArena>(arena));
|
||||
}
|
||||
|
||||
this->global_env_ = DGlobalEnv::_make(mm_.to_op(), reader_.global_symtab());
|
||||
this->global_env_ = reader_.global_env();
|
||||
|
||||
this->install_core_primitives();
|
||||
}
|
||||
|
|
@ -915,26 +915,6 @@ namespace xo {
|
|||
static DPrimitive_gco_0 s_cwd_pm("_cwd",
|
||||
&xfer_cwd);
|
||||
|
||||
// ----- primitive: nth() -----
|
||||
|
||||
// TODO: seq_gc -> obj<ASequence>
|
||||
// n_gco -> obj<AGCObject,DInteger>
|
||||
//
|
||||
obj<AGCObject>
|
||||
xfer_nth(obj<ARuntimeContext> rcx,
|
||||
obj<AGCObject> seq_gco,
|
||||
obj<AGCObject> n_gco)
|
||||
{
|
||||
(void)rcx;
|
||||
|
||||
obj<ASequence> seq = seq_gco.to_facet<ASequence>();
|
||||
auto n = obj<AGCObject,DInteger>::from(n_gco);
|
||||
|
||||
return seq.at(n->value());
|
||||
}
|
||||
|
||||
static DPrimitive_gco_2_gco_gco s_nth_pm("_nth", &xfer_nth);
|
||||
|
||||
// ----- primitive: cons() -----
|
||||
|
||||
obj<AGCObject>
|
||||
|
|
@ -1045,18 +1025,6 @@ namespace xo {
|
|||
obj<AGCObject,DPrimitive_gco_0>(&s_cwd_pm));
|
||||
}
|
||||
|
||||
/* nth */
|
||||
{
|
||||
const DUniqueString * name
|
||||
= reader_.intern_string("nth");
|
||||
|
||||
global_env_->_upsert_value
|
||||
(mm_.to_op(),
|
||||
name,
|
||||
Reflect::require<DPrimitive_gco_2_gco_gco>(),
|
||||
obj<AGCObject,DPrimitive_gco_2_gco_gco>(&s_nth_pm));
|
||||
}
|
||||
|
||||
/* cons */
|
||||
{
|
||||
const DUniqueString * name
|
||||
|
|
|
|||
|
|
@ -35,6 +35,10 @@ namespace xo {
|
|||
static DPrimitive_gco_2_gco_gco * make_cmplt_pm(obj<AAllocator> mm);
|
||||
/** polymorphic (in both arguments) compare (<=) **/
|
||||
static DPrimitive_gco_2_gco_gco * make_cmple_pm(obj<AAllocator> mm);
|
||||
/** polymorphic (in both arguments) compare (>) **/
|
||||
static DPrimitive_gco_2_gco_gco * make_cmpgt_pm(obj<AAllocator> mm);
|
||||
/** polymorphic (in both arguments) compare (>=) **/
|
||||
static DPrimitive_gco_2_gco_gco * make_cmpge_pm(obj<AAllocator> mm);
|
||||
};
|
||||
}
|
||||
}
|
||||
|
|
|
|||
|
|
@ -10,8 +10,8 @@
|
|||
|
||||
namespace xo {
|
||||
namespace scm {
|
||||
/** Register gc-aware (AGCObject,DRepr) combinations with garbage collector @p gc **/
|
||||
bool numeric_register_primitives(obj<xo::mm::AAllocator> gc,
|
||||
/** Register primitive factories with primitive registry **/
|
||||
bool numeric_register_primitives(obj<xo::mm::AAllocator> mm,
|
||||
InstallSink sink,
|
||||
InstallFlags flags);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -68,6 +68,22 @@ namespace xo {
|
|||
&NumericDispatch::cmp_lessequal);
|
||||
}
|
||||
|
||||
DPrimitive_gco_2_gco_gco *
|
||||
NumericPrimitives::make_cmpgt_pm(obj<AAllocator> mm)
|
||||
{
|
||||
return DPrimitive_gco_2_gco_gco::_make(mm, "_cmpgt",
|
||||
&NumericDispatch::cmp_greater);
|
||||
}
|
||||
|
||||
DPrimitive_gco_2_gco_gco *
|
||||
NumericPrimitives::make_cmpge_pm(obj<AAllocator> mm)
|
||||
{
|
||||
return DPrimitive_gco_2_gco_gco::_make(mm, "_cmpge",
|
||||
&NumericDispatch::cmp_greatequal);
|
||||
}
|
||||
|
||||
|
||||
|
||||
} /*namespace scm*/
|
||||
} /*namespace xo*/
|
||||
|
||||
|
|
|
|||
|
|
@ -61,18 +61,24 @@ namespace xo {
|
|||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_divide_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
ok = ok & install_aux(sink, mm, "_add", &NumericDispatch::add,
|
||||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_add_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
ok = ok & install_aux(sink, mm, "_sub", &NumericDispatch::subtract,
|
||||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_subtract_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
|
||||
ok = ok & install_aux(sink, mm, "_cmpeq", &NumericDispatch::cmp_equal,
|
||||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_cmpeq_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
ok = ok & install_aux(sink, mm, "_cmpne", &NumericDispatch::cmp_notequal,
|
||||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_cmpne_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
ok = ok & install_aux(sink, mm, "_cmplt", &NumericDispatch::cmp_less,
|
||||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_cmplt_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
ok = ok & install_aux(sink, mm, "_cmple", &NumericDispatch::cmp_lessequal,
|
||||
ok = ok & install_aux(sink,
|
||||
NumericPrimitives::make_cmple_pm(mm),
|
||||
flags & InstallFlags::f_essential);
|
||||
ok = ok & install_aux(sink, mm, "_cmpgt", &NumericDispatch::cmp_greater,
|
||||
flags & InstallFlags::f_essential);
|
||||
|
|
|
|||
|
|
@ -72,6 +72,7 @@ namespace xo {
|
|||
template <typename Fn>
|
||||
class Primitive {
|
||||
public:
|
||||
using FunctionPtrType = Fn;
|
||||
using Traits = detail::PmFnTraits<Fn>;
|
||||
|
||||
using ACollector = xo::mm::ACollector;
|
||||
|
|
|
|||
29
xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp
Normal file
29
xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp
Normal file
|
|
@ -0,0 +1,29 @@
|
|||
/** @file ObjectPrimitives.hpp
|
||||
*
|
||||
* @author Roland Conybeare, Mar 2026
|
||||
**/
|
||||
|
||||
#pragma once
|
||||
|
||||
#include <xo/procedure2/DPrimitive_gco_2_gco_gco.hpp>
|
||||
|
||||
namespace xo {
|
||||
namespace scm {
|
||||
/** @brief primitives centered on object2/ data structures.
|
||||
*
|
||||
* Note: they don't reside in object2/ because DPrimitive
|
||||
* not available yet at that level
|
||||
**/
|
||||
class ObjectPrimitives {
|
||||
public:
|
||||
using AAllocator = xo::mm::AAllocator;
|
||||
|
||||
public:
|
||||
/** create primitive for fetching nth element of a sequence **/
|
||||
static DPrimitive_gco_2_gco_gco * make_nth_pm(obj<AAllocator> mm);
|
||||
};
|
||||
|
||||
} /*namespace scm*/
|
||||
} /*namespace xo*/
|
||||
|
||||
/* end ObjectPrimitives.hpp */
|
||||
|
|
@ -10,8 +10,10 @@
|
|||
|
||||
namespace xo {
|
||||
namespace scm {
|
||||
/** Register gc-aware (AGCObject,DRepr) combinations with garbage collector @p gc **/
|
||||
bool procedure2_register_primitives(obj<xo::mm::AAllocator> gc, InstallSink sink);
|
||||
/** Register primitive-factories **/
|
||||
bool procedure2_register_primitives(obj<xo::mm::AAllocator> gc,
|
||||
InstallSink sink,
|
||||
InstallFlags flags);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -4,8 +4,10 @@ set(SELF_LIB xo_procedure2)
|
|||
set(SELF_SRCS
|
||||
init_procedure2.cpp
|
||||
init_primitives.cpp
|
||||
procedure2_register_primitives.cpp
|
||||
procedure2_register_types.cpp
|
||||
procedure2_register_facets.cpp
|
||||
ObjectPrimitives.cpp
|
||||
PrimitiveRegistry.cpp
|
||||
DPrimitive.cpp
|
||||
DSimpleRcx.cpp
|
||||
|
|
|
|||
45
xo-procedure2/src/procedure2/ObjectPrimitives.cpp
Normal file
45
xo-procedure2/src/procedure2/ObjectPrimitives.cpp
Normal file
|
|
@ -0,0 +1,45 @@
|
|||
/** @file ObjectPrimitives.cpp
|
||||
*
|
||||
* @author Roland Conybeare, Mar 2026
|
||||
**/
|
||||
|
||||
#include "ObjectPrimitives.hpp"
|
||||
#include "Primitive_gco_2_gco_gco.hpp"
|
||||
#include <xo/object2/Sequence.hpp>
|
||||
#include <xo/object2/Integer.hpp>
|
||||
|
||||
namespace xo {
|
||||
using xo::scm::ASequence;
|
||||
using xo::mm::AAllocator;
|
||||
using xo::mm::AGCObject;
|
||||
|
||||
namespace scm {
|
||||
|
||||
// TODO: seq_gc -> obj<ASequence>
|
||||
// n_gco -> obj<AGCObject,DInteger>
|
||||
//
|
||||
obj<AGCObject>
|
||||
xfer_nth(obj<ARuntimeContext> rcx,
|
||||
obj<AGCObject> seq_gco,
|
||||
obj<AGCObject> n_gco)
|
||||
{
|
||||
scope log(XO_DEBUG(true));
|
||||
|
||||
(void)rcx;
|
||||
|
||||
obj<ASequence> seq = seq_gco.to_facet<ASequence>();
|
||||
auto n = obj<AGCObject,DInteger>::from(n_gco);
|
||||
|
||||
return seq.at(n->value());
|
||||
}
|
||||
|
||||
DPrimitive_gco_2_gco_gco *
|
||||
ObjectPrimitives::make_nth_pm(obj<AAllocator> mm)
|
||||
{
|
||||
return DPrimitive_gco_2_gco_gco::_make(mm, "nth", &xfer_nth);
|
||||
}
|
||||
|
||||
} /*namespace scm*/
|
||||
} /*namespace xo*/
|
||||
|
||||
/* end ObjectPrimitives.cpp */
|
||||
|
|
@ -7,6 +7,7 @@
|
|||
#include "init_primitives.hpp"
|
||||
#include "procedure2_register_facets.hpp"
|
||||
#include "procedure2_register_types.hpp"
|
||||
#include "procedure2_register_primitives.hpp"
|
||||
|
||||
#include <xo/object2/init_object2.hpp>
|
||||
#include <xo/alloc2/CollectorTypeRegistry.hpp>
|
||||
|
|
@ -14,6 +15,8 @@
|
|||
namespace xo {
|
||||
using xo::scm::procedure2_register_facets;
|
||||
using xo::scm::procedure2_register_types;
|
||||
using xo::scm::procedure2_register_primitives;
|
||||
using xo::scm::PrimitiveRegistry;
|
||||
using xo::mm::CollectorTypeRegistry;
|
||||
|
||||
void
|
||||
|
|
@ -22,6 +25,7 @@ namespace xo {
|
|||
procedure2_register_facets();
|
||||
|
||||
CollectorTypeRegistry::instance().register_types(&procedure2_register_types);
|
||||
PrimitiveRegistry::instance().register_primitives(&procedure2_register_primitives);
|
||||
}
|
||||
|
||||
InitEvidence
|
||||
|
|
|
|||
|
|
@ -0,0 +1,73 @@
|
|||
/** @file procedure2_register_primitives.cpp
|
||||
*
|
||||
* @author Roland Conybeare, Mar 2026
|
||||
**/
|
||||
|
||||
#include "procedure2_register_primitives.hpp"
|
||||
#include "ObjectPrimitives.hpp"
|
||||
#include "Primitive_gco_2_gco_gco.hpp"
|
||||
#include <xo/object2/Sequence.hpp>
|
||||
#include <xo/object2/Integer.hpp>
|
||||
|
||||
namespace xo {
|
||||
using xo::scm::ASequence;
|
||||
using xo::mm::AAllocator;
|
||||
using xo::mm::AGCObject;
|
||||
|
||||
namespace scm {
|
||||
template <typename PrimitiveRepr>
|
||||
bool install_aux(InstallSink sink,
|
||||
PrimitiveRepr * pm,
|
||||
InstallFlags flags)
|
||||
{
|
||||
scope log(XO_DEBUG(true));
|
||||
|
||||
if ((flags & InstallFlags::f_generalpurpose) == InstallFlags::f_generalpurpose) {
|
||||
log && log("create primitive", xtag("name", pm->name()));
|
||||
|
||||
return sink(pm->name(),
|
||||
pm->fn_td(),
|
||||
obj<AProcedure,PrimitiveRepr>(pm),
|
||||
flags);
|
||||
} else {
|
||||
log && log("skip primitive", xtag("name", pm->name()));
|
||||
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
template <typename Primitive>
|
||||
bool install_aux(InstallSink sink,
|
||||
obj<AAllocator> mm,
|
||||
std::string_view name,
|
||||
typename Primitive::FunctionPtrType impl,
|
||||
InstallFlags flags)
|
||||
{
|
||||
if (flags != InstallFlags::f_none) {
|
||||
auto pm
|
||||
= Primitive::_make(mm, name, impl);
|
||||
|
||||
return install_aux(sink, pm, flags);
|
||||
} else {
|
||||
return true;
|
||||
}
|
||||
}
|
||||
|
||||
bool
|
||||
procedure2_register_primitives(obj<xo::mm::AAllocator> mm,
|
||||
InstallSink sink,
|
||||
InstallFlags flags)
|
||||
{
|
||||
scope log(XO_DEBUG(true));
|
||||
|
||||
bool ok = true;
|
||||
|
||||
ok = ok & install_aux(sink, ObjectPrimitives::make_nth_pm(mm), flags);
|
||||
|
||||
return ok;
|
||||
}
|
||||
|
||||
} /*namespace scm*/
|
||||
} /*namespace xo*/
|
||||
|
||||
/* end procedure2_register_primitives.cpp */
|
||||
|
|
@ -90,6 +90,7 @@ namespace xo {
|
|||
obj<AAllocator> expr_alloc() const noexcept { return expr_alloc_; }
|
||||
DGlobalSymtab * global_symtab() const noexcept { return global_symtab_.data(); }
|
||||
DLocalSymtab * local_symtab() const noexcept { return local_symtab_; }
|
||||
DGlobalEnv * global_env() const noexcept { return global_env_.data(); }
|
||||
const ParserResult & result() const noexcept { return result_; }
|
||||
|
||||
/** polymoprhihc multiply primitive. Use to implement infix op* **/
|
||||
|
|
|
|||
|
|
@ -184,6 +184,7 @@ namespace xo {
|
|||
///@{
|
||||
|
||||
DGlobalSymtab * global_symtab() const noexcept;
|
||||
DGlobalEnv * global_env() const noexcept;
|
||||
|
||||
bool debug_flag() const { return debug_flag_; }
|
||||
|
||||
|
|
|
|||
|
|
@ -57,6 +57,9 @@ namespace xo {
|
|||
/** top-level symbol table **/
|
||||
DGlobalSymtab * global_symtab() const noexcept;
|
||||
|
||||
/** top-level global environment (e.g. contains built-in primitives) **/
|
||||
DGlobalEnv * global_env() const noexcept;
|
||||
|
||||
/** visit reader-owned memory pools; call visitor(info) for each.
|
||||
* Specifically exclude expr_alloc, since we don't consider
|
||||
* that reader-owned
|
||||
|
|
|
|||
|
|
@ -41,19 +41,17 @@ namespace xo {
|
|||
DGlobalSymtab * global_symtab,
|
||||
InstallFlags pm_install_flags)
|
||||
{
|
||||
scope log(XO_DEBUG(true));
|
||||
|
||||
DGlobalEnv * env = DGlobalEnv::_make(mm,
|
||||
global_symtab);
|
||||
|
||||
InstallSink sink = ([env, mm, &stringtable]
|
||||
InstallSink sink = ([env, mm, &stringtable, &log]
|
||||
(std::string_view name,
|
||||
TypeDescr fn_td,
|
||||
obj<AProcedure> pm,
|
||||
InstallFlags flags)
|
||||
{
|
||||
scope log(XO_DEBUG(false));
|
||||
|
||||
log && log(xtag("name", name));
|
||||
|
||||
(void)flags;
|
||||
|
||||
obj<AGCObject> pm_gco = pm.to_facet<AGCObject>();
|
||||
|
|
@ -61,6 +59,8 @@ namespace xo {
|
|||
const DUniqueString * sym
|
||||
= stringtable.intern(name);
|
||||
|
||||
log && log("upsert", xtag("sym", std::string_view(*sym)));
|
||||
|
||||
env->_upsert_value(mm,
|
||||
sym,
|
||||
fn_td,
|
||||
|
|
|
|||
|
|
@ -42,6 +42,12 @@ namespace xo {
|
|||
return psm_.global_symtab();
|
||||
}
|
||||
|
||||
DGlobalEnv *
|
||||
SchematikaParser::global_env() const noexcept
|
||||
{
|
||||
return psm_.global_env();
|
||||
}
|
||||
|
||||
bool
|
||||
SchematikaParser::is_at_toplevel() const
|
||||
{
|
||||
|
|
|
|||
|
|
@ -32,6 +32,12 @@ namespace xo {
|
|||
return parser_.global_symtab();
|
||||
}
|
||||
|
||||
DGlobalEnv *
|
||||
SchematikaReader::global_env() const noexcept
|
||||
{
|
||||
return parser_.global_env();
|
||||
}
|
||||
|
||||
void
|
||||
SchematikaReader::visit_pools(const MemorySizeVisitor & visitor) const
|
||||
{
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue