fix repr of anonymous classes #361

jcubic · May 13, 2024 · 21955b9 · 21955b9
1 parent a5264e6
commit 21955b9
Show file tree

Hide file tree

Showing 12 changed files with 98 additions and 73 deletions.
diff --git a/CHANGELOG.md b/CHANGELOG.md
@@ -13,6 +13,7 @@
 * fix handling of REPL in Emacs (`run-scheme`)
 * fix `promise?` predicate
 * fix handling of `|1|1` and `|a|b|c|` symbols
+* fix repr of anonymous classes [#361](https://github.com/LIPS-scheme/lips/issues/361)
 
 ## 1.0.0-beta.19
 ### Breaking

diff --git a/dist/lips.cjs b/dist/lips.cjs
diff --git a/dist/lips.esm.js b/dist/lips.esm.js
diff --git a/dist/lips.esm.min.js b/dist/lips.esm.min.js
diff --git a/dist/lips.js b/dist/lips.js
diff --git a/dist/lips.min.js b/dist/lips.min.js
diff --git a/dist/std.min.scm b/dist/std.min.scm
diff --git a/dist/std.scm b/dist/std.scm
diff --git a/dist/std.xcb b/dist/std.xcb
diff --git a/docs/reference.json b/docs/reference.json
diff --git a/lib/bootstrap.scm b/lib/bootstrap.scm
@@ -982,6 +982,7 @@
   "(define-class name parent . body)
 
    Defines a class - JavaScript function constructor with prototype.
+   parent needs to be class, constructor function, or #null
 
    usage:
 
@@ -993,40 +994,45 @@
                (newline))))
      (define jack (new Person \"Jack\"))
      (jack.hi) ; prints \"Jack says hi\""
-  (let iter ((functions '()) (constructor '()) (lst body))
-    (if (null? lst)
-        `(begin
-           (define ,name ,(if (null? constructor)
-                              `(lambda ())
-                              ;; we return this to solve issue when constructor
-                              ;; return a promise
-                              ;; ref: https://stackoverflow.com/a/50885340/387194
-                              (append (%class-lambda constructor)
-                                      (list 'this))))
-           (set-obj! ,name (Symbol.for "__class__") true)
-           ,(if (not (null? parent))
-                `(begin
-                   (set-obj! ,name 'prototype (Object.create (. ,parent 'prototype)))
-                   (set-obj! (. ,name 'prototype) 'constructor ,name)))
-           (set-obj! ,name '__name__ ',name)
-           ,@(map (lambda (fn)
-                    `(set-obj! (. ,name 'prototype)
-                               ,(%class-method-name (car fn))
-                               ,(%class-lambda fn)))
-                  functions))
-        (let ((item (car lst)))
-          (if (eq? (car item) 'constructor)
-              (iter functions item (cdr lst))
-              (iter (cons item functions) constructor (cdr lst)))))))
+  (let ((g:parent (gensym)))
+    (let iter ((functions '()) (constructor '()) (lst body))
+      (if (null? lst)
+          `(begin
+             (define ,name ,(if (null? constructor)
+                                `(lambda ())
+                                ;; we return this to solve issue when constructor
+                                ;; return a promise
+                                ;; ref: https://stackoverflow.com/a/50885340/387194
+                                (append (%class-lambda constructor)
+                                        (list 'this))))
+             (set-obj! ,name (Symbol.for "__class__") true)
+             (let ((,g:parent ,parent ))
+               (if (not (null? ,g:parent))
+                   (begin
+                     (set-obj! ,name 'prototype (Object.create (. ,g:parent 'prototype)))
+                     (set-obj! (. ,name 'prototype) 'constructor ,name))))
+             (set-obj! ,name '__name__ ',name)
+             ,@(map (lambda (fn)
+                      `(set-obj! (. ,name 'prototype)
+                                 ,(%class-method-name (car fn))
+                                 ,(%class-lambda fn)))
+                    functions))
+          (let ((item (car lst)))
+            (if (eq? (car item) 'constructor)
+                (iter functions item (cdr lst))
+                (iter (cons item functions) constructor (cdr lst))))))))
 
 ;; -----------------------------------------------------------------------------
 (define-syntax class
   (syntax-rules ()
     ((_)
      (error "class: parent required"))
-    ((_ parent body ...)
-     (let ()
+    ((_ parent-expr body ...)
+     (let ((parent parent-expr))
+       (if (not (or (procedure? parent) (eq? parent #null)))
+           (error "parent class need to be a function or #null"))
        (define-class temp parent body ...)
+       (set-obj! temp "__name__" "anonymous")
        temp)))
   "(class <parent> body ...)
 

diff --git a/src/lips.js b/src/lips.js
@@ -3438,6 +3438,9 @@ function toString(obj, quote, skip_cycles, ...pair_args) {
         if (type(obj) === 'instance') {
             if (is_lambda(constructor) && constructor.__name__) {
                 name = constructor.__name__.valueOf();
+                if (typeof name === 'symbol') {
+                    name = name.toString().replace(/^Symbol\((?:#:)?([^\)]+)\)$/, '$1');
+                }
             } else if (!is_native_function(constructor)) {
                 name = 'instance';
             }