roland/xo-procedure2
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

xo-procedure2: + assign_head + set-car pm impl [WIP]

Browse source 
Not actuall installed in global env
This commit is contained in:
Roland Conybeare 2026-03-24 22:17:41 -04:00
commit 1ec0d042d1
2 changed files with 47 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

4
include/xo/procedure2/ObjectPrimitives.hpp
View file

@ -35,6 +35,10 @@ namespace xo {
static DPrimitive_gco_2_gco_gco * make_cons_pm(obj<AAllocator> mm,
StringTable * stbl);
/** create primitive: set first member of cons cell **/
static DPrimitive_gco_2_gco_gco * make_set_car_pm(obj<AAllocator> mm,
StringTable * stbl);
/** create primitive for creating a dictionary instance **/
static DPrimitive_gco_0 * make_dict_make_pm(obj<AAllocator> mm,
StringTable * stbl);

43
src/procedure2/ObjectPrimitives.cpp
View file

@ -116,6 +116,48 @@ namespace xo {
return DPrimitive_gco_2_gco_gco::_make(mm, "cons", cons_ty, &xfer_cons);
}
// ----- set-car -----
obj<AGCObject>
xfer_set_car(obj<ARuntimeContext> rcx,
obj<AGCObject> cell_arg,
obj<AGCObject> dest)
{
scope log(XO_DEBUG(true));
(void)rcx;
(void)dest;
auto cell = obj<AGCObject,DList>::from(cell_arg);
assert(!cell->is_empty());
if (!cell->is_empty()) {
cell->assign_head(rcx.collector(), dest);
}
return cell;
}
DPrimitive_gco_2_gco_gco *
ObjectPrimitives::make_set_car_pm(obj<AAllocator> mm,
StringTable * stbl)
{
(void)stbl;
auto any_ty = DAtomicType::make(mm, Metatype::t_any());
auto T_ty = DTypeVarRef::make(mm, stbl->intern("T"));
auto list_T_ty = DListType::make(mm, T_ty);
/** pm_ty: list<T> x any -> list<T> **/
auto pm_ty
= obj<AType,DFunctionType>(DFunctionType::_make(mm,
list_T_ty,
any_ty,
list_T_ty));
return DPrimitive_gco_2_gco_gco::_make(mm, "set-car", pm_ty, &xfer_set_car);
}
// ----- dict_make -----
obj<AGCObject>
@ -233,6 +275,7 @@ namespace xo {
xfer_fn_n_args(obj<ARuntimeContext> rcx,
obj<AGCObject> fn_gco)
{
scope log(XO_DEBUG(true));
log && log(xtag("fn_gco.tseq", fn_gco._typeseq()));