/** @file ObjectPrimitives.cpp * * @author Roland Conybeare, Mar 2026 **/ #include "ObjectPrimitives.hpp" #include #include #include #include #include #include #include #include #include #include #include #include // for getcwd() namespace xo { using xo::scm::ASequence; using xo::print::APrintable; using xo::mm::AAllocator; using xo::mm::AGCObject; using xo::facet::FacetRegistry; using xo::facet::TypeRegistry; namespace scm { // ----- cwd ----- obj xfer_cwd(obj rcx) { char buf[PATH_MAX]; char * cwd = ::getcwd(buf, sizeof(buf)); return obj(DString::from_cstr(rcx.allocator(), cwd)); } DPrimitive_gco_0 * ObjectPrimitives::make_cwd_pm(obj mm, StringTable * stbl) { (void)stbl; auto str_ty = DAtomicType::make(mm, Metatype::t_str()); auto cwd_ty = obj(DFunctionType::_make(mm, str_ty)); return DPrimitive_gco_0::_make(mm, "cwd", cwd_ty, &xfer_cwd); } // ----- 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()); } DPrimitive_gco_2_gco_gco * ObjectPrimitives::make_nth_pm(obj mm, StringTable * stbl) { auto T_ty = DTypeVarRef::make(mm, stbl->intern("T")); auto list_T_ty = DListType::make(mm, T_ty); auto int_ty = DAtomicType::make(mm, Metatype::t_integer()); /** nth_ty: list x int -> T **/ auto nth_ty = obj (DFunctionType::_make(mm, T_ty, list_T_ty, int_ty)); return DPrimitive_gco_2_gco_gco::_make(mm, "nth", nth_ty, &xfer_nth); } // ----- cons ----- obj xfer_cons(obj rcx, obj car, obj cdr) { (void)rcx; auto cdr_list = obj::from(cdr); return DList::cons(rcx.allocator(), car, cdr_list.data()); } DPrimitive_gco_2_gco_gco * ObjectPrimitives::make_cons_pm(obj mm, StringTable * stbl) { auto T_ty = DTypeVarRef::make(mm, stbl->intern("T")); auto list_T_ty = DListType::make(mm, T_ty); /** cons_ty: T x list -> list **/ auto cons_ty = obj(DFunctionType::_make(mm, list_T_ty, T_ty, list_T_ty)); 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.allocator(), 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 xfer_dict_make(obj rcx) { return obj(DDictionary::empty(rcx.allocator(), 8 /*cap*/)); } DPrimitive_gco_0 * ObjectPrimitives::make_dict_make_pm(obj mm, StringTable * stbl) { (void)stbl; // nit: technically better to use empty struct type here auto dict_ty = DAtomicType::make(mm, Metatype::t_dict()); auto pm_ty = obj(DFunctionType::_make(mm, dict_ty)); return DPrimitive_gco_0::_make(mm, "dict_make", pm_ty, &xfer_dict_make); } // ----- dict_at ----- obj xfer_dict_lookup(obj rcx, obj dict, obj key) { auto opt = dict->lookup(key.data()); if (opt) { return opt.value(); } else { DString * src_fn = DString::from_cstr(rcx.allocator(), "dict_lookup"); DString * error = DString::printf(rcx.allocator(), 100, "no value in dict for key [%s]", key.data()->data()); return obj (DRuntimeError::_make(rcx.allocator(), src_fn, error)); } } DPrimitive_gco_2_dict_string * ObjectPrimitives::make_dict_lookup_pm(obj mm, StringTable * stbl) { (void)stbl; // dict_ty: generic dictionary auto dict_ty = DAtomicType::make(mm, Metatype::t_dict()); auto str_ty = DAtomicType::make(mm, Metatype::t_str()); auto any_ty = DAtomicType::make(mm, Metatype::t_any()); // pm_ty: dict x string -> any auto pm_ty = obj (DFunctionType::_make(mm, any_ty, dict_ty, str_ty)); return DPrimitive_gco_2_dict_string::_make (mm, "dict_lookup", pm_ty, &xfer_dict_lookup); } // ----- dict_upsert ----- obj xfer_dict_upsert(obj rcx, obj dict, obj key, obj value) { scope log(XO_DEBUG(true)); log && log(xtag("dict.tseq", dict._typeseq()), xtag("dict.tname", TypeRegistry::id2name(dict._typeseq()))); log && log(xtag("key.tseq", key._typeseq()), xtag("key.tname", TypeRegistry::id2name(key._typeseq()))); log && log(xtag("value.tseq", value._typeseq()), xtag("value.tname", TypeRegistry::id2name(value._typeseq()))); auto value_pr = FacetRegistry::instance().variant(value); log && log(xtag("value", value_pr)); dict->upsert(rcx.allocator(), DDictionary::pair_type(key.data(), value)); return dict; } DPrimitive_gco_3_dict_string_gco * ObjectPrimitives::make_dict_upsert_pm(obj mm, StringTable * stbl) { (void)stbl; auto dict_ty = DAtomicType::make(mm, Metatype::t_dict()); auto str_ty = DAtomicType::make(mm, Metatype::t_str()); auto any_ty = DAtomicType::make(mm, Metatype::t_any()); // pm_ty: dict x string x any -> dict auto pm_ty = obj(DFunctionType::_make(mm, dict_ty, dict_ty, str_ty, any_ty)); return DPrimitive_gco_3_dict_string_gco::_make (mm, "dict_upsert", pm_ty, &xfer_dict_upsert); } // ----- fn_n_args ----- obj xfer_fn_n_args(obj rcx, obj fn_gco) { scope log(XO_DEBUG(true)); log && log(xtag("fn_gco.tseq", fn_gco._typeseq())); log && log(xtag("fn_gco.tname", TypeRegistry::id2name(fn_gco._typeseq()))); auto fn_proc = FacetRegistry::instance().try_variant(fn_gco); assert(fn_proc); return DInteger::box(rcx.allocator(), fn_proc.n_args()); } DPrimitive_gco_1_gco * ObjectPrimitives::make_fn_n_args_pm(obj mm, StringTable * stbl) { (void)stbl; auto integer_ty = DAtomicType::make(mm, Metatype::t_integer()); auto callable_ty = DAtomicType::make(mm, Metatype::t_callable()); auto pm_ty = obj(DFunctionType::_make(mm, integer_ty, callable_ty)); return DPrimitive_gco_1_gco::_make(mm, "fn_n_args", pm_ty, &xfer_fn_n_args); } } /*namespace scm*/ } /*namespace xo*/ /* end ObjectPrimitives.cpp */