mirror of
https://github.com/justinethier/cyclone.git
synced 2025-07-11 14:57:36 +02:00
Merge branch 'master' into bignum-experimental-dev
This commit is contained in:
commit
224997169b
7 changed files with 74 additions and 46 deletions
|
@ -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.
|
||||
|
|
|
@ -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?
|
|
@ -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();
|
||||
/**@}*/
|
||||
|
||||
|
||||
|
|
|
@ -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)
|
||||
{
|
||||
|
|
|
@ -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,
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Add table
Reference in a new issue