load library.scm before contribs
This commit is contained in:
Yuichi Nishiwaki
parent
69ab7e4970
commit
1adcd26d85
93
Makefile
93
Makefile
|
|
@ -1,34 +1,7 @@
|
|||
LIBPICRIN_SRCS = \
|
||||
lib/blob.c\
|
||||
lib/bool.c\
|
||||
lib/char.c\
|
||||
lib/cont.c\
|
||||
lib/data.c\
|
||||
lib/debug.c\
|
||||
lib/dict.c\
|
||||
lib/error.c\
|
||||
lib/gc.c\
|
||||
lib/number.c\
|
||||
lib/pair.c\
|
||||
lib/port.c\
|
||||
lib/proc.c\
|
||||
lib/record.c\
|
||||
lib/state.c\
|
||||
lib/string.c\
|
||||
lib/symbol.c\
|
||||
lib/var.c\
|
||||
lib/vector.c\
|
||||
lib/weak.c\
|
||||
lib/ext/boot.c\
|
||||
lib/ext/lib.c\
|
||||
lib/ext/file.c\
|
||||
lib/ext/load.c\
|
||||
lib/ext/read.c\
|
||||
lib/ext/write.c
|
||||
LIBPICRIN_OBJS = $(LIBPICRIN_SRCS:.c=.o)
|
||||
|
||||
PICRIN_SRCS = \
|
||||
src/main.c\
|
||||
src/init_lib.c\
|
||||
src/lib.c\
|
||||
src/load_piclib.c\
|
||||
src/init_contrib.c
|
||||
PICRIN_OBJS = \
|
||||
|
|
@ -45,25 +18,40 @@ REPL_ISSUE_TESTS = $(wildcard t/issue/*.sh)
|
|||
|
||||
TEST_RUNNER = picrin
|
||||
|
||||
CFLAGS += -I./lib/include -Wall -Wextra
|
||||
CFLAGS += -I./lib/include -I./include -Wall -Wextra
|
||||
LDFLAGS += -lm
|
||||
|
||||
prefix ?= /usr/local
|
||||
|
||||
all: CFLAGS += -O2 -g -DNDEBUG=1
|
||||
all: picrin
|
||||
|
||||
debug: CFLAGS += -O0 -g
|
||||
debug: picrin
|
||||
|
||||
tiny-picrin: CFLAGS += -O0 -g -DPIC_USE_LIBRARY=0
|
||||
tiny-picrin: $(LIBPICRIN_OBJS) src/tiny-main.o
|
||||
$(CC) $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) src/tiny-main.o $(LDFLAGS)
|
||||
|
||||
include $(sort $(wildcard contrib/*/nitro.mk))
|
||||
|
||||
picrin: $(PICRIN_OBJS) $(CONTRIB_OBJS) $(LIBPICRIN_OBJS)
|
||||
$(CC) $(CFLAGS) -o $@ $(PICRIN_OBJS) $(CONTRIB_OBJS) $(LIBPICRIN_OBJS) $(LDFLAGS)
|
||||
all: CFLAGS += -O2 -g -DNDEBUG=1
|
||||
all: bootstrap picrin
|
||||
|
||||
debug: CFLAGS += -O0 -g
|
||||
debug: bootstrap picrin
|
||||
|
||||
bootstrap: bin/picrin-bootstrap
|
||||
|
||||
bin/picrin-bootstrap:
|
||||
test -f bin/picrin-bootstrap || { $(MAKE) lib/mini-picrin && mv lib/mini-picrin bin/picrin-bootstrap; }
|
||||
|
||||
lib/mini-picrin:
|
||||
$(MAKE) -C lib mini-picrin
|
||||
|
||||
lib/libpicrin.a:
|
||||
$(MAKE) -C lib libpicrin.a
|
||||
|
||||
ext: lib/ext/eval.c
|
||||
|
||||
lib/ext/eval.c: piclib/eval.scm
|
||||
bin/picrin-bootstrap -c piclib/eval.scm | bin/picrin-bootstrap tools/mkeval.scm > lib/ext/eval.c
|
||||
|
||||
picrin: $(PICRIN_OBJS) $(CONTRIB_OBJS) ext lib/libpicrin.a
|
||||
$(CC) $(CFLAGS) -o $@ $(PICRIN_OBJS) $(CONTRIB_OBJS) lib/libpicrin.a $(LDFLAGS)
|
||||
|
||||
src/init_lib.c: piclib/library.scm
|
||||
cat piclib/library.scm | bin/picrin-bootstrap tools/mklib.scm > src/init_lib.c
|
||||
|
||||
src/load_piclib.c: $(CONTRIB_LIBS)
|
||||
perl tools/mkloader.pl $(CONTRIB_LIBS) > $@
|
||||
|
|
@ -71,14 +59,7 @@ src/load_piclib.c: $(CONTRIB_LIBS)
|
|||
src/init_contrib.c:
|
||||
perl tools/mkinit.pl $(CONTRIB_INITS) > $@
|
||||
|
||||
# FIXME: Undefined symbols error for _emyg_atod and _emyg_dtoa
|
||||
# libpicrin.so: $(LIBPICRIN_OBJS)
|
||||
# $(CC) -shared $(CFLAGS) -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
|
||||
|
||||
lib/ext/boot.c: piclib/compile.scm piclib/library.scm
|
||||
cat piclib/compile.scm piclib/library.scm | bin/picrin-bootstrap tools/mkboot.scm > lib/ext/boot.c
|
||||
|
||||
$(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/object.h lib/state.h
|
||||
$(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/*.h lib/include/picrin/*.h lib/*.h include/picrin/*.h
|
||||
|
||||
doc: docs/*.rst docs/contrib.rst
|
||||
$(MAKE) -C docs html
|
||||
|
|
@ -95,8 +76,8 @@ test: test-contribs test-nostdlib test-issue
|
|||
|
||||
test-contribs: picrin $(CONTRIB_TESTS)
|
||||
|
||||
test-nostdlib: lib/ext/boot.c
|
||||
$(CC) -I./lib -I./lib/include -D'PIC_USE_LIBC=0' -D'PIC_USE_STDIO=0' -D'PIC_USE_WRITE=0' -D'PIC_USE_LIBRARY=0' -D'PIC_USE_EVAL=0' -ffreestanding -nostdlib -Os -fPIC -shared -std=c89 -pedantic -Wall -Wextra -Werror -o libpicrin-tiny.so $(LIBPICRIN_SRCS) etc/libc_polyfill.c -fno-stack-protector
|
||||
test-nostdlib: ext
|
||||
$(CC) -I./lib/include -Os -DPIC_USE_LIBC=0 -DPIC_USE_CALLCC=0 -DPIC_USE_FILE=0 -DPIC_USE_READ=0 -DPIC_USE_WRITE=0 -DPIC_USE_EVAL=0 -nostdlib -ffreestanding -fno-stack-protector -shared -pedantic -std=c89 -Wall -Wextra -Werror -o libpicrin-tiny.so $(wildcard lib/*.c)
|
||||
strip libpicrin-tiny.so
|
||||
ls -lh libpicrin-tiny.so
|
||||
rm -f libpicrin-tiny.so
|
||||
|
|
@ -120,11 +101,11 @@ install: all
|
|||
install -c picrin $(prefix)/bin/picrin
|
||||
|
||||
clean:
|
||||
$(MAKE) -C lib clean
|
||||
$(RM) picrin
|
||||
$(RM) src/load_piclib.c src/init_contrib.c lib/ext/boot.c
|
||||
$(RM) libpicrin.so libpicrin-tiny.so
|
||||
$(RM) $(LIBPICRIN_OBJS)
|
||||
$(RM) src/load_piclib.c src/init_contrib.c src/init_lib.c
|
||||
$(RM) libpicrin-tiny.so
|
||||
$(RM) $(PICRIN_OBJS)
|
||||
$(RM) $(CONTRIB_OBJS)
|
||||
|
||||
.PHONY: all install clean push test test-r7rs test-contribs test-issue test-picrin-issue test-repl-issue doc $(CONTRIB_TESTS) $(REPL_ISSUE_TESTS)
|
||||
.PHONY: all bootstrap ext install clean push test test-r7rs test-contribs test-issue test-picrin-issue test-repl-issue doc $(CONTRIB_TESTS) $(REPL_ISSUE_TESTS)
|
||||
|
|
|
|||
Binary file not shown.
|
|
@ -1,5 +1,6 @@
|
|||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
#include "picrin/lib.h"
|
||||
|
||||
#include <math.h>
|
||||
|
||||
|
|
|
|||
|
|
@ -2,7 +2,6 @@ CONTRIB_INITS += r7rs
|
|||
|
||||
CONTRIB_SRCS += \
|
||||
contrib/20.r7rs/src/r7rs.c\
|
||||
contrib/20.r7rs/src/file.c\
|
||||
contrib/20.r7rs/src/load.c\
|
||||
contrib/20.r7rs/src/system.c\
|
||||
contrib/20.r7rs/src/time.c
|
||||
|
|
|
|||
|
|
@ -1,87 +0,0 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
|
||||
#include <stdio.h>
|
||||
|
||||
PIC_NORETURN static void
|
||||
file_error(pic_state *pic, const char *msg)
|
||||
{
|
||||
pic_raise(pic, pic_make_error(pic, "file", msg, pic_nil_value(pic)));
|
||||
}
|
||||
|
||||
static pic_value
|
||||
open_file(pic_state *pic, const char *fname, const char *mode)
|
||||
{
|
||||
FILE *fp;
|
||||
|
||||
if ((fp = fopen(fname, mode)) == NULL) {
|
||||
file_error(pic, "could not open file...");
|
||||
}
|
||||
return pic_fopen(pic, fp, mode);
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_file_open_input_file(pic_state *pic)
|
||||
{
|
||||
char *fname;
|
||||
|
||||
pic_get_args(pic, "z", &fname);
|
||||
|
||||
return open_file(pic, fname, "r");
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_file_open_output_file(pic_state *pic)
|
||||
{
|
||||
char *fname;
|
||||
|
||||
pic_get_args(pic, "z", &fname);
|
||||
|
||||
return open_file(pic, fname, "w");
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_file_exists_p(pic_state *pic)
|
||||
{
|
||||
char *fname;
|
||||
FILE *fp;
|
||||
|
||||
pic_get_args(pic, "z", &fname);
|
||||
|
||||
fp = fopen(fname, "r");
|
||||
if (fp) {
|
||||
fclose(fp);
|
||||
return pic_true_value(pic);
|
||||
} else {
|
||||
return pic_false_value(pic);
|
||||
}
|
||||
}
|
||||
|
||||
pic_value
|
||||
pic_file_delete(pic_state *pic)
|
||||
{
|
||||
char *fname;
|
||||
|
||||
pic_get_args(pic, "z", &fname);
|
||||
|
||||
if (remove(fname) != 0) {
|
||||
file_error(pic, "file cannot be deleted");
|
||||
}
|
||||
return pic_undef_value(pic);
|
||||
}
|
||||
|
||||
void
|
||||
pic_nitro_init_file(pic_state *pic)
|
||||
{
|
||||
pic_defun(pic, "scheme.base:open-input-file", pic_file_open_input_file); /* for `include' */
|
||||
pic_defun(pic, "scheme.file:open-input-file", pic_file_open_input_file);
|
||||
pic_defun(pic, "scheme.file:open-binary-input-file", pic_file_open_input_file);
|
||||
pic_defun(pic, "scheme.file:open-output-file", pic_file_open_output_file);
|
||||
pic_defun(pic, "scheme.file:open-binary-output-file", pic_file_open_output_file);
|
||||
pic_defun(pic, "scheme.file:file-exists?", pic_file_exists_p);
|
||||
pic_defun(pic, "scheme.file:delete-file", pic_file_delete);
|
||||
}
|
||||
|
|
@ -23,10 +23,12 @@ pic_load_load(pic_state *pic)
|
|||
|
||||
port = pic_fopen(pic, fp, "r");
|
||||
pic_try {
|
||||
pic_value form;
|
||||
size_t ai = pic_enter(pic);
|
||||
|
||||
while (! pic_eof_p(pic, form = pic_read(pic, port))) {
|
||||
while (1) {
|
||||
pic_value form = pic_funcall(pic, "read", 1, port);
|
||||
if (pic_eof_p(pic, form))
|
||||
break;
|
||||
pic_funcall(pic, "eval", 1, form);
|
||||
pic_leave(pic, ai);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
#include "picrin.h"
|
||||
|
||||
void pic_nitro_init_file(pic_state *);
|
||||
void pic_nitro_init_load(pic_state *);
|
||||
void pic_nitro_init_system(pic_state *);
|
||||
void pic_nitro_init_time(pic_state *);
|
||||
|
|
@ -12,7 +11,6 @@ void pic_nitro_init_time(pic_state *);
|
|||
void
|
||||
pic_nitro_init_r7rs(pic_state *pic)
|
||||
{
|
||||
pic_nitro_init_file(pic);
|
||||
pic_nitro_init_load(pic);
|
||||
pic_nitro_init_system(pic);
|
||||
pic_nitro_init_time(pic);
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
#include "picrin/lib.h"
|
||||
|
||||
double genrand_real3(void);
|
||||
|
||||
|
|
|
|||
|
|
@ -7,6 +7,7 @@ forget to use the C++ extern "C" to get it to compile.
|
|||
*/
|
||||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
#include "picrin/lib.h"
|
||||
|
||||
#include <editline/readline.h>
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
#include "picrin/lib.h"
|
||||
|
||||
#include <regex.h>
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,24 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#ifndef PICRIN_LIB_H
|
||||
#define PICRIN_LIB_H
|
||||
|
||||
#if defined(__cplusplus)
|
||||
extern "C" {
|
||||
#endif
|
||||
|
||||
/*
|
||||
* library
|
||||
*/
|
||||
|
||||
void pic_deflibrary(pic_state *, const char *lib);
|
||||
void pic_in_library(pic_state *, const char *lib);
|
||||
void pic_export(pic_state *, int n, ...);
|
||||
|
||||
#if defined(__cplusplus)
|
||||
}
|
||||
#endif
|
||||
|
||||
#endif
|
||||
15
lib/Makefile
15
lib/Makefile
|
|
@ -39,20 +39,15 @@ LIBPICRIN_HEADERS = \
|
|||
|
||||
CFLAGS += -I./include -Wall -Wextra -g
|
||||
|
||||
mini-picrin: $(LIBPICRIN_OBJS) ext/main.o
|
||||
$(CC) $(CFLAGS) -o $@ ext/main.o $(LIBPICRIN_OBJS)
|
||||
mini-picrin: ext/main.o libpicrin.a
|
||||
$(CC) $(CFLAGS) -o $@ ext/main.o libpicrin.a
|
||||
|
||||
libpicrin.so: CFLAGS += -fPIC
|
||||
libpicrin.so: $(LIBPICRIN_OBJS)
|
||||
$(CC) $(CFLAGS) -shared -o $@ $(LIBPICRIN_OBJS) $(LDFLAGS)
|
||||
|
||||
libpicrin.so.minimal: $(LIBPICRIN_SRCS)
|
||||
$(CC) -I./include -Os -DPIC_USE_LIBC=0 -DPIC_USE_CALLCC=0 -DPIC_USE_FILE=0 -DPIC_USE_READ=0 -DPIC_USE_WRITE=0 -DPIC_USE_EVAL=0 -nostdlib -ffreestanding -fno-stack-protector -shared -o $@ $(LIBPICRIN_SRCS) $(LDFLAGS)
|
||||
strip $@
|
||||
libpicrin.a: $(LIBPICRIN_OBJS)
|
||||
$(AR) $(ARFLAGS) $@ $(LIBPICRIN_OBJS)
|
||||
|
||||
$(LIBPICRIN_OBJS): $(LIBPICRIN_HEADERS)
|
||||
|
||||
clean:
|
||||
$(RM) $(LIBPICRIN_OBJS) ext/main.o mini-picrin libpicrin.so libpicrin.so.minimal
|
||||
$(RM) $(LIBPICRIN_OBJS) ext/main.o mini-picrin libpicrin.a
|
||||
|
||||
.PHONY: clean
|
||||
|
|
|
|||
|
|
@ -41,7 +41,7 @@ cont_call(pic_state *pic)
|
|||
}
|
||||
pic->cxt = cxt;
|
||||
|
||||
PIC_LONGJMP(cxt->jmp, 1);
|
||||
longjmp(cxt->jmp, 1);
|
||||
PIC_UNREACHABLE();
|
||||
}
|
||||
|
||||
|
|
|
|||
|
|
@ -42,10 +42,9 @@
|
|||
# include <setjmp.h>
|
||||
# define PIC_JMPBUF jmp_buf
|
||||
# define PIC_SETJMP(buf) setjmp(buf)
|
||||
# define PIC_LONGJMP(buf, val) longjmp((buf), (val))
|
||||
#else
|
||||
# define PIC_JMPBUF char
|
||||
# define PIC_SETJMP(buf) 0
|
||||
# define PIC_SETJMP(buf) ((void)(buf), 0)
|
||||
#endif
|
||||
|
||||
#ifndef PIC_ABORT
|
||||
|
|
|
|||
|
|
@ -56,9 +56,10 @@ assemble(pic_state *pic, pic_value as)
|
|||
i = 0;
|
||||
/* TODO: validate operands */
|
||||
pic_for_each (r, codes, it) {
|
||||
pic_value op;
|
||||
if (! pic_pair_p(pic, r))
|
||||
continue;
|
||||
pic_value op = pic_car(pic, r);
|
||||
op = pic_car(pic, r);
|
||||
if (pic_eq_p(pic, op, pic_intern_lit(pic, "HALT"))) {
|
||||
code[i++] = OP_HALT;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -92,7 +92,7 @@ enum {
|
|||
OP_LOADF = 0x0A, /* 0x0A 0x** OP_LOADF dest */
|
||||
OP_LOADN = 0x0B, /* 0x0B 0x** OP_LOADN dest */
|
||||
OP_LOADU = 0x0C, /* 0x0C 0x** OP_LOADU dest */
|
||||
OP_LOADI = 0x0D, /* 0x0D 0x** 0x** OP_LOADI dest i */
|
||||
OP_LOADI = 0x0D /* 0x0D 0x** 0x** OP_LOADI dest i */
|
||||
};
|
||||
|
||||
typedef unsigned char code_t;
|
||||
|
|
|
|||
|
|
@ -93,9 +93,10 @@
|
|||
(lambda (expr)
|
||||
(let ((exprs (if (and (pair? expr) (eq? (car expr) 'begin))
|
||||
(cdr expr)
|
||||
(list expr))))
|
||||
(list expr)))
|
||||
(env (library-environment name)))
|
||||
(for-each
|
||||
(lambda (e) (eval e name))
|
||||
(lambda (e) (eval e env))
|
||||
exprs)))
|
||||
body)))))
|
||||
|
||||
|
|
@ -122,7 +123,7 @@
|
|||
(if (null? clauses)
|
||||
#undefined
|
||||
(if (test (caar clauses))
|
||||
`(,(make-identifier 'begin default-environment) ,@(cdar clauses))
|
||||
`(,(make-identifier 'begin (default-environment)) ,@(cdar clauses))
|
||||
(loop (cdr clauses))))))))
|
||||
|
||||
(define-transformer 'import
|
||||
|
|
@ -206,7 +207,7 @@
|
|||
|
||||
(let ()
|
||||
(make-library '(picrin base))
|
||||
(set-car! (dictionary-ref *libraries* (mangle '(picrin base))) default-environment)
|
||||
(set-car! (dictionary-ref *libraries* (mangle '(picrin base))) (default-environment))
|
||||
(let* ((exports
|
||||
(library-exports '(picrin base)))
|
||||
(export-keyword
|
||||
|
|
@ -222,12 +223,6 @@
|
|||
do when unless
|
||||
parameterize define-record-type))
|
||||
(dictionary-for-each export-keyword (global-objects)))
|
||||
(set! eval
|
||||
(let ((e eval))
|
||||
(lambda (expr . lib)
|
||||
(let ((lib (if (null? lib) (current-library) (car lib))))
|
||||
(parameterize ((current-library lib))
|
||||
(e expr (library-environment lib)))))))
|
||||
(make-library '(picrin user)))
|
||||
|
||||
(values current-library
|
||||
|
|
|
|||
|
|
@ -0,0 +1,40 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
|
||||
void
|
||||
pic_deflibrary(pic_state *pic, const char *lib)
|
||||
{
|
||||
pic_value name = pic_intern_cstr(pic, lib), v;
|
||||
|
||||
v = pic_funcall(pic, "find-library", 1, name);
|
||||
if (! pic_bool(pic, v)) {
|
||||
pic_funcall(pic, "make-library", 1, name);
|
||||
}
|
||||
}
|
||||
|
||||
void
|
||||
pic_in_library(pic_state *pic, const char *lib)
|
||||
{
|
||||
pic_value name = pic_intern_cstr(pic, lib);
|
||||
|
||||
pic_funcall(pic, "current-library", 1, name);
|
||||
}
|
||||
|
||||
void
|
||||
pic_export(pic_state *pic, int n, ...)
|
||||
{
|
||||
size_t ai = pic_enter(pic);
|
||||
va_list ap;
|
||||
|
||||
va_start(ap, n);
|
||||
while (n--) {
|
||||
pic_value var = pic_intern_cstr(pic, va_arg(ap, const char *));
|
||||
pic_funcall(pic, "library-export", 2, var, var);
|
||||
}
|
||||
va_end(ap);
|
||||
pic_leave(pic, ai);
|
||||
}
|
||||
|
|
@ -8,9 +8,11 @@
|
|||
void
|
||||
pic_init_picrin(pic_state *pic)
|
||||
{
|
||||
void pic_init_lib(pic_state *);
|
||||
void pic_init_contrib(pic_state *);
|
||||
void pic_load_piclib(pic_state *);
|
||||
|
||||
pic_init_lib(pic);
|
||||
pic_init_contrib(pic);
|
||||
pic_load_piclib(pic);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -1,39 +0,0 @@
|
|||
/**
|
||||
* See Copyright Notice in picrin.h
|
||||
*/
|
||||
|
||||
#include "picrin.h"
|
||||
#include "picrin/extra.h"
|
||||
|
||||
int
|
||||
main()
|
||||
{
|
||||
pic_state *pic;
|
||||
pic_value e, form;
|
||||
int status;
|
||||
|
||||
pic = pic_open(pic_default_allocf, NULL);
|
||||
|
||||
pic_try {
|
||||
while (1) {
|
||||
size_t ai = pic_enter(pic);
|
||||
pic_printf(pic, "> ");
|
||||
form = pic_read(pic, pic_stdin(pic));
|
||||
if (pic_eof_p(pic, form)) {
|
||||
break;
|
||||
}
|
||||
pic_printf(pic, "~s\n", pic_funcall(pic, "eval", 1, form));
|
||||
pic_leave(pic, ai);
|
||||
}
|
||||
|
||||
status = 0;
|
||||
}
|
||||
pic_catch(e) {
|
||||
pic_print_error(pic, pic_stderr(pic), e);
|
||||
status = 1;
|
||||
}
|
||||
|
||||
pic_close(pic);
|
||||
|
||||
return status;
|
||||
}
|
||||
|
|
@ -1,9 +1,9 @@
|
|||
(import (scheme base)
|
||||
(scheme read)
|
||||
(scheme write))
|
||||
|
||||
(define (generate-rom)
|
||||
|
||||
(define open-output-string open-output-bytevector)
|
||||
(define (get-output-string port)
|
||||
(list->string (map integer->char (bytevector->list (get-output-bytevector port)))))
|
||||
|
||||
(define (with-output-to-string thunk)
|
||||
(let ((port (open-output-string)))
|
||||
(parameterize ((current-output-port port))
|
||||
|
|
@ -23,10 +23,10 @@
|
|||
(string-for-each
|
||||
(lambda (c)
|
||||
(case c
|
||||
((#\\) (write-string "\\\\"))
|
||||
((#\") (write-string "\\\""))
|
||||
((#\newline) (write-string "\\n"))
|
||||
(else (write-char c))))
|
||||
((#\\) (display "\\\\"))
|
||||
((#\") (display "\\\""))
|
||||
((#\newline) (display "\\n"))
|
||||
(else (display c))))
|
||||
s))))
|
||||
|
||||
(define (group-string i s)
|
||||
|
|
@ -0,0 +1,64 @@
|
|||
(define (generate-rom)
|
||||
|
||||
(define open-output-string open-output-bytevector)
|
||||
(define (get-output-string port)
|
||||
(list->string (map integer->char (bytevector->list (get-output-bytevector port)))))
|
||||
|
||||
(define (with-output-to-string thunk)
|
||||
(let ((port (open-output-string)))
|
||||
(parameterize ((current-output-port port))
|
||||
(thunk)
|
||||
(let ((s (get-output-string port)))
|
||||
(close-port port)
|
||||
s))))
|
||||
|
||||
(define text
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(write (read)))))
|
||||
|
||||
(define (escape-string s)
|
||||
(with-output-to-string
|
||||
(lambda ()
|
||||
(string-for-each
|
||||
(lambda (c)
|
||||
(case c
|
||||
((#\\) (display "\\\\"))
|
||||
((#\") (display "\\\""))
|
||||
((#\newline) (display "\\n"))
|
||||
(else (display c))))
|
||||
s))))
|
||||
|
||||
(define (group-string i s)
|
||||
(let loop ((t s) (n (string-length s)) (acc '()))
|
||||
(if (= n 0)
|
||||
(reverse acc)
|
||||
(if (< n i)
|
||||
(loop "" 0 (cons t acc))
|
||||
(loop (string-copy t i) (- n i) (cons (string-copy t 0 i) acc))))))
|
||||
|
||||
(define lines (map escape-string (group-string 80 text)))
|
||||
|
||||
(let loop ((lines lines) (acc ""))
|
||||
(if (null? lines)
|
||||
acc
|
||||
(loop (cdr lines) (string-append acc "\"" (car lines) "\",\n")))))
|
||||
|
||||
|
||||
(for-each
|
||||
display
|
||||
`("#include \"picrin.h\"\n"
|
||||
"#include \"picrin/extra.h\"\n"
|
||||
"\n"
|
||||
"static const char lib_rom[][80] = {\n"
|
||||
,(generate-rom)
|
||||
"};\n"
|
||||
"\n"
|
||||
"void\n"
|
||||
"pic_init_lib(pic_state *PIC_UNUSED(pic))\n"
|
||||
"{\n"
|
||||
" pic_value port;\n"
|
||||
" port = pic_fmemopen(pic, &lib_rom[0][0], strlen(&lib_rom[0][0]), \"r\");\n"
|
||||
" pic_funcall(pic, \"eval\", 1, pic_funcall(pic, \"read\", 1, port));\n"
|
||||
"}\n"))
|
||||
|
||||
|
|
@ -21,9 +21,11 @@ pic_eval_native(pic_state *pic, const char *str)
|
|||
|
||||
pic_try {
|
||||
size_t ai = pic_enter(pic);
|
||||
pic_value form;
|
||||
|
||||
while (! pic_eof_p(pic, form = pic_read(pic, port))) {
|
||||
while (1) {
|
||||
pic_value form = pic_funcall(pic, "read", 1, port);
|
||||
if (pic_eof_p(pic, form))
|
||||
break;
|
||||
pic_funcall(pic, "eval", 1, form);
|
||||
pic_leave(pic, ai);
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue