qse/ase/test/lsp/lisp.c

168 lines
3.3 KiB
C
Raw Normal View History

2005-02-05 05:03:05 +00:00
#include <xp/lisp/lisp.h>
2005-05-01 06:47:49 +00:00
#include <xp/bas/stdio.h>
#include <xp/bas/ctype.h>
#include <xp/bas/stdcli.h>
2005-02-05 05:03:05 +00:00
2005-04-21 03:31:39 +00:00
#ifdef __linux
2005-02-05 05:18:20 +00:00
#include <mcheck.h>
#endif
2005-02-15 09:09:09 +00:00
static int get_char (xp_cint_t* ch, void* arg)
2005-02-05 05:03:05 +00:00
{
2005-02-15 09:09:09 +00:00
xp_cint_t c;
2005-02-05 05:18:20 +00:00
2005-02-06 03:27:54 +00:00
c = xp_fgetc(xp_stdin);
2005-02-05 05:18:20 +00:00
if (c == XP_EOF) {
2005-02-06 03:27:54 +00:00
if (xp_ferror(xp_stdin)) return -1;
2005-02-05 05:18:20 +00:00
c = XP_EOF;
}
2005-02-05 05:03:05 +00:00
2005-02-05 05:18:20 +00:00
*ch = c;
2005-02-05 05:03:05 +00:00
return 0;
}
2005-02-05 05:18:20 +00:00
int to_int (const xp_char_t* str)
{
int r = 0;
while (*str != XP_CHAR('\0')) {
if (!xp_isdigit(*str)) break;
r = r * 10 + (*str - XP_CHAR('0'));
str++;
}
return r;
}
2005-02-07 15:10:41 +00:00
#include <locale.h>
2005-03-23 14:57:35 +00:00
int handle_cli_error (
const xp_cli_t* cli, int code,
const xp_char_t* name, const xp_char_t* value)
{
xp_printf (XP_TEXT("usage: %s /memory=nnn /increment=nnn\n"), cli->verb);
if (code == XP_CLI_ERROR_INVALID_OPTNAME) {
xp_printf (XP_TEXT("unknown option - %s\n"), name);
}
else if (code == XP_CLI_ERROR_MISSING_OPTNAME) {
xp_printf (XP_TEXT("missing option - %s\n"), name);
}
else if (code == XP_CLI_ERROR_REDUNDANT_OPTVAL) {
xp_printf (XP_TEXT("redundant value %s for %s\n"), value, name);
}
else if (code == XP_CLI_ERROR_MISSING_OPTVAL) {
xp_printf (XP_TEXT("missing value for %s\n"), name);
}
else if (code == XP_CLI_ERROR_MEMORY) {
xp_printf (XP_TEXT("memory error in processing %s\n"), name);
}
else {
xp_printf (XP_TEXT("error code: %d\n"), code);
}
return -1;
}
xp_cli_t* parse_cli (int argc, xp_char_t* argv[])
{
static const xp_char_t* optsta[] =
{
XP_TEXT("/"), XP_TEXT("--"), XP_NULL
};
static xp_cliopt_t opts[] =
{
{ XP_TEXT("memory"), XP_CLI_OPTNAME | XP_CLI_OPTVAL },
{ XP_TEXT("increment"), XP_CLI_OPTNAME | XP_CLI_OPTVAL },
{ XP_NULL, 0 }
};
static xp_cli_t cli =
{
handle_cli_error,
optsta,
XP_TEXT("="),
opts
};
if (xp_parsecli (argc, argv, &cli) == -1) return XP_NULL;
return &cli;
}
2005-02-05 05:18:20 +00:00
int xp_main (int argc, xp_char_t* argv[])
{
xp_lisp_t* lisp;
xp_lisp_obj_t* obj;
2005-03-23 14:57:35 +00:00
xp_cli_t* cli;
int mem, inc;
2005-02-05 05:18:20 +00:00
2005-04-21 03:31:39 +00:00
#ifdef __linux
2005-02-05 05:18:20 +00:00
mtrace ();
#endif
2005-02-07 15:10:41 +00:00
setlocale (LC_ALL, "");
2005-03-23 14:57:35 +00:00
if ((cli = parse_cli (argc, argv)) == XP_NULL) return -1;
mem = to_int(xp_getclioptval(cli, XP_TEXT("memory")));
inc = to_int(xp_getclioptval(cli, XP_TEXT("increment")));
xp_clearcli (cli);
if (mem <= 0) {
xp_fprintf (xp_stderr,
XP_TEXT("error: invalid memory size given\n"));
2005-02-05 05:18:20 +00:00
return -1;
}
2005-03-23 14:57:35 +00:00
lisp = xp_lisp_new (mem, inc);
2005-05-01 06:47:49 +00:00
if (lisp == XP_NULL) {
2005-03-23 14:57:35 +00:00
xp_fprintf (xp_stderr,
XP_TEXT("error: cannot create a lisp instance\n"));
2005-02-05 05:18:20 +00:00
return -1;
}
xp_printf (XP_TEXT("LISP 0.0001\n"));
2005-05-01 06:47:49 +00:00
xp_lisp_set_creader (lisp, get_char, XP_NULL);
2005-02-05 05:18:20 +00:00
for (;;) {
xp_printf (XP_TEXT("%s> "), argv[0]);
obj = xp_lisp_read (lisp);
2005-05-01 06:47:49 +00:00
if (obj == XP_NULL) {
2005-02-05 05:18:20 +00:00
if (lisp->error != XP_LISP_ERR_END &&
lisp->error != XP_LISP_ERR_ABORT) {
xp_fprintf (xp_stderr,
XP_TEXT("error while reading: %d\n"), lisp->error);
}
if (lisp->error < XP_LISP_ERR_SYNTAX) break;
continue;
}
2005-05-01 06:47:49 +00:00
if ((obj = xp_lisp_eval (lisp, obj)) != XP_NULL) {
2005-02-05 05:18:20 +00:00
xp_lisp_print (lisp, obj);
xp_printf (XP_TEXT("\n"));
}
else {
if (lisp->error == XP_LISP_ERR_ABORT) break;
xp_fprintf (xp_stderr,
XP_TEXT("error while reading: %d\n"), lisp->error);
}
/*
printf ("-----------\n");
xp_lisp_print (lisp, obj);
printf ("\n-----------\n");
*/
}
xp_lisp_free (lisp);
2005-04-21 03:31:39 +00:00
#ifdef __linux
2005-02-05 05:18:20 +00:00
muntrace ();
#endif
return 0;
}