lassik
/
upscheme
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fixing bug printing functions involved in cycles

This commit is contained in:
JeffBezanson 2009-05-21 00:56:25 +00:00
parent 99c17feac1
commit 1ee81e2625
3 changed files with 24 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
femtolisp/cps.lsp
View File

@ -274,7 +274,7 @@
(shift yk
(begin (set! ,ko yk)
(set! ,cur v))))))
,(f-body body))))))))))
,@body)))))))))
; a test case
(define-generator (range-iterator lo hi)

35
femtolisp/print.c
View File

@ -340,9 +340,24 @@ static void print_pair(ios_t *f, value_t v)
static void cvalue_print(ios_t *f, value_t v);
void fl_print_child(ios_t *f, value_t v)
static int print_circle_prefix(ios_t *f, value_t v)
{
value_t label;
if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) !=
(value_t)HT_NOTFOUND) {
if (!ismarked(v)) {
HPOS+=ios_printf(f, "#%ld#", numval(label));
return 1;
}
HPOS+=ios_printf(f, "#%ld=", numval(label));
}
if (ismanaged(v))
unmark_cons(v);
return 0;
}
void fl_print_child(ios_t *f, value_t v)
{
char *name;
switch (tag(v)) {
@ -376,6 +391,7 @@ void fl_print_child(ios_t *f, value_t v)
}
else {
assert(isclosure(v));
if (print_circle_prefix(f, v)) return;
function_t *fn = (function_t*)ptr(v);
outs("#function(", f);
char *data = cvalue_data(fn->bcode);
@ -397,18 +413,10 @@ void fl_print_child(ios_t *f, value_t v)
if (v == UNBOUND) { outs("#<undefined>", f); break; }
case TAG_VECTOR:
case TAG_CONS:
if ((label=(value_t)ptrhash_get(&printconses, (void*)v)) !=
(value_t)HT_NOTFOUND) {
if (!ismarked(v)) {
HPOS+=ios_printf(f, "#%ld#", numval(label));
return;
}
HPOS+=ios_printf(f, "#%ld=", numval(label));
}
if (print_circle_prefix(f, v)) return;
if (isvector(v)) {
outc('[', f);
int newindent = HPOS, est;
unmark_cons(v);
int i, sz = vector_size(v);
for(i=0; i < sz; i++) {
fl_print_child(f, vector_elt(v,i));
@ -432,12 +440,9 @@ void fl_print_child(ios_t *f, value_t v)
outc(']', f);
break;
}
if (iscvalue(v) || iscprim(v)) {
if (ismanaged(v))
unmark_cons(v);
if (iscvalue(v) || iscprim(v))
cvalue_print(f, v);
break;
}
else
print_pair(f, v);
break;
}

4
femtolisp/system.lsp
View File

@ -376,8 +376,8 @@
(let* ,(cdr binds) ,@body))
,(cadar binds))))
(define-macro (when c . body) (list 'if c (f-body body) #f))
(define-macro (unless c . body) (list 'if c #f (f-body body)))
(define-macro (when c . body) (list 'if c (cons 'begin body) #f))
(define-macro (unless c . body) (list 'if c #f (cons 'begin body)))
(define-macro (case key . clauses)
(define (vals->cond key v)