Register srfi-180 as a feature

.envrc

@@ -1 +1 @@
-use nix -p chicken chickenPackages_5.chickenEggs.apropos chickenPackages_5.chickenEggs.chicken-doc chickenPackages_5.chickenEggs.srfi-1 chickenPackages_5.chickenEggs.srfi-18 chickenPackages_5.chickenEggs.srfi-34 chickenPackages_5.chickenEggs.srfi-35 chickenPackages_5.chickenEggs.srfi-158 chicken chickenPackages_5.chickenEggs.apropos chickenPackages_5.chickenEggs.chicken-doc chickenPackages_5.chickenEggs.srfi-1 chickenPackages_5.chickenEggs.srfi-18 chickenPackages_5.chickenEggs.test
+use nix -p chicken chickenPackages_5.chickenEggs.apropos chickenPackages_5.chickenEggs.chicken-doc chickenPackages_5.chickenEggs.srfi-1 chickenPackages_5.chickenEggs.srfi-18 chickenPackages_5.chickenEggs.lsp-server chickenPackages_5.chickenEggs.srfi-34 chickenPackages_5.chickenEggs.srfi-35 chickenPackages_5.chickenEggs.srfi-158 chicken chickenPackages_5.chickenEggs.apropos chickenPackages_5.chickenEggs.chicken-doc chickenPackages_5.chickenEggs.srfi-1 chickenPackages_5.chickenEggs.srfi-18 chickenPackages_5.chickenEggs.lsp-server chickenPackages_5.chickenEggs.test

README.org

@@ -1,4 +1,4 @@
-# Created 2024-09-14 Sat 00:15
+# Created 2024-09-14 Sat 14:52
 #+title: SRFI-180
 #+author: Daniel Ziltener
 #+export_file_name: README.org
@@ -182,8 +182,9 @@ Daniel Ziltener
 ** Version History
 
 #+name: version-history
-| 1.5 | Reimplementation         |
+| 1.5.1 | Escape sequences         |
-| 1.0 | Reference Implementation |
+| 1.5.0 | Reimplementation         |
+| 1.0.0 | Reference Implementation |
 
 * License
 

srfi-180.egg

@@ -3,7 +3,7 @@
  (synopsis "A JSON parser and printer that supports JSON bigger than memory.")
  (category parsing)
  (license "BSD")
- (version "1.5.0")
+ (version "1.5.2")
  (dependencies srfi-34 srfi-35 srfi-158)
  (test-dependencies test)
  (components

srfi-180.impl.scm

@@ -103,7 +103,7 @@
            (let-values (((token next-char* new-charcount nesting-delta)
                          ((determine-reader-proc next-char)
                           json-number-of-characters next-char input-generator)))
-             (if (not (eq? '() token))
+             (unless (null? token)
                  (yield token))
              (loop next-char* (+ (or json-nesting-depth 0) nesting-delta) new-charcount)))))))))
 
@@ -146,6 +146,36 @@
                 next-char* (+ charcount 1) 0)
         (read-number (+ charcount 1) next-char* input-proc accu))))
 
