Commit be30c4c6 authored by Erick's avatar Erick

Extended the string->list function to be R7RS compliant

parent 34484e47
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 19:36 (eg)
;;;; Last file update: 26-Jun-2018 14:41 (eg)
;;;; Last file update: 26-Jun-2018 14:57 (eg)
;;;;
;;;; ----------------------------------------------------------------------
......@@ -45,6 +45,9 @@ doc>
;;;; 6.7 Strings
;;;; ----------------------------------------------------------------------
;;
;; Generalized string comparison functions
;;
(define-macro (%generalize-string-compare func func2)
`(begin
;; Keep the old function since it is twice faster than the general one
......@@ -72,7 +75,6 @@ doc>
(%generalize-string-compare string-ci>? string-ci2>?)
(%generalize-string-compare string-ci>=? string-ci2>=?)
(define (s->l s :optional (start 0 start?) (end 0 end?))
(if (or start? end?)
(let ((end (if end? end (string-length s))))
......@@ -81,6 +83,22 @@ doc>
(string->list (substring s start end))))
(string->list s)))
;;
;; Generalized string->list
;;
(let ((s->l string->list)) ;; s->l is the R5RS function
(set! string->list
(lambda (str :optional (start 0 start?) (end 0 end?))
(if (or start? end?)
(let ((end (if end? end (string-length str))))
(with-handler (lambda (x)
(error 'string->list
(condition-ref x 'message)))
(s->l (substring str start end))))
(s->l str))))
(%set-procedure-name! string->list 'string->list))
;;;; ----------------------------------------------------------------------
;;;; 6.8 Vectors
;;;; ----------------------------------------------------------------------
......
......@@ -22,7 +22,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: ??????
* Last file update: 26-Jun-2018 11:50 (eg)
* Last file update: 26-Jun-2018 15:23 (eg)
*/
#include <ctype.h>
......@@ -668,15 +668,20 @@ DEFINE_PRIMITIVE("string-append", string_append, vsubr, (int argc, SCM* argv))
/*
<doc string->list list->string
<doc R57RS string->list list->string
* (string->list string)
* (string->list string start)
* (string->list string start end)
* (list->string list)
*
* |String->list| returns a newly allocated list of the characters that make
* up the given string. |List->string| returns a newly allocated string
* formed from the characters in the list |list|, which must be a list of
* characters. |String->list| and |list->string| are inverses so far as
* |equal?| is concerned.
* |String->list| returns a newly allocated list of the characters of
* |string| between |start| and |end|. |List->string| returns a newly
* allocated string formed from the characters in the list |list|,
* which must be a list of characters. |String->list| and
* |list->string| are inverses so far as |equal?| is concerned.
*
* ,@("Note"): The R5RS version of |string->list| accepts only one
* parameter.
doc>
*/
DEFINE_PRIMITIVE("string->list", string2list, subr1, (SCM str))
......
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 26-Jun-2018 11:58 (eg)
;;;; Last file update: 26-Jun-2018 14:57 (eg)
;;;;
(require "test")
......@@ -101,6 +101,11 @@
(test "Extended string-ci<?.3" #t (string-ci<? "a" "B" "c" "D"))
(test "Extended string-ci<?.4" #f (string-ci<? "a" "a" "A" "b"))
(let ((str "abcdef"))
(test "Extended string->list.1" '(#\a #\b #\c #\d #\e #\f) (string->list str))
(test "Extended string->list.2" '(#\c #\d #\e #\f) (string->list str 2))
(test "Extended string->list.3" '(#\c #\d #\e) (string->list str 2 5))
(test "Extended string->list.4" *test-failed* (string->list str 2 100)))
;;------------------------------------------------------------------
(test-subsection "Lists and Pairs")
......@@ -136,4 +141,3 @@
(make-list 4 42))
(test-section-end)
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment