[nongnu] elpa/geiser-chibi 2502fed134: Miscellaneous fixes for chibi

[ELPA Syncer]

branch: elpa/geiser-chibi
commit 2502fed1349c2703eea528b74bcc980ad6bceab8
Author: Eliza Velasquez <4576666+elizagamedev@users.noreply.github.com>
Commit: Eliza Velasquez <4576666+elizagamedev@users.noreply.github.com>

    Miscellaneous fixes for chibi
    
    I don't necessarily think this PR brings chibi up to par with the other 
scheme
    implementations, but it does improve quite a few things.
    
    - (analyze) was sometimes causing hangs and throwing warnings, but it 
doesn't
      seem to be necessary for calling (eval), so I removed it.
    - I got autodoc back to a somewhat working-ish state which throws fewer
      exceptions overall.
    - I removed the default extra command line parameters, since they didn't 
seem to
      be necessary.
---
 geiser-chibi.el       |   2 +-
 src/geiser/geiser.scm | 128 +++++++++++++++++++++++++-------------------------
 2 files changed, 66 insertions(+), 64 deletions(-)

diff --git a/geiser-chibi.el b/geiser-chibi.el
index 3b10fb8310..7bbdbab27f 100644
--- a/geiser-chibi.el
+++ b/geiser-chibi.el
@@ -44,7 +44,7 @@
   :group 'geiser-chibi)
 
 (geiser-custom--defcustom geiser-chibi-extra-command-line-parameters
-    '("-R" "-m" "chibi ast")
+    nil
   "Additional parameters to supply to the Chibi binary."
   :type '(repeat string)
   :group 'geiser-chibi)
diff --git a/src/geiser/geiser.scm b/src/geiser/geiser.scm
index 84174c44ec..3372224620 100644
--- a/src/geiser/geiser.scm
+++ b/src/geiser/geiser.scm
@@ -10,7 +10,6 @@
       '()))
 
 (define (geiser:completions prefix . rest)
-  rest
   (sort (all-environment-exports (current-environment) prefix)
         string-ci<?))
 
@@ -41,7 +40,6 @@
       (get-output-string err-output))))
 
 (define (geiser:eval module form . rest)
-  rest
   (guard (err
           (else
            (show #t ; to standard output (to comint)
@@ -49,27 +47,28 @@
            (show #t "Error: \n" err "\n")
            (print-stack-trace)))
     (let* ((output (open-output-string))
-           (form-analyzed (analyze form))
            (result (parameterize ((current-output-port output))
-                     (call/cc (lambda (continuation)
-                                (with-exception-handler
-                                    (lambda (err)
-                                      (let ((stack-trace (get-stack-trace)))
-                                        (show #t
-                                              "Output (exception): "
-                                              err
-                                              " \nStack trace:\n"
-                                              stack-trace)
-                                        (continuation (write-to-string
-                                                       (show #f
-                                                             "Result 
(exception): "
-                                                             err
-                                                             "\nStack trace:\n"
-                                                             stack-trace)))))
-                                  (lambda () (if module
-                                           (let ((mod (module-env (find-module 
module))))
-                                              (eval form-analyzed mod))
-                                           (eval form-analyzed)))))))))
+                     (call-with-current-continuation
+                      (lambda (continuation)
+                        (with-exception-handler
+                            (lambda (err)
+                              (let ((stack-trace (get-stack-trace)))
+                                (show #t
+                                      "Output (exception): "
+                                      err
+                                      " \nStack trace:\n"
+                                      stack-trace)
+                                (continuation (write-to-string
+                                               (show #f
+                                                     "Result (exception): "
+                                                     err
+                                                     "\nStack trace:\n"
+                                                     stack-trace)))))
+                          (lambda ()
+                            (if module
+                                (let ((mod (module-env (find-module module))))
+                                  (eval form mod))
+                                (eval form)))))))))
       (write ; to standard output (to comint)
        `((result ,(write-to-string result))
          (output . ,(get-output-string output))))))
@@ -88,57 +87,60 @@
                   modules)))))
 
 (define (procedure-arglist id fun)
-  (let ((arglist (lambda-params (procedure-analysis fun))))
-    (if (pair? arglist)
-        (let loop ((arglist arglist)
-                   (optionals? #f)
-                   (required '())
-                   (optional '()))
-          (cond ((null? arglist)
-                 `(,id ("args" (("required" ,@(reverse required))
-                                ("optional" ,@(reverse optional))
-                                ("key")
-                                ("module" ,(let ((mod (containing-module 
fun))) (if mod (car mod) #f)))))))
-                ((symbol? arglist)
-                 (loop '()
-                       #t
-                       required
-                       (cons "..." (cons arglist optional))))
-                (else
-                 (loop
-                  (cdr arglist)
-                  optionals?
-                  (if optionals? required (cons (car arglist) required))
-                  (if optionals? (cons (car arglist) optional) optional)))))
+  (let ((analysis (procedure-analysis fun)))
+    (if (lambda? analysis)
+        (let ((arglist (lambda-params analysis)))
+          (if (pair? arglist)
+              (let loop ((arglist arglist)
+                         (optionals? #f)
+                         (required '())
+                         (optional '()))
+                (cond ((null? arglist)
+                       `(,id ("args" (("required" ,@(reverse required))
+                                      ("optional" ,@(reverse optional))
+                                      ("key")
+                                      ("module" ,(let ((mod (containing-module 
fun))) (if mod (car mod) #f)))))))
+                      ((symbol? arglist)
+                       (loop '()
+                             #t
+                             required
+                             (cons "..." (cons arglist optional))))
+                      (else
+                       (loop
+                        (cdr arglist)
+                        optionals?
+                        (if optionals? required (cons (car arglist) required))
+                        (if optionals? (cons (car arglist) optional) 
optional)))))
+              '()))
         '())))
 
 (define (geiser:operator-arglist id)
-  (let ((binding (eval id)))
-    (cond ((procedure? binding)
-           (if (opcode? binding)
-               '()
-               (procedure-arglist id binding)))
-          (else
-           '()))))
+  (let ((cell (env-cell (interaction-environment) id)))
+    (if (pair? cell)
+        (let ((proc (cdr cell)))
+          (cond
+           ((macro? proc) '())
+           ((opcode? proc) '())
+           ((procedure? proc) (procedure-arglist id proc))
+           (else '())))
+        '())))
 
 (define (geiser:autodoc ids . rest)
-  (and #f ( ;; disabled temporarily, because it didn't really work
-          rest
-          (cond ((null? ids) '())
-                ((not (list? ids))
-                 (geiser:autodoc (list ids)))
-                ((not (symbol? (car ids)))
-                 (geiser:autodoc (cdr ids)))
-                (else
-                 (map (lambda (id)
-                        (geiser:operator-arglist id))
-                      ids))))))
+  (cond ((null? ids) '())
+        ((not (list? ids))
+         (geiser:autodoc (list ids)))
+        ((not (symbol? (car ids)))
+         (geiser:autodoc (cdr ids)))
+        (else
+         (map (lambda (id)
+                (geiser:operator-arglist id))
+              ids))))
 
 (define (geiser:no-values)
   #f)
 
 (define (geiser:newline)
-  #f)
+  (newline))