diff --git a/xo-object2/include/xo/object2/DList.hpp b/xo-object2/include/xo/object2/DList.hpp index 8009f7b5..ddc54f3f 100644 --- a/xo-object2/include/xo/object2/DList.hpp +++ b/xo-object2/include/xo/object2/DList.hpp @@ -57,6 +57,8 @@ namespace xo { /** return element at 0-based index @p ix **/ obj at(size_type ix) const; + /** assign head **/ + void assign_head(obj gc, obj h); /** assign rest-pointer **/ void assign_rest(DList * r); diff --git a/xo-object2/src/object2/DList.cpp b/xo-object2/src/object2/DList.cpp index 7ef06f36..b9ac0583 100644 --- a/xo-object2/src/object2/DList.cpp +++ b/xo-object2/src/object2/DList.cpp @@ -119,6 +119,14 @@ namespace xo { return l->head_; } + void + DList::assign_head(obj gc, obj rhs) + { + scope log(XO_DEBUG(true), xtag("gc.data", gc.data_)); + + mm_do_assign(gc, this, &head_, rhs); + } + void DList::assign_rest(DList * r) { diff --git a/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp b/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp index c403dc17..87a80457 100644 --- a/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp +++ b/xo-procedure2/include/xo/procedure2/ObjectPrimitives.hpp @@ -35,6 +35,10 @@ namespace xo { static DPrimitive_gco_2_gco_gco * make_cons_pm(obj mm, StringTable * stbl); + /** create primitive: set first member of cons cell **/ + static DPrimitive_gco_2_gco_gco * make_set_car_pm(obj mm, + StringTable * stbl); + /** create primitive for creating a dictionary instance **/ static DPrimitive_gco_0 * make_dict_make_pm(obj mm, StringTable * stbl); diff --git a/xo-procedure2/src/procedure2/ObjectPrimitives.cpp b/xo-procedure2/src/procedure2/ObjectPrimitives.cpp index d9d86f4a..36dd2a37 100644 --- a/xo-procedure2/src/procedure2/ObjectPrimitives.cpp +++ b/xo-procedure2/src/procedure2/ObjectPrimitives.cpp @@ -116,6 +116,48 @@ namespace xo { return DPrimitive_gco_2_gco_gco::_make(mm, "cons", cons_ty, &xfer_cons); } + // ----- set-car ----- + + obj + xfer_set_car(obj rcx, + obj cell_arg, + obj dest) + { + scope log(XO_DEBUG(true)); + + (void)rcx; + (void)dest; + + auto cell = obj::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 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 x any -> list **/ + auto pm_ty + = obj(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 @@ -233,6 +275,7 @@ namespace xo { xfer_fn_n_args(obj rcx, obj fn_gco) { + scope log(XO_DEBUG(true)); log && log(xtag("fn_gco.tseq", fn_gco._typeseq()));