artemist/mes
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

mes: Fix display of closure.

Browse source 
* module/mes/display.mes (display): Drop extra ( at start of *closure*, *circ*.
* src/lib.c (display_helper): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2017-12-11 07:06:21 +01:00
parent 30efe5ffbc
commit eb0505300c
2 changed files with 24 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
module/mes/display.mes
View file

@ -99,17 +99,17 @@
((pair? x)
(if (not cont?) (write-char #\( port))
(cond ((eq? (car x) '*circular*)
(display "(*circ* . #-1#)" port))
(display "*circ* . #-1#)" port))
((eq? (car x) '*closure*)
(display "(*closure* . #-1#)" port))
(display "*closure* . #-1#)" port))
(#t
(display (car x) port write?)
(if (pair? (cdr x)) (d (cdr x) #t " ")
(if (and (cdr x) (not (null? (cdr x))))
(begin
(display " . " port)
(display (cdr x) port write?))))
(if (not cont?) (write-char #\) port)))))
(display (cdr x) port write?))))))
(if (not cont?) (write-char #\) port)))
((or (keyword? x) (special? x) (string? x) (symbol? x))
(if (and (string? x) write?) (write-char #\" port))
(if (keyword? x) (display "#:" port))

28
src/lib.c
View file

@ -38,6 +38,13 @@ display_helper (SCM x, int cont, char* sep, int fd)
fputc (VALUE (x), fd);
break;
}
case TCLOSURE:
{
fputs ("#<closure ", fd);
display_helper (CDR (x), cont, "", fd);
fputs (">", fd);
break;
}
case TFUNCTION:
{
fputs ("#<procedure ", fd);
@ -55,7 +62,7 @@ display_helper (SCM x, int cont, char* sep, int fd)
case TMACRO:
{
fputs ("#<macro ", fd);
display_helper (cdr (x), cont, "", fd);
display_helper (CDR (x), cont, "", fd);
fputs (">", fd);
break;
}
@ -67,14 +74,19 @@ display_helper (SCM x, int cont, char* sep, int fd)
case TPAIR:
{
if (!cont) fputs ("(", fd);
if (x && x != cell_nil) fdisplay_ (CAR (x), fd);
if (CDR (x) && TYPE (CDR (x)) == TPAIR)
display_helper (CDR (x), 1, " ", fd);
else if (CDR (x) && CDR (x) != cell_nil)
if (CAR (x) == cell_circular)
fputs ("*circ* . #-1#", fd);
else
{
if (TYPE (CDR (x)) != TPAIR)
fputs (" . ", fd);
fdisplay_ (CDR (x), fd);
if (x && x != cell_nil) fdisplay_ (CAR (x), fd);
if (CDR (x) && TYPE (CDR (x)) == TPAIR)
display_helper (CDR (x), 1, " ", fd);
else if (CDR (x) && CDR (x) != cell_nil)
{
if (TYPE (CDR (x)) != TPAIR)
fputs (" . ", fd);
fdisplay_ (CDR (x), fd);
}
}
if (!cont) fputs (")", fd);
break;