xo-interpreter2 stack: modularize nth() primitive setup/install

This commit is contained in:
Roland Conybeare 2026-03-15 09:47:14 -05:00
commit a3aa582eb9
19 changed files with 216 additions and 49 deletions

View file

@ -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;

View file

@ -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

View file

@ -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);
};
}
}

View file

@ -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);
}

View file

@ -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*/

View file

@ -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);

View file

@ -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;

View 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 */

View file

@ -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);
}
}

View file

@ -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

View 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 */

View file

@ -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

View file

@ -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 */

View file

@ -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* **/

View file

@ -184,6 +184,7 @@ namespace xo {
///@{
DGlobalSymtab * global_symtab() const noexcept;
DGlobalEnv * global_env() const noexcept;
bool debug_flag() const { return debug_flag_; }

View file

@ -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

View file

@ -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,

View file

@ -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
{

View file

@ -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
{