diff --git a/CHANGELOG.md b/CHANGELOG.md index 6e918630..fabc5939 100644 --- a/CHANGELOG.md +++ b/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`: diff --git a/Makefile b/Makefile index 10a4b494..fcbc54b0 100644 --- a/Makefile +++ b/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) diff --git a/srfi/28.scm b/srfi/28.scm new file mode 100644 index 00000000..cfc3bfc0 --- /dev/null +++ b/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)) diff --git a/srfi/28.sld b/srfi/28.sld new file mode 100644 index 00000000..a3c0b98d --- /dev/null +++ b/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")) + diff --git a/tests/srfi-28-tests.scm b/tests/srfi-28-tests.scm new file mode 100644 index 00000000..3e2705f9 --- /dev/null +++ b/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) diff --git a/tests/srfi-60-tests.scm b/tests/srfi-60-tests.scm index 9991e8c6..59189538 100644 --- a/tests/srfi-60-tests.scm +++ b/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)