Improve Printing Support for OCaml Values

.gitignore

@@ -70,3 +70,7 @@ pythonenv*
 /clang/utils/analyzer/projects/*/RefScanBuildResults
 # automodapi puts generated documentation files here.
 /lldb/docs/python_api/
+
+
+_install/
+build/

clang/include/clang/AST/Decl.h

@@ -3149,6 +3149,22 @@ class FieldDecl : public DeclaratorDecl, public Mergeable<FieldDecl> {
   // Implement isa/cast/dyncast/etc.
   static bool classof(const Decl *D) { return classofKind(D->getKind()); }
   static bool classofKind(Kind K) { return K >= firstField && K <= lastField; }
+
+private:
+  uint64_t m_variant_discr_value = UINT64_MAX;
+
+public:
+  void setVariantDiscrValue(uint64_t value) {
+    m_variant_discr_value = value;
+  }
+
+  uint64_t getVariantDiscrValue() {
+    return m_variant_discr_value;
+  }
+
+  bool hasVariantDiscrValue() {
+    return getVariantDiscrValue() != UINT64_MAX;
+  }
 };
 
 /// An instance of this object exists for each enum constant

clang/include/clang/AST/DeclCXX.h

@@ -1835,6 +1835,27 @@ class CXXRecordDecl : public RecordDecl {
     return K >= firstCXXRecord && K <= lastCXXRecord;
   }
   void markAbstract() { data().Abstract = true; }
+
+private:
+  bool m_is_variant = false;
+  int64_t m_offset_record_from_pointer = 0;
+
+public:
+  bool isVariant() const {
+    return m_is_variant;
+  }
+
+  void setVariant(bool is_variant) {
+    m_is_variant = is_variant;
+  }
+
+  int64_t getOffsetRecordFromPointer() const {
+    return m_offset_record_from_pointer;
+  }
+
+  void setOffsetRecordFromPointer(int64_t offset) {
+    m_offset_record_from_pointer = offset;
+  }
 };
 
 /// Store information needed for an explicit specifier.

clang/lib/AST/TypePrinter.cpp

@@ -544,7 +544,14 @@ void TypePrinter::printIncompleteArrayBefore(const IncompleteArrayType *T,
 
 void TypePrinter::printIncompleteArrayAfter(const IncompleteArrayType *T,
                                             raw_ostream &OS) {
-  OS << "[]";
+  // CR sspies: If we stick with this, we should find a way to propagate the
+  // language information here. Once we add a type def with an explicit name
+  // for the top-level type, custom printing will no longer be needed.
+  bool is_ocaml = true;
+
+  if (is_ocaml) OS << " array";
+  else OS << "[]";
+
   printAfter(T->getElementType(), OS);
 }
 

lldb/include/lldb/Core/ValueObject.h

@@ -361,6 +361,10 @@ class ValueObject {
 
   virtual lldb::ValueType GetValueType() const = 0;
 
+  // XXX mshinwell: why don't any of the following three functions get
+  // called for displaying the type names in parameter lists and
+  // "frame var"?
+
   // Subclasses can implement the functions below.
   virtual ConstString GetTypeName() { return GetCompilerType().GetTypeName(); }
 

lldb/include/lldb/Symbol/SymbolFile.h

@@ -205,6 +205,7 @@ class SymbolFile : public PluginInterface {
   /// To support variable-length array types, this function takes an
   /// optional \p ExecutionContext. If \c exe_ctx is non-null, the
   /// dynamic characteristics for that context are returned.
+  // CR mshinwell: maybe we could use this?
   virtual std::optional<ArrayInfo>
   GetDynamicArrayInfoForUID(lldb::user_id_t type_uid,
                             const lldb_private::ExecutionContext *exe_ctx) = 0;

lldb/include/lldb/Utility/DataExtractor.h

@@ -991,6 +991,14 @@ class DataExtractor {
             uint8_t(GetAddressByteSize())};
   }
 
+  void setDataOriginalSource(lldb::addr_t ptr) {
+    m_data_original_source = ptr;
+  }
+
+  lldb::addr_t getDataOriginalSource() const {
+    return m_data_original_source;
+  }
+
 protected:
   template <typename T> T Get(lldb::offset_t *offset_ptr, T fail_value) const {
     constexpr size_t src_size = sizeof(T);
@@ -1018,6 +1026,8 @@ class DataExtractor {
   lldb::DataBufferSP m_data_sp;
   /// Making it const would require implementation of move assignment operator.
   uint32_t m_target_byte_size = 1;
+  /// Temporary hack for reading more data from the source than is currently available.
+  lldb::addr_t m_data_original_source = 0;
 };
 
 } // namespace lldb_private

lldb/include/lldb/lldb-enumerations.h

@@ -1080,7 +1080,10 @@ FLAGS_ENUM(TypeFlags){
     eTypeIsVector = (1u << 16),         eTypeIsScalar = (1u << 17),
     eTypeIsInteger = (1u << 18),        eTypeIsFloat = (1u << 19),
     eTypeIsComplex = (1u << 20),        eTypeIsSigned = (1u << 21),
-    eTypeInstanceIsPointer = (1u << 22)};
+    eTypeInstanceIsPointer = (1u << 22),eTypeIsOCaml = (1u << 23)};
+
+// FIXME: The info eTypeIsOCaml is currently unused. If this information never
+// becomes useful, remove the flag from the enum above.
 
 FLAGS_ENUM(CommandFlags){
     /// eCommandRequiresTarget

lldb/source/Core/DumpDataExtractor.cpp

@@ -338,6 +338,92 @@ static const llvm::fltSemantics &GetFloatSemantics(const TargetSP &target_sp,
   return llvm::APFloat::Bogus();
 }
 
+
+static std::optional<llvm::APInt> ReadAPIntFromMemory(const DataExtractor &data, Process * process,
+                                           lldb::addr_t load_addr,
+                                           size_t byte_size) {
+  if (byte_size == 0)
+    return std::nullopt;
+
+  llvm::SmallVector<uint64_t, 2> uint64_array;
+  size_t bytes_left = byte_size;
+  uint64_t u64;
+  Status error;
+  const lldb::ByteOrder byte_order = data.GetByteOrder();
+  if (byte_order == lldb::eByteOrderLittle) {
+    while (bytes_left > 0) {
+      if (bytes_left >= 8) {
+        u64 = process->ReadUnsignedIntegerFromMemory(load_addr, 8, 0, error);
+        bytes_left -= 8;
+        load_addr += 8;
+        if (error.Fail())
+          return std::nullopt;
+      } else {
+        u64 = process->ReadUnsignedIntegerFromMemory(load_addr, bytes_left, 0, error);
+        if (error.Fail())
+          return std::nullopt;
+        bytes_left = 0;
+      }
+      uint64_array.push_back(u64);
+    }
+    return llvm::APInt(byte_size * 8, llvm::ArrayRef<uint64_t>(uint64_array));
+  }
+  // CR sspies: big endian not supported
+  return std::nullopt;
+}
+
+
+
+void PrintAPIntAsFloat(Stream *s, llvm::APInt apint,
+                      const llvm::fltSemantics &semantics,
+                      std::optional<unsigned> format_max_padding,
+                      std::string prefix = "", std::string suffix = "") {
+
+  llvm::APFloat apfloat(semantics, apint);
+  llvm::SmallVector<char, 256> sv;
+  if (format_max_padding)
+    apfloat.toPossiblyShortString(sv, *format_max_padding);
+  else
+    apfloat.toPossiblyShortString(sv);
+
+  s->AsRawOstream() << prefix;
+  s->AsRawOstream() << sv;
+  // OCaml Specific:
+  // Following OCaml conventions, print the trailing "." to
+  // identify that the integer is in fact a float, but don't
+  // print any trailing zeros.
+  bool print_trailing_dot = true;
+  for (char c : sv) {
+    switch (c) {
+      case '-':
+      case '0':
+      case '1':
+      case '2':
+      case '3':
+      case '4':
+      case '5':
+      case '6':
+      case '7':
+      case '8':
+      case '9':
+        continue;
+      default:
+        // if we find something that is not a number such as 'e' or 'E' or '.'
+        // there is no need to print the trailing ".".
+        print_trailing_dot = false;
+    }
+    break; // we found something that is not a number, so we will not print
+           // the trailing "."
+  }
+  if (print_trailing_dot){
+    s->AsRawOstream() << ".";
+  }
+
+  s->AsRawOstream() << suffix;
+
+}
+
+
 static offset_t FormatOCamlValue(const DataExtractor &DE, Stream *s,
                                  offset_t start_offset, uint64_t base_addr,
                                  ExecutionContextScope *exe_ctx_scope,
@@ -365,6 +451,16 @@ static offset_t FormatOCamlValue(const DataExtractor &DE, Stream *s,
       exe_ctx_scope->CalculateExecutionContext(exe_ctx);
     Process *process = exe_ctx.GetProcessPtr();
 
+    // max padding for floating point numbers
+    TargetSP target_sp;
+    if (exe_ctx_scope)
+      target_sp = exe_ctx_scope->CalculateTarget();
+
+    std::optional<unsigned> format_max_padding;
+    if (target_sp)
+      format_max_padding = target_sp->GetMaxZeroPaddingInFloatFormat();
+
+
     if (process) {
       Status error;
       lldb::addr_t header = process->ReadPointerFromMemory(value - 8, error);
@@ -497,51 +593,40 @@ static offset_t FormatOCamlValue(const DataExtractor &DE, Stream *s,
         }
 
         case 253: { // Double_tag
-          union {
-            double f;
-            uint64_t i;
-          } u;
-          u.i = process->ReadUnsignedIntegerFromMemory(value, 8, 0, error);
-          if (error.Fail()) {
+          std::optional<llvm::APInt> apint = ReadAPIntFromMemory(DE, process, value, 8);
+          if (!apint) {
             s->Printf("<could not read float>@");
-          } else {
-            // CR mshinwell: should probably use proper float printing code
-            // elsewhere in this file
-            s->Printf("%g", u.f);
-            print_default = false;
+            break;
           }
+          const llvm::fltSemantics &semantics = llvm::APFloat::IEEEdouble();
+          PrintAPIntAsFloat(s, *apint, semantics, format_max_padding);
+          print_default = false;
           break;
         }
 
         case 254: { // Double_array_tag
           // N.B. Empty float arrays have tag zero
           uint64_t wosize_to_print = wosize <= 10 ? wosize : 10;
-          s->Printf("[|");
+          print_default = false; // we still print the default if one of the fields fails
+          s->Printf("[| ");
           for (uint64_t field = 0; field < wosize_to_print; field++) {
-            union {
-              double f;
-              uint64_t i;
-            } u;
-            u.i = process->ReadUnsignedIntegerFromMemory(value, 8, 0, error);
-            if (error.Fail()) {
+            std::optional<llvm::APInt> apint = ReadAPIntFromMemory(DE, process, value + field * 8, 8);
+            if (!apint) {
               s->Printf("<could not read floatarray field %" PRIu64 ">", field);
+              print_default = true;
             } else {
-              // CR mshinwell: should probably use proper float printing code
-              // elsewhere in this file
-              s->Printf("%g", u.f);
+              const llvm::fltSemantics &semantics = llvm::APFloat::IEEEdouble();
+              PrintAPIntAsFloat(s, *apint, semantics, format_max_padding);
             }
 
             if (field < wosize_to_print - 1)
-              s->Printf(", ");
+              s->Printf("; ");
           }
           if (wosize_to_print < wosize) {
-            s->Printf(", <%" PRIu64 " more elements in floatarray>",
+            s->Printf("; <%" PRIu64 " more elements in floatarray>",
                       wosize - wosize_to_print);
           }
-          s->Printf("|]");
-
-          if (!error.Fail())
-            print_default = false;
+          s->Printf(" |]");
           break;
         }
 
@@ -612,7 +697,17 @@ static offset_t FormatOCamlValue(const DataExtractor &DE, Stream *s,
                                 (void *)bigarray_data_ptr);
                       print_default = false;
                     }
-                  } else {
+                  } else if (identifier_str == "_f32") {
+                    std::optional<llvm::APInt> apint = ReadAPIntFromMemory(DE, process, value + 8, 4);
+                    if (!apint) {
+                      s->Printf("<could not read float32>@");
+                      break;
+                    }
+                    const llvm::fltSemantics &semantics = llvm::APFloat::IEEEsingle();
+                    PrintAPIntAsFloat(s, *apint, semantics, format_max_padding, "", "s");
+                    print_default = false;
+                  }
+                  else {
                     // CR mshinwell: check about converting Address.t to (void*)
                     s->Printf("<custom|\"%s\")>@", identifier_str.c_str());
                   }
@@ -987,9 +1082,6 @@ lldb::offset_t lldb_private::DumpDataExtractor(
       if (target_sp)
         format_max_padding = target_sp->GetMaxZeroPaddingInFloatFormat();
 
-      // Show full precision when printing float values
-      const unsigned format_precision = 0;
-
       const llvm::fltSemantics &semantics =
           GetFloatSemantics(target_sp, item_byte_size);
 
@@ -1001,13 +1093,12 @@ lldb::offset_t lldb_private::DumpDataExtractor(
       std::optional<llvm::APInt> apint =
           GetAPInt(DE, &offset, semantics_byte_size);
       if (apint) {
-        llvm::APFloat apfloat(semantics, *apint);
-        llvm::SmallVector<char, 256> sv;
-        if (format_max_padding)
-          apfloat.toString(sv, format_precision, *format_max_padding);
-        else
-          apfloat.toString(sv, format_precision);
-        s->AsRawOstream() << sv;
+        std::string suffix = "";
+        if (semantics_byte_size == 4){
+          suffix = "s";
+        }
+        PrintAPIntAsFloat(s, *apint, semantics,
+                          format_max_padding, "#", suffix);
       } else {
         s->Format("error: unsupported byte size ({0}) for float format",
                   item_byte_size);