Object inspection API

ListTalk/ListTalk.h

@@ -43,6 +43,7 @@
 #include <ListTalk/classes/Symbol.h>
 #include <ListTalk/classes/SourceLocation.h>
 #include <ListTalk/classes/StackFrame.h>
+#include <ListTalk/classes/ObjectInspection.h>
 #include <ListTalk/classes/Message.h>
 #include <ListTalk/classes/BindingDescriptor.h>
 #include <ListTalk/classes/MethodDescriptor.h>

ListTalk/classes/Object.h

@@ -20,6 +20,10 @@ extern LT_Class LT_Object_class_class;
 
 LT_Value LT_Object_slot_ref(LT_Value object, LT_Value slot_name);
 LT_Value LT_Object_slot_set(LT_Value object, LT_Value slot_name, LT_Value value);
+LT_Value LT_Object_inspection(LT_Value object);
+LT_Value LT_Object_inspection_with_contents(LT_Value object,
+                                            char* contents_label,
+                                            LT_Value contents);
 
 LT__END_DECLS
 

ListTalk/classes/ObjectInspection.h

@@ -0,0 +1,40 @@
+/*
+ * SPDX-License-Identifier: MIT
+ * Copyright (c) 2023 - 2026 Ales Hakl
+ */
+
+#ifndef H__ListTalk__ObjectInspection__
+#define H__ListTalk__ObjectInspection__
+
+#include <ListTalk/macros/env_macros.h>
+
+#include <ListTalk/vm/value.h>
+#include <ListTalk/macros/decl_macros.h>
+
+LT__BEGIN_DECLS
+
+LT_DECLARE_CLASS(LT_ObjectInspection);
+
+struct LT_ObjectInspection_s {
+    LT_Object base;
+    LT_Value name;
+    LT_Value description;
+    LT_Value slots;
+    LT_Value contents_label;
+    LT_Value contents;
+};
+
+LT_Value LT_ObjectInspection_new(LT_Value name,
+                                 LT_Value description,
+                                 LT_Value slots,
+                                 LT_Value contents_label,
+                                 LT_Value contents);
+LT_Value LT_ObjectInspection_name(LT_ObjectInspection* inspection);
+LT_Value LT_ObjectInspection_description(LT_ObjectInspection* inspection);
+LT_Value LT_ObjectInspection_slots(LT_ObjectInspection* inspection);
+LT_Value LT_ObjectInspection_contents_label(LT_ObjectInspection* inspection);
+LT_Value LT_ObjectInspection_contents(LT_ObjectInspection* inspection);
+
+LT__END_DECLS
+
+#endif

ListTalk/debugger/debugger.h

@@ -7,6 +7,7 @@
 #define H__ListTalk__debugger__debugger__
 
 #include <ListTalk/macros/env_macros.h>
+#include <ListTalk/classes/Environment.h>
 #include <ListTalk/vm/value.h>
 
 LT__BEGIN_DECLS
@@ -23,6 +24,9 @@ LT_Value LT_Debugger_get_hook(void);
 /* Install LT_Debugger_get_hook() as the current thread's debugger hook. */
 void LT_Debugger_enable(void);
 
+/* Bind the interactive inspector primitive as ListTalk:inspect. */
+void LT_Debugger_define_inspect(LT_Environment* environment);
+
 /* Interactively display OBJECT and descend through its named slots. */
 void LT_Debugger_inspect(LT_Value object);
 

meson.build

@@ -191,6 +191,7 @@ vm_lib = library(
                 'src/classes/ImmutableList.c',
                 'src/classes/Pair.c',
                 'src/classes/StackFrame.c',
+                'src/classes/ObjectInspection.c',
                 'src/classes/BindingDescriptor.c',
                 'src/classes/MethodDescriptor.c',
                 'src/classes/Message.c',

src/bin/listtalk/main.c

@@ -431,6 +431,7 @@ int main(int argc, char**argv){
         command_action_ensure_standard_resolvers(&command_action);
         LT_enable_KeyboardInterrupt();
         LT_Debugger_enable();
+        LT_Debugger_define_inspect(base_environment);
         {
             LT_REPL_State* repl = LT_REPL_State_new();
 

src/classes/Class.c

@@ -186,6 +186,12 @@ LT_DECLARE_PRIMITIVE(
     "(self)",
     "Return direct method descriptors as a list."
 );
+LT_DECLARE_PRIMITIVE(
+    class_method_inspection,
+    "Class>>inspection",
+    "(self)",
+    "Return an inspection whose contents are direct methods."
+);
 LT_DECLARE_PRIMITIVE(
     class_method_all_methods_do,
     "Class>>allMethodsDo:",
@@ -223,6 +229,7 @@ static LT_Method_Descriptor Class_methods[] = {
     {"allSelectorsAsList", &class_method_all_selectors_as_list},
     {"methodsDo:", &class_method_methods_do},
     {"methodsAsList", &class_method_methods_as_list},
+    {"inspection", &class_method_inspection},
     {"allMethodsDo:", &class_method_all_methods_do},
     {"allMethodsAsList", &class_method_all_methods_as_list},
     {"addMethod:withSelector:", &class_method_add_method_with_selector},
@@ -1300,6 +1307,32 @@ static LT_Value class_direct_methods_as_list(LT_Class* klass){
     return LT_ListBuilder_value(builder);
 }
 
+LT_PRIMITIVE_HEAD(class_method_inspection){
+    LT_Value cursor = arguments;
+    LT_Value self;
+    LT_Value methods;
+    LT_ListBuilder* contents = LT_ListBuilder_new();
+    (void)tail_call_unwind_marker;
+
+    LT_OBJECT_ARG(cursor, self);
+    LT_ARG_END(cursor);
+    methods = class_direct_methods_as_list(LT_Class_from_object(self));
+    while (methods != LT_NIL){
+        LT_Value method = LT_car(methods);
+        LT_ListBuilder_append(
+            contents,
+            LT_MethodDescriptor_selector(LT_MethodDescriptor_from_value(method))
+        );
+        LT_ListBuilder_append(contents, method);
+        methods = LT_cdr(methods);
+    }
+    return LT_Object_inspection_with_contents(
+        self,
+        "Methods:",
+        LT_ListBuilder_value(contents)
+    );
+}
+
 static void class_all_methods_do(LT_Class* klass, LT_Value callable){
     LT_Value precedence_cursor = LT_Class_precedence_list(klass);
     LT_IdentitySet* seen = LT_IdentitySet_new();

src/classes/Environment.c

@@ -115,6 +115,12 @@ LT_DECLARE_PRIMITIVE(
     "(self)",
     "Return direct binding reflections as a list."
 );
+LT_DECLARE_PRIMITIVE(
+    environment_method_inspection,
+    "Environment>>inspection",
+    "(self)",
+    "Return an inspection whose contents are direct bindings."
+);
 
 static LT_Method_Descriptor Environment_methods[] = {
     {"contains?:", &environment_method_contains},
@@ -124,6 +130,7 @@ static LT_Method_Descriptor Environment_methods[] = {
     {"constant?:", &environment_method_constant},
     {"bindingsDo:", &environment_method_bindings_do},
     {"bindingsAsList", &environment_method_bindings_as_list},
+    {"inspection", &environment_method_inspection},
     LT_NULL_NATIVE_CLASS_METHOD_DESCRIPTOR
 };
 
@@ -439,6 +446,31 @@ static LT_Value Environment_bindings_as_list(LT_Environment* environment){
     return LT_ListBuilder_value(builder);
 }
 
+LT_PRIMITIVE_HEAD(environment_method_inspection){
+    LT_Value cursor = arguments;
+    LT_Value self;
+    LT_Value bindings;
+    LT_ListBuilder* contents = LT_ListBuilder_new();
+    (void)tail_call_unwind_marker;
+
+    LT_OBJECT_ARG(cursor, self);
+    LT_ARG_END(cursor);
+    bindings = Environment_bindings_as_list(LT_Environment_from_value(self));
+    while (bindings != LT_NIL){
+        LT_BindingDescriptor* binding = LT_BindingDescriptor_from_value(
+            LT_car(bindings)
+        );
+        LT_ListBuilder_append(contents, LT_BindingDescriptor_symbol(binding));
+        LT_ListBuilder_append(contents, LT_BindingDescriptor_value(binding));
+        bindings = LT_cdr(bindings);
+    }
+    return LT_Object_inspection_with_contents(
+        self,
+        "Bindings:",
+        LT_ListBuilder_value(contents)
+    );
+}
+
 LT_PRIMITIVE_HEAD(environment_method_bindings_do){
     LT_Value cursor = arguments;
     LT_Value self;

src/classes/List.c

@@ -919,7 +919,40 @@ LT_DEFINE_PRIMITIVE(
     return (LT_Value)(uintptr_t)vector;
 }
 
+LT_DEFINE_PRIMITIVE(
+    list_method_inspection,
+    "List>>inspection",
+    "(self)",
+    "Return an inspection whose contents are the list elements."
+){
+    LT_Value cursor = arguments;
+    LT_Value self;
+    LT_Value list;
+    LT_ListBuilder* contents = LT_ListBuilder_new();
+    int64_t index = 0;
+    (void)tail_call_unwind_marker;
+
+    LT_OBJECT_ARG(cursor, self);
+    LT_ARG_END(cursor);
+    list = self;
+    while (LT_Pair_p(list)){
+        LT_ListBuilder_append(contents, LT_SmallInteger_new(index++));
+        LT_ListBuilder_append(contents, LT_car(list));
+        list = LT_cdr(list);
+    }
+    if (list != LT_NIL){
+        LT_ListBuilder_append(contents, LT_SmallInteger_new(index));
+        LT_ListBuilder_append(contents, list);
+    }
+    return LT_Object_inspection_with_contents(
+        self,
+        "Elements:",
+        LT_ListBuilder_value(contents)
+    );
+}
+
 static LT_Method_Descriptor List_methods[] = {
+    {"inspection", &list_method_inspection},
     {"length", &list_method_length},
     {"at:", &list_method_at},
     {"map:", &list_method_map},

src/classes/Object.c

@@ -4,13 +4,19 @@
  */
 
 #include <ListTalk/classes/Object.h>
+#include <ListTalk/classes/ObjectInspection.h>
 #include <ListTalk/classes/Message.h>
 #include <ListTalk/classes/Primitive.h>
+#include <ListTalk/classes/String.h>
+#include <ListTalk/classes/Symbol.h>
+#include <ListTalk/utils.h>
 #include <ListTalk/macros/arg_macros.h>
 #include <ListTalk/macros/decl_macros.h>
 #include <ListTalk/macros/method_macros.h>
 #include <ListTalk/vm/value.h>
 
+#include <inttypes.h>
+
 LT_DEFINE_PRIMITIVE(
     object_method_class,
     "Object>>class",
@@ -78,6 +84,21 @@ LT_DEFINE_PRIMITIVE_FLAGS(
     return (LT_Value)(uintptr_t)LT_Value_asString(self);
 }
 
+LT_DEFINE_PRIMITIVE(
+    object_method_inspection,
+    "Object>>inspection",
+    "(self)",
+    "Return a presentation-independent inspection of receiver."
+){
+    LT_Value cursor = arguments;
+    LT_Value self;
+    (void)tail_call_unwind_marker;
+
+    LT_OBJECT_ARG(cursor, self);
+    LT_ARG_END(cursor);
+    return LT_Object_inspection(self);
+}
+
 LT_DEFINE_PRIMITIVE_FLAGS(
     object_method_identity_equal,
     "Object>>==",
@@ -179,6 +200,7 @@ static LT_Method_Descriptor Object_methods[] = {
     {"slot:", &object_method_slot},
     {"slot:put:", &object_method_slot_put},
     {"asString", &object_method_as_string},
+    {"inspection", &object_method_inspection},
     {"==", &object_method_identity_equal},
     {"=",  &object_method_equal},
     {"subclassResponsibility", &object_method_subclass_responsibility},
@@ -197,6 +219,46 @@ LT_DEFINE_CLASS(LT_Object) {
     .methods = Object_methods,
 };
 
+LT_Value LT_Object_inspection(LT_Value object){
+    return LT_Object_inspection_with_contents(object, "Contents:", LT_NIL);
+}
+
+LT_Value LT_Object_inspection_with_contents(LT_Value object,
+                                            char* contents_label,
+                                            LT_Value contents){
+    LT_Class* klass = LT_Value_class(object);
+    LT_ListBuilder* slots = LT_ListBuilder_new();
+    char* name_text;
+    LT_Value name;
+    LT_Value description;
+    size_t i;
+
+    name_text = LT_sprintf(
+        "%s at 0x%" PRIxPTR,
+        LT_Symbol_name(LT_Symbol_from_value(klass->name)),
+        (uintptr_t)object
+    );
+    name = (LT_Value)(uintptr_t)LT_String_new_cstr(name_text);
+    description = klass->documentation == LT_NIL
+        ? (LT_Value)(uintptr_t)LT_String_new_cstr("")
+        : klass->documentation;
+    for (i = 0; i < klass->slot_count; i++){
+        LT_ListBuilder_append(slots, klass->slots[i].name);
+        LT_ListBuilder_append(
+            slots,
+            klass->slots[i].type->ref(&klass->slots[i], object)
+        );
+    }
+
+    return LT_ObjectInspection_new(
+        name,
+        description,
+        LT_ListBuilder_value(slots),
+        (LT_Value)(uintptr_t)LT_String_new_cstr(contents_label),
+        contents
+    );
+}
+
 LT_Value LT_Object_slot_ref(LT_Value object, LT_Value slot_name){
     LT_Class* klass = LT_Value_class(object);
     LT_Class_Slot* slot = LT_Class_lookup_slot(klass, slot_name);