diff --git a/xo-interpreter2/include/xo/interpreter2/VirtualSchematikaMachine.hpp b/xo-interpreter2/include/xo/interpreter2/VirtualSchematikaMachine.hpp index ec7eda34..6663538e 100644 --- a/xo-interpreter2/include/xo/interpreter2/VirtualSchematikaMachine.hpp +++ b/xo-interpreter2/include/xo/interpreter2/VirtualSchematikaMachine.hpp @@ -280,7 +280,7 @@ namespace xo { obj expr_; /** environment pointer. Maintains bindings - * for global variables. + * for global variables. Obtained from reader **/ DGlobalEnv * global_env_ = nullptr; diff --git a/xo-interpreter2/src/interpreter2/VirtualSchematikaMachine.cpp b/xo-interpreter2/src/interpreter2/VirtualSchematikaMachine.cpp index 6bcbe8bf..a4ed2810 100644 --- a/xo-interpreter2/src/interpreter2/VirtualSchematikaMachine.cpp +++ b/xo-interpreter2/src/interpreter2/VirtualSchematikaMachine.cpp @@ -86,7 +86,7 @@ namespace xo { this->error_mm_.adopt(obj(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 - // n_gco -> obj - // - obj - xfer_nth(obj rcx, - obj seq_gco, - obj n_gco) - { - (void)rcx; - - obj seq = seq_gco.to_facet(); - auto n = obj::from(n_gco); - - return seq.at(n->value()); - } - - static DPrimitive_gco_2_gco_gco s_nth_pm("_nth", &xfer_nth); - // ----- primitive: cons() ----- obj @@ -1045,18 +1025,6 @@ namespace xo { obj(&s_cwd_pm)); } - /* nth */ - { - const DUniqueString * name - = reader_.intern_string("nth"); - - global_env_->_upsert_value - (mm_.to_op(), - name, - Reflect::require(), - obj(&s_nth_pm)); - } - /* cons */ { const DUniqueString * name diff --git a/xo-numeric/include/xo/numeric/NumericPrimitives.hpp b/xo-numeric/include/xo/numeric/NumericPrimitives.hpp index a703af4a..54201f59 100644 --- a/xo-numeric/include/xo/numeric/NumericPrimitives.hpp +++ b/xo-numeric/include/xo/numeric/NumericPrimitives.hpp @@ -35,6 +35,10 @@ namespace xo { static DPrimitive_gco_2_gco_gco * make_cmplt_pm(obj mm); /** polymorphic (in both arguments) compare (<=) **/ static DPrimitive_gco_2_gco_gco * make_cmple_pm(obj mm); + /** polymorphic (in both arguments) compare (>) **/ + static DPrimitive_gco_2_gco_gco * make_cmpgt_pm(obj mm); + /** polymorphic (in both arguments) compare (>=) **/ + static DPrimitive_gco_2_gco_gco * make_cmpge_pm(obj mm); }; } } diff --git a/xo-numeric/include/xo/numeric/numeric_register_primitives.hpp b/xo-numeric/include/xo/numeric/numeric_register_primitives.hpp index 455d8b44..18a594be 100644 --- a/xo-numeric/include/xo/numeric/numeric_register_primitives.hpp +++ b/xo-numeric/include/xo/numeric/numeric_register_primitives.hpp @@ -10,8 +10,8 @@ namespace xo { namespace scm { - /** Register gc-aware (AGCObject,DRepr) combinations with garbage collector @p gc **/ - bool numeric_register_primitives(obj gc, + /** Register primitive factories with primitive registry **/ + bool numeric_register_primitives(obj mm, InstallSink sink, InstallFlags flags); } diff --git a/xo-numeric/src/numeric/NumericPrimitives.cpp b/xo-numeric/src/numeric/NumericPrimitives.cpp index e48c1a30..9ef0b979 100644 --- a/xo-numeric/src/numeric/NumericPrimitives.cpp +++ b/xo-numeric/src/numeric/NumericPrimitives.cpp @@ -68,6 +68,22 @@ namespace xo { &NumericDispatch::cmp_lessequal); } + DPrimitive_gco_2_gco_gco * + NumericPrimitives::make_cmpgt_pm(obj mm) + { + return DPrimitive_gco_2_gco_gco::_make(mm, "_cmpgt", + &NumericDispatch::cmp_greater); + } + + DPrimitive_gco_2_gco_gco * + NumericPrimitives::make_cmpge_pm(obj mm) + { + return DPrimitive_gco_2_gco_gco::_make(mm, "_cmpge", + &NumericDispatch::cmp_greatequal); + } + + + } /*namespace scm*/ } /*namespace xo*/ diff --git a/xo-numeric/src/numeric/numeric_register_primitives.cpp b/xo-numeric/src/numeric/numeric_register_primitives.cpp index ff2749e3..b2da4d9e 100644 --- a/xo-numeric/src/numeric/numeric_register_primitives.cpp +++ b/xo-numeric/src/numeric/numeric_register_primitives.cpp @@ -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); diff --git a/xo-procedure2/include/xo/procedure2/DPrimitive.hpp b/xo-procedure2/include/xo/procedure2/DPrimitive.hpp index 4cc45f83..07c19c4f 100644 --- a/xo-procedure2/include/xo/procedure2/DPrimitive.hpp +++ b/xo-procedure2/include/xo/procedure2/DPrimitive.hpp @@ -72,6 +72,7 @@ namespace xo { template class Primitive { public: + using FunctionPtrType = Fn; using Traits = detail::PmFnTraits; using ACollector = xo::mm::ACollector; diff --git a/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp b/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp new file mode 100644 index 00000000..392cf939 --- /dev/null +++ b/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp @@ -0,0 +1,29 @@ +/** @file ObjectPrimitives.hpp + * + * @author Roland Conybeare, Mar 2026 + **/ + +#pragma once + +#include + +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 mm); + }; + + } /*namespace scm*/ +} /*namespace xo*/ + +/* end ObjectPrimitives.hpp */ diff --git a/xo-procedure2/include/xo/procedure2/procedure2_register_primitives.hpp b/xo-procedure2/include/xo/procedure2/procedure2_register_primitives.hpp index 12e1db94..69237697 100644 --- a/xo-procedure2/include/xo/procedure2/procedure2_register_primitives.hpp +++ b/xo-procedure2/include/xo/procedure2/procedure2_register_primitives.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 gc, InstallSink sink); + /** Register primitive-factories **/ + bool procedure2_register_primitives(obj gc, + InstallSink sink, + InstallFlags flags); } } diff --git a/xo-procedure2/src/procedure2/CMakeLists.txt b/xo-procedure2/src/procedure2/CMakeLists.txt index 9e1af2c7..f38ea2f1 100644 --- a/xo-procedure2/src/procedure2/CMakeLists.txt +++ b/xo-procedure2/src/procedure2/CMakeLists.txt @@ -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 diff --git a/xo-procedure2/src/procedure2/ObjectPrimitives.cpp b/xo-procedure2/src/procedure2/ObjectPrimitives.cpp new file mode 100644 index 00000000..5164efc6 --- /dev/null +++ b/xo-procedure2/src/procedure2/ObjectPrimitives.cpp @@ -0,0 +1,45 @@ +/** @file ObjectPrimitives.cpp + * + * @author Roland Conybeare, Mar 2026 + **/ + +#include "ObjectPrimitives.hpp" +#include "Primitive_gco_2_gco_gco.hpp" +#include +#include + +namespace xo { + using xo::scm::ASequence; + using xo::mm::AAllocator; + using xo::mm::AGCObject; + + namespace scm { + + // TODO: seq_gc -> obj + // n_gco -> obj + // + obj + xfer_nth(obj rcx, + obj seq_gco, + obj n_gco) + { + scope log(XO_DEBUG(true)); + + (void)rcx; + + obj seq = seq_gco.to_facet(); + auto n = obj::from(n_gco); + + return seq.at(n->value()); + } + + DPrimitive_gco_2_gco_gco * + ObjectPrimitives::make_nth_pm(obj mm) + { + return DPrimitive_gco_2_gco_gco::_make(mm, "nth", &xfer_nth); + } + + } /*namespace scm*/ +} /*namespace xo*/ + +/* end ObjectPrimitives.cpp */ diff --git a/xo-procedure2/src/procedure2/init_procedure2.cpp b/xo-procedure2/src/procedure2/init_procedure2.cpp index bc7e53ab..d202931e 100644 --- a/xo-procedure2/src/procedure2/init_procedure2.cpp +++ b/xo-procedure2/src/procedure2/init_procedure2.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 #include @@ -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 diff --git a/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp b/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp new file mode 100644 index 00000000..e17cda4e --- /dev/null +++ b/xo-procedure2/src/procedure2/procedure2_register_primitives.cpp @@ -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 +#include + +namespace xo { + using xo::scm::ASequence; + using xo::mm::AAllocator; + using xo::mm::AGCObject; + + namespace scm { + template + 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(pm), + flags); + } else { + log && log("skip primitive", xtag("name", pm->name())); + + return true; + } + } + + template + bool install_aux(InstallSink sink, + obj 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 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 */ diff --git a/xo-reader2/include/xo/reader2/ParserStateMachine.hpp b/xo-reader2/include/xo/reader2/ParserStateMachine.hpp index 4f14f72a..a7726c35 100644 --- a/xo-reader2/include/xo/reader2/ParserStateMachine.hpp +++ b/xo-reader2/include/xo/reader2/ParserStateMachine.hpp @@ -90,6 +90,7 @@ namespace xo { obj 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* **/ diff --git a/xo-reader2/include/xo/reader2/SchematikaParser.hpp b/xo-reader2/include/xo/reader2/SchematikaParser.hpp index ce7b3335..dd6ae341 100644 --- a/xo-reader2/include/xo/reader2/SchematikaParser.hpp +++ b/xo-reader2/include/xo/reader2/SchematikaParser.hpp @@ -184,6 +184,7 @@ namespace xo { ///@{ DGlobalSymtab * global_symtab() const noexcept; + DGlobalEnv * global_env() const noexcept; bool debug_flag() const { return debug_flag_; } diff --git a/xo-reader2/include/xo/reader2/SchematikaReader.hpp b/xo-reader2/include/xo/reader2/SchematikaReader.hpp index 5d20226e..0761b6e3 100644 --- a/xo-reader2/include/xo/reader2/SchematikaReader.hpp +++ b/xo-reader2/include/xo/reader2/SchematikaReader.hpp @@ -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 diff --git a/xo-reader2/src/reader2/ParserStateMachine.cpp b/xo-reader2/src/reader2/ParserStateMachine.cpp index 0634a564..5e6b4164 100644 --- a/xo-reader2/src/reader2/ParserStateMachine.cpp +++ b/xo-reader2/src/reader2/ParserStateMachine.cpp @@ -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 pm, InstallFlags flags) { - scope log(XO_DEBUG(false)); - - log && log(xtag("name", name)); - (void)flags; obj pm_gco = pm.to_facet(); @@ -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, diff --git a/xo-reader2/src/reader2/SchematikaParser.cpp b/xo-reader2/src/reader2/SchematikaParser.cpp index acfbeaa1..7d27e41c 100644 --- a/xo-reader2/src/reader2/SchematikaParser.cpp +++ b/xo-reader2/src/reader2/SchematikaParser.cpp @@ -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 { diff --git a/xo-reader2/src/reader2/SchematikaReader.cpp b/xo-reader2/src/reader2/SchematikaReader.cpp index 98ef2292..de815f97 100644 --- a/xo-reader2/src/reader2/SchematikaReader.cpp +++ b/xo-reader2/src/reader2/SchematikaReader.cpp @@ -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 {