Merge pull request #1503 from clasp-developers/print-quasiquote

Improve printing of quasiquote

Author: yitzchak

RELEASE_NOTES.md

@@ -10,6 +10,9 @@
 * Support for Linux AARCH64.
 * LLVM17 support. LLVM15 and LLVM16 are still supported.
 
+## Changed
+* Improved printing of backquote and unquote.
+
 ## Fixed
 * Avoid segmentation faults from incorrectly calling MP:PROCESS-JOIN in
   EXT:RUN-PROGRAM.

include/clasp/core/cons.h

@@ -91,7 +91,7 @@ T_sp oEighth(T_sp o);
 T_sp oNinth(T_sp o);
 T_sp oTenth(T_sp o);
 
-#define CONS_CAR(x) (gctools::reinterpret_cast_smart_ptr<::core::Cons_O>(x)->ocar())
+#define CONS_CAR(x) (gctools::reinterpret_cast_smart_ptr<::core::Cons_O>(x)->car())
 #define CONS_CDR(x) (gctools::reinterpret_cast_smart_ptr<::core::Cons_O>(x)->cdr())
 #define CAR(x) oCar(x)
 #define CDR(x) oCdr(x)
@@ -121,7 +121,7 @@ namespace core {
     friend T_sp oCdr(T_sp o);
 #ifdef USE_PRECISE_GC
   public: // Garbage collector functions
-    uintptr_t rawRefCar() const { return (uintptr_t)this->ocar().raw_(); }
+    uintptr_t rawRefCar() const { return (uintptr_t)this->car().raw_(); }
     uintptr_t rawRefCdr() const { return (uintptr_t)this->cdr().raw_(); }
     void rawRefSetCar(uintptr_t val) { T_sp tval((gctools::Tagged)val); this->setCarNoValidate(tval); }
     void rawRefSetCdr(uintptr_t val) { T_sp tval((gctools::Tagged)val); this->setCdrNoValidate(tval); }
@@ -182,7 +182,7 @@ namespace core {
     }
 
   public: // basic access
-    inline T_sp ocar() const { return _Car.load(std::memory_order_relaxed); }
+    inline T_sp car() const { return _Car.load(std::memory_order_relaxed); }
     inline T_sp cdr() const { return _Cdr.load(std::memory_order_relaxed); }
     inline void setCarNoValidate(T_sp o) {
       _Car.store(o, std::memory_order_relaxed);
@@ -245,14 +245,14 @@ namespace core {
       T_sp cdr = this->cdr();
       if (UNLIKELY(!cdr.consp()))
         return nil<T_O>();
-      return cdr.unsafe_cons()->ocar();
+      return cdr.unsafe_cons()->car();
     }
 
   /*! Get the data for the first element */
     template <class o_class>
       gctools::smart_ptr<o_class> car() {
-      ASSERTNOTNULL(this->ocar());
-      return gc::As<gc::smart_ptr<o_class>>(this->ocar());
+      ASSERTNOTNULL(this->car());
+      return gc::As<gc::smart_ptr<o_class>>(this->car());
     };
     T_sp setf_nth(cl_index index, T_sp val);
   /*! Return the last cons (not the last element) of list.
@@ -266,7 +266,7 @@ namespace core {
   /*! Recursively hash the car and cdr parts - until the HashGenerator fills up */
     inline void sxhash_(HashGenerator &hg) const {
       if (hg.isFilling())
-        hg.hashObject(this->ocar());
+        hg.hashObject(this->car());
       if (hg.isFilling())
         hg.hashObject(this->cdr());
     }
@@ -325,6 +325,7 @@ namespace core {
     void describe(T_sp stream);
     string __repr__() const;
     void __write__(T_sp stream) const;
+    bool maybe_write_quoted_form(bool tail, T_sp stream) const;
 
   /*!Set the owner of every car in the list
 	 */
@@ -350,10 +351,10 @@ namespace core {
     // These are necessary because atomics are not copyable.
     // More specifically they are necessary if you want to store conses in vectors,
     // which the hash table code does.
-    Cons_O(const Cons_O& other) : _Car(other.ocar()), _Cdr(other.cdr())  {};
+    Cons_O(const Cons_O& other) : _Car(other.car()), _Cdr(other.cdr())  {};
     Cons_O& operator=(const Cons_O& other) {
         if (this != &other) {
-            setCar(other.ocar());
+            setCar(other.car());
             setCdr(other.cdr());
         }
         return *this;
@@ -385,7 +386,7 @@ CL_DOCSTRING("Return the first object in a list.")
 DOCGROUP(clasp)
 CL_DEFUN inline core::T_sp oCar(T_sp obj) {
  if (obj.consp())
-   return obj.unsafe_cons()->ocar();
+   return obj.unsafe_cons()->car();
  if (obj.nilp())
    return obj;
  TYPE_ERROR(obj, cl::_sym_Cons_O);
@@ -638,15 +639,15 @@ CL_DOCSTRING("Return the tenth object in a list.")
 DOCGROUP(clasp)
 CL_DEFUN inline T_sp oTenth(T_sp o) { return oCar(oCdr(oCdr(oCdr(oCdr(oCdr(oCdr(oCdr(oCdr(oCdr(o)))))))))); }
 
-inline T_sp cons_car(T_sp x) {ASSERT(x.consp());return gctools::reinterpret_cast_smart_ptr<Cons_O>(x)->ocar();};
+inline T_sp cons_car(T_sp x) {ASSERT(x.consp());return gctools::reinterpret_cast_smart_ptr<Cons_O>(x)->car();};
 
 inline T_sp cons_cdr(T_sp x) {ASSERT(x.consp());return gctools::reinterpret_cast_smart_ptr<Cons_O>(x)->cdr();};
 
-inline T_sp cons_car(Cons_sp x) {ASSERT(x.consp());return x->ocar();};
+inline T_sp cons_car(Cons_sp x) {ASSERT(x.consp());return x->car();};
 
 inline T_sp cons_cdr(Cons_sp x) {ASSERT(x.consp());return x->cdr();};
 
-inline T_sp cons_car(Cons_O* x) {return x->ocar();};
+inline T_sp cons_car(Cons_O* x) {return x->car();};
 
 inline T_sp cons_cdr(Cons_O* x) {return x->cdr();};
 
@@ -709,7 +710,7 @@ template <class T>
 void fillVec0(core::List_sp c, gctools::Vec0<T> &vec) {
   vec.clear();
   for (auto me : (List_sp)(c)) {
-    vec.emplace_back(gc::As<T>(me->ocar()));
+    vec.emplace_back(gc::As<T>(me->car()));
   }
 }
 

src/core/bytecode.cc

@@ -370,7 +370,7 @@ gctools::return_type bytecode_vm(VirtualMachine& vm,
     case vm_cell_ref: {
       DBG_VM1("cell-ref\n");
       T_sp cons((gctools::Tagged)vm.pop(sp));
-      vm.push(sp, cons.unsafe_cons()->ocar().raw_());
+      vm.push(sp, cons.unsafe_cons()->car().raw_());
       pc++;
       break;
     }
@@ -1487,10 +1487,10 @@ List_sp bytecode_bindings_for_pc(BytecodeModule_sp module, void* pc, T_O** fp) {
       size_t end = entry->end().unsafe_fixnum();
       if ((start <= bpc) && (bpc < end)) {
         for (Cons_sp cur : entry->bindings()) {
-          T_sp tinfo = cur->ocar();
+          T_sp tinfo = cur->car();
           if (gc::IsA<Cons_sp>(tinfo)) {
             Cons_sp info = gc::As_unsafe<Cons_sp>(tinfo);
-            T_sp name = info->ocar();
+            T_sp name = info->car();
             T_sp cdr = info->cdr();
             if (cdr.fixnump()) {
               gc::Fixnum index = cdr.unsafe_fixnum();
@@ -1500,11 +1500,11 @@ List_sp bytecode_bindings_for_pc(BytecodeModule_sp module, void* pc, T_O** fp) {
               bindings << Cons_O::create(name, value);
             } else if (gc::IsA<Cons_sp>(cdr)) {
               // indirect cell
-              T_sp tindex = gc::As_unsafe<Cons_sp>(cdr)->ocar();
+              T_sp tindex = gc::As_unsafe<Cons_sp>(cdr)->car();
               if (tindex.fixnump()) {
                 gc::Fixnum index = tindex.unsafe_fixnum();
                 T_sp cell((gctools::Tagged)(*(fp+index+1)));
-                T_sp value = gc::As<Cons_sp>(cell)->ocar();
+                T_sp value = gc::As<Cons_sp>(cell)->car();
                 bindings << Cons_O::create(name, value);
               }
             }

src/core/bytecode_compiler.cc

@@ -968,7 +968,7 @@ static void resolve_debug_vars(BytecodeDebugVars_sp info) {
   else
     info->setEnd(clasp_make_fixnum(0));
   for (Cons_sp cur : info->bindings()) {
-    T_sp tentry = cur->ocar();
+    T_sp tentry = cur->car();
     if (gc::IsA<Cons_sp>(tentry)) {
       Cons_sp entry = gc::As_unsafe<Cons_sp>(tentry);
       T_sp tlvinfo = entry->cdr();

src/core/compiler.cc

@@ -1570,7 +1570,7 @@ void ltvc_fill_list_varargs(gctools::GCRootsInModule *roots, T_O *list, size_t l
   for (; len != 0; --len) {
     Cons_sp cur_cons = gc::As<Cons_sp>(cur);
     Cons_sp cur_vargs = gc::As<Cons_sp>(vargs);
-    cur_cons->rplaca(cur_vargs->ocar());
+    cur_cons->rplaca(cur_vargs->car());
     cur = cur_cons->cdr();
     vargs = cur_vargs->cdr();
   }

src/core/cons.cc

@@ -416,7 +416,7 @@ bool Cons_O::equal(T_sp obj) const {
   if (!obj.consp()) return false;
   if (this == obj.unsafe_cons()) return true;
   List_sp other = obj;
-  if (!cl__equal(this->ocar(), CONS_CAR(other))) return false;
+  if (!cl__equal(this->car(), CONS_CAR(other))) return false;
   T_sp this_cdr = this->cdr();
   T_sp other_cdr = cons_cdr(other);
   return cl__equal(this_cdr, other_cdr);
@@ -426,7 +426,7 @@ bool Cons_O::equalp(T_sp obj) const {
   if (!obj.consp()) return false;
   if (this == obj.unsafe_cons()) return true;
   List_sp other = obj;
-  if (!cl__equalp(this->ocar(), oCar(other)))
+  if (!cl__equalp(this->car(), oCar(other)))
     return false;
   T_sp this_cdr = this->cdr();
   T_sp other_cdr = oCdr(other);
@@ -647,7 +647,7 @@ List_sp Cons_O::copyTree() const {
 
 List_sp Cons_O::copyTreeCar() const {
 
-  T_sp obj = this->ocar();
+  T_sp obj = this->car();
   ASSERTNOTNULL(obj);
   Cons_sp rootCopy = Cons_O::create(nil<T_O>(), nil<T_O>());
   List_sp cobj;
@@ -691,13 +691,13 @@ void Cons_O::describe(T_sp stream)
 
 string Cons_O::__repr__() const {
   Cons_sp start = this->asSmartPtr();
-  T_sp car = start->ocar();
+  T_sp car = start->car();
   T_sp cdr = start->cdr();
   stringstream sout;
   sout << "(" << _safe_rep_(car);
   while (cdr.consp()) {
     Cons_sp p = gc::As<Cons_sp>(cdr);
-    car = p->ocar();
+    car = p->car();
     sout << " " << _safe_rep_(car);
     cdr = oCdr(p);
   }

src/core/corePackage.cc

@@ -503,6 +503,7 @@ SYMBOL_EXPORT_SC_(ClPkg, hash_table_p);
 SYMBOL_EXPORT_SC_(CorePkg, STARenablePrintPrettySTAR);
 SYMBOL_EXPORT_SC_(CorePkg, STARcircle_counterSTAR);
 SYMBOL_EXPORT_SC_(CorePkg, STARcircle_stackSTAR);
+SYMBOL_EXPORT_SC_(CorePkg, STARquasiquoteSTAR);
 SYMBOL_EXPORT_SC_(CorePkg, dynamicGo);
 SYMBOL_EXPORT_SC_(CorePkg, localGo);
 SYMBOL_EXPORT_SC_(ClPkg, _DIVIDE_);
@@ -846,7 +847,7 @@ void testConses() {
     fastTimer.start();
     for (int i = 0; i < times; ++i) {
       for (auto c : l.full()) {
-        T_sp t = c->ocar();
+        T_sp t = c->car();
         fastCount += unbox_fixnum(gc::As<Fixnum_sp>(t));
       }
     }
@@ -859,7 +860,7 @@ void testConses() {
     normalTimer.start();
     for (int i = 0; i < times; ++i) {
       for (auto c : l) {
-        T_sp t = c->ocar();
+        T_sp t = c->car();
         normalCount += unbox_fixnum(gc::As<Fixnum_sp>(t));
       }
     }
@@ -1064,6 +1065,10 @@ void CoreExposer_O::define_essential_globals(LispPtr lisp) {
   _sym_STARprintPackageSTAR->defparameter(nil<T_O>());
   _sym_STARcircle_counterSTAR->defparameter(nil<T_O>());
   _sym_STARcircle_stackSTAR->defparameter(nil<T_O>());
+  // *quasiquote* is currently a dynamically bound plist of stream to nil/t values. It indicates whether or not the current stream
+  // in inside a quasiquote during printing. This is used so that unquote forms print correctly inside of a quasiquote but print as
+  // normal forms outside of a quasiquote.
+  _sym_STARquasiquoteSTAR->defparameter(nil<T_O>());
   _sym_STARdebugReaderSTAR->defparameter(nil<T_O>());
   _sym__PLUS_known_typep_predicates_PLUS_->defparameter(nil<T_O>());
   cl::_sym_STARloadPathnameSTAR->defparameter(nil<T_O>());

src/core/mpPackage.cc

@@ -157,7 +157,7 @@ struct SafeRegisterDeregisterProcessWithLisp {
 void do_start_thread_inner(Process_sp process, core::List_sp bindings) {
   if (bindings.consp()) {
     core::Cons_sp pair = gc::As<core::Cons_sp>(CONS_CAR(bindings));
-    core::DynamicScopeManager scope(gc::As<core::Symbol_sp>(pair->ocar()),core::eval::evaluate(pair->cdr(),nil<core::T_O>()));
+    core::DynamicScopeManager scope(gc::As<core::Symbol_sp>(pair->car()),core::eval::evaluate(pair->cdr(),nil<core::T_O>()));
     do_start_thread_inner(process,CONS_CDR(bindings));
   } else {
     core::List_sp args = process->_Arguments;

src/core/unwind.cc

@@ -61,7 +61,7 @@ DynEnv_O::SearchStatus sjlj_throw_search(T_sp tag, CatchDynEnv_sp& dest) {
 #ifdef UNWIND_INVALIDATE_STRICT
 void sjlj_unwind_invalidate(DestDynEnv_sp dest) {
   for (T_sp iter = my_thread->dynEnvStackGet();
-       iter.notnilp() && (iter->ocar() != dest);
+       iter.notnilp() && (iter->car() != dest);
        iter = CONS_CDR(iter))
     iter->invalidate();
 }