call main.scm inside main.c
This commit is contained in:
parent
db38f13600
commit
fc388f8d46
303
tools/main.c
303
tools/main.c
|
@ -2,284 +2,9 @@
|
|||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <string.h>
|
||||
#include <getopt.h>
|
||||
|
||||
#include "picrin.h"
|
||||
#include "picrin/pair.h"
|
||||
#include "picrin/string.h"
|
||||
#include "picrin/error.h"
|
||||
|
||||
#if PIC_ENABLE_READLINE
|
||||
# include <editline/readline.h>
|
||||
#endif
|
||||
|
||||
#define CODE_MAX_LENGTH 1024
|
||||
#define LINE_MAX_LENGTH 256
|
||||
|
||||
void
|
||||
print_help(void)
|
||||
{
|
||||
const char *help =
|
||||
"picrin scheme\n"
|
||||
"\n"
|
||||
"Usage: picrin [options] [file]\n"
|
||||
"\n"
|
||||
"Options:\n"
|
||||
" -e [program] run one liner ecript\n"
|
||||
" -h show this help";
|
||||
|
||||
puts(help);
|
||||
}
|
||||
|
||||
void
|
||||
import_repllib(pic_state *pic)
|
||||
{
|
||||
int ai = pic_gc_arena_preserve(pic);
|
||||
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme base)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme load)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme process-context)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme read)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme write)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme file)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme inexact)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme cxr)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme lazy)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(scheme time)"));
|
||||
pic_import(pic, pic_read_cstr(pic, "(picrin macro)"));
|
||||
|
||||
#if DEBUG
|
||||
puts("* imported repl libraries");
|
||||
#endif
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
}
|
||||
|
||||
int exit_status;
|
||||
|
||||
void
|
||||
repl(pic_state *pic)
|
||||
{
|
||||
char code[CODE_MAX_LENGTH] = "", line[LINE_MAX_LENGTH];
|
||||
char *prompt;
|
||||
pic_value v, exprs;
|
||||
int ai;
|
||||
|
||||
#if PIC_ENABLE_READLINE
|
||||
char *read_line;
|
||||
#else
|
||||
int 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) {
|
||||
prompt = code[0] == '\0' ? "> " : "* ";
|
||||
|
||||
#if DEBUG
|
||||
printf("[current ai = %d]\n", ai);
|
||||
#endif
|
||||
|
||||
#if PIC_ENABLE_READLINE
|
||||
read_line = readline(prompt);
|
||||
if (read_line == NULL) {
|
||||
goto eof;
|
||||
}
|
||||
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;
|
||||
if (char_index == LINE_MAX_LENGTH)
|
||||
goto overflow;
|
||||
line[char_index++] = (char)last_char;
|
||||
}
|
||||
line[char_index] = '\0';
|
||||
#endif
|
||||
|
||||
if (strlen(code) + strlen(line) >= CODE_MAX_LENGTH)
|
||||
goto overflow;
|
||||
strcat(code, line);
|
||||
|
||||
pic_try {
|
||||
|
||||
/* read */
|
||||
exprs = pic_parse_cstr(pic, code);
|
||||
|
||||
if (pic_undef_p(exprs)) {
|
||||
/* wait for more input */
|
||||
}
|
||||
else {
|
||||
code[0] = '\0';
|
||||
|
||||
pic_for_each (v, exprs) {
|
||||
|
||||
/* eval */
|
||||
v = pic_eval(pic, v, pic->lib);
|
||||
|
||||
/* print */
|
||||
pic_printf(pic, "=> ~s\n", v);
|
||||
}
|
||||
}
|
||||
}
|
||||
pic_catch {
|
||||
pic_print_backtrace(pic, pic->err);
|
||||
pic->err = NULL;
|
||||
code[0] = '\0';
|
||||
}
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
}
|
||||
|
||||
eof:
|
||||
puts("");
|
||||
exit_status = 0;
|
||||
#if PIC_ENABLE_READLINE
|
||||
write_history(histfile);
|
||||
#endif
|
||||
return;
|
||||
|
||||
overflow:
|
||||
puts("** [fatal] line input overflow");
|
||||
exit_status = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
void
|
||||
exec_file(pic_state *pic, const char *fname)
|
||||
{
|
||||
FILE *file;
|
||||
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);
|
||||
if (pic_undef_p(exprs)) {
|
||||
fprintf(stderr, "fatal error: %s broken\n", fname);
|
||||
goto abort;
|
||||
}
|
||||
|
||||
pic_for_each (v, exprs) {
|
||||
|
||||
proc = pic_compile(pic, v, pic->lib);
|
||||
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;
|
||||
}
|
||||
|
||||
}
|
||||
|
||||
return;
|
||||
|
||||
abort:
|
||||
exit_status = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
void
|
||||
exec_string(pic_state *pic, const char *str)
|
||||
{
|
||||
pic_value v, exprs;
|
||||
struct pic_proc *proc;
|
||||
int ai;
|
||||
|
||||
exprs = pic_parse_cstr(pic, str);
|
||||
if (pic_undef_p(exprs)) {
|
||||
goto abort;
|
||||
}
|
||||
|
||||
ai = pic_gc_arena_preserve(pic);
|
||||
pic_for_each (v, exprs) {
|
||||
|
||||
proc = pic_compile(pic, v, pic->lib);
|
||||
if (proc == NULL) {
|
||||
goto abort;
|
||||
}
|
||||
v = pic_apply(pic, proc, pic_nil_value());
|
||||
if (pic_undef_p(v)) {
|
||||
goto abort;
|
||||
}
|
||||
|
||||
pic_gc_arena_restore(pic, ai);
|
||||
}
|
||||
|
||||
return;
|
||||
|
||||
abort:
|
||||
exit_status = 1;
|
||||
return;
|
||||
}
|
||||
|
||||
static char *fname;
|
||||
static char *script;
|
||||
|
||||
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':
|
||||
script = optarg;
|
||||
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)
|
||||
{
|
||||
|
@ -287,32 +12,14 @@ main(int argc, char *argv[], char **envp)
|
|||
|
||||
pic = pic_open(argc, argv, envp);
|
||||
|
||||
parse_opt(argc, argv);
|
||||
|
||||
if (mode == INTERACTIVE_MODE || mode == ONE_LINER_MODE) {
|
||||
import_repllib(pic);
|
||||
pic_try {
|
||||
pic_load(pic, "/Users/yuichi/workspace/picrin/tools/main.scm");
|
||||
}
|
||||
|
||||
switch (mode) {
|
||||
case NO_MODE:
|
||||
puts("logic flaw");
|
||||
abort();
|
||||
case INTERACTIVE_MODE:
|
||||
repl(pic);
|
||||
break;
|
||||
case FILE_EXEC_MODE:
|
||||
exec_file(pic, fname);
|
||||
break;
|
||||
case ONE_LINER_MODE:
|
||||
exec_string(pic, script);
|
||||
break;
|
||||
pic_catch {
|
||||
pic_print_backtrace(pic, pic->err);
|
||||
}
|
||||
|
||||
pic_close(pic);
|
||||
|
||||
#if DEBUG
|
||||
puts("* picrin successfully closed");
|
||||
#endif
|
||||
|
||||
return exit_status;
|
||||
return 0;
|
||||
}
|
||||
|
|
Loading…
Reference in New Issue