Fcalva/cyclone
1
0
Fork 0
mirror of https://github.com/justinethier/cyclone.git synced 2025-05-19 05:39:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

WIP

Browse source
This commit is contained in:
Justin Ethier 2022-05-24 23:02:18 -04:00
parent 85b941619c
commit 43267e2939
2 changed files with 59 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
circ-test.scm Normal file
View file

@ -0,0 +1,17 @@
;; TODO: Temporary test file
(import (scheme base) (scheme write))
(define v1 (vector #f))
(define v2 (vector v1))
(vector-set! v1 0 v2)
(display v1)
;(equal? v1 v2)
(define v1 (vector 1 2 3))
(define v2 (vector 1 v1 3))
(vector-set! v1 1 v2)
(display v1)
(define l1 (list #f))
(define l2 (list l1))
(set-cdr! l1 l2)
(display l1)

48
runtime.c
View file

@ -1031,7 +1031,29 @@ object Cyc_display_va_list(void *data, object x, object opts)
return Cyc_display(data, x, fp);
}
object Cyc_display(void *data, object x, FILE * port)
object _next(object x) {
if (x == NULL || is_value_type(x)) {
return x;
}
switch(type_of(x)) {
case pair_tag:
return cdr(x);
case vector_tag: {
vector_type *v = (vector)x;
if (v->num_elements > 1) {
return v->elements[1];
} else {
return x;
}
}
default:
return x;
}
}
object _Cyc_display(void *data, object x, FILE * port, object fast)
{
object tmp = NULL;
object has_cycle = boolean_f;
@ -1117,7 +1139,12 @@ object Cyc_display(void *data, object x, FILE * port)
if (i > 0) {
fprintf(port, " ");
}
Cyc_display(data, ((vector) x)->elements[i], port);
object o = ((vector) x)->elements[i];
if (o == fast) {
fprintf(port, "...");
} else {
_Cyc_display(data, o, port, _next(_next(fast)));
}
}
}
fprintf(port, ")");
@ -1133,9 +1160,14 @@ object Cyc_display(void *data, object x, FILE * port)
fprintf(port, ")");
break;
case pair_tag:
if (x == fast) {
fprintf(port, "...");
break;
}
has_cycle = Cyc_has_cycle(x);
fprintf(port, "(");
Cyc_display(data, car(x), port);
_Cyc_display(data, car(x), port, _next(_next(fast)));
// Experimenting with displaying lambda defs in REPL
// not good enough but this is a start. would probably need
@ -1143,7 +1175,7 @@ object Cyc_display(void *data, object x, FILE * port)
if (Cyc_is_symbol(car(x)) == boolean_t &&
strncmp(((symbol) car(x))->desc, "procedure", 10) == 0) {
fprintf(port, " ");
Cyc_display(data, cadr(x), port);
_Cyc_display(data, cadr(x), port, _next(_next(cadr(x)))); // TODO: fast?
fprintf(port, " ...)"); /* skip body and env for now */
break;
}
@ -1154,13 +1186,13 @@ object Cyc_display(void *data, object x, FILE * port)
break; /* arbitrary number, for now */
}
fprintf(port, " ");
Cyc_display(data, car(tmp), port);
_Cyc_display(data, car(tmp), port, _next(_next(fast)));
}
if (has_cycle == boolean_t) {
fprintf(port, " ...");
} else if (tmp) {
fprintf(port, " . ");
Cyc_display(data, tmp, port);
_Cyc_display(data, tmp, port, _next(_next(fast)));
}
fprintf(port, ")");
break;
@ -1203,6 +1235,10 @@ object Cyc_display(void *data, object x, FILE * port)
return quote_void;
}
object Cyc_display(void *data, object x, FILE * port) {
return _Cyc_display(data, x, port, _next(x));
}
void dispatch_write_va(void *data, object clo, int argc, object *args)
{
object x = args[0];