New Pretty Printer (#994)

* begin work on improved pretty printer

* update ref

* finish pretty printer

* force line break for defstate

test/test_pretty_print.cpp

@@ -2,6 +2,7 @@
 #include "common/goos/Reader.h"
 #include "common/util/FileUtil.h"
 #include "common/goos/PrettyPrinter.h"
+#include "common/goos/PrettyPrinter2.h"
 #include "third-party/fmt/core.h"
 
 using namespace goos;
@@ -14,7 +15,7 @@ Object read(const std::string& str) {
 }
 
 std::string pprint(const Object& o, int len = 80) {
-  return pretty_print::to_string(o, len);
+  return pretty_print::to_string_v1(o, len);
 }
 
 // read then pretty print a string.
@@ -42,7 +43,7 @@ TEST(PrettyPrinter, ReadAgain) {
                            .as_pair()
                            ->cdr.as_pair()
                            ->car;
-  auto printed_gcommon2 = pretty_print::to_string(gcommon_code);
+  auto printed_gcommon2 = pretty_print::to_string_v1(gcommon_code);
   EXPECT_TRUE(gcommon_code == gcommon_code2);
 }
 
@@ -58,7 +59,7 @@ TEST(PrettyPrinter, ReadAgainVeryShortLines) {
                            .as_pair()
                            ->cdr.as_pair()
                            ->car;
-  auto printed_gcommon2 = pretty_print::to_string(gcommon_code);
+  auto printed_gcommon2 = pretty_print::to_string_v1(gcommon_code);
   EXPECT_TRUE(gcommon_code == gcommon_code2);
 }
 
@@ -75,7 +76,7 @@ TEST(PrettyPrinter, DefunNoArgs) {
                  .as_pair()
                  ->cdr.as_pair()
                  ->car;
-  auto printed = pretty_print::to_string(obj, 80);
+  auto printed = pretty_print::to_string_v1(obj, 80);
 
   EXPECT_EQ(printed,
             "(defun looping-code ()\n"
@@ -84,4 +85,158 @@ TEST(PrettyPrinter, DefunNoArgs) {
             "   )\n"
             "  (the-as symbol #f)\n"
             "  )");
-}
+}
+
+TEST(PrettyPrinter2, Debugging) {
+  // first read the gcommon file
+  auto gcommon_code = pretty_print::get_pretty_printer_reader().read_from_file(
+      {"goal_src", "kernel", "gcommon.gc"});
+  // pretty print it
+  auto printed_gcommon = pretty_print::to_string(gcommon_code);
+  auto gcommon_code2 = pretty_print::get_pretty_printer_reader()
+                           .read_from_string(printed_gcommon)
+                           .as_pair()
+                           ->cdr.as_pair()
+                           ->car;
+  EXPECT_TRUE(gcommon_code == gcommon_code2);
+}
+
+namespace {
+std::string pretty_print_v2(const std::string& str) {
+  auto obj =
+      pretty_print::get_pretty_printer_reader().read_from_string(str).as_pair()->cdr.as_pair()->car;
+  return pretty_print::to_string(obj);
+}
+}  // namespace
+
+TEST(PrettyPrinter2, Defun) {
+  // checks that edefun is split up properly
+  std::string code = "(defun identity ((obj object)) obj)";
+  EXPECT_EQ(pretty_print_v2(code),
+            R"((defun identity ((obj object))
+  obj
+  ))");
+}
+
+TEST(PrettyPrinter2, MultiLine) {
+  // check that multiple lines are split correctly
+  std::string code =
+      "(defmethod inspect vec4s ((obj vec4s)) (format #t \"[~8x] ~A~%\" obj 'vec4s) (format #t "
+      "\"~Tx: ~f~%\" (-> obj x)) (format #t \"~Ty: ~f~%\" (-> obj y)) (format #t \"~Tz: ~f~%\" (-> "
+      "obj z)) (format #t \"~Tw: ~f~%\" (-> obj w)) obj )";
+  EXPECT_EQ(pretty_print_v2(code),
+            R"((defmethod inspect vec4s ((obj vec4s))
+  (format #t "[~8x] ~A~%" obj 'vec4s)
+  (format #t "~Tx: ~f~%" (-> obj x))
+  (format #t "~Ty: ~f~%" (-> obj y))
+  (format #t "~Tz: ~f~%" (-> obj z))
+  (format #t "~Tw: ~f~%" (-> obj w))
+  obj
+  ))");
+}
+
+TEST(PrettyPrinter2, LetUntilIf) {
+  std::string code =
+      "(defun basic-type? ((obj basic) (parent-type type))  (let ((obj-type (-> obj type))        "
+      "(end-type object)        )    (until (= obj-type end-type)      (if (= obj-type "
+      "parent-type)          (return #t)          )      (set! obj-type (-> obj-type parent))      "
+      ")    ) #f  )";
+
+  // this checks that let defs are properly aligned, until is properly aligned (body only indented
+  // by two), if indented properly (aligned with condition)
+  EXPECT_EQ(pretty_print_v2(code),
+            R"((defun basic-type? ((obj basic) (parent-type type))
+  (let ((obj-type (-> obj type))
+        (end-type object)
+        )
+    (until (= obj-type end-type)
+      (if (= obj-type parent-type)
+          (return #t)
+          )
+      (set! obj-type (-> obj-type parent))
+      )
+    )
+  #f
+  ))");
+}
+
+TEST(PrettyPrinter2, Overhang) {
+  std::string code =
+      "(defun nassoc ((item-name string) (alist object)) (while (not (or (null? alist) (let ((key "
+      "(car (car alist)))) (if (pair? key) (nmember item-name key) (name= (the-as basic key) "
+      "item-name) ) ) ) ) (set! alist (cdr alist)) ) (if (not (null? alist)) (car alist) ) )";
+
+  // this case is tricky: you have several lists starting at the (while with their last elements
+  // split. this makes sure that the close parens of these list are right.
+  EXPECT_EQ(pretty_print_v2(code),
+            R"((defun nassoc ((item-name string) (alist object))
+  (while (not (or (null? alist) (let ((key (car (car alist))))
+                                  (if (pair? key)
+                                      (nmember item-name key)
+                                      (name= (the-as basic key) item-name)
+                                      )
+                                  )
+                  )
+              )
+    (set! alist (cdr alist))
+    )
+  (if (not (null? alist))
+      (car alist)
+      )
+  ))");
+}
+
+TEST(PrettyPrint2, Cond) {
+  // check that cond and its else get split.
+  // note that for now we allow a short condition and body to be on the same line.
+  std::string code =
+      "(defmethod length pair ((obj pair)) (local-vars (result int)) (cond ((null? obj) (set! "
+      "result 0)) (else (let ((iter (cdr obj))) (set! result 1) (while (and (not (null? iter)) "
+      "(pair? iter)) (+! result 1) (set! iter (cdr iter)) ) ) ) ) result )";
+  EXPECT_EQ(pretty_print_v2(code),
+            R"((defmethod length pair ((obj pair))
+  (local-vars (result int))
+  (cond
+    ((null? obj)
+     (set! result 0)
+     )
+    (else
+      (let ((iter (cdr obj)))
+        (set! result 1)
+        (while (and (not (null? iter)) (pair? iter))
+          (+! result 1)
+          (set! iter (cdr iter))
+          )
+        )
+      )
+    )
+  result
+  ))");
+}
+
+TEST(PrettyPrint2, ParenWayOutToTheRight) {
+  std::string code =
+      "(defmethod new inline-array-class ((allocation symbol) (type-to-make type) (size int)) (let "
+      "((obj (object-new allocation type-to-make (the-as int (+ (-> type-to-make size) (* (the-as "
+      "uint size) (-> type-to-make heap-base)))) ) ) ) (when (nonzero? obj) (set! (-> obj length) "
+      "size) (set! (-> obj allocated-length) size)) obj ) )";
+
+  // checks that the c0 stuff works right.
+  EXPECT_EQ(
+      pretty_print_v2(code),
+      R"((defmethod new inline-array-class ((allocation symbol) (type-to-make type) (size int))
+  (let ((obj (object-new
+               allocation
+               type-to-make
+               (the-as int (+ (-> type-to-make size) (* (the-as uint size) (-> type-to-make heap-base))))
+               )
+             )
+        )
+    (when (nonzero? obj)
+      (set! (-> obj length) size)
+      (set! (-> obj allocated-length) size)
+      )
+    obj
+    )
+  ))");
+}