+(define (translate-escape char input-proc)
+  (case char
+    ((#\") #\")
+    ((#\') #\')
+    ((#\\) #\\)
+    ((#\n) #\newline)
+    ((#\t) #\tab)
+    ((#\u) (read-unicode-escape input-proc))
+    ((#\x) (read-hex-escape input-proc))
+    ((#\O) #\null)
+    ((#\r) #\return)
+    ((#\|) #\|)
+    ((#\v) #\vtab)
+    ((#\a) #\alarm)
+    ((#\b) #\backspace)))
+
+(define (read-hex-escape input-proc)
+  (let ((pos1 (input-proc))
+        (pos2 (input-proc)))
+    (integer->char
+     (string->number (list->string (list pos1 pos2)) 16))))
+
+(define (read-unicode-escape input-proc)
+  (let ((pos1 (input-proc))
+        (pos2 (input-proc))
+        (pos3 (input-proc))
+        (pos4 (input-proc)))
+    (integer->char
+     (string->number (list->string (list pos1 pos2 pos3 pos4)) 16))))
+
 (define (read-string charcount next-char input-proc #!optional (beginning? #t) (accu '()) (esc? #f))
   (cond
    (beginning?
@@ -156,10 +186,16 @@
    ((and (not esc?) (char=? next-char #\"))
     (values (reverse-list->string accu)
             (input-proc) (+ charcount 1) 0))
-   (else (read-string (+ charcount 1)
+   ((and (not esc?) (char=? next-char #\\))
+    (read-string (+ charcount 1) (input-proc) input-proc #f accu #t))
+   (else (let ((current-char (if esc?
+                                 (translate-escape next-char input-proc)
+                                 next-char)))
+           (read-string (+ charcount 1)
                         (input-proc) input-proc
-                      #f (cons next-char accu)
+                        #f
-                      (and (not esc?) (char=? next-char #\\))))))
+                        (cons current-char accu)
+                        #f)))))
 
 (define-record json-foldstate mode cache accumulator)
 
@@ -172,7 +208,7 @@
                      (cons obj (json-foldstate-accumulator foldstate)))
                     foldstate))
         ((%object) (begin
-                     (if (equal? '() (json-foldstate-cache foldstate))
+                     (if (null? (json-foldstate-cache foldstate))
                          (begin
                            (json-foldstate-cache-set! foldstate obj))
                          (begin

srfi-180.org

@@ -62,7 +62,7 @@ Test dependencies:
 #+name: dependencies-for-nix
 #+begin_src emacs-lisp :var tbl=dependencies :colnames yes :results raw :exports none
   (concat
-   "chicken chickenPackages_5.chickenEggs.apropos chickenPackages_5.chickenEggs.chicken-doc chickenPackages_5.chickenEggs.srfi-1 chickenPackages_5.chickenEggs.srfi-18 "
+   "chicken chickenPackages_5.chickenEggs.apropos chickenPackages_5.chickenEggs.chicken-doc chickenPackages_5.chickenEggs.srfi-1 chickenPackages_5.chickenEggs.srfi-18 chickenPackages_5.chickenEggs.lsp-server "
    (mapconcat (lambda (row) (concat "chickenPackages_5.chickenEggs." (car row))) tbl " "))
 #+end_src
 
@@ -92,7 +92,10 @@ use nix -p <<dependencies-for-nix()>> <<dependencies-for-nix(tbl=test-dependenci
      json-sequence-read
      json-accumulator
      json-write)
-    (import (chicken base))
+    (import (scheme)
+            (chicken base)
+            (chicken platform))
+    (register-feature! 'srfi-180)
     (include-relative "srfi-180.impl.scm"))
 #+end_src
 
@@ -203,6 +206,7 @@ The needed token predicates are:
 
 #+name: tokenpred-whitespace-test
 #+begin_src scheme :tangle tests/run.scm :noweb strip-tangle :exports none :post test-post(input=*this*) :results output
+  <<prep-test>>
   <<tokpred-whitespace>>
   (test-group "Whitespace predicate"
     (test "#\\space"
@@ -305,7 +309,7 @@ Streaming event-based JSON reader. =PORT-OR-GENERATOR= default value is the valu
              (let-values (((token next-char* new-charcount nesting-delta)
                            ((determine-reader-proc next-char)
                             json-number-of-characters next-char input-generator)))
-               (if (not (eq? '() token))
+               (unless (null? token)
                    (yield token))
                (loop next-char* (+ (or json-nesting-depth 0) nesting-delta) new-charcount)))))))))
 #+end_src
@@ -571,6 +575,36 @@ String reader
 
 #+name: string-reader
 #+begin_src scheme :tangle srfi-180.impl.scm :exports none :results silent
+  (define (translate-escape char input-proc)
+    (case char
+      ((#\") #\")
+      ((#\') #\')
+      ((#\\) #\\)
+      ((#\n) #\newline)
+      ((#\t) #\tab)
+      ((#\u) (read-unicode-escape input-proc))
+      ((#\x) (read-hex-escape input-proc))
+      ((#\O) #\null)
+      ((#\r) #\return)
+      ((#\|) #\|)
+      ((#\v) #\vtab)
+      ((#\a) #\alarm)
+      ((#\b) #\backspace)))
+
+  (define (read-hex-escape input-proc)
+    (let ((pos1 (input-proc))
+          (pos2 (input-proc)))
+      (integer->char
+       (string->number (list->string (list pos1 pos2)) 16))))
+
+  (define (read-unicode-escape input-proc)
+    (let ((pos1 (input-proc))
+          (pos2 (input-proc))
+          (pos3 (input-proc))
+          (pos4 (input-proc)))
+      (integer->char
+       (string->number (list->string (list pos1 pos2 pos3 pos4)) 16))))
+
   (define (read-string charcount next-char input-proc #!optional (beginning? #t) (accu '()) (esc? #f))
     (cond
      (beginning?
@@ -581,10 +615,16 @@ String reader
      ((and (not esc?) (char=? next-char #\"))
       (values (reverse-list->string accu)
               (input-proc) (+ charcount 1) 0))
-     (else (read-string (+ charcount 1)
+     ((and (not esc?) (char=? next-char #\\))
+      (read-string (+ charcount 1) (input-proc) input-proc #f accu #t))
+     (else (let ((current-char (if esc?
+                                   (translate-escape next-char input-proc)
+                                   next-char)))
+             (read-string (+ charcount 1)
                           (input-proc) input-proc
-                        #f (cons next-char accu)
+                          #f
-                        (and (not esc?) (char=? next-char #\\))))))
+                          (cons current-char accu)
+                          #f)))))
 #+end_src
 
 #+name: string-reader-test
@@ -593,9 +633,9 @@ String reader
   <<string-reader>>
   <<tokenpredicates>>
   (test-group "String reading"
-    (let ((input '(#\T #\e #\s #\t #\space #\T #\e #\\ #\s #\\ #\" #\t #\" #\space)))
+    (let ((input '(#\T #\e #\s #\t #\space #\T #\e #\s #\\ #\" #\t #\" #\space)))
       (test "String"
-            '("Test Te\\s\\\"t" #\space 14)
+            '("Test Tes\"t" #\space 13)
             (let-values (((val input charcount nesting-delta)
                           (read-string 0 #\" (lambda () (let ((next (car input)))
                                                      (set! input (cdr input))
@@ -635,7 +675,7 @@ Fundamental JSON iterator.
                          (cons obj (json-foldstate-accumulator foldstate)))
                         foldstate))
             ((%object) (begin
-                         (if (equal? '() (json-foldstate-cache foldstate))
+                         (if (null? (json-foldstate-cache foldstate))
                              (begin
                                (json-foldstate-cache-set! foldstate obj))
                              (begin
@@ -963,6 +1003,8 @@ Daniel Ziltener
 ** Version History
 
 #+name: version-history
+| 1.5.2 | Register srfi-180 as a feature |
+| 1.5.1 | Escape sequences               |
 | 1.5.0 | Reimplementation               |
 | 1.0.0 | Reference Implementation       |
 

srfi-180.release-info

@@ -1,5 +1,7 @@
 ;; -*- Scheme -*-
 (repo git "https://gitea.lyrion.ch/Chicken/srfi-180.git")
 (uri targz "https://gitea.lyrion.ch/Chicken/srfi-180/archive/{egg-release}.tar.gz")
+(release "1.5.2") ;; Register srfi-180 as a feature
+(release "1.5.1") ;; Escape sequences
 (release "1.5.0") ;; Reimplementation
 (release "1.0.0") ;; Reference Implementation

srfi-180.scm

@@ -13,5 +13,8 @@
    json-sequence-read
    json-accumulator
    json-write)
-  (import (chicken base))
+  (import (scheme)
+          (chicken base)
+          (chicken platform))
+  (register-feature! 'srfi-180)
   (include-relative "srfi-180.impl.scm"))

tests/run.scm

@@ -79,9 +79,9 @@
             (list val input charcount)))))
 
 (test-group "String reading"
-  (let ((input '(#\T #\e #\s #\t #\space #\T #\e #\\ #\s #\\ #\" #\t #\" #\space)))
+  (let ((input '(#\T #\e #\s #\t #\space #\T #\e #\s #\\ #\" #\t #\" #\space)))
     (test "String"
-          '("Test Te\\s\\\"t" #\space 14)
+          '("Test Tes\"t" #\space 13)
           (let-values (((val input charcount nesting-delta)
                         (read-string 0 #\" (lambda () (let ((next (car input)))
                                                    (set! input (cdr input))