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

make pic_get_args more useful

This commit is contained in:
Yuichi Nishiwaki 2016-02-20 21:16:10 +09:00
parent b5a27437e3
commit 9e5f846787
7 changed files with 115 additions and 122 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
contrib/30.regexp/src/regexp.c
View File

@ -19,9 +19,6 @@ regexp_dtor(pic_state *pic, void *data)
static const pic_data_type regexp_type = { "regexp", regexp_dtor, NULL };
#define pic_regexp_p(pic, o) (pic_data_type_p(pic, (o), &regexp_type))
#define pic_regexp_data(pic, v) ((struct pic_regexp_t *)pic_data(pic, v))
static pic_value
pic_regexp_regexp(pic_state *pic)
{
@ -72,30 +69,28 @@ pic_regexp_regexp_p(pic_state *pic)
pic_get_args(pic, "o", &obj);
return pic_bool_value(pic, pic_regexp_p(pic, obj));
return pic_bool_value(pic, pic_data_p(pic, obj, &regexp_type));
}
static pic_value
pic_regexp_regexp_match(pic_state *pic)
{
pic_value reg;
struct pic_regexp_t *reg;
const char *input;
regmatch_t match[100];
pic_value str, matches, positions;
int i, offset;
pic_get_args(pic, "oz", &reg, &input);
pic_assert_type(pic, reg, regexp);
pic_get_args(pic, "uz", &reg, &regexp_type, &input);
matches = pic_nil_value(pic);
positions = pic_nil_value(pic);
if (strchr(pic_regexp_data(pic, reg)->flags, 'g') != NULL) {
if (strchr(reg->flags, 'g') != NULL) {
/* global search */
offset = 0;
while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, match, 0) != REG_NOMATCH) {
while (regexec(&reg->reg, input, 1, match, 0) != REG_NOMATCH) {
pic_push(pic, pic_str_value(pic, input, match[0].rm_eo - match[0].rm_so), matches);
pic_push(pic, pic_int_value(pic, offset), positions);
@ -105,7 +100,7 @@ pic_regexp_regexp_match(pic_state *pic)
} else {
/* local search */
if (regexec(&pic_regexp_data(pic, reg)->reg, input, 100, match, 0) == 0) {
if (regexec(&reg->reg, input, 100, match, 0) == 0) {
for (i = 0; i < 100; ++i) {
if (match[i].rm_so == -1) {
break;
@ -130,16 +125,14 @@ pic_regexp_regexp_match(pic_state *pic)
static pic_value
pic_regexp_regexp_split(pic_state *pic)
{
pic_value reg;
struct pic_regexp_t *reg;
const char *input;
regmatch_t match;
pic_value output = pic_nil_value(pic);
pic_get_args(pic, "oz", &reg, &input);
pic_get_args(pic, "uz", &reg, &regexp_type, &input);
pic_assert_type(pic, reg, regexp);
while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, &match, 0) != REG_NOMATCH) {
while (regexec(&reg->reg, input, 1, &match, 0) != REG_NOMATCH) {
pic_push(pic, pic_str_value(pic, input, match.rm_so), output);
input += match.rm_eo;
@ -153,16 +146,14 @@ pic_regexp_regexp_split(pic_state *pic)
static pic_value
pic_regexp_regexp_replace(pic_state *pic)
{
pic_value reg;
struct pic_regexp_t *reg;
const char *input;
regmatch_t match;
pic_value txt, output = pic_lit_value(pic, "");
pic_get_args(pic, "ozs", &reg, &input, &txt);
pic_get_args(pic, "uzs", &reg, &regexp_type, &input, &txt);
pic_assert_type(pic, reg, regexp);
while (regexec(&pic_regexp_data(pic, reg)->reg, input, 1, &match, 0) != REG_NOMATCH) {
while (regexec(&reg->reg, input, 1, &match, 0) != REG_NOMATCH) {
output = pic_str_cat(pic, output, pic_str_value(pic, input, match.rm_so));
output = pic_str_cat(pic, output, txt);

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

@ -46,16 +46,14 @@ socket_dtor(pic_state *pic, void *data)
static const pic_data_type socket_type = { "socket", socket_dtor, NULL };
#define pic_socket_p(pic, o) (pic_data_type_p(pic, (o), &socket_type))
#define pic_socket_data(pic, o) ((struct pic_socket_t *)pic_data(pic, o))
static pic_value
pic_socket_socket_p(pic_state *pic)
{
pic_value obj;
pic_get_args(pic, "o", &obj);
return pic_bool_value(pic, pic_socket_p(pic, obj));
return pic_bool_value(pic, pic_data_p(pic, obj, &socket_type));
}
static pic_value
@ -139,14 +137,11 @@ pic_socket_make_socket(pic_state *pic)
static pic_value
pic_socket_socket_accept(pic_state *pic)
{
pic_value obj;
int fd = -1;
struct pic_socket_t *sock, *new_sock;
pic_get_args(pic, "o", &obj);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "u", &sock, &socket_type);
sock = pic_socket_data(pic, obj);
ensure_socket_is_open(pic, sock);
errno = 0;
@ -177,18 +172,14 @@ pic_socket_socket_accept(pic_state *pic)
static pic_value
pic_socket_socket_send(pic_state *pic)
{
pic_value obj, bv;
const unsigned char *cursor;
int flags = 0, remain, written;
struct pic_socket_t *sock;
pic_get_args(pic, "ob|i", &obj, &bv, &flags);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "ub|i", &sock, &socket_type, &cursor, &remain, &flags);
sock = pic_socket_data(pic, obj);
ensure_socket_is_open(pic, sock);
cursor = pic_blob(pic, bv, &remain);
written = 0;
errno = 0;
while (remain > 0) {
@ -213,20 +204,18 @@ pic_socket_socket_send(pic_state *pic)
static pic_value
pic_socket_socket_recv(pic_state *pic)
{
pic_value obj;
void *buf;
int size;
int flags = 0;
ssize_t len;
struct pic_socket_t *sock;
pic_get_args(pic, "oi|i", &obj, &size, &flags);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "ui|i", &sock, &socket_type, &size, &flags);
if (size < 0) {
pic_errorf(pic, "size must not be negative");
}
sock = pic_socket_data(pic, obj);
ensure_socket_is_open(pic, sock);
buf = pic_blob(pic, pic_blob_value(pic, NULL, size), NULL);
@ -250,14 +239,11 @@ pic_socket_socket_recv(pic_state *pic)
static pic_value
pic_socket_socket_shutdown(pic_state *pic)
{
pic_value obj;
int how;
struct pic_socket_t *sock;
pic_get_args(pic, "oi", &obj, &how);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "ui", &sock, &socket_type, &how);
sock = pic_socket_data(pic, obj);
if (sock->fd != -1) {
shutdown(sock->fd, how);
sock->fd = -1;
@ -269,12 +255,11 @@ pic_socket_socket_shutdown(pic_state *pic)
static pic_value
pic_socket_socket_close(pic_state *pic)
{
pic_value obj;
struct pic_socket_t *sock;
pic_get_args(pic, "o", &obj);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "u", &sock, &socket_type);
socket_close(pic_socket_data(pic, obj));
socket_close(sock);
return pic_undef_value(pic);
}
@ -329,13 +314,10 @@ make_socket_port(pic_state *pic, struct pic_socket_t *sock, const char *mode)
static pic_value
pic_socket_socket_input_port(pic_state *pic)
{
pic_value obj;
struct pic_socket_t *sock;
pic_get_args(pic, "o", &obj);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "u", &sock, &socket_type);
sock = pic_socket_data(pic, obj);
ensure_socket_is_open(pic, sock);
return make_socket_port(pic, sock, "r");
@ -344,13 +326,10 @@ pic_socket_socket_input_port(pic_state *pic)
static pic_value
pic_socket_socket_output_port(pic_state *pic)
{
pic_value obj;
struct pic_socket_t *sock;
pic_get_args(pic, "o", &obj);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "u", &sock, &socket_type);
sock = pic_socket_data(pic, obj);
ensure_socket_is_open(pic, sock);
return make_socket_port(pic, sock, "w");
@ -362,10 +341,8 @@ pic_socket_call_with_socket(pic_state *pic)
pic_value obj, proc, result;
struct pic_socket_t *sock;
pic_get_args(pic, "ol", &obj, &proc);
pic_assert_type(pic, obj, socket);
pic_get_args(pic, "u+l", &sock, &socket_type, &obj, &proc);
sock = pic_socket_data(pic, obj);
ensure_socket_is_open(pic, sock);
result = pic_call(pic, proc, 1, obj);

40
extlib/benz/blob.c
View File

@ -89,12 +89,9 @@ pic_blob_make_bytevector(pic_state *pic)
static pic_value
pic_blob_bytevector_length(pic_state *pic)
{
pic_value bv;
int len;
pic_get_args(pic, "b", &bv);
pic_blob(pic, bv, &len);
pic_get_args(pic, "b", NULL, &len);
return pic_int_value(pic, len);
}
@ -102,13 +99,10 @@ pic_blob_bytevector_length(pic_state *pic)
static pic_value
pic_blob_bytevector_u8_ref(pic_state *pic)
{
pic_value bv;
unsigned char *buf;
int k, len;
int len, k;
pic_get_args(pic, "bi", &bv, &k);
buf = pic_blob(pic, bv, &len);
pic_get_args(pic, "bi", &buf, &len, &k);
VALID_INDEX(pic, len, k);
@ -118,17 +112,14 @@ pic_blob_bytevector_u8_ref(pic_state *pic)
static pic_value
pic_blob_bytevector_u8_set(pic_state *pic)
{
pic_value bv;
unsigned char *buf;
int k, v, len;
int len, k, v;
pic_get_args(pic, "bii", &bv, &k, &v);
pic_get_args(pic, "bii", &buf, &len, &k, &v);
if (v < 0 || v > 255)
pic_errorf(pic, "byte out of range");
buf = pic_blob(pic, bv, &len);
VALID_INDEX(pic, len, k);
buf[k] = (unsigned char)v;
@ -139,14 +130,10 @@ pic_blob_bytevector_u8_set(pic_state *pic)
static pic_value
pic_blob_bytevector_copy_i(pic_state *pic)
{
pic_value to, from;
unsigned char *tobuf, *frombuf;
unsigned char *to, *from;
int n, at, start, end, tolen, fromlen;
n = pic_get_args(pic, "bib|ii", &to, &at, &from, &start, &end);
tobuf = pic_blob(pic, to, &tolen);
frombuf = pic_blob(pic, from, &fromlen);
n = pic_get_args(pic, "bib|ii", &to, &tolen, &at, &from, &fromlen, &start, &end);
switch (n) {
case 3:
@ -157,7 +144,7 @@ pic_blob_bytevector_copy_i(pic_state *pic)
VALID_ATRANGE(pic, tolen, at, fromlen, start, end);
memmove(tobuf + at, frombuf + start, end - start);
memmove(to + at, from + start, end - start);
return pic_undef_value(pic);
}
@ -165,13 +152,10 @@ pic_blob_bytevector_copy_i(pic_state *pic)
static pic_value
pic_blob_bytevector_copy(pic_state *pic)
{
pic_value from;
unsigned char *buf;
int n, start, end, len;
n = pic_get_args(pic, "b|ii", &from, &start, &end);
buf = pic_blob(pic, from, &len);
n = pic_get_args(pic, "b|ii", &buf, &len, &start, &end);
switch (n) {
case 1:
@ -241,13 +225,11 @@ pic_blob_list_to_bytevector(pic_state *pic)
static pic_value
pic_blob_bytevector_to_list(pic_state *pic)
{
pic_value blob, list;
pic_value list;
unsigned char *buf;
int n, len, start, end, i;
n = pic_get_args(pic, "b|ii", &blob, &start, &end);
buf = pic_blob(pic, blob, &len);
n = pic_get_args(pic, "b|ii", &buf, &len, &start, &end);
switch (n) {
case 1:

7
extlib/benz/data.c
View File

@ -2,9 +2,12 @@
#include "picrin/object.h"
bool
pic_data_type_p(pic_state *pic, pic_value obj, const pic_data_type *type)
pic_data_p(pic_state *pic, pic_value obj, const pic_data_type *type)
{
return pic_data_p(pic, obj) && pic_data_ptr(pic, obj)->type == type;
if (pic_type(pic, obj) != PIC_TYPE_DATA) {
return false;
}
return type == NULL || pic_data_ptr(pic, obj)->type == type;
}
void *

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

@ -186,7 +186,6 @@ enum {
#define pic_str_p(pic,v) (pic_type(pic,v) == PIC_TYPE_STRING)
#define pic_blob_p(pic,v) (pic_type(pic,v) == PIC_TYPE_BLOB)
#define pic_proc_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PROC)
#define pic_data_p(pic,v) (pic_type(pic,v) == PIC_TYPE_DATA)
#define pic_nil_p(pic,v) (pic_type(pic,v) == PIC_TYPE_NIL)
#define pic_pair_p(pic,v) (pic_type(pic,v) == PIC_TYPE_PAIR)
#define pic_vec_p(pic,v) (pic_type(pic,v) == PIC_TYPE_VECTOR)
@ -194,6 +193,7 @@ enum {
#define pic_weak_p(pic,v) (pic_type(pic,v) == PIC_TYPE_WEAK)
#define pic_port_p(pic, v) (pic_type(pic, v) == PIC_TYPE_PORT)
#define pic_sym_p(pic,v) (pic_type(pic,v) == PIC_TYPE_SYMBOL)
bool pic_data_p(pic_state *, pic_value, const pic_data_type *);
int pic_type(pic_state *, pic_value);
const char *pic_typename(pic_state *, int);
@ -338,8 +338,6 @@ pic_value pic_eval(pic_state *, pic_value program, const char *lib);
void pic_load(pic_state *, pic_value port);
void pic_load_cstr(pic_state *, const char *);
bool pic_data_type_p(pic_state *, pic_value, const pic_data_type *);
#define pic_deflibrary(pic, lib) do { \
if (! pic_find_library(pic, lib)) { \
pic_make_library(pic, lib); \

16
extlib/benz/port.c
View File

@ -134,13 +134,10 @@ pic_port_close_port(pic_state *pic)
static pic_value
pic_port_open_input_bytevector(pic_state *pic)
{
pic_value blob;
unsigned char *buf;
int len;
pic_get_args(pic, "b", &blob);
buf = pic_blob(pic, blob, &len);
pic_get_args(pic, "b", &buf, &len);
return pic_open_port(pic, xfopen_buf(pic, (char *)buf, len, "r"));
}
@ -240,13 +237,11 @@ pic_port_read_bytevector(pic_state *pic)
static pic_value
pic_port_read_bytevector_ip(pic_state *pic)
{
pic_value bv, port;
pic_value port;
unsigned char *buf;
int n, start, end, i, len;
n = pic_get_args(pic, "b|pii", &bv, &port, &start, &end);
buf = pic_blob(pic, bv, &len);
n = pic_get_args(pic, "b|pii", &buf, &len, &port, &start, &end);
switch (n) {
case 1:
@ -284,14 +279,11 @@ pic_port_write_u8(pic_state *pic)
static pic_value
pic_port_write_bytevector(pic_state *pic)
{
pic_value blob;
pic_value port;
unsigned char *buf;
int n, start, end, len, done;
n = pic_get_args(pic, "b|pii", &blob, &port, &start, &end);
buf = pic_blob(pic, blob, &len);
n = pic_get_args(pic, "b|pii", &buf, &len, &port, &start, &end);
switch (n) {
case 1:

88
extlib/benz/proc.c
View File

@ -20,15 +20,17 @@
* F double *, bool * float with exactness
* c char * char
* z char ** c string
* b unsigned char *, int * bytevector
* u void **, const pic_data_type * user data type
* m pic_value * symbol
* v pic_value * vector
* s pic_value * string
* b pic_value * bytevector
* l pic_value * lambda
* p pic_value * port
* d pic_value * dictionary
* r pic_value * record
*
* + aliasing operator
* | optional operator
* * int *, pic_value ** variable length operator
* ---- ---- ----
@ -38,34 +40,41 @@ int
pic_get_args(pic_state *pic, const char *format, ...)
{
char c;
const char *p = format;
int paramc = 0, optc = 0;
int i, argc = pic->ci->argc - 1;
va_list ap;
bool proc = false, rest = false, opt = false;
bool proc = 0, rest = 0, opt = 0;
/* parse format */
if ((c = *format) != '\0') {
if ((c = *p) != '\0') {
if (c == '&') {
proc = true;
format++; /* forget about '&' */
proc = 1;
p++;
}
for (paramc = 0, c = *format; c; c = format[++paramc]) {
while ((c = *p++) != '\0') {
if (c == '+')
continue;
if (c == '|') {
opt = true;
break;
opt = 1; break;
} else if (c == '*') {
rest = true;
break;
rest = 1; break;
}
paramc++;
}
if (opt) {
while ((c = *p++) != '\0') {
if (c == '+')
continue;
if (c == '*') {
rest = 1; break;
}
optc++;
}
}
for (optc = 0; opt && c; c = format[paramc + opt + ++optc]) {
if (c == '*') {
rest = true;
break;
}
}
assert((opt ? 1 : 0) <= optc); /* at least 1 char after '|'? */
assert(format[paramc + opt + optc + rest] == '\0'); /* no extra chars? */
if (rest) c = *p++;
assert(opt <= optc); /* at least 1 char after '|'? */
assert(c == '\0'); /* no extra chars? */
}
if (argc < paramc || (paramc + optc < argc && ! rest)) {
@ -80,6 +89,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
proc = va_arg(ap, pic_value *);
*proc = GET_OPERAND(pic, 0);
format++; /* skip '&' */
}
for (i = 1; i <= MIN(paramc + optc, argc); ++i) {
@ -97,6 +107,41 @@ pic_get_args(pic_state *pic, const char *format, ...)
break;
}
case 'u': {
void **data;
const pic_data_type *type;
pic_value v;
data = va_arg(ap, void **);
type = va_arg(ap, const pic_data_type *);
v = GET_OPERAND(pic, i);
if (pic_data_p(pic, v, type)) {
*data = pic_data(pic, v);
}
else {
pic_errorf(pic, "pic_get_args: expected data type \"%s\", but got ~s", type->type_name, v);
}
break;
}
case 'b': {
unsigned char **buf;
int *len;
pic_value v;
buf = va_arg(ap, unsigned char **);
len = va_arg(ap, int *);
v = GET_OPERAND(pic, i);
if (pic_blob_p(pic, v)) {
unsigned char *tmp = pic_blob(pic, v, len);
if (buf) *buf = tmp;
}
else {
pic_errorf(pic, "pic_get_args: expected bytevector, but got ~s", v);
}
break;
}
#define NUM_CASE(c1, c2, ctype) \
case c1: case c2: { \
ctype *n; \
@ -149,7 +194,6 @@ pic_get_args(pic_state *pic, const char *format, ...)
OBJ_CASE('m', sym)
OBJ_CASE('s', str)
OBJ_CASE('l', proc)
OBJ_CASE('b', blob)
OBJ_CASE('v', vec)
OBJ_CASE('d', dict)
OBJ_CASE('p', port)
@ -158,6 +202,12 @@ pic_get_args(pic_state *pic, const char *format, ...)
default:
pic_errorf(pic, "pic_get_args: invalid argument specifier '%c' given", c);
}
if (format[1] == '+') {
pic_value *p;
p = va_arg(ap, pic_value*);
*p = GET_OPERAND(pic, i);
}
}
if (rest) {
int *n;