From fc388f8d46a961df1ca540c17eb7efd942743236 Mon Sep 17 00:00:00 2001 From: Yuichi Nishiwaki Date: Mon, 28 Jul 2014 11:43:52 +0900 Subject: [PATCH] call main.scm inside main.c --- tools/main.c | 303 +-------------------------------------------------- 1 file changed, 5 insertions(+), 298 deletions(-) diff --git a/tools/main.c b/tools/main.c index e5129daf..dc342d82 100644 --- a/tools/main.c +++ b/tools/main.c @@ -2,284 +2,9 @@ * See Copyright Notice in picrin.h */ -#include -#include -#include -#include - #include "picrin.h" -#include "picrin/pair.h" -#include "picrin/string.h" #include "picrin/error.h" -#if PIC_ENABLE_READLINE -# include -#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; }