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);
}
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;

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

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

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);
/* 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 */
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
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;
@ -1150,20 +1150,39 @@ pic_define(pic_state *pic, const char *name, pic_value 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
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
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

42
t/ir-macro.scm
View File

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