Hack to print OCaml values as pointers or integers (#3)

Author: mshinwell

clang/include/clang/AST/ASTContext.h

@@ -1107,6 +1107,7 @@ class ASTContext : public RefCountedBase<ASTContext> {
   CanQualType PseudoObjectTy, ARCUnbridgedCastTy;
   CanQualType ObjCBuiltinIdTy, ObjCBuiltinClassTy, ObjCBuiltinSelTy;
   CanQualType ObjCBuiltinBoolTy;
+  CanQualType OCamlValueTy;
 #define IMAGE_TYPE(ImgType, Id, SingletonId, Access, Suffix) \
   CanQualType SingletonId;
 #include "clang/Basic/OpenCLImageTypes.def"

clang/include/clang/AST/BuiltinTypes.def

@@ -226,6 +226,9 @@ FLOATING_TYPE(Ibm128, Ibm128Ty)
 // This is the type of C++0x 'nullptr'.
 BUILTIN_TYPE(NullPtr, NullPtrTy)
 
+// OCaml values
+BUILTIN_TYPE(OCamlValue, OCamlValueTy)
+
 // The primitive Objective C 'id' type.  The user-visible 'id'
 // type is a typedef of an ObjCObjectPointerType to an
 // ObjCObjectType with this as its base.  In fact, this only ever

clang/lib/AST/ASTContext.cpp

@@ -1441,6 +1441,8 @@ void ASTContext::InitBuiltinTypes(const TargetInfo &Target,
 
   ObjCSuperType = QualType();
 
+  InitBuiltinType(OCamlValueTy, BuiltinType::OCamlValue);
+
   // void * type
   if (LangOpts.OpenCLGenericAddressSpace) {
     auto Q = VoidTy.getQualifiers();
@@ -2040,6 +2042,10 @@ TypeInfo ASTContext::getTypeInfoImpl(const Type *T) const {
   case Type::Builtin:
     switch (cast<BuiltinType>(T)->getKind()) {
     default: llvm_unreachable("Unknown builtin type!");
+    case BuiltinType::OCamlValue:
+      Width = 64;
+      Align = 64;
+      break;
     case BuiltinType::Void:
       // GCC extension: alignof(void) = 8 bits.
       Width = 0;
@@ -8038,6 +8044,9 @@ static char getObjCEncodingForPrimitiveType(const ASTContext *C,
         return ' ';
       }
 
+    case BuiltinType::OCamlValue:
+      llvm_unreachable("@encoding OCaml value type");
+
     case BuiltinType::ObjCId:
     case BuiltinType::ObjCClass:
     case BuiltinType::ObjCSel:

clang/lib/AST/ExprConstant.cpp

@@ -11338,6 +11338,7 @@ EvaluateBuiltinClassifyType(QualType T, const LangOptions &LangOpts) {
 
     case BuiltinType::NullPtr:
 
+    case BuiltinType::OCamlValue:
     case BuiltinType::ObjCId:
     case BuiltinType::ObjCClass:
     case BuiltinType::ObjCSel:

clang/lib/AST/ItaniumMangle.cpp

@@ -3064,6 +3064,9 @@ void CXXNameMangler::mangleType(const BuiltinType *T) {
     Out << "Dn";
     break;
 
+  case BuiltinType::OCamlValue:
+    llvm_unreachable("mangling an OCaml value type");
+
 #define BUILTIN_TYPE(Id, SingletonId)
 #define PLACEHOLDER_TYPE(Id, SingletonId) \
   case BuiltinType::Id:

clang/lib/AST/MicrosoftMangle.cpp

@@ -2415,6 +2415,9 @@ void MicrosoftCXXNameMangler::mangleType(const BuiltinType *T, Qualifiers,
   case BuiltinType::Dependent:
     llvm_unreachable("placeholder types shouldn't get to name mangling");
 
+  case BuiltinType::OCamlValue:
+    llvm_unreachable("cannot mangle OCaml value types");
+
   case BuiltinType::ObjCId:
     mangleArtificialTagType(TTK_Struct, "objc_object");
     break;

clang/lib/AST/NSAPI.cpp

@@ -459,6 +459,7 @@ NSAPI::getNSNumberFactoryMethodKind(QualType T) const {
   case BuiltinType::Float128:
   case BuiltinType::Ibm128:
   case BuiltinType::NullPtr:
+  case BuiltinType::OCamlValue:
   case BuiltinType::ObjCClass:
   case BuiltinType::ObjCId:
   case BuiltinType::ObjCSel:

clang/lib/AST/Type.cpp

@@ -3106,6 +3106,8 @@ StringRef BuiltinType::getName(const PrintingPolicy &Policy) const {
     return "<ARC unbridged cast type>";
   case BuiltinFn:
     return "<builtin fn type>";
+  case OCamlValue:
+    return "ocaml_value";
   case ObjCId:
     return "id";
   case ObjCClass:
@@ -4257,6 +4259,7 @@ bool Type::canHaveNullability(bool ResultIfUnknown) const {
       return ResultIfUnknown;
 
     case BuiltinType::Void:
+    case BuiltinType::OCamlValue:
     case BuiltinType::ObjCId:
     case BuiltinType::ObjCClass:
     case BuiltinType::ObjCSel:

clang/lib/AST/TypeLoc.cpp

@@ -402,6 +402,7 @@ TypeSpecifierType BuiltinTypeLoc::getWrittenTypeSpec() const {
   case BuiltinType::UnknownAny:
   case BuiltinType::ARCUnbridgedCast:
   case BuiltinType::PseudoObject:
+  case BuiltinType::OCamlValue:
   case BuiltinType::ObjCId:
   case BuiltinType::ObjCClass:
   case BuiltinType::ObjCSel:

clang/lib/CodeGen/CGDebugInfo.cpp

@@ -844,6 +844,7 @@ llvm::DIType *CGDebugInfo::CreateType(const BuiltinType *BT) {
   case BuiltinType::Long:
   case BuiltinType::WChar_S:
   case BuiltinType::LongLong:
+  case BuiltinType::OCamlValue:
     Encoding = llvm::dwarf::DW_ATE_signed;
     break;
   case BuiltinType::Bool: