picrin/tools/main.c

319 lines
5.6 KiB
C
Raw Normal View History

2014-01-17 06:58:31 -05:00
/**
* See Copyright Notice in picrin.h
*/
2013-10-09 03:58:35 -04:00
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
2014-03-01 23:33:12 -05:00
#include <getopt.h>
2013-10-09 03:58:35 -04:00
2013-10-10 03:15:41 -04:00
#include "picrin.h"
#include "picrin/pair.h"
2014-03-29 07:02:11 -04:00
#include "picrin/string.h"
#include "picrin/error.h"
2013-10-10 03:15:41 -04:00
2013-10-17 04:08:33 -04:00
#if PIC_ENABLE_READLINE
# include <readline/readline.h>
# include <readline/history.h>
#endif
2013-10-17 07:48:50 -04:00
#define CODE_MAX_LENGTH 1024
2013-10-09 04:14:48 -04:00
#define LINE_MAX_LENGTH 256
2013-10-24 06:06:31 -04:00
void
print_help(void)
{
const char *help =
"picrin scheme\n"
"\n"
"Usage: picrin [options] [file]\n"
2013-10-24 06:06:31 -04:00
"\n"
"Options:\n"
2013-12-05 03:21:42 -05:00
" -e [program] run one liner ecript\n"
" -h show this help";
2013-10-24 06:06:31 -04:00
puts(help);
}
2014-01-08 01:38:47 -05:00
void
import_repllib(pic_state *pic)
{
int ai = pic_gc_arena_preserve(pic);
2014-03-01 06:21:44 -05:00
pic_import(pic, pic_read(pic, "(scheme base)"));
2014-04-05 12:04:19 -04:00
pic_import(pic, pic_read(pic, "(scheme load)"));
pic_import(pic, pic_read(pic, "(scheme process-context)"));
pic_import(pic, pic_read(pic, "(scheme write)"));
pic_import(pic, pic_read(pic, "(scheme file)"));
pic_import(pic, pic_read(pic, "(scheme inexact)"));
pic_import(pic, pic_read(pic, "(scheme cxr)"));
pic_import(pic, pic_read(pic, "(scheme lazy)"));
pic_import(pic, pic_read(pic, "(scheme time)"));
pic_import(pic, pic_read(pic, "(picrin macro)"));
2014-01-08 01:38:47 -05:00
#if DEBUG
puts("* imported repl libraries");
#endif
pic_gc_arena_restore(pic, ai);
}
int exit_status;
void
repl(pic_state *pic)
2013-10-09 03:58:35 -04:00
{
2013-10-17 07:48:50 -04:00
char code[CODE_MAX_LENGTH] = "", line[LINE_MAX_LENGTH];
char *prompt;
2014-03-01 06:21:44 -05:00
pic_value v, exprs;
int ai;
#if PIC_ENABLE_READLINE
char *read_line;
#else
2013-10-19 14:05:42 -04:00
char last_char;
int char_index;
#endif
#if PIC_ENABLE_READLINE
using_history();
char histfile[snprintf(NULL, 0, "%s/.picrin_history", getenv("HOME")) + 1];
sprintf(histfile, "%s/.picrin_history", getenv("HOME"));
read_history(histfile);
#endif
ai = pic_gc_arena_preserve(pic);
while (1) {
2013-10-17 07:48:50 -04:00
prompt = code[0] == '\0' ? "> " : "* ";
2013-10-17 04:08:33 -04:00
2013-12-09 01:36:41 -05:00
#if DEBUG
printf("[current ai = %d]\n", ai);
#endif
2013-10-17 04:08:33 -04:00
#if PIC_ENABLE_READLINE
2013-10-17 07:48:50 -04:00
read_line = readline(prompt);
2013-10-17 04:08:33 -04:00
if (read_line == NULL) {
2013-10-19 23:57:15 -04:00
goto eof;
2013-10-17 04:08:33 -04:00
}
else {
strncpy(line, read_line, LINE_MAX_LENGTH - 1);
add_history(read_line);
free(read_line);
}
#else
printf("%s", prompt);
char_index = 0;
while ((last_char = getchar()) != '\n') {
if (last_char == EOF)
goto eof;
2013-10-09 04:14:48 -04:00
if (char_index == LINE_MAX_LENGTH)
goto overflow;
line[char_index++] = last_char;
}
line[char_index] = '\0';
2013-10-17 04:08:33 -04:00
#endif
2013-10-17 07:48:50 -04:00
if (strlen(code) + strlen(line) >= CODE_MAX_LENGTH)
goto overflow;
strcat(code, line);
2014-03-03 09:00:58 -05:00
pic_try {
2014-03-03 09:00:58 -05:00
/* read */
exprs = pic_parse_cstr(pic, code);
2014-03-03 09:00:58 -05:00
if (pic_undef_p(exprs)) {
/* wait for more input */
}
2014-03-03 09:00:58 -05:00
else {
code[0] = '\0';
pic_for_each (v, exprs) {
2014-03-03 09:00:58 -05:00
/* eval */
v = pic_eval(pic, v);
2014-03-03 09:00:58 -05:00
/* print */
pic_printf(pic, "=> ~s\n", v);
}
}
}
pic_catch {
2014-04-06 01:00:45 -04:00
pic_print_backtrace(pic, pic->err);
2014-03-03 09:00:58 -05:00
pic->err = NULL;
code[0] = '\0';
2013-10-20 10:30:01 -04:00
}
2013-10-12 00:06:02 -04:00
pic_gc_arena_restore(pic, ai);
}
eof:
puts("");
exit_status = 0;
#if PIC_ENABLE_READLINE
write_history(histfile);
#endif
return;
2013-10-09 04:14:48 -04:00
overflow:
puts("** [fatal] line input overflow");
exit_status = 1;
return;
}
void
exec_file(pic_state *pic, const char *fname)
{
FILE *file;
2014-03-01 06:21:44 -05:00
pic_value v, exprs;
struct pic_proc *proc;
file = fopen(fname, "r");
if (file == NULL) {
fprintf(stderr, "fatal error: could not read %s\n", fname);
goto abort;
}
exprs = pic_parse_file(pic, file);
2014-03-01 06:21:44 -05:00
if (pic_undef_p(exprs)) {
fprintf(stderr, "fatal error: %s broken\n", fname);
goto abort;
}
2014-03-01 06:21:44 -05:00
pic_for_each (v, exprs) {
2014-01-20 02:57:39 -05:00
proc = pic_compile(pic, v);
if (proc == NULL) {
fputs(pic_errmsg(pic), stderr);
fprintf(stderr, "fatal error: %s compilation failure\n", fname);
goto abort;
}
v = pic_apply(pic, proc, pic_nil_value());
if (pic_undef_p(v)) {
fputs(pic_errmsg(pic), stderr);
fprintf(stderr, "fatal error: %s evaluation failure\n", fname);
goto abort;
}
}
2013-10-10 03:15:41 -04:00
return;
abort:
exit_status = 1;
return;
2013-10-09 03:58:35 -04:00
}
void
2013-12-05 03:10:28 -05:00
exec_string(pic_state *pic, const char *str)
{
2014-03-01 06:21:44 -05:00
pic_value v, exprs;
2013-12-05 03:10:28 -05:00
struct pic_proc *proc;
2014-03-01 06:21:44 -05:00
int ai;
2013-12-05 03:10:28 -05:00
exprs = pic_parse_cstr(pic, str);
2014-03-01 06:21:44 -05:00
if (pic_undef_p(exprs)) {
goto abort;
2013-12-05 03:10:28 -05:00
}
2014-03-01 06:21:44 -05:00
ai = pic_gc_arena_preserve(pic);
pic_for_each (v, exprs) {
2013-12-05 03:10:28 -05:00
2014-01-20 02:57:39 -05:00
proc = pic_compile(pic, v);
2013-12-05 03:10:28 -05:00
if (proc == NULL) {
goto abort;
2013-12-05 03:10:28 -05:00
}
v = pic_apply(pic, proc, pic_nil_value());
if (pic_undef_p(v)) {
goto abort;
2013-12-05 03:10:28 -05:00
}
pic_gc_arena_restore(pic, ai);
}
return;
abort:
exit_status = 1;
return;
2013-12-05 03:10:28 -05:00
}
static char *fname;
2013-12-07 00:11:15 -05:00
static char *script;
2013-12-05 03:10:28 -05:00
enum {
NO_MODE = 0,
INTERACTIVE_MODE,
FILE_EXEC_MODE,
ONE_LINER_MODE,
} mode;
void
parse_opt(int argc, char *argv[])
{
int r;
while (~(r = getopt(argc, argv, "he:"))) {
switch (r) {
case 'h':
print_help();
exit(0);
case 'e':
2013-12-07 00:11:15 -05:00
script = optarg;
2013-12-05 03:10:28 -05:00
mode = ONE_LINER_MODE;
}
}
argc -= optind;
argv += optind;
if (argc == 0) {
if (mode == NO_MODE)
mode = INTERACTIVE_MODE;
}
else {
fname = argv[0];
mode = FILE_EXEC_MODE;
}
}
int
main(int argc, char *argv[], char **envp)
{
pic_state *pic;
pic = pic_open(argc, argv, envp);
2013-12-05 03:10:28 -05:00
parse_opt(argc, argv);
2014-01-08 01:38:47 -05:00
if (mode == INTERACTIVE_MODE || mode == ONE_LINER_MODE) {
import_repllib(pic);
}
2013-12-05 03:10:28 -05:00
switch (mode) {
case NO_MODE:
puts("logic flaw");
abort();
case INTERACTIVE_MODE:
repl(pic);
2013-12-05 03:10:28 -05:00
break;
case FILE_EXEC_MODE:
exec_file(pic, fname);
2013-12-05 03:10:28 -05:00
break;
case ONE_LINER_MODE:
exec_string(pic, script);
2013-12-05 03:10:28 -05:00
break;
}
pic_close(pic);
2014-01-16 08:03:00 -05:00
#if DEBUG
puts("* picrin successfully closed");
#endif
return exit_status;
}