Merge branch 'master' into bignum-experimental-dev

This commit is contained in:
Justin Ethier 2022-06-02 17:46:16 -07:00
commit 224997169b
7 changed files with 74 additions and 46 deletions

View file

@ -2,6 +2,10 @@
## 0.35.0 - TBD
Features
- Add `memory-streams` to the list of symbols that `(features)` can return, indicating that the current installation supports in-memory streams.
Bug Fixes
- Enforce a maximum recursion depth when printing an object via `display` and `write`, and when comparing objects via `equal?`. This prevents segmentation faults when working with circular data structures.

View file

@ -1,39 +0,0 @@
;; TODO: Temporary test file
(import (scheme base) (scheme write))
(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(display v1)
(display (equal? v1 v2))
(newline)
(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(display v1)
;(display (equal? v1 v2))
(newline)
(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(display l1)
(display (equal? l1 l2))
(newline)
(define l1 (list 1 2 3))
(define l2 (list 1 l1 3))
(set-cdr! (cdr l1) l2)
(write l1)
(display (equal? l1 l2))
(newline)
; TODO: need to compare pointers to prevent this sort of thing:
;
; cyclone> (display #(1 1 1 1 1 1 1 1))
; #(... ... ... ... ... ... ... ...)
;
; for equalp of pairs we track progress using cdr, cddr
; proves that if pointers are equal we are traversing the same list
;
; how to handle vector traversal?

View file

@ -375,6 +375,7 @@ object Cyc_io_peek_u8(void *data, object cont, object port);
object Cyc_write_bytevector(void *data, object bvec, object port, object start, object end);
object Cyc_io_read_line(void *data, object cont, object port);
void Cyc_io_read_token(void *data, object cont, object port);
int Cyc_have_mstreams();
/**@}*/

View file

@ -32,6 +32,15 @@ if (obj_is_not_closure(clo)) { \
} \
}
int Cyc_have_mstreams()
{
#if CYC_HAVE_FMEMOPEN && CYC_HAVE_OPEN_MEMSTREAM
return 1;
#else
return 0;
#endif
}
object Cyc_heap_alloc_port(void *data, port_type *p);
port_type *Cyc_io_open_input_string(void *data, object str)
{

View file

@ -2962,6 +2962,13 @@ object Cyc_compilation_environment(void *data, object cont, object var)
snprintf(buf, sizeof(buf), "%s", CYC_PLATFORM);
make_utf8_string(data, str, buf);
_return_closcall1(data, cont, &str);
} else if (strncmp(((symbol) var)->desc, "memory-streams", 9) == 0) {
char buf[] = "memory-streams";
if (!Cyc_have_mstreams()) {
buf[0] = '\0';
}
make_utf8_string(data, str, buf);
_return_closcall1(data, cont, &str);
}
}
Cyc_rt_raise2(data,

View file

@ -235,14 +235,17 @@
(begin
;; Features implemented by this Scheme
(define (features)
(cons
'cyclone
(cons
(string->symbol
(string-append "version-" *version-number*))
(let ((feats *other-features*))
(if (> (string-length (Cyc-compilation-environment 'memory-streams)) 0)
(set! feats (cons 'memory-streams feats)))
(cons
'cyclone
(cons
(string->symbol (Cyc-compilation-environment 'platform))
*other-features*))))
(string->symbol
(string-append "version-" *version-number*))
(cons
(string->symbol (Cyc-compilation-environment 'platform))
feats)))))
(define *other-features*
'(r7rs

View file

@ -35,6 +35,49 @@
(set-cdr! l '(c b)) ; Above seems to break if it replaces this line
(assert:equal "list? on circular list" (list? l) #t)
;; Circular data structures
(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(cond-expand
(memory-streams
(let ((fp (open-output-string)))
(display v1 fp)
(assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors" (equal? v1 v2) #t)
(newline)
(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(cond-expand
(memory-streams
(let ((fp (open-output-string)))
(write v1 fp)
(assert:equal "display circular vector" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular vectors, test 2" (equal? v1 v2) #t)
(newline)
(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(cond-expand
(memory-streams
(let ((fp (open-output-string)))
(display l1 fp)
(assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists" (equal? l1 l2) #f)
(define l1 (list 1 2 3))
(define l2 (list 1 l1 3))
(set-cdr! (cdr l1) l2)
(cond-expand
(memory-streams
(let ((fp (open-output-string)))
(write l1 fp)
(assert:equal "display circular list" (> (string-length (get-output-string fp)) 0) #t))))
(assert:equal "equality on circular lists, test 2" (equal? l1 l2) #f)
;; Adder example
(define (make-adder x)
(lambda (y) (+ x y)))