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

mes: Add write, core:write.

Browse source 
* src/lib.c (display_helper, fdisplay_): Add parameter, write_p.
  Update callers.  When write_p: write quoted strings.
  (write_, write_port_): New function.
* module/mes/read-0.mes (write): New function.
This commit is contained in:
Jan Nieuwenhuizen 2018-01-01 21:10:15 +01:00
parent c092aeb7f7
commit 81404179c1
2 changed files with 31 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
module/mes/read-0.mes
View file

@ -117,6 +117,8 @@
(define (newline . rest) (core:display (list->string (list (integer->char 10))))) (define (newline . rest) (core:display (list->string (list (integer->char 10)))))
(define (display x . rest) (if (null? rest) (core:display x) (define (display x . rest) (if (null? rest) (core:display x)
(core:display-port x (car rest)))) (core:display-port x (car rest))))
(define (write x . rest) (if (null? rest) (core:write x)
(core:write-port x (car rest))))
(define (list->symbol lst) (core:lookup-symbol lst)) (define (list->symbol lst) (core:lookup-symbol lst))

42
src/lib.c
View file

@ -19,12 +19,10 @@
*/ */
int g_depth; int g_depth;
SCM fdisplay_ (SCM, int); SCM fdisplay_ (SCM, int, int);
SCM display_helper (SCM x, int cont, char* sep, int fd);
SCM SCM
display_helper (SCM x, int cont, char* sep, int fd) display_helper (SCM x, int cont, char* sep, int fd, int write_p)
{ {
fputs (sep, fd); fputs (sep, fd);
if (g_depth == 0) return cell_unspecified; if (g_depth == 0) return cell_unspecified;
@ -41,7 +39,7 @@ display_helper (SCM x, int cont, char* sep, int fd)
case TCLOSURE: case TCLOSURE:
{ {
fputs ("#<closure ", fd); fputs ("#<closure ", fd);
display_helper (CDR (x), cont, "", fd); display_helper (CDR (x), cont, "", fd, 0);
fputs (">", fd); fputs (">", fd);
break; break;
} }
@ -62,7 +60,7 @@ display_helper (SCM x, int cont, char* sep, int fd)
case TMACRO: case TMACRO:
{ {
fputs ("#<macro ", fd); fputs ("#<macro ", fd);
display_helper (CDR (x), cont, "", fd); display_helper (CDR (x), cont, "", fd, 0);
fputs (">", fd); fputs (">", fd);
break; break;
} }
@ -78,14 +76,14 @@ display_helper (SCM x, int cont, char* sep, int fd)
fputs ("*circ* . #-1#", fd); fputs ("*circ* . #-1#", fd);
else else
{ {
if (x && x != cell_nil) fdisplay_ (CAR (x), fd); if (x && x != cell_nil) fdisplay_ (CAR (x), fd, write_p);
if (CDR (x) && TYPE (CDR (x)) == TPAIR) if (CDR (x) && TYPE (CDR (x)) == TPAIR)
display_helper (CDR (x), 1, " ", fd); display_helper (CDR (x), 1, " ", fd, write_p);
else if (CDR (x) && CDR (x) != cell_nil) else if (CDR (x) && CDR (x) != cell_nil)
{ {
if (TYPE (CDR (x)) != TPAIR) if (TYPE (CDR (x)) != TPAIR)
fputs (" . ", fd); fputs (" . ", fd);
fdisplay_ (CDR (x), fd); fdisplay_ (CDR (x), fd, write_p);
} }
} }
if (!cont) fputs (")", fd); if (!cont) fputs (")", fd);
@ -95,12 +93,14 @@ display_helper (SCM x, int cont, char* sep, int fd)
case TSTRING: case TSTRING:
case TSYMBOL: case TSYMBOL:
{ {
if (write_p && TYPE (x) == TSTRING) fputc ('"', fd);
SCM t = CAR (x); SCM t = CAR (x);
while (t && t != cell_nil) while (t && t != cell_nil)
{ {
fputc (VALUE (CAR (t)), fd); fputc (VALUE (CAR (t)), fd);
t = CDR (t); t = CDR (t);
} }
if (write_p && TYPE (x) == TSTRING) fputc ('"', fd);
break; break;
} }
default: default:
@ -120,28 +120,42 @@ SCM
display_ (SCM x) display_ (SCM x)
{ {
g_depth = 5; g_depth = 5;
return display_helper (x, 0, "", g_stdout); return display_helper (x, 0, "", g_stdout, 0);
} }
SCM SCM
display_error_ (SCM x) display_error_ (SCM x)
{ {
g_depth = 5; g_depth = 5;
return display_helper (x, 0, "", STDERR); return display_helper (x, 0, "", STDERR, 0);
} }
SCM SCM
display_port_ (SCM x, SCM p) display_port_ (SCM x, SCM p)
{ {
assert (TYPE (p) == TNUMBER); assert (TYPE (p) == TNUMBER);
return fdisplay_ (x, VALUE (p)); return fdisplay_ (x, VALUE (p), 0);
} }
SCM SCM
fdisplay_ (SCM x, int fd) ///((internal)) write_ (SCM x)
{ {
g_depth = 5; g_depth = 5;
return display_helper (x, 0, "", fd); return display_helper (x, 0, "", g_stdout, 1);
}
SCM
write_port_ (SCM x, SCM p)
{
assert (TYPE (p) == TNUMBER);
return fdisplay_ (x, VALUE (p), 1);
}
SCM
fdisplay_ (SCM x, int fd, int write_p) ///((internal))
{
g_depth = 5;
return display_helper (x, 0, "", fd, write_p);
} }
SCM SCM