conservatory
/
picrin
4
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'master' into khash-kvec

This commit is contained in:
Yuichi Nishiwaki 2015-06-25 05:58:12 +09:00
parent 5cf1822813 6b15304d85
commit a7475a66fe
7 changed files with 106 additions and 74 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
contrib/10.callcc/callcc.c
View File

@ -178,7 +178,7 @@ restore_cont(pic_state *pic, struct pic_fullcont *cont)
if (&v > cont->stk_pos) native_stack_extend(pic, cont); if (&v > cont->stk_pos) native_stack_extend(pic, cont);
} }
else { else {
if (&v > cont->stk_pos + cont->stk_len) native_stack_extend(pic, cont); if (&v < cont->stk_pos + cont->stk_len) native_stack_extend(pic, cont);
} }
pic->cc = cont->prev_jmp; pic->cc = cont->prev_jmp;

100
contrib/40.srfi/src/106.c
View File

@ -400,122 +400,122 @@ void
pic_init_socket(pic_state *pic) pic_init_socket(pic_state *pic)
{ {
pic_deflibrary (pic, "(srfi 106)") { pic_deflibrary (pic, "(srfi 106)") {
pic_defun(pic, "socket?", pic_socket_socket_p); pic_defun_(pic, "socket?", pic_socket_socket_p);
pic_defun(pic, "make-socket", pic_socket_make_socket); pic_defun_(pic, "make-socket", pic_socket_make_socket);
pic_defun(pic, "socket-accept", pic_socket_socket_accept); pic_defun_(pic, "socket-accept", pic_socket_socket_accept);
pic_defun(pic, "socket-send", pic_socket_socket_send); pic_defun_(pic, "socket-send", pic_socket_socket_send);
pic_defun(pic, "socket-recv", pic_socket_socket_recv); pic_defun_(pic, "socket-recv", pic_socket_socket_recv);
pic_defun(pic, "socket-shutdown", pic_socket_socket_shutdown); pic_defun_(pic, "socket-shutdown", pic_socket_socket_shutdown);
pic_defun(pic, "socket-close", pic_socket_socket_close); pic_defun_(pic, "socket-close", pic_socket_socket_close);
pic_defun(pic, "socket-input-port", pic_socket_socket_input_port); pic_defun_(pic, "socket-input-port", pic_socket_socket_input_port);
pic_defun(pic, "socket-output-port", pic_socket_socket_output_port); pic_defun_(pic, "socket-output-port", pic_socket_socket_output_port);
pic_defun(pic, "call-with-socket", pic_socket_call_with_socket); pic_defun_(pic, "call-with-socket", pic_socket_call_with_socket);
#ifdef AF_INET #ifdef AF_INET
pic_define(pic, "*af-inet*", pic_int_value(AF_INET)); pic_define_(pic, "*af-inet*", pic_int_value(AF_INET));
#else #else
pic_define(pic, "*af-inet*", pic_false_value()); pic_define_(pic, "*af-inet*", pic_false_value());
#endif #endif
#ifdef AF_INET6 #ifdef AF_INET6
pic_define(pic, "*af-inet6*", pic_int_value(AF_INET6)); pic_define_(pic, "*af-inet6*", pic_int_value(AF_INET6));
#else #else
pic_define(pic, "*af-inet6*", pic_false_value()); pic_define_(pic, "*af-inet6*", pic_false_value());
#endif #endif
#ifdef AF_UNSPEC #ifdef AF_UNSPEC
pic_define(pic, "*af-unspec*", pic_int_value(AF_UNSPEC)); pic_define_(pic, "*af-unspec*", pic_int_value(AF_UNSPEC));
#else #else
pic_define(pic, "*af-unspec*", pic_false_value()); pic_define_(pic, "*af-unspec*", pic_false_value());
#endif #endif
#ifdef SOCK_STREAM #ifdef SOCK_STREAM
pic_define(pic, "*sock-stream*", pic_int_value(SOCK_STREAM)); pic_define_(pic, "*sock-stream*", pic_int_value(SOCK_STREAM));
#else #else
pic_define(pic, "*sock-stream*", pic_false_value()); pic_define_(pic, "*sock-stream*", pic_false_value());
#endif #endif
#ifdef SOCK_DGRAM #ifdef SOCK_DGRAM
pic_define(pic, "*sock-dgram*", pic_int_value(SOCK_DGRAM)); pic_define_(pic, "*sock-dgram*", pic_int_value(SOCK_DGRAM));
#else #else
pic_define(pic, "*sock-dgram*", pic_false_value()); pic_define_(pic, "*sock-dgram*", pic_false_value());
#endif #endif
#ifdef AI_CANONNAME #ifdef AI_CANONNAME
pic_define(pic, "*ai-canonname*", pic_int_value(AI_CANONNAME)); pic_define_(pic, "*ai-canonname*", pic_int_value(AI_CANONNAME));
#else #else
pic_define(pic, "*ai-canonname*", pic_false_value()); pic_define_(pic, "*ai-canonname*", pic_false_value());
#endif #endif
#ifdef AI_NUMERICHOST #ifdef AI_NUMERICHOST
pic_define(pic, "*ai-numerichost*", pic_int_value(AI_NUMERICHOST)); pic_define_(pic, "*ai-numerichost*", pic_int_value(AI_NUMERICHOST));
#else #else
pic_define(pic, "*ai-numerichost*", pic_false_value()); pic_define_(pic, "*ai-numerichost*", pic_false_value());
#endif #endif
/* AI_V4MAPPED and AI_ALL are not supported by *BSDs, even though they are defined in netdb.h. */ /* AI_V4MAPPED and AI_ALL are not supported by *BSDs, even though they are defined in netdb.h. */
#if defined(AI_V4MAPPED) && !defined(BSD) #if defined(AI_V4MAPPED) && !defined(BSD)
pic_define(pic, "*ai-v4mapped*", pic_int_value(AI_V4MAPPED)); pic_define_(pic, "*ai-v4mapped*", pic_int_value(AI_V4MAPPED));
#else #else
pic_define(pic, "*ai-v4mapped*", pic_false_value()); pic_define_(pic, "*ai-v4mapped*", pic_false_value());
#endif #endif
#if defined(AI_ALL) && !defined(BSD) #if defined(AI_ALL) && !defined(BSD)
pic_define(pic, "*ai-all*", pic_int_value(AI_ALL)); pic_define_(pic, "*ai-all*", pic_int_value(AI_ALL));
#else #else
pic_define(pic, "*ai-all*", pic_false_value()); pic_define_(pic, "*ai-all*", pic_false_value());
#endif #endif
#ifdef AI_ADDRCONFIG #ifdef AI_ADDRCONFIG
pic_define(pic, "*ai-addrconfig*", pic_int_value(AI_ADDRCONFIG)); pic_define_(pic, "*ai-addrconfig*", pic_int_value(AI_ADDRCONFIG));
#else #else
pic_define(pic, "*ai-addrconfig*", pic_false_value()); pic_define_(pic, "*ai-addrconfig*", pic_false_value());
#endif #endif
#ifdef AI_PASSIVE #ifdef AI_PASSIVE
pic_define(pic, "*ai-passive*", pic_int_value(AI_PASSIVE)); pic_define_(pic, "*ai-passive*", pic_int_value(AI_PASSIVE));
#else #else
pic_define(pic, "*ai-passive*", pic_false_value()); pic_define_(pic, "*ai-passive*", pic_false_value());
#endif #endif
#ifdef IPPROTO_IP #ifdef IPPROTO_IP
pic_define(pic, "*ipproto-ip*", pic_int_value(IPPROTO_IP)); pic_define_(pic, "*ipproto-ip*", pic_int_value(IPPROTO_IP));
#else #else
pic_define(pic, "*ipproto-ip*", pic_false_value()); pic_define_(pic, "*ipproto-ip*", pic_false_value());
#endif #endif
#ifdef IPPROTO_TCP #ifdef IPPROTO_TCP
pic_define(pic, "*ipproto-tcp*", pic_int_value(IPPROTO_TCP)); pic_define_(pic, "*ipproto-tcp*", pic_int_value(IPPROTO_TCP));
#else #else
pic_define(pic, "*ipproto-tcp*", pic_false_value()); pic_define_(pic, "*ipproto-tcp*", pic_false_value());
#endif #endif
#ifdef IPPROTO_UDP #ifdef IPPROTO_UDP
pic_define(pic, "*ipproto-udp*", pic_int_value(IPPROTO_UDP)); pic_define_(pic, "*ipproto-udp*", pic_int_value(IPPROTO_UDP));
#else #else
pic_define(pic, "*ipproto-udp*", pic_false_value()); pic_define_(pic, "*ipproto-udp*", pic_false_value());
#endif #endif
#ifdef MSG_PEEK #ifdef MSG_PEEK
pic_define(pic, "*msg-peek*", pic_int_value(MSG_PEEK)); pic_define_(pic, "*msg-peek*", pic_int_value(MSG_PEEK));
#else #else
pic_define(pic, "*msg-peek*", pic_false_value()); pic_define_(pic, "*msg-peek*", pic_false_value());
#endif #endif
#ifdef MSG_OOB #ifdef MSG_OOB
pic_define(pic, "*msg-oob*", pic_int_value(MSG_OOB)); pic_define_(pic, "*msg-oob*", pic_int_value(MSG_OOB));
#else #else
pic_define(pic, "*msg-oob*", pic_false_value()); pic_define_(pic, "*msg-oob*", pic_false_value());
#endif #endif
#ifdef MSG_WAITALL #ifdef MSG_WAITALL
pic_define(pic, "*msg-waitall*", pic_int_value(MSG_WAITALL)); pic_define_(pic, "*msg-waitall*", pic_int_value(MSG_WAITALL));
#else #else
pic_define(pic, "*msg-waitall*", pic_false_value()); pic_define_(pic, "*msg-waitall*", pic_false_value());
#endif #endif
#ifdef SHUT_RD #ifdef SHUT_RD
pic_define(pic, "*shut-rd*", pic_int_value(SHUT_RD)); pic_define_(pic, "*shut-rd*", pic_int_value(SHUT_RD));
#else #else
pic_define(pic, "*shut-rd*", pic_false_value()); pic_define_(pic, "*shut-rd*", pic_false_value());
#endif #endif
#ifdef SHUT_WR #ifdef SHUT_WR
pic_define(pic, "*shut-wr*", pic_int_value(SHUT_WR)); pic_define_(pic, "*shut-wr*", pic_int_value(SHUT_WR));
#else #else
pic_define(pic, "*shut-wr*", pic_false_value()); pic_define_(pic, "*shut-wr*", pic_false_value());
#endif #endif
#ifdef SHUT_RDWR #ifdef SHUT_RDWR
pic_define(pic, "*shut-rdwr*", pic_int_value(SHUT_RDWR)); pic_define_(pic, "*shut-rdwr*", pic_int_value(SHUT_RDWR));
#else #else
pic_define(pic, "*shut-rdwr*", pic_false_value()); pic_define_(pic, "*shut-rdwr*", pic_false_value());
#endif #endif
} }
} }

4
extlib/benz/include/picrin.h
View File

@ -194,6 +194,10 @@ void pic_load_cstr(pic_state *, const char *);
void pic_define(pic_state *, const char *, pic_value); void pic_define(pic_state *, const char *, pic_value);
void pic_defun(pic_state *, const char *, pic_func_t); void pic_defun(pic_state *, const char *, pic_func_t);
void pic_defvar(pic_state *, const char *, pic_value, struct pic_proc *); void pic_defvar(pic_state *, const char *, pic_value, struct pic_proc *);
/* functions suffixed with '_' will not perform automatic export */
void pic_define_(pic_state *, const char *, pic_value);
void pic_defun_(pic_state *, const char *, pic_func_t);
void pic_defvar_(pic_state *, const char *, pic_value, struct pic_proc *);
pic_value pic_ref(pic_state *, struct pic_lib *, const char *); pic_value pic_ref(pic_state *, struct pic_lib *, const char *);
void pic_set(pic_state *, struct pic_lib *, const char *, pic_value); void pic_set(pic_state *, struct pic_lib *, const char *, pic_value);

3
extlib/benz/port.c
View File

@ -108,7 +108,8 @@ pic_open_file(pic_state *pic, const char *name, int flags) {
mode = 'w'; mode = 'w';
} }
if ((file = file_open(pic, name, &mode)) == NULL) { if ((file = file_open(pic, name, &mode)) == NULL) {
pic_errorf(pic, "could not open file '%s'", name); pic_str *msg = pic_format(pic, "could not open file '%s'", name);
pic_raise(pic, pic_obj_value(pic_make_error(pic, pic->sFILE, pic_str_cstr(pic, msg), pic_nil_value())));
} }
port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT); port = (struct pic_port *)pic_obj_alloc(pic, sizeof(struct pic_port), PIC_TT_PORT);

2
extlib/benz/state.c
View File

@ -365,7 +365,7 @@ pic_open(int argc, char *argv[], char **envp, pic_allocf allocf)
pic_reader_init(pic); pic_reader_init(pic);
/* parameter table */ /* parameter table */
pic->ptable = pic_cons(pic, pic_obj_value(pic_make_dict(pic)), pic->ptable); pic->ptable = pic_cons(pic, pic_obj_value(pic_make_reg(pic)), pic->ptable);
/* standard libraries */ /* standard libraries */
pic->PICRIN_BASE = pic_make_library(pic, pic_read_cstr(pic, "(picrin base)")); pic->PICRIN_BASE = pic_make_library(pic, pic_read_cstr(pic, "(picrin base)"));

27
extlib/benz/vm.c
View File

@ -1137,7 +1137,7 @@ pic_defun_vm(pic_state *pic, const char *name, pic_sym *uid, pic_func_t func)
} }
void void
pic_define(pic_state *pic, const char *name, pic_value val) pic_define_(pic_state *pic, const char *name, pic_value val)
{ {
pic_sym *sym, *uid; pic_sym *sym, *uid;
@ -1150,20 +1150,39 @@ pic_define(pic_state *pic, const char *name, pic_value val)
} }
pic_dict_set(pic, pic->globals, uid, val); pic_dict_set(pic, pic->globals, uid, val);
}
pic_export(pic, sym); void
pic_define(pic_state *pic, const char *name, pic_value val)
{
pic_define_(pic, name, val);
pic_export(pic, pic_intern_cstr(pic, name));
}
void
pic_defun_(pic_state *pic, const char *name, pic_func_t cfunc)
{
pic_define_(pic, name, pic_obj_value(pic_make_proc(pic, cfunc, name)));
} }
void void
pic_defun(pic_state *pic, const char *name, pic_func_t cfunc) pic_defun(pic_state *pic, const char *name, pic_func_t cfunc)
{ {
pic_define(pic, name, pic_obj_value(pic_make_proc(pic, cfunc, name))); pic_defun_(pic, name, cfunc);
pic_export(pic, pic_intern_cstr(pic, name));
}
void
pic_defvar_(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv)
{
pic_define_(pic, name, pic_obj_value(pic_make_var(pic, init, conv)));
} }
void void
pic_defvar(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv) pic_defvar(pic_state *pic, const char *name, pic_value init, struct pic_proc *conv)
{ {
pic_define(pic, name, pic_obj_value(pic_make_var(pic, init, conv))); pic_defvar_(pic, name, init, conv);
pic_export(pic, pic_intern_cstr(pic, name));
} }
pic_value pic_value

42
t/ir-macro.scm
View File

@ -1,7 +1,10 @@
(import (scheme base) (import (scheme base)
(picrin macro)) (picrin macro)
(picrin test))
(define-syntax aif (test-begin)
(define-macro aif
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject cmp) (lambda (form inject cmp)
(let ((it (inject 'it)) (let ((it (inject 'it))
@ -11,11 +14,12 @@
`(let ((,it ,expr)) `(let ((,it ,expr))
(if ,it ,then ,else)))))) (if ,it ,then ,else))))))
(aif (member 'b '(a b c)) (car it) #f) (test 'b
(aif (member 'b '(a b c)) (car it) #f))
;;; test hygiene begin ;;; test hygiene begin
(define-syntax mif (define-macro mif
(ir-macro-transformer (ir-macro-transformer
(lambda (form inject cmp) (lambda (form inject cmp)
(let ((expr (car (cdr form))) (let ((expr (car (cdr form)))
@ -24,12 +28,14 @@
`(let ((it ,expr)) `(let ((it ,expr))
(if it ,then ,else)))))) (if it ,then ,else))))))
(let ((if 42)) (test 2
(mif 1 2 3)) (let ((if 42))
(mif 1 2 3)))
; => 2 ; => 2
(let ((it 42)) (test 42
(mif 1 it 2)) (let ((it 42))
(mif 1 it 2)))
; => 42 ; => 42
;;; end ;;; end
@ -38,10 +44,10 @@
;;; test core syntax begin ;;; test core syntax begin
(mif 'a 'b 'c) (test 'b (mif 'a 'b 'c))
; => b ; => b
(define-syntax loop (define-macro loop
(ir-macro-transformer (ir-macro-transformer
(lambda (expr inject cmp) (lambda (expr inject cmp)
(let ((body (cdr expr))) (let ((body (cdr expr)))
@ -51,14 +57,16 @@
,@body (f)))))))) ,@body (f))))))))
(define a 1) (define a 1)
(loop (test #f
(if (= a 2) (exit #f)) (loop
(set! a 2)) (if (= a 2) (exit #f))
(set! a 2)))
; => #f ; => #f
(loop (test #f
(define a 1) (loop
(if (= a 1) (exit #f))) (define a 1)
(if (= a 1) (exit #f))))
; => #f ; => #f
;;; end (test-end)