Commit 4af1ecbd authored by Erick's avatar Erick

Added extended functions display-simple display-shared

parent 60bd9995
......@@ -18,7 +18,7 @@
;; USA.
;; Author: Erick Gallesio [eg@unice.fr]
;; Creation date: 26-Nov-2000 18:19 (eg)
;; Last file update: 22-Aug-2018 14:15 (eg)
;; Last file update: 24-Aug-2018 15:43 (eg)
;;
;; ======================================================================
......@@ -616,6 +616,8 @@ be accessed as a normal port with the standard Scheme primitives.])
(index "SRFI-38")
(insertdoc 'write-with-shared-structure)
(insertdoc 'display)
(insertdoc 'display-shared)
(insertdoc 'display-simple)
(insertdoc 'newline)
(insertdoc 'write-string)
(insertdoc 'write-u8)
......
......@@ -21,7 +21,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 14-Jun-2000 17:24 (eg)
;;;; Last file update: 22-Aug-2018 13:03 (eg)
;;;; Last file update: 24-Aug-2018 15:20 (eg)
;;;;
......@@ -30,6 +30,10 @@
(define read-chars! read-bytes!)
;;;; Aliases
(define display-shared display)
#|
<doc EXT gensym
* (gensym)
......
......@@ -20,7 +20,7 @@
*
* Author: Erick Gallesio [eg@unice.fr]
* Creation date: 17-Feb-1993 12:27
* Last file update: 23-Aug-2018 15:45 (eg)
* Last file update: 24-Aug-2018 15:21 (eg)
*
*/
......@@ -697,6 +697,36 @@ DEFINE_PRIMITIVE("display", display, subr12, (SCM expr, SCM port))
}
/*
<doc EXT display-simple
* (display-simple obj)
* (display-simple obj port)
*
* The |display-simple| procedure is the same as |display|, except
* that shared structure is never represented using datum labels.
* This can cause |display-simple| not to terminate if |obj|
* contains circular structure.
doc>
*/
DEFINE_PRIMITIVE("display-simple", display_simple, subr12, (SCM expr, SCM port))
{
port = verify_port(port, PORT_WRITE | PORT_TEXTUAL);
STk_print(expr, port, DSP_MODE);
return STk_void;
}
/*
<doc EXT display-shared
* (display-shared obj)
* (display-shared obj port)
*
* The |display-shared| procedure is the same as |display|, except
* that shared structure are represented using datum labels.
doc>
*/
/* Aliased to display in lib/bonus.stk */
/*
<doc newline
* (newline)
......@@ -1704,6 +1734,7 @@ int STk_init_port(void)
ADD_PRIMITIVE(write);
ADD_PRIMITIVE(display);
ADD_PRIMITIVE(display_simple);
ADD_PRIMITIVE(newline);
ADD_PRIMITIVE(write_char);
ADD_PRIMITIVE(write_string);
......
......@@ -22,7 +22,7 @@
;;;;
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 17-Apr-2011 20:58 (eg)
;;;; Last file update: 23-Aug-2018 15:52 (eg)
;;;; Last file update: 24-Aug-2018 15:41 (eg)
;;;;
(require "test")
......@@ -552,6 +552,18 @@
(display y out)
(get-output-string out)))
(test "display (cyclic list).2"
"(#0=(abc def A foo) #0#)(abc def A foo)(\"abc\" \"def\" #\\A foo)"
(let* ((x '("abc" "def" #\A foo))
(y (list x x))
(out (open-output-string)))
(display y out)
(display-simple x out)
(write-simple x out)
(get-output-string out)))
(test "write-shared (cyclic list).1"
"(#0=(\"abc\" \"def\" #\\A foo) #0#)"
(let* ((x '("abc" "def" #\A foo))
......
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