From e619618f510ef6ddf6a75c3a4f1341a42e0de95b Mon Sep 17 00:00:00 2001
From: vyzo <vyzo@hackzen.org>
Date: Thu, 21 Sep 2023 20:14:26 +0300
Subject: [PATCH 1/3] std/error: exception-context and check-argument macros

---
 src/std/error.ss | 24 +++++++++++++++++++++++-
 1 file changed, 23 insertions(+), 1 deletion(-)

diff --git a/src/std/error.ss b/src/std/error.ss
index 79efa411a..fb26855b1 100644
--- a/src/std/error.ss
+++ b/src/std/error.ss
@@ -3,7 +3,8 @@
 ;;; Gerbil error objects
 (import :gerbil/runtime/error
         :gerbil/gambit/continuations
-        :gerbil/gambit/threads)
+        :gerbil/gambit/threads
+        (for-syntax :gerbil/expander))
 (export Exception Exception?
         RuntimeException RuntimeException?
         Error Error?
@@ -72,6 +73,27 @@
 ;; key lookup errors
 (deferror-class UnboundKey () unbound-key-error?)
 
+;; utility macros
+(defsyntax (exception-context stx)
+  (syntax-case stx ()
+    ((macro)
+     #'(exception-context macro))
+    ((_ here)
+     (with-syntax ((where
+                    (cond
+                     ((or (AST-source #'here)
+                          (AST-source stx))
+                      => (lambda (locat)
+                           (call-with-output-string "" (cut ##display-locat locat #t <>))))
+                     (else
+                      (expander-context-id (core-context-top))))))
+       #'(quote where)))))
+
+(defrules check-argument ()
+  ((_ expr expectation argument)
+   (unless expr
+     (raise-bad-argument (exception-context argument) expectation argument))))
+
 ;; check to the raiser!
 (def (raise-bad-argument where expectation . irritants)
   (raise

From e970a80ecfd820282091df0a4e4b1c643eb3e2b9 Mon Sep 17 00:00:00 2001
From: vyzo <vyzo@hackzen.org>
Date: Thu, 21 Sep 2023 20:39:26 +0300
Subject: [PATCH 2/3] avoid clown shoes with in error display

 The repl handler prepends an *** ERROR, which makes it two in the
 same line with our own.
 To avoid this situation, we check if there is output in the port
 buffer already, and if that's the case print a newline before
 displaying our exception.
---
 src/gerbil/runtime/error.ss  | 8 +++++++-
 src/gerbil/runtime/gambit.ss | 1 +
 2 files changed, 8 insertions(+), 1 deletion(-)

diff --git a/src/gerbil/runtime/error.ss b/src/gerbil/runtime/error.ss
index 4d3e8b2e3..c0f8dfad6 100644
--- a/src/gerbil/runtime/error.ss
+++ b/src/gerbil/runtime/error.ss
@@ -131,9 +131,15 @@ namespace: #f
 
 (defmethod {display-exception Error}
   (lambda (self port)
-    (let (tmp-port (open-output-string))
+    (let ((tmp-port (open-output-string))
+          (display-error-newline
+           (if (macro-character-port? port)
+             (> (macro-character-port-wchars port) 0)
+             #f)))
       (fix-port-width! tmp-port)
       (parameterize ((current-output-port tmp-port))
+        (when display-error-newline ; avoid clown shoes at the repl prompt
+          (newline))
         (display "*** ERROR IN ")
         (cond
          ((&Error-where self) => display)
diff --git a/src/gerbil/runtime/gambit.ss b/src/gerbil/runtime/gambit.ss
index bd8308242..2a6280a54 100644
--- a/src/gerbil/runtime/gambit.ss
+++ b/src/gerbil/runtime/gambit.ss
@@ -62,6 +62,7 @@ namespace: #f
   macro-readtable-brace-handler-set!
   macro-exception?
   macro-character-port?
+  macro-character-port-wchars
   macro-character-port-output-width
   macro-character-port-output-width-set!)
 

From f56f35c129e4339f6fdaa5ae85c9f219eebb25cd Mon Sep 17 00:00:00 2001
From: vyzo <vyzo@hackzen.org>
Date: Thu, 21 Sep 2023 21:48:18 +0300
Subject: [PATCH 3/3] fix references to non existent procedure

refactoring left over, raise-unspecified-error does not exist any
more.
---
 src/std/xml/_libxml.scm     | 2 +-
 src/std/xml/sxml-to-xml.scm | 3 ---
 2 files changed, 1 insertion(+), 4 deletions(-)

diff --git a/src/std/xml/_libxml.scm b/src/std/xml/_libxml.scm
index f200e797a..6f8a2320a 100644
--- a/src/std/xml/_libxml.scm
+++ b/src/std/xml/_libxml.scm
@@ -404,7 +404,7 @@ END-C
    ((macro-character-input-port? port)
     (parse (read-char-port port) url encoding options))
    (else
-    (std/error#raise-unspecified-error "Can't parse port; not a byte or character input port" port))))
+    (error "Can't parse port; not a byte or character input port" port))))
 
 (define (xmlRead-port port url encoding options)
   (xmlRead-iocontext xmlRead-u8vector* port url encoding options))
diff --git a/src/std/xml/sxml-to-xml.scm b/src/std/xml/sxml-to-xml.scm
index ce2190a15..0b55faf0a 100644
--- a/src/std/xml/sxml-to-xml.scm
+++ b/src/std/xml/sxml-to-xml.scm
@@ -95,9 +95,6 @@
               next-separator
               ))
 
-(define-macro (error message . args)
-  `(std/error#raise-unspecified-error message ,@args))
-
 (define valid-quote-chars '(#\" #\'))
 
 ; The following regards HTML/XHTML though as XML is so frequently used, we include it here.