From cc5e0f5e7e917a8d279004784a80e6ffa6b5ae98 Mon Sep 17 00:00:00 2001
From: Masaya Tojo <masaya@tojo.tokyo>
Date: Sun, 4 Aug 2024 15:04:03 +0900
Subject: Add custom exceptions for improved error handling in the parsing
 process

---
 pnm/read.scm | 61 +++++++++++++++++++++++++++++++++++++++++++++++-------------
 1 file changed, 48 insertions(+), 13 deletions(-)

diff --git a/pnm/read.scm b/pnm/read.scm
index 1f0017a..55e5068 100644
--- a/pnm/read.scm
+++ b/pnm/read.scm
@@ -17,18 +17,17 @@
 ;;; along with R7RS-PNM. If not, see <https://www.gnu.org/licenses/>.
 
 (define-library (pnm read)
-  (export image-read)
+  (export image-read
+          pnm-parse-error?
+          pnm-parse-error-type)
   (import (scheme base)
+          (scheme write)
           (pnm image)
           (pnm pbm)
           (pnm pgm)
           (pnm ppm))
   (begin
     (define (image-read in)
-      (define (unexpected-eof-error)
-        (error "(pnm read) image-read: Unexpected end of file"))
-      (define (unexpected-char-error)
-        (error "(pnm read) image-read: Unexpected character"))
       (define (read-u8*)
         (let ((u8 (read-u8 in)))
           (when (eof-object? u8)
@@ -39,24 +38,24 @@
           (when (eof-object? magic-number)
             (unexpected-eof-error))
           (unless magic-number
-            (error "(pnm read) image-read: Not supported magic number"))
+            (unexpected-magic-number-error))
           magic-number))
       (define (read-number*)
         (let ((n (read-number in)))
           (when (eof-object? n)
             (unexpected-eof-error))
           (unless n
-            (unexpected-char-error))
+            (unexpected-character-error))
           n))
       (define (read-whitespaces*)
         (let ((result (read-whitespaces in)))
           (when (eof-object? result)
             (unexpected-eof-error))
           (unless result
-            (error "(pnm read) image-read: Unexpected character (expected whitespace)"))))
+            (unexpected-character-error))))
       (define (read-single-whitespace*)
         (unless (whitespace? (read-u8*))
-          (unexpected-char-error)))
+          (unexpected-character-error)))
 
       (let ((magic-number (read-magic-number*)))
         (read-whitespaces*)
@@ -75,7 +74,7 @@
                                    (lambda (x y v)
                                      (image-set! pbm-image x y (= v 1)))
                                    unexpected-eof-error
-                                   unexpected-char-error)
+                                   unexpected-character-error)
                  pbm-image))
               (else
                (read-whitespaces*)
@@ -91,7 +90,7 @@
                     (let ((ppm-image (make-ppm-image width height maxval)))
                       (read-text-raster width height #t in (image-pixel-setter ppm-image)
                                         unexpected-eof-error
-                                        unexpected-char-error)
+                                        unexpected-character-error)
                       ppm-image))
                    ((P5)
                     (read-single-whitespace*)
@@ -103,7 +102,7 @@
                     (let ((pgm-image (make-pgm-image width height maxval)))
                       (read-text-raster width height #f in (image-pixel-setter pgm-image)
                                         unexpected-eof-error
-                                        unexpected-char-error)
+                                        unexpected-character-error)
                       pgm-image))))))))))
 
     (define (whitespace? u8)
@@ -218,4 +217,40 @@
                    ((digit? u8)
                     (read-u8 in)
                     (loop (+ (* number 10) (u8->integer u8))))
-                   (else number)))))))))
+                   (else number))))))))
+  (cond-expand
+    ((library (srfi 35))
+     (import (srfi 35))
+     (begin
+       (define-condition-type &pnm-parse-error &error
+         pnm-parse-error?
+         (type pnm-parse-error-type))
+
+       (define (unexpected-magic-number-error)
+         (raise (condition (&pnm-parse-error
+                            (type 'unexpected-magic-number-error))
+                           (&message
+                            (message "(pnm read) image-read: Not supported magic number")))))
+       (define (unexpected-eof-error)
+         (raise (condition (&pnm-parse-error
+                            (type 'unexpected-eof-error))
+                           (&message
+                            (message "(pnm read) image-read: Unexpected end of file")))))
+       (define (unexpected-character-error)
+         (raise (condition (&pnm-parse-error
+                            (type 'unexpected-character-error))
+                           (&message
+                            (message "(pnm read) image-read: Unexpected character")))))))
+    (r7rs
+     (begin
+       (define-record-type <pnm-parse-error>
+         (make-pnm-parse-error type)
+         pnm-parse-error?
+         (type pnm-parse-error-type))
+
+       (define (unexpected-magic-number-error)
+         (raise (make-pnm-parse-error 'unexpected-magic-number-error)))
+       (define (unexpected-eof-error)
+         (raise (make-pnm-parse-error 'unexpected-eof-error)))
+       (define (unexpected-character-error)
+         (raise (make-pnm-parse-error 'unexpected-character-error)))))))
-- 
cgit v1.2.3