Adding full support for SRFI 28, adding tests for compliance, modifying changelog

CHANGELOG.md

@@ -2,7 +2,7 @@
 
 Features
 
-- Koz Ross added an implementation of SRFI 60.
+- Koz Ross added implementations of SRFI 28 and 60.
 - Allow a program to have more than one `import` declaration. A program can now also use `cond-expand` to selectively expand `import` declarations.
 - Added the `-A` and `-I` compiler options from SRFI 138 to `cyclone`:
 

Makefile

@@ -22,7 +22,9 @@ SLDFILES = $(wildcard $(SCHEME_DIR)/*.sld) \
 					 $(wildcard $(SCHEME_DIR)/cyclone/*.sld)
 COBJECTS = $(SLDFILES:.sld=.o)
 HEADERS = $(HEADER_DIR)/runtime.h $(HEADER_DIR)/types.h
-TEST_SRC = $(TEST_DIR)/unit-tests.scm $(TEST_DIR)/srfi-60-tests.scm
+TEST_SRC = $(TEST_DIR)/unit-tests.scm \
+					 $(TEST_DIR)/srfi-28-tests.scm \
+					 $(TEST_DIR)/srfi-60-tests.scm
 TESTS = $(basename $(TEST_SRC))
 
 # Primary rules (of interest to an end user)

srfi/28.scm

@@ -0,0 +1,46 @@
+#|
+ | Copyright (C) 2002 Scott Miller
+ | Copyright (C) 2017 Koz Ross
+ |
+ | Permission is hereby granted, free of charge, to any person obtaining a copy of
+ | this software and associated documentation files (the "Software"), to deal in
+ | the Software without restriction, including without limitation the rights to
+ | use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of
+ | the Software, and to permit persons to whom the Software is furnished to do so,
+ | subject to the following conditions:
+ |
+ | The above copyright notice and this permission notice shall be included in all
+ | copies or substantial portions of the Software.
+ |
+ | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+ | IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS
+ | FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR
+ | COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER
+ | IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
+ | CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ |#
+
+(define (format format-string . objects)
+  (define buffer (open-output-string))
+  (define (fmt-rec format-list objs)
+    (define (escape-write how)
+      (if (null? objs)
+          (error "No value for escape sequence")
+          (begin
+            (how (car objs) buffer)
+            (fmt-rec (cddr format-list) (cdr objs)))))
+    (define (raw-write what next)
+      (write-char what buffer)
+      (fmt-rec (next format-list) objs))
+    (cond
+      ((null? format-list) (get-output-string buffer))
+      ((char=? (car format-list) #\~) (if (null? (cdr format-list))
+                                          (error "Incomplete escape sequence")
+                                          (case (cadr format-list)
+                                            ((#\a) (escape-write display))
+                                            ((#\s) (escape-write write))
+                                            ((#\%) (raw-write #\newline cddr)) 
+                                            ((#\~) (raw-write #\~ cddr))
+                                            (else (error "Unrecognized escape sequence")))))
+      (else (raw-write (car format-list) cdr)))) 
+  (fmt-rec (string->list format-string) objects))

srfi/28.sld

@@ -0,0 +1,14 @@
+;;;; Cyclone Scheme
+;;;; https://github.com/justinethier/cyclone
+;;;;
+;;;; Copyright (c) 2017, Koz Ross
+;;;;
+;;;; This module is an interface to the Basic Format Strings library.
+(define-library
+  (srfi 28)
+  (import 
+    (scheme base)
+    (scheme write))
+  (export format)
+  (include "28.scm"))
+

tests/srfi-28-tests.scm

@@ -0,0 +1,13 @@
+(import
+  (scheme base)
+  (srfi 28)
+  (scheme cyclone test))
+
+(test-group
+  "format"
+  (test "Hello, World!" (format "Hello, ~a" "World!"))
+  (test "Error, list is too short: (one \"two\" 3)
+"
+        (format "Error, list is too short: ~s~%" '(one "two" 3))))
+
+(test-exit)

tests/srfi-60-tests.scm

@@ -135,4 +135,4 @@
   "reverse-bit-field"
   (test "E5" (number->string (reverse-bit-field #xa7 0 8) 16)))
 
-(test-end)
+(test-exit)