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

core: lib: Prepare for M2-Planet.

Browse source 
* src/lib.c (display_helper): Refactor to use if instead of switch.
(memq): Likewise.
This commit is contained in:
Jan Nieuwenhuizen 2018-08-12 16:41:07 +02:00
parent 03ee240904
commit 1e787637d8
No known key found for this signature in database
GPG key ID: F3C1A0D9C1D65273
1 changed files with 155 additions and 178 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

333
src/lib.c
View file

@ -29,179 +29,162 @@ display_helper (SCM x, int cont, char* sep, int fd, int write_p)
return cell_unspecified;
g_depth = g_depth - 1;
switch (TYPE (x))
int t = TYPE (x);
if (t == TCHAR)
{
case TCHAR:
{
if (!write_p)
fdputc (VALUE (x), fd);
else
{
fdputs ("#\\", fd);
switch (VALUE (x))
{
case '\0': fdputs ("nul", fd); break;
case '\a': fdputs ("alarm", fd); break;
case '\b': fdputs ("backspace", fd); break;
case '\t': fdputs ("tab", fd); break;
case '\n': fdputs ("newline", fd); break;
case '\v': fdputs ("vtab", fd); break;
case '\f': fdputs ("page", fd); break;
//Nyacc bug
// case '\r': fdputs ("return", fd); break;
case 13: fdputs ("return", fd); break;
case ' ': fdputs ("space", fd); break;
default: fdputc (VALUE (x), fd);
}
}
break;
}
case TCLOSURE:
{
fdputs ("#<closure ", fd);
display_helper (CDR (x), cont, "", fd, 0);
fdputs (">", fd);
break;
}
case TFUNCTION:
{
fdputs ("#<procedure ", fd);
char const *p = "?";
if (FUNCTION (x).name != 0)
p = FUNCTION (x).name;
fdputs (p, fd);
fdputs ("[", fd);
fdputs (itoa (CDR (x)), fd);
fdputs (",", fd);
fdputs (itoa (x), fd);
fdputs ("]>", fd);
break;
}
case TMACRO:
{
fdputs ("#<macro ", fd);
display_helper (CDR (x), cont, "", fd, 0);
fdputs (">", fd);
break;
}
case TVARIABLE:
{
fdputs ("#<variable ", fd);
display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
fdputs (">", fd);
break;
}
case TNUMBER:
{
fdputs (itoa (VALUE (x)), fd);
break;
}
case TPAIR:
{
if (!cont)
fdputs ("(", fd);
if (CAR (x) == cell_circular
&& CADR (x) != cell_closure)
{
fdputs ("(*circ* . ", fd);
int i = 0;
x = CDR (x);
while (x != cell_nil && i++ < 10)
{
fdisplay_ (CAAR (x), fd, write_p); fdputs (" ", fd);
x = CDR (x);
}
fdputs (" ...)", fd);
}
else
{
if (x && x != cell_nil)
fdisplay_ (CAR (x), fd, write_p);
if (CDR (x) && TYPE (CDR (x)) == TPAIR)
display_helper (CDR (x), 1, " ", fd, write_p);
else if (CDR (x) && CDR (x) != cell_nil)
{
if (TYPE (CDR (x)) != TPAIR)
fdputs (" . ", fd);
fdisplay_ (CDR (x), fd, write_p);
}
}
if (!cont)
fdputs (")", fd);
break;
}
case TKEYWORD:
case TPORT:
case TSPECIAL:
case TSTRING:
case TSYMBOL:
{
if (TYPE (x) == TPORT)
{
fdputs ("#<port ", fd);
fdputs (itoa (PORT (x)), fd);
fdputs (" " ,fd);
}
if (TYPE (x) == TKEYWORD)
fdputs ("#:", fd);
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fdputc ('"', fd);
SCM t = CAR (x);
while (t && t != cell_nil)
{
switch (write_p ? VALUE (CAR (t)) : -1)
{
case '\0': fdputs ("\\0", fd); break;
case '\a': fdputs ("\\a", fd); break;
case '\b': fdputs ("\\b", fd); break;
case '\t': fdputs ("\\t", fd); break;
case '\v': fdputs ("\\v", fd); break;
case '\n': fdputs ("\\n", fd); break;
case '\f': fdputs ("\\f", fd); break;
if (!write_p)
fdputc (VALUE (x), fd);
else
{
fdputs ("#\\", fd);
int v = VALUE (x);
if (v == '\0') fdputs ("nul", fd);
else if (v == '\a') fdputs ("alarm", fd);
else if (v == '\b') fdputs ("backspace", fd);
else if (v == '\t') fdputs ("tab", fd);
else if (v == '\n') fdputs ("newline", fd);
else if (v == '\v') fdputs ("vtab", fd);
else if (v == '\f') fdputs ("page", fd);
//Nyacc bug
// else if (v == '\r') fdputs ("return", fd);
else if (v == 13) fdputs ("return", fd);
else if (v == ' ') fdputs ("space", fd);
else fdputc (VALUE (x), fd);
}
}
else if (t == TCLOSURE)
{
fdputs ("#<closure ", fd);
display_helper (CDR (x), cont, "", fd, 0);
fdputs (">", fd);
}
else if (t == TFUNCTION)
{
fdputs ("#<procedure ", fd);
char const *p = "?";
if (FUNCTION (x).name != 0)
p = FUNCTION (x).name;
fdputs (p, fd);
fdputs ("[", fd);
fdputs (itoa (CDR (x)), fd);
fdputs (",", fd);
fdputs (itoa (x), fd);
fdputs ("]>", fd);
}
else if (t == TMACRO)
{
fdputs ("#<macro ", fd);
display_helper (CDR (x), cont, "", fd, 0);
fdputs (">", fd);
}
else if (t == TVARIABLE)
{
fdputs ("#<variable ", fd);
display_helper (CAR (VARIABLE (x)), cont, "", fd, 0);
fdputs (">", fd);
}
else if (t == TNUMBER)
{
fdputs (itoa (VALUE (x)), fd);
}
else if (t == TPAIR)
{
if (!cont)
fdputs ("(", fd);
if (CAR (x) == cell_circular
&& CADR (x) != cell_closure)
{
fdputs ("(*circ* . ", fd);
int i = 0;
x = CDR (x);
while (x != cell_nil && i++ < 10)
{
fdisplay_ (CAAR (x), fd, write_p); fdputs (" ", fd);
x = CDR (x);
}
fdputs (" ...)", fd);
}
else
{
if (x && x != cell_nil)
fdisplay_ (CAR (x), fd, write_p);
if (CDR (x) && TYPE (CDR (x)) == TPAIR)
display_helper (CDR (x), 1, " ", fd, write_p);
else if (CDR (x) && CDR (x) != cell_nil)
{
if (TYPE (CDR (x)) != TPAIR)
fdputs (" . ", fd);
fdisplay_ (CDR (x), fd, write_p);
}
}
if (!cont)
fdputs (")", fd);
}
else if (t == TKEYWORD
|| t == TPORT
|| t == TSPECIAL
|| t == TSTRING
|| t == TSYMBOL)
{
if (TYPE (x) == TPORT)
{
fdputs ("#<port ", fd);
fdputs (itoa (PORT (x)), fd);
fdputs (" " ,fd);
}
if (TYPE (x) == TKEYWORD)
fdputs ("#:", fd);
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fdputc ('"', fd);
SCM t = CAR (x);
while (t && t != cell_nil)
{
int v = write_p ? VALUE (CAR (t)) : -1;
if (v == '\0') fdputs ("\\0", fd);
else if (v == '\a') fdputs ("\\a", fd);
else if (v == '\b') fdputs ("\\b", fd);
else if (v == '\t') fdputs ("\\t", fd);
else if (v == '\v') fdputs ("\\v", fd);
else if (v == '\n') fdputs ("\\n", fd);
else if (v == '\f') fdputs ("\\f", fd);
#if 1 //__MESC__
//Nyacc bug
case 13: fdputs ("\\r", fd); break;
case 27: fdputs ("\\e", fd); break;
else if (v == 13) fdputs ("\\r", fd);
else if (v == 27) fdputs ("\\e", fd);
#else
//case '\r': fdputs ("\\r", fd); break;
//Nyacc crash
//case '\e': fdputs ("\\e", fd); break;
//else if (v == '\r') fdputs ("\\r", fd);
//Nyacc crash
//else if (v == '\e') fdputs ("\\e", fd);
#endif
case '\\': fdputs ("\\\\", fd); break;
case '"': fdputs ("\\\"", fd); break;
default:
fdputc (VALUE (CAR (t)), fd);
}
t = CDR (t);
}
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fdputc ('"', fd);
if (TYPE (x) == TPORT)
fdputs (">", fd);
break;
}
case TVECTOR:
{
fdputs ("#(", fd);
SCM t = CAR (x);
for (int i = 0; i < LENGTH (x); i++)
{
if (i)
fdputc (' ', fd);
fdisplay_ (VECTOR (x) + i, fd, write_p);
}
fdputc (')', fd);
break;
}
default:
{
fdputs ("<", fd);
fdputs (itoa (TYPE (x)), fd);
fdputs (":", fd);
fdputs (itoa (x), fd);
else if (v == '\\') fdputs ("\\\\", fd);
else if (v == '"') fdputs ("\\\"", fd);
else fdputc (VALUE (CAR (t)), fd);
t = CDR (t);
}
if ((write_p && TYPE (x) == TSTRING) || TYPE (x) == TPORT)
fdputc ('"', fd);
if (TYPE (x) == TPORT)
fdputs (">", fd);
break;
}
}
else if (t == TVECTOR)
{
fdputs ("#(", fd);
SCM t = CAR (x);
for (int i = 0; i < LENGTH (x); i++)
{
if (i)
fdputc (' ', fd);
fdisplay_ (VECTOR (x) + i, fd, write_p);
}
fdputc (')', fd);
}
else
{
fdputs ("<", fd);
fdputs (itoa (TYPE (x)), fd);
fdputs (":", fd);
fdputs (itoa (x), fd);
fdputs (">", fd);
}
return 0;
}
@ -273,29 +256,23 @@ xassq (SCM x, SCM a) ///for speed in core only
SCM
memq (SCM x, SCM a)
{
switch (TYPE (x))
{
case TCHAR:
case TNUMBER:
int t = TYPE (x);
if (t == TCHAR
|| t == TNUMBER)
{
SCM v = VALUE (x);
while (a != cell_nil && v != VALUE (CAR (a)))
a = CDR (a);
break;
}
case TKEYWORD:
else if (t == TKEYWORD)
{
SCM v = STRING (x);
while (a != cell_nil && v != STRING (CAR (a)))
a = CDR (a);
break;
}
// case TSYMBOL:
// case TSPECIAL:
default:
else
while (a != cell_nil && x != CAR (a))
a = CDR (a);
}
return a != cell_nil ? a : cell_f;
}