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

add value.h

This commit is contained in:
Yuichi Nishiwaki 2017-03-29 07:11:27 +09:00
parent f7484c089f
commit b44d69b4da
35 changed files with 775 additions and 575 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
Makefile
View File

@ -17,7 +17,6 @@ LIBPICRIN_SRCS = \
lib/state.c\
lib/string.c\
lib/symbol.c\
lib/value.c\
lib/var.c\
lib/vector.c\
lib/weak.c\
@ -77,7 +76,7 @@ src/init_contrib.c:
lib/boot.c: piclib/boot.scm
bin/picrin-bootstrap tools/mkboot.scm < piclib/boot.scm > lib/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 lib/vm.h
$(LIBPICRIN_OBJS) $(PICRIN_OBJS) $(CONTRIB_OBJS): lib/include/picrin.h lib/include/picrin/*.h lib/khash.h lib/value.h lib/object.h lib/state.h lib/vm.h
doc: docs/*.rst docs/contrib.rst
$(MAKE) -C docs html

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

@ -1,4 +1,5 @@
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"

18
contrib/20.r7rs/src/system.c
View File

@ -33,15 +33,10 @@ pic_system_exit(pic_state *pic)
argc = pic_get_args(pic, "|o", &v);
if (argc == 1) {
switch (pic_type(pic, v)) {
case PIC_TYPE_FLOAT:
if (pic_float_p(pic, v)) {
status = (int)pic_float(pic, v);
break;
case PIC_TYPE_INT:
} else if (pic_int_p(pic, v)) {
status = pic_int(pic, v);
break;
default:
break;
}
}
@ -58,15 +53,10 @@ pic_system_emergency_exit(pic_state *pic)
argc = pic_get_args(pic, "|o", &v);
if (argc == 1) {
switch (pic_type(pic, v)) {
case PIC_TYPE_FLOAT:
if (pic_float_p(pic, v)) {
status = (int)pic_float(pic, v);
break;
case PIC_TYPE_INT:
} else if (pic_int_p(pic, v)) {
status = pic_int(pic, v);
break;
default:
break;
}
}

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

@ -18,7 +18,7 @@ struct pic_socket_t {
int fd;
};
PIC_INLINE void
PIC_STATIC_INLINE void
socket_close(struct pic_socket_t *sock)
{
if (sock != NULL && sock->fd != -1) {
@ -27,7 +27,7 @@ socket_close(struct pic_socket_t *sock)
}
}
PIC_INLINE void
PIC_STATIC_INLINE void
ensure_socket_is_open(pic_state *pic, struct pic_socket_t *sock)
{
if (sock != NULL && sock->fd == -1) {
@ -297,10 +297,17 @@ xf_socket_close(pic_state *PIC_UNUSED(pic), void *PIC_UNUSED(cookie))
static pic_value
make_socket_port(pic_state *pic, struct pic_socket_t *sock, const char *mode)
{
static const pic_port_type xf_socket_rd = {
xf_socket_read, 0, xf_socket_seek, xf_socket_close
};
static const pic_port_type xf_socket_wr = {
0, xf_socket_write, xf_socket_seek, xf_socket_close
};
if (*mode == 'r') {
return pic_funopen(pic, sock, xf_socket_read, 0, xf_socket_seek, xf_socket_close);
return pic_funopen(pic, sock, &xf_socket_rd);
} else {
return pic_funopen(pic, sock, 0, xf_socket_write, xf_socket_seek, xf_socket_close);
return pic_funopen(pic, sock, &xf_socket_wr);
}
}

1
lib/blob.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
pic_value

27
lib/bool.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#if PIC_NAN_BOXING
@ -10,13 +11,13 @@
bool
pic_eq_p(pic_state *PIC_UNUSED(pic), pic_value x, pic_value y)
{
return x == y;
return x.v == y.v;
}
bool
pic_eqv_p(pic_state *PIC_UNUSED(pic), pic_value x, pic_value y)
{
return x == y;
return x.v == y.v;
}
#else
@ -24,36 +25,36 @@ pic_eqv_p(pic_state *PIC_UNUSED(pic), pic_value x, pic_value y)
bool
pic_eq_p(pic_state *PIC_UNUSED(pic), pic_value x, pic_value y)
{
if (pic_type(pic, x) != pic_type(pic, y))
if (value_type(pic, x) != value_type(pic, y))
return false;
switch (pic_type(pic, x)) {
switch (value_type(pic, x)) {
case PIC_TYPE_NIL:
return true;
case PIC_TYPE_TRUE: case PIC_TYPE_FALSE:
return pic_type(pic, x) == pic_type(pic, y);
return value_type(pic, x) == value_type(pic, y);
default:
return pic_obj_ptr(x) == pic_obj_ptr(y);
return obj_ptr(x) == obj_ptr(y);
}
}
bool
pic_eqv_p(pic_state *PIC_UNUSED(pic), pic_value x, pic_value y)
{
if (pic_type(pic, x) != pic_type(pic, y))
if (value_type(pic, x) != value_type(pic, y))
return false;
switch (pic_type(pic, x)) {
switch (value_type(pic, x)) {
case PIC_TYPE_NIL:
return true;
case PIC_TYPE_TRUE: case PIC_TYPE_FALSE:
return pic_type(pic, x) == pic_type(pic, y);
return value_type(pic, x) == value_type(pic, y);
case PIC_TYPE_FLOAT:
return pic_float(pic, x) == pic_float(pic, y);
case PIC_TYPE_INT:
return pic_int(pic, x) == pic_int(pic, y);
default:
return pic_obj_ptr(x) == pic_obj_ptr(y);
return obj_ptr(x) == obj_ptr(y);
}
}
@ -76,7 +77,7 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
}
if (pic_pair_p(pic, x) || pic_vec_p(pic, x)) {
int ret;
kh_put(m, h, pic_obj_ptr(x), &ret);
kh_put(m, h, obj_ptr(x), &ret);
if (ret != 0) {
return true; /* `x' was seen already. */
}
@ -88,11 +89,11 @@ internal_equal_p(pic_state *pic, pic_value x, pic_value y, int depth, khash_t(m)
if (pic_eqv_p(pic, x, y)) {
return true;
}
if (pic_type(pic, x) != pic_type(pic, y)) {
if (value_type(pic, x) != value_type(pic, y)) {
return false;
}
switch (pic_type(pic, x)) {
switch (value_type(pic, x)) {
case PIC_TYPE_ID: {
struct identifier *id1, *id2;
pic_value s1, s2;

1
lib/char.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
static pic_value

1
lib/cont.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"

3
lib/data.c
View File

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

1
lib/debug.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"

1
lib/dict.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
KHASH_DEFINE(dict, symbol *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)

3
lib/error.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"
@ -101,7 +102,7 @@ pic_start_try(pic_state *pic, PIC_JMPBUF *jmp)
void
pic_end_try(pic_state *pic, pic_value cookie)
{
struct checkpoint *here = (struct checkpoint *)pic_obj_ptr(pic_car(pic, cookie));
struct checkpoint *here = pic_cp_ptr(pic, pic_car(pic, cookie));
pic_value out = pic_cdr(pic, cookie);
pic->cp = here;

11
lib/ext/eval.c
View File

@ -4,6 +4,7 @@
#include "picrin.h"
#include "picrin/extra.h"
#include "value.h"
#include "object.h"
#include "state.h"
#include "vm.h"
@ -172,7 +173,7 @@ expand_defmacro(pic_state *pic, pic_value expr, pic_value env)
static pic_value
expand_node(pic_state *pic, pic_value expr, pic_value env, pic_value deferred)
{
switch (pic_type(pic, expr)) {
switch (value_type(pic, expr)) {
case PIC_TYPE_ID:
case PIC_TYPE_SYMBOL: {
return expand_var(pic, expr, env, deferred);
@ -497,7 +498,7 @@ analyze_call(pic_state *pic, analyze_scope *scope, pic_value obj)
static pic_value
analyze_node(pic_state *pic, analyze_scope *scope, pic_value obj)
{
switch (pic_type(pic, obj)) {
switch (value_type(pic, obj)) {
case PIC_TYPE_SYMBOL: {
return analyze_var(pic, scope, obj);
}
@ -946,7 +947,7 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
int pidx;
obj = pic_list_ref(pic, obj, 1);
switch (pic_type(pic, obj)) {
switch (value_type(pic, obj)) {
case PIC_TYPE_UNDEF:
emit_n(pic, cxt, OP_PUSHUNDEF);
break;
@ -981,10 +982,10 @@ codegen_quote(pic_state *pic, codegen_context *cxt, pic_value obj, bool tailpos)
emit_i(pic, cxt, OP_PUSHCHAR, pidx);
break;
default:
assert(pic_obj_p(pic,obj));
assert(obj_p(pic,obj));
check_pool_size(pic, cxt);
pidx = (int)cxt->plen++;
cxt->pool[pidx] = pic_obj_ptr(obj);
cxt->pool[pidx] = obj_ptr(obj);
emit_i(pic, cxt, OP_PUSHCONST, pidx);
break;
}

1
lib/ext/lib.c
View File

@ -4,6 +4,7 @@
#include "picrin.h"
#include "picrin/extra.h"
#include "value.h"
#include "object.h"
#include "state.h"

1
lib/ext/read.c
View File

@ -4,6 +4,7 @@
#include "picrin.h"
#include "picrin/extra.h"
#include "value.h"
#include "object.h"
#undef EOF

68
lib/ext/write.c
View File

@ -4,6 +4,7 @@
#include "picrin.h"
#include "picrin/extra.h"
#include "value.h"
#include "object.h"
struct writer_control {
@ -169,7 +170,7 @@ traverse(pic_state *pic, pic_value obj, struct writer_control *p)
return;
}
switch (pic_type(pic, obj)) {
switch (value_type(pic, obj)) {
case PIC_TYPE_PAIR:
case PIC_TYPE_VECTOR:
case PIC_TYPE_DICT: {
@ -217,7 +218,7 @@ static bool
is_shared_object(pic_state *pic, pic_value obj, struct writer_control *p) {
pic_value shared = p->shared;
if (! pic_obj_p(pic, obj)) {
if (! obj_p(pic, obj)) {
return false;
}
if (! pic_weak_has(pic, shared, obj)) {
@ -409,6 +410,65 @@ write_dict(pic_state *pic, pic_value dict, pic_value port, struct writer_control
pic_fprintf(pic, port, ")");
}
static const char *
typename(pic_state *pic, pic_value obj)
{
switch (value_type(pic, obj)) {
case PIC_TYPE_NIL:
return "null";
case PIC_TYPE_TRUE:
case PIC_TYPE_FALSE:
return "boolean";
case PIC_TYPE_FLOAT:
return "float";
case PIC_TYPE_INT:
return "int";
case PIC_TYPE_SYMBOL:
return "symbol";
case PIC_TYPE_CHAR:
return "char";
case PIC_TYPE_EOF:
return "eof-object";
case PIC_TYPE_UNDEF:
return "undefined";
case PIC_TYPE_INVALID:
return "invalid";
case PIC_TYPE_PAIR:
return "pair";
case PIC_TYPE_STRING:
return "string";
case PIC_TYPE_VECTOR:
return "vector";
case PIC_TYPE_BLOB:
return "bytevector";
case PIC_TYPE_PORT:
return "port";
case PIC_TYPE_ERROR:
return "error";
case PIC_TYPE_ID:
return "identifier";
case PIC_TYPE_CXT:
return "context";
case PIC_TYPE_FUNC:
case PIC_TYPE_IREP:
return "procedure";
case PIC_TYPE_ENV:
return "environment";
case PIC_TYPE_DATA:
return "data";
case PIC_TYPE_DICT:
return "dictionary";
case PIC_TYPE_WEAK:
return "ephemeron";
case PIC_TYPE_RECORD:
return "record";
case PIC_TYPE_CP:
return "checkpoint";
default:
pic_error(pic, "typename: invalid type given", 1, obj);
}
}
static void
write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control *p)
{
@ -426,7 +486,7 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
pic_weak_set(pic, labels, obj, pic_int_value(pic, i));
}
switch (pic_type(pic, obj)) {
switch (value_type(pic, obj)) {
case PIC_TYPE_UNDEF:
pic_fprintf(pic, port, "#undefined");
break;
@ -473,7 +533,7 @@ write_core(pic_state *pic, pic_value obj, pic_value port, struct writer_control
write_dict(pic, obj, port, p);
break;
default:
pic_fprintf(pic, port, "#<%s %p>", pic_typename(pic, pic_type(pic, obj)), pic_obj_ptr(obj));
pic_fprintf(pic, port, "#<%s %p>", typename(pic, obj), obj_ptr(obj));
break;
}

19
lib/gc.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"
@ -168,10 +169,10 @@ gc_protect(pic_state *pic, struct object *obj)
pic_value
pic_protect(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
if (! obj_p(pic, v))
return v;
gc_protect(pic, pic_obj_ptr(v));
gc_protect(pic, obj_ptr(v));
return v;
}
@ -305,10 +306,10 @@ static void gc_mark_object(pic_state *, struct object *);
static void
gc_mark(pic_state *pic, pic_value v)
{
if (! pic_obj_p(pic, v))
if (! obj_p(pic, v))
return;
gc_mark_object(pic, pic_obj_ptr(v));
gc_mark_object(pic, obj_ptr(v));
}
static void
@ -326,8 +327,8 @@ gc_mark_object(pic_state *pic, struct object *obj)
switch (obj->u.basic.tt) {
case PIC_TYPE_PAIR: {
gc_mark(pic, obj->u.pair.car);
if (pic_obj_p(pic, obj->u.pair.cdr)) {
LOOP(pic_obj_ptr(obj->u.pair.cdr));
if (obj_p(pic, obj->u.pair.cdr)) {
LOOP(obj_ptr(obj->u.pair.cdr));
}
break;
}
@ -416,8 +417,8 @@ gc_mark_object(pic_state *pic, struct object *obj)
}
case PIC_TYPE_RECORD: {
gc_mark(pic, obj->u.rec.type);
if (pic_obj_p(pic, obj->u.rec.datum)) {
LOOP(pic_obj_ptr(obj->u.rec.datum));
if (obj_p(pic, obj->u.rec.datum)) {
LOOP(obj_ptr(obj->u.rec.datum));
}
break;
}
@ -531,7 +532,7 @@ gc_mark_phase(pic_state *pic)
key = kh_key(h, it);
val = kh_val(h, it);
if (is_marked(pic, key)) {
if (pic_obj_p(pic, val) && ! is_marked(pic, pic_obj_ptr(val))) {
if (obj_p(pic, val) && ! is_marked(pic, obj_ptr(val))) {
gc_mark(pic, val);
++j;
}

355
lib/include/picrin.h
View File

@ -36,80 +36,103 @@ extern "C" {
typedef struct pic_state pic_state;
#if PIC_NAN_BOXING
# include <stdint.h>
typedef uint64_t pic_value;
#else
typedef struct {
unsigned char type;
#if PIC_NAN_BOXING
uint64_t v;
#else
union {
void *data;
double f;
int i;
char c;
} u;
} pic_value;
unsigned char type;
#endif
} pic_value;
/*
* state manipulation
*/
typedef void *(*pic_allocf)(void *userdata, void *ptr, size_t n);
pic_state *pic_open(pic_allocf f, void *userdata);
void pic_close(pic_state *);
void pic_add_feature(pic_state *, const char *feature);
/*
* memory management
*/
void *pic_malloc(pic_state *, size_t);
void *pic_realloc(pic_state *, void *, size_t);
void *pic_calloc(pic_state *, size_t, size_t);
void pic_free(pic_state *, void *);
typedef pic_value (*pic_func_t)(pic_state *);
void *pic_alloca(pic_state *, size_t);
/* for managed area: */
size_t pic_enter(pic_state *);
void pic_leave(pic_state *, size_t);
pic_value pic_protect(pic_state *, pic_value);
void *pic_alloca(pic_state *, size_t);
void pic_gc(pic_state *);
int pic_get_args(pic_state *, const char *fmt, ...);
void pic_defun(pic_state *, const char *name, pic_func_t f);
void pic_defvar(pic_state *, const char *name, pic_value v);
void pic_define(pic_state *, const char *lib, const char *name, pic_value v);
pic_value pic_ref(pic_state *, const char *lib, const char *name);
void pic_set(pic_state *, const char *lib, const char *name, pic_value v);
pic_value pic_closure_ref(pic_state *, int i);
void pic_closure_set(pic_state *, int i, pic_value v);
pic_value pic_funcall(pic_state *, const char *lib, const char *name, int n, ...);
pic_value pic_make_var(pic_state *, pic_value init, pic_value conv);
/*
* comparison
*/
pic_value pic_return(pic_state *, int n, ...);
pic_value pic_vreturn(pic_state *, int n, va_list);
pic_value pic_valuesk(pic_state *, int n, pic_value *retv);
int pic_receive(pic_state *, int n, pic_value *retv);
bool pic_eq_p(pic_state *, pic_value, pic_value);
bool pic_eqv_p(pic_state *, pic_value, pic_value);
bool pic_equal_p(pic_state *, pic_value, pic_value);
void pic_make_library(pic_state *, const char *lib);
void pic_in_library(pic_state *, const char *lib);
bool pic_find_library(pic_state *, const char *lib);
const char *pic_current_library(pic_state *);
void pic_import(pic_state *, const char *lib);
void pic_export(pic_state *, pic_value sym);
typedef void (*pic_panicf)(pic_state *, const char *msg);
/*
* number, boolean, character, string, bytevector, and userdata
*/
pic_panicf pic_atpanic(pic_state *, pic_panicf f);
PIC_NORETURN void pic_panic(pic_state *, const char *msg);
PIC_NORETURN void pic_error(pic_state *, const char *msg, int n, ...);
PIC_NORETURN void pic_raise(pic_state *, pic_value v);
pic_value pic_make_error(pic_state *, const char *type, const char *msg, pic_value irrs);
typedef struct {
const char *type_name;
void (*dtor)(pic_state *, void *);
void (*mark)(pic_state *, void *, void (*)(pic_state *, pic_value));
} pic_data_type;
pic_value pic_lambda(pic_state *, pic_func_t f, int n, ...);
pic_value pic_vlambda(pic_state *, pic_func_t f, int n, va_list);
pic_value pic_call(pic_state *, pic_value proc, int, ...);
pic_value pic_vcall(pic_state *, pic_value proc, int, va_list);
pic_value pic_apply(pic_state *, pic_value proc, int n, pic_value *argv);
pic_value pic_applyk(pic_state *, pic_value proc, int n, pic_value *argv);
typedef struct {
int (*read)(pic_state *, void *, char *, int);
int (*write)(pic_state *, void *, const char *, int);
long (*seek)(pic_state *, void *, long, int);
int (*close)(pic_state *, void *);
} pic_port_type;
typedef pic_value (*pic_func_t)(pic_state *);
#include "value.h"
#include "object.h"
bool pic_undef_p(pic_state *, pic_value); /* deprecated */
bool pic_int_p(pic_state *, pic_value);
bool pic_float_p(pic_state *, pic_value);
bool pic_char_p(pic_state *, pic_value);
bool pic_true_p(pic_state *, pic_value);
bool pic_false_p(pic_state *, pic_value);
bool pic_bool_p(pic_state *, pic_value);
bool pic_str_p(pic_state *, pic_value);
bool pic_blob_p(pic_state *, pic_value);
bool pic_data_p(pic_state *, pic_value, const pic_data_type *);
/* constructors */
pic_value pic_undef_value(pic_state *);
pic_value pic_int_value(pic_state *, int);
pic_value pic_float_value(pic_state *, double);
pic_value pic_char_value(pic_state *, char);
pic_value pic_bool_value(pic_state *, bool);
pic_value pic_true_value(pic_state *);
pic_value pic_false_value(pic_state *);
pic_value pic_str_value(pic_state *, const char *str, int len);
#define pic_cstr_value(pic, cstr) pic_str_value(pic, (cstr), strlen(cstr))
#define pic_lit_value(pic, lit) pic_str_value(pic, "" lit, -((int)sizeof lit - 1))
pic_value pic_strf_value(pic_state *, const char *fmt, ...);
pic_value pic_vstrf_value(pic_state *, const char *fmt, va_list ap);
pic_value pic_blob_value(pic_state *, const unsigned char *buf, int len);
pic_value pic_data_value(pic_state *, void *ptr, const pic_data_type *type);
/* destructors */
int pic_int(pic_state *, pic_value i);
double pic_float(pic_state *, pic_value f);
char pic_char(pic_state *, pic_value c);
@ -118,90 +141,12 @@ const char *pic_str(pic_state *, pic_value str, int *len);
unsigned char *pic_blob(pic_state *, pic_value blob, int *len);
void *pic_data(pic_state *, pic_value data);
typedef struct {
const char *type_name;
void (*dtor)(pic_state *, void *);
void (*mark)(pic_state *, void *, void (*)(pic_state *, pic_value));
} pic_data_type;
pic_value pic_invalid_value(pic_state *);
pic_value pic_undef_value(pic_state *);
pic_value pic_int_value(pic_state *, int);
pic_value pic_float_value(pic_state *, double);
pic_value pic_char_value(pic_state *, char);
pic_value pic_true_value(pic_state *);
pic_value pic_false_value(pic_state *);
#define pic_bool_value(pic, b) ((b) ? pic_true_value(pic) : pic_false_value(pic))
pic_value pic_eof_object(pic_state *);
pic_value pic_str_value(pic_state *, const char *str, int len);
#define pic_cstr_value(pic, cstr) pic_str_value(pic, (cstr), strlen(cstr))
#define pic_lit_value(pic, lit) pic_str_value(pic, "" lit, -((int)sizeof lit - 1))
pic_value pic_strf_value(pic_state *, const char *fmt, ...);
pic_value pic_vstrf_value(pic_state *, const char *fmt, va_list ap);
pic_value pic_blob_value(pic_state *, const unsigned char *buf, int len);
pic_value pic_data_value(pic_state *, void *ptr, const pic_data_type *type);
/*
* pair
*/
enum {
PIC_TYPE_INVALID = 1,
PIC_TYPE_FLOAT = 2,
PIC_TYPE_INT = 3,
PIC_TYPE_CHAR = 4,
PIC_TYPE_EOF = 5,
PIC_TYPE_UNDEF = 6,
PIC_TYPE_TRUE = 8,
PIC_TYPE_NIL = 7,
PIC_TYPE_FALSE = 9,
PIC_IVAL_END = 10,
/* -------------------- */
PIC_TYPE_STRING = 16,
PIC_TYPE_VECTOR = 17,
PIC_TYPE_BLOB = 18,
PIC_TYPE_PORT = 20,
PIC_TYPE_ERROR = 21,
PIC_TYPE_ID = 22,
PIC_TYPE_ENV = 23,
PIC_TYPE_DATA = 24,
PIC_TYPE_DICT = 25,
PIC_TYPE_WEAK = 26,
PIC_TYPE_RECORD = 27,
PIC_TYPE_SYMBOL = 28,
PIC_TYPE_PAIR = 29,
PIC_TYPE_CXT = 30,
PIC_TYPE_CP = 31,
PIC_TYPE_FUNC = 32,
PIC_TYPE_IREP = 33
};
#define pic_invalid_p(pic,v) (pic_type(pic,v) == PIC_TYPE_INVALID)
#define pic_undef_p(pic,v) (pic_type(pic,v) == PIC_TYPE_UNDEF)
#define pic_int_p(pic,v) (pic_type(pic,v) == PIC_TYPE_INT)
#define pic_float_p(pic,v) (pic_type(pic,v) == PIC_TYPE_FLOAT)
#define pic_char_p(pic,v) (pic_type(pic,v) == PIC_TYPE_CHAR)
#define pic_eof_p(pic, v) (pic_type(pic, v) == PIC_TYPE_EOF)
#define pic_bool_p(pic,v) (pic_type(pic,v) == PIC_TYPE_TRUE || pic_type(pic,v) == PIC_TYPE_FALSE)
#define pic_true_p(pic,v) (pic_type(pic,v) == PIC_TYPE_TRUE)
#define pic_false_p(pic,v) (pic_type(pic,v) == PIC_TYPE_FALSE)
#define pic_id_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ID || pic_type(pic, v) == PIC_TYPE_SYMBOL)
#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_FUNC || pic_type(pic, v) == PIC_TYPE_IREP)
#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)
#define pic_dict_p(pic,v) (pic_type(pic,v) == PIC_TYPE_DICT)
#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);
bool pic_eq_p(pic_state *, pic_value, pic_value);
bool pic_eqv_p(pic_state *, pic_value, pic_value);
bool pic_equal_p(pic_state *, pic_value, pic_value);
/* pair */
bool pic_pair_p(pic_state *, pic_value);
pic_value pic_cons(pic_state *, pic_value car, pic_value cdr);
pic_value pic_car(pic_state *, pic_value pair);
pic_value pic_cdr(pic_state *, pic_value pair);
@ -212,9 +157,14 @@ pic_value pic_cadr(pic_state *, pic_value);
pic_value pic_cdar(pic_state *, pic_value);
pic_value pic_cddr(pic_state *, pic_value);
/* list */
pic_value pic_nil_value(pic_state *);
/*
* list
*/
bool pic_nil_p(pic_state *, pic_value);
bool pic_list_p(pic_state *, pic_value);
pic_value pic_nil_value(pic_state *);
pic_value pic_make_list(pic_state *, int n, pic_value *argv);
pic_value pic_list(pic_state *, int n, ...);
pic_value pic_vlist(pic_state *, int n, va_list);
@ -225,13 +175,23 @@ int pic_length(pic_state *, pic_value list);
pic_value pic_reverse(pic_state *, pic_value list);
pic_value pic_append(pic_state *, pic_value xs, pic_value ys);
/* vector */
/*
* vector
*/
bool pic_vec_p(pic_state *, pic_value);
pic_value pic_make_vec(pic_state *, int n, pic_value *argv);
pic_value pic_vec_ref(pic_state *, pic_value vec, int i);
void pic_vec_set(pic_state *, pic_value vec, int i, pic_value v);
int pic_vec_len(pic_state *, pic_value vec);
/* dictionary */
/*
* dictionary
*/
bool pic_dict_p(pic_state *, pic_value);
pic_value pic_make_dict(pic_state *);
pic_value pic_dict_ref(pic_state *, pic_value dict, pic_value key);
void pic_dict_set(pic_state *, pic_value dict, pic_value key, pic_value);
@ -240,21 +200,23 @@ bool pic_dict_has(pic_state *, pic_value dict, pic_value key);
int pic_dict_size(pic_state *, pic_value dict);
bool pic_dict_next(pic_state *, pic_value dict, int *iter, pic_value *key, pic_value *val);
/* ephemeron */
/*
* ephemeron
*/
bool pic_weak_p(pic_state *, pic_value);
pic_value pic_make_weak(pic_state *);
pic_value pic_weak_ref(pic_state *, pic_value weak, pic_value key);
void pic_weak_set(pic_state *, pic_value weak, pic_value key, pic_value val);
void pic_weak_del(pic_state *, pic_value weak, pic_value key);
bool pic_weak_has(pic_state *, pic_value weak, pic_value key);
/* symbol */
pic_value pic_intern(pic_state *, pic_value str);
#define pic_intern_str(pic,s,i) pic_intern(pic, pic_str_value(pic, (s), (i)))
#define pic_intern_cstr(pic,s) pic_intern(pic, pic_cstr_value(pic, (s)))
#define pic_intern_lit(pic,lit) pic_intern(pic, pic_lit_value(pic, lit))
pic_value pic_sym_name(pic_state *, pic_value sym);
/* string */
/*
* string
*/
int pic_str_len(pic_state *, pic_value str);
char pic_str_ref(pic_state *, pic_value str, int i);
pic_value pic_str_cat(pic_state *, pic_value str1, pic_value str2);
@ -263,8 +225,37 @@ int pic_str_cmp(pic_state *, pic_value str1, pic_value str2);
int pic_str_hash(pic_state *, pic_value str);
/*
* symbol
*/
/* External I/O */
bool pic_sym_p(pic_state *, pic_value);
pic_value pic_intern(pic_state *, pic_value str);
#define pic_intern_str(pic,s,i) pic_intern(pic, pic_str_value(pic, (s), (i)))
#define pic_intern_cstr(pic,s) pic_intern(pic, pic_cstr_value(pic, (s)))
#define pic_intern_lit(pic,lit) pic_intern(pic, pic_lit_value(pic, lit))
pic_value pic_sym_name(pic_state *, pic_value sym);
/*
* procedure
*/
bool pic_proc_p(pic_state *, pic_value);
pic_value pic_lambda(pic_state *, pic_func_t f, int n, ...);
pic_value pic_vlambda(pic_state *, pic_func_t f, int n, va_list);
int pic_get_args(pic_state *, const char *fmt, ...);
pic_value pic_closure_ref(pic_state *, int i);
void pic_closure_set(pic_state *, int i, pic_value v);
pic_value pic_call(pic_state *, pic_value proc, int, ...);
pic_value pic_vcall(pic_state *, pic_value proc, int, va_list);
pic_value pic_apply(pic_state *, pic_value proc, int n, pic_value *argv);
pic_value pic_applyk(pic_state *, pic_value proc, int n, pic_value *argv);
/*
* port
*/
#define PIC_SEEK_CUR 0
#define PIC_SEEK_END 1
@ -273,39 +264,105 @@ int pic_str_hash(pic_state *, pic_value str);
#define pic_stdin(pic) pic_funcall(pic, "picrin.base", "current-input-port", 0)
#define pic_stdout(pic) pic_funcall(pic, "picrin.base", "current-output-port", 0)
#define pic_stderr(pic) pic_funcall(pic, "picrin.base", "current-error-port", 0)
pic_value pic_funopen(pic_state *, void *cookie, int (*read)(pic_state *, void *, char *, int), int (*write)(pic_state *, void *, const char *, int), long (*seek)(pic_state *, void *, long, int), int (*close)(pic_state *, void *));
bool pic_eof_p(pic_state *, pic_value);
pic_value pic_eof_object(pic_state *);
bool pic_port_p(pic_state *, pic_value, const pic_port_type *type);
pic_value pic_funopen(pic_state *, void *cookie, const pic_port_type *type);
size_t pic_fread(pic_state *, void *ptr, size_t size, size_t count, pic_value port);
size_t pic_fwrite(pic_state *, const void *ptr, size_t size, size_t count, pic_value port);
long pic_fseek(pic_state *, pic_value port, long offset, int whence);
int pic_fclose(pic_state *, pic_value port);
/* error */
void pic_clearerr(pic_state *, pic_value port);
int pic_feof(pic_state *, pic_value port);
int pic_ferror(pic_state *, pic_value port);
/* basic I/O */
int pic_fputc(pic_state *, int c, pic_value port);
int pic_fgetc(pic_state *, pic_value port);
int pic_fputs(pic_state *, const char *s, pic_value port);
char *pic_fgets(pic_state *, char *s, int size, pic_value port);
int pic_ungetc(pic_state *, int c, pic_value port);
int pic_fflush(pic_state *, pic_value port);
/* formatted output */
int pic_printf(pic_state *, const char *fmt, ...);
int pic_fprintf(pic_state *, pic_value port, const char *fmt, ...);
int pic_vfprintf(pic_state *, pic_value port, const char *fmt, va_list ap);
/* string buffer */
pic_value pic_fmemopen(pic_state *, const char *buf, int len, const char *mode); /* deprecated */
int pic_fgetbuf(pic_state *, pic_value port, const char **buf, int *len); /* deprecated */
/* debug */
void pic_warnf(pic_state *, const char *, ...);
pic_value pic_get_backtrace(pic_state *);
/*
* error handling
*/
typedef void (*pic_panicf)(pic_state *, const char *msg);
pic_panicf pic_atpanic(pic_state *, pic_panicf f);
PIC_NORETURN void pic_panic(pic_state *, const char *msg);
PIC_NORETURN void pic_error(pic_state *, const char *msg, int n, ...);
PIC_NORETURN void pic_raise(pic_state *, pic_value v);
pic_value pic_make_error(pic_state *, const char *type, const char *msg, pic_value irrs); /* deprecated */
pic_value pic_get_backtrace(pic_state *); /* deprecated */
#define pic_try pic_try_(PIC_GENSYM(cont), PIC_GENSYM(jmp))
#define pic_try_(cont, jmp) \
do { \
extern pic_value pic_start_try(pic_state *, PIC_JMPBUF *); \
extern void pic_end_try(pic_state *, pic_value); \
extern pic_value pic_err(pic_state *); \
PIC_JMPBUF jmp; \
if (PIC_SETJMP(pic, jmp) == 0) { \
pic_value pic_try_cookie_ = pic_start_try(pic, &jmp);
#define pic_catch(e) pic_catch_(e, PIC_GENSYM(label))
#define pic_catch_(e, label) \
pic_end_try(pic, pic_try_cookie_); \
} else { \
e = pic_err(pic); \
goto label; \
} \
} while (0); \
if (0) \
label:
/*
* library
*/
/* utility macros */
void pic_make_library(pic_state *, const char *lib);
void pic_in_library(pic_state *, const char *lib);
bool pic_find_library(pic_state *, const char *lib);
const char *pic_current_library(pic_state *);
void pic_import(pic_state *, const char *lib);
void pic_export(pic_state *, pic_value sym);
#define pic_deflibrary(pic, lib) do { \
if (! pic_find_library(pic, lib)) { \
pic_make_library(pic, lib); \
} \
pic_in_library(pic, lib); \
} while (0)
/*
* core language features
*/
void pic_add_feature(pic_state *, const char *feature);
void pic_define(pic_state *, const char *lib, const char *name, pic_value v);
pic_value pic_ref(pic_state *, const char *lib, const char *name);
void pic_set(pic_state *, const char *lib, const char *name, pic_value v);
pic_value pic_make_var(pic_state *, pic_value init, pic_value conv);
void pic_defun(pic_state *, const char *name, pic_func_t f);
void pic_defvar(pic_state *, const char *name, pic_value v);
pic_value pic_funcall(pic_state *, const char *lib, const char *name, int n, ...);
pic_value pic_return(pic_state *, int n, ...);
pic_value pic_vreturn(pic_state *, int n, va_list);
pic_value pic_valuesk(pic_state *, int n, pic_value *retv);
int pic_receive(pic_state *, int n, pic_value *retv);
/*
* utility macros
*/
#define pic_for_each(var, list, it) \
for (it = (list); ! pic_nil_p(pic, it); it = pic_cdr(pic, it)) \

26
lib/include/picrin/extra.h
View File

@ -27,32 +27,6 @@ void pic_load_cstr(pic_state *, const char *);
pic_value pic_fopen(pic_state *, FILE *, const char *mode);
#endif
#define pic_deflibrary(pic, lib) do { \
if (! pic_find_library(pic, lib)) { \
pic_make_library(pic, lib); \
} \
pic_in_library(pic, lib); \
} while (0)
#define pic_try pic_try_(PIC_GENSYM(cont), PIC_GENSYM(jmp))
#define pic_try_(cont, jmp) \
do { \
extern pic_value pic_start_try(pic_state *, PIC_JMPBUF *); \
extern void pic_end_try(pic_state *, pic_value); \
extern pic_value pic_err(pic_state *); \
PIC_JMPBUF jmp; \
if (PIC_SETJMP(pic, jmp) == 0) { \
pic_value pic_try_cookie_ = pic_start_try(pic, &jmp);
#define pic_catch(e) pic_catch_(e, PIC_GENSYM(label))
#define pic_catch_(e, label) \
pic_end_try(pic, pic_try_cookie_); \
} else { \
e = pic_err(pic); \
goto label; \
} \
} while (0); \
if (0) \
label:
/* for debug */

56
lib/include/picrin/setup.h
View File

@ -117,12 +117,32 @@ typedef unsigned long uint32_t;
# define PIC_NORETURN
#endif
/*
* normalize inline keyword; PIC_*_INLINE macros have the same semantics as c99
*/
#if __STDC_VERSION__ >= 199901L
# define PIC_INLINE static inline
# define PIC_STATIC_INLINE static inline
#elif __GNUC__ || __clang__
# define PIC_INLINE static __inline__
# define PIC_STATIC_INLINE static __inline__
#else
# define PIC_INLINE static
# define PIC_STATIC_INLINE static
#endif
#if defined __GNUC__ && !defined __GNUC_STDC_INLINE__ && !defined __GNUC_GNU_INLINE__
# define __GNUC_GNU_INLINE__ 1
#endif
/* PIC_INLINE does not necessarily unify identical definitions */
#if defined __GNUC_GNU_INLINE__
# define PIC_EXTERN_INLINE inline
# define PIC_INLINE extern inline
#elif __STDC_VERSION__ >= 199901L
# define PIC_EXTERN_INLINE extern inline
# define PIC_INLINE inline
#else
# define PIC_EXTERN_INLINE
# define PIC_INLINE static
#endif
#if defined(__cplusplus)
@ -173,25 +193,25 @@ typedef unsigned long uint32_t;
# define assert(v) (void)0
PIC_INLINE int
PIC_STATIC_INLINE int
isspace(int c)
{
return c == ' ' || c == '\t' || c == '\r' || c == '\v' || c == '\f' || c == '\n';
}
PIC_INLINE int
PIC_STATIC_INLINE int
tolower(int c)
{
return ('A' <= c && c <= 'Z') ? c - 'A' + 'a' : c;
}
PIC_INLINE int
PIC_STATIC_INLINE int
isdigit(int c)
{
return '0' <= c && c <= '9';
}
PIC_INLINE char *
PIC_STATIC_INLINE char *
strchr(const char *s, int c)
{
do {
@ -201,7 +221,7 @@ strchr(const char *s, int c)
return NULL;
}
PIC_INLINE size_t
PIC_STATIC_INLINE size_t
strlen(const char *s)
{
size_t l = 0;
@ -212,7 +232,7 @@ strlen(const char *s)
return l;
}
PIC_INLINE int
PIC_STATIC_INLINE int
strcmp(const char *s1, const char *s2)
{
while (*s1 && *s1 == *s2) {
@ -222,7 +242,7 @@ strcmp(const char *s1, const char *s2)
return (unsigned)*s1 - (unsigned)*s2;
}
PIC_INLINE long
PIC_STATIC_INLINE long
strtol(const char *nptr, char **endptr, int base)
{
long l = 0;
@ -252,7 +272,7 @@ strtol(const char *nptr, char **endptr, int base)
return l;
}
PIC_INLINE void *
PIC_STATIC_INLINE void *
memset(void *s, int n, size_t c)
{
char *p = s;
@ -263,7 +283,7 @@ memset(void *s, int n, size_t c)
return s;
}
PIC_INLINE void *
PIC_STATIC_INLINE void *
memcpy(void *dst, const void *src, size_t n)
{
const char *s = src;
@ -275,7 +295,7 @@ memcpy(void *dst, const void *src, size_t n)
return d;
}
PIC_INLINE void *
PIC_STATIC_INLINE void *
memmove(void *dst, const void *src, size_t n)
{
const char *s = src;
@ -293,7 +313,7 @@ memmove(void *dst, const void *src, size_t n)
return d;
}
PIC_INLINE int
PIC_STATIC_INLINE int
memcmp(const void *b1, const void *b2, size_t n)
{
const char *s1 = b1, *s2 = b2;
@ -305,7 +325,7 @@ memcmp(const void *b1, const void *b2, size_t n)
return (unsigned)*s1 - (unsigned)*s2;
}
PIC_INLINE char *
PIC_STATIC_INLINE char *
strcpy(char *dst, const char *src)
{
char *d = dst;
@ -315,7 +335,7 @@ strcpy(char *dst, const char *src)
return d;
}
PIC_INLINE double
PIC_STATIC_INLINE double
atof(const char *nptr)
{
int c;
@ -384,7 +404,7 @@ atof(const char *nptr)
#if PIC_USE_STDIO
# include <stdio.h>
PIC_INLINE void
PIC_STATIC_INLINE void
pic_dtoa(double dval, char *buf)
{
sprintf(buf, "%g", dval);
@ -392,7 +412,7 @@ pic_dtoa(double dval, char *buf)
#else
PIC_INLINE void
PIC_STATIC_INLINE void
pic_dtoa(double dval, char *buf)
{
# define fabs(x) ((x) >= 0 ? (x) : -(x))

2
lib/khash.h
View File

@ -201,7 +201,7 @@
#define kh_ptr_hash_equal(a, b) ((a) == (b))
#define kh_int_hash_func(key) (int)(key)
#define kh_int_hash_equal(a, b) ((a) == (b))
PIC_INLINE int kh_str_hash_func(const char *s) {
PIC_STATIC_INLINE int kh_str_hash_func(const char *s) {
int h = 0;
while (*s) {
h = (h << 5) - h + *s++;

2
lib/number.c
View File

@ -3,6 +3,8 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
static pic_value
pic_number_number_p(pic_state *pic)

66
lib/object.h
View File

@ -145,13 +145,8 @@ struct port {
char *ptr; /* next character position */
char *base; /* location of the buffer */
/* operators */
struct {
void *cookie;
int (*read)(pic_state *, void *, char *, int);
int (*write)(pic_state *, void *, const char *, int);
long (*seek)(pic_state *, void *, long, int);
int (*close)(pic_state *, void *);
} vtable;
void *cookie;
const pic_port_type *vtable;
int flag; /* mode of the file access */
} file;
};
@ -164,31 +159,6 @@ struct checkpoint {
struct checkpoint *prev;
};
struct object *pic_obj_ptr(pic_value);
#define pic_id_ptr(pic, o) (assert(pic_id_p(pic, o)), (struct identifier *)pic_obj_ptr(o))
#define pic_sym_ptr(pic, o) (assert(pic_sym_p(pic, o)), (symbol *)pic_obj_ptr(o))
#define pic_str_ptr(pic, o) (assert(pic_str_p(pic, o)), (struct string *)pic_obj_ptr(o))
#define pic_blob_ptr(pic, o) (assert(pic_blob_p(pic, o)), (struct blob *)pic_obj_ptr(o))
#define pic_pair_ptr(pic, o) (assert(pic_pair_p(pic, o)), (struct pair *)pic_obj_ptr(o))
#define pic_vec_ptr(pic, o) (assert(pic_vec_p(pic, o)), (struct vector *)pic_obj_ptr(o))
#define pic_dict_ptr(pic, o) (assert(pic_dict_p(pic, o)), (struct dict *)pic_obj_ptr(o))
#define pic_weak_ptr(pic, o) (assert(pic_weak_p(pic, o)), (struct weak *)pic_obj_ptr(o))
#define pic_data_ptr(pic, o) (assert(pic_data_p(pic, o, NULL)), (struct data *)pic_obj_ptr(o))
#define pic_proc_ptr(pic, o) (assert(pic_proc_p(pic, o)), (struct proc *)pic_obj_ptr(o))
#define pic_env_ptr(pic, o) (assert(pic_env_p(pic, o)), (struct env *)pic_obj_ptr(o))
#define pic_port_ptr(pic, o) (assert(pic_port_p(pic, o)), (struct port *)pic_obj_ptr(o))
#define pic_error_ptr(pic, o) (assert(pic_error_p(pic, o)), (struct error *)pic_obj_ptr(o))
#define pic_rec_ptr(pic, o) (assert(pic_rec_p(pic, o)), (struct record *)pic_obj_ptr(o))
#define pic_obj_p(pic,v) (pic_type(pic,v) > PIC_IVAL_END)
#define pic_env_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ENV)
#define pic_error_p(pic, v) (pic_type(pic, v) == PIC_TYPE_ERROR)
#define pic_rec_p(pic, v) (pic_type(pic, v) == PIC_TYPE_RECORD)
pic_value pic_obj_value(void *ptr);
struct object *pic_obj_alloc(pic_state *, size_t, int type);
#define TYPENAME_int "integer"
#define TYPENAME_blob "bytevector"
#define TYPENAME_char "character"
@ -218,6 +188,35 @@ struct object *pic_obj_alloc(pic_state *, size_t, int type);
if (tolen - at < e - s) pic_error(pic, "invalid range", 0); \
} while (0)
PIC_STATIC_INLINE struct object *obj_ptr(pic_value); /* defined in value.h */
PIC_STATIC_INLINE int obj_tt(void *ptr) {
return ((struct basic *)ptr)->tt;
}
#define DEFPTR(name,type) \
PIC_STATIC_INLINE type *name(pic_state *PIC_UNUSED(pic), pic_value o) { \
return (type *) obj_ptr(o); \
}
DEFPTR(pic_id_ptr, struct identifier)
DEFPTR(pic_sym_ptr, symbol)
DEFPTR(pic_str_ptr, struct string)
DEFPTR(pic_blob_ptr, struct blob)
DEFPTR(pic_pair_ptr, struct pair)
DEFPTR(pic_vec_ptr, struct vector)
DEFPTR(pic_dict_ptr, struct dict)
DEFPTR(pic_weak_ptr, struct weak)
DEFPTR(pic_data_ptr, struct data)
DEFPTR(pic_proc_ptr, struct proc)
DEFPTR(pic_env_ptr, struct env)
DEFPTR(pic_port_ptr, struct port)
DEFPTR(pic_error_ptr, struct error)
DEFPTR(pic_rec_ptr, struct record)
DEFPTR(pic_cp_ptr, struct checkpoint)
struct object *pic_obj_alloc(pic_state *, size_t, int type);
pic_value pic_make_identifier(pic_state *, pic_value id, pic_value env);
pic_value pic_make_proc(pic_state *, pic_func_t, int, pic_value *);
pic_value pic_make_proc_irep(pic_state *, struct irep *, struct context *);
@ -232,9 +231,6 @@ pic_value pic_id_name(pic_state *, pic_value id);
struct rope *pic_rope_incref(struct rope *);
void pic_rope_decref(pic_state *, struct rope *);
#define pic_func_p(pic, proc) (pic_type(pic, proc) == PIC_TYPE_FUNC)
#define pic_irep_p(pic, proc) (pic_type(pic, proc) == PIC_TYPE_IREP)
struct cont *pic_alloca_cont(pic_state *);
pic_value pic_make_cont(pic_state *, struct cont *);
void pic_save_point(pic_state *, struct cont *, PIC_JMPBUF *);

1
lib/pair.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
pic_value

75
lib/port.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"
@ -10,20 +11,26 @@
# define EOF (-1)
#endif
bool
pic_port_p(pic_state *pic, pic_value obj, const pic_port_type *type)
{
if (value_type(pic, obj) != PIC_TYPE_PORT) {
return false;
}
return type == NULL || pic_port_ptr(pic, obj)->file.vtable == type;
}
pic_value
pic_funopen(pic_state *pic, void *cookie, int (*read)(pic_state *, void *, char *, int), int (*write)(pic_state *, void *, const char *, int), long (*seek)(pic_state *, void *, long, int), int (*close)(pic_state *, void *))
pic_funopen(pic_state *pic, void *cookie, const pic_port_type *type)
{
struct port *port;
port = (struct port *)pic_obj_alloc(pic, sizeof(struct port), PIC_TYPE_PORT);
port->file.cnt = 0;
port->file.base = NULL;
port->file.flag = read? FILE_READ : FILE_WRITE;
port->file.vtable.cookie = cookie;
port->file.vtable.read = read;
port->file.vtable.write = write;
port->file.vtable.seek = seek;
port->file.vtable.close = close;
port->file.flag = type->read ? FILE_READ : FILE_WRITE;
port->file.cookie = cookie;
port->file.vtable = type;
return pic_obj_value(port);
}
@ -39,7 +46,7 @@ pic_fclose(pic_state *pic, pic_value port)
fp->flag = 0;
if (fp->base != fp->buf)
pic_free(pic, fp->base);
return fp->vtable.close(pic, fp->vtable.cookie);
return fp->vtable->close(pic, fp->cookie);
}
void
@ -88,7 +95,7 @@ fillbuf(pic_state *pic, struct file *fp)
bufsize = (fp->flag & FILE_UNBUF) ? sizeof(fp->buf) : PIC_BUFSIZ;
fp->ptr = fp->base;
fp->cnt = fp->vtable.read(pic, fp->vtable.cookie, fp->ptr, bufsize);
fp->cnt = fp->vtable->read(pic, fp->cookie, fp->ptr, bufsize);
if (--fp->cnt < 0) {
if (fp->cnt == -1)
@ -126,7 +133,7 @@ flushbuf(pic_state *pic, int x, struct file *fp)
fp->cnt = 0;
if (x == EOF)
return EOF;
num_written = fp->vtable.write(pic, fp->vtable.cookie, (const char *) &c, 1);
num_written = fp->vtable->write(pic, fp->cookie, (const char *) &c, 1);
bufsize = 1;
} else {
/* buffered write */
@ -137,7 +144,7 @@ flushbuf(pic_state *pic, int x, struct file *fp)
bufsize = (int)(fp->ptr - fp->base);
while(bufsize - num_written > 0) {
int t;
t = fp->vtable.write(pic, fp->vtable.cookie, fp->base + num_written, bufsize - num_written);
t = fp->vtable->write(pic, fp->cookie, fp->base + num_written, bufsize - num_written);
if (t < 0)
break;
num_written += t;
@ -304,7 +311,7 @@ pic_fseek(pic_state *pic, pic_value port, long offset, int whence)
fp->ptr = fp->base;
fp->cnt = 0;
if ((s = fp->vtable.seek(pic, fp->vtable.cookie, offset, whence)) != 0)
if ((s = fp->vtable->seek(pic, fp->cookie, offset, whence)) != 0)
return s;
fp->flag &= ~FILE_EOF;
return 0;
@ -366,12 +373,19 @@ file_close(pic_state *PIC_UNUSED(pic), void *cookie) {
return fclose(cookie);
}
static const pic_port_type file_rd = {
file_read, 0, file_seek, file_close
};
static const pic_port_type file_wr = {
0, file_write, file_seek, file_close
};
pic_value
pic_fopen(pic_state *pic, FILE *fp, const char *mode) {
if (*mode == 'r') {
return pic_funopen(pic, fp, file_read, 0, file_seek, file_close);
return pic_funopen(pic, fp, &file_rd);
} else {
return pic_funopen(pic, fp, 0, file_write, file_seek, file_close);
return pic_funopen(pic, fp, &file_wr);
}
}
@ -397,14 +411,22 @@ null_close(pic_state *PIC_UNUSED(pic), void *PIC_UNUSED(cookie)) {
return 0;
}
static const pic_port_type null_rd = {
null_read, 0, null_seek, null_close
};
static const pic_port_type null_wr = {
0, null_write, null_seek, null_close
};
static pic_value
pic_fopen_null(pic_state *PIC_UNUSED(pic), const char *mode)
{
switch (*mode) {
case 'r':
return pic_funopen(pic, 0, null_read, 0, null_seek, null_close);
return pic_funopen(pic, 0, &null_rd);
default:
return pic_funopen(pic, 0, 0, null_write, null_seek, null_close);
return pic_funopen(pic, 0, &null_wr);
}
}
@ -470,6 +492,13 @@ string_close(pic_state *pic, void *cookie)
return 0;
}
static const pic_port_type string_rd = {
string_read, 0, string_seek, string_close
};
static const pic_port_type string_wr = {
0, string_write, string_seek, string_close
};
pic_value
pic_fmemopen(pic_state *pic, const char *data, int size, const char *mode)
{
@ -483,9 +512,9 @@ pic_fmemopen(pic_state *pic, const char *data, int size, const char *mode)
if (*mode == 'r') {
memcpy(m->buf, data, size);
return pic_funopen(pic, m, string_read, NULL, string_seek, string_close);
return pic_funopen(pic, m, &string_rd);
} else {
return pic_funopen(pic, m, NULL, string_write, string_seek, string_close);
return pic_funopen(pic, m, &string_wr);
}
}
@ -497,10 +526,10 @@ pic_fgetbuf(pic_state *pic, pic_value port, const char **buf, int *len)
pic_fflush(pic, port);
if (fp->vtable.write != string_write) {
if (fp->vtable->write != string_write) {
return -1;
}
s = fp->vtable.cookie;
s = fp->cookie;
*len = s->end;
*buf = s->buf;
return 0;
@ -513,7 +542,7 @@ pic_port_input_port_p(pic_state *pic)
pic_get_args(pic, "o", &v);
if (pic_port_p(pic, v) && (pic_port_ptr(pic, v)->file.flag & FILE_READ) != 0) {
if (pic_port_p(pic, v, NULL) && (pic_port_ptr(pic, v)->file.flag & FILE_READ) != 0) {
return pic_true_value(pic);
} else {
return pic_false_value(pic);
@ -527,7 +556,7 @@ pic_port_output_port_p(pic_state *pic)
pic_get_args(pic, "o", &v);
if (pic_port_p(pic, v) && (pic_port_ptr(pic, v)->file.flag & FILE_WRITE) != 0) {
if (pic_port_p(pic, v, NULL) && (pic_port_ptr(pic, v)->file.flag & FILE_WRITE) != 0) {
return pic_true_value(pic);
}
else {
@ -542,7 +571,7 @@ pic_port_port_p(pic_state *pic)
pic_get_args(pic, "o", &v);
return pic_bool_value(pic, pic_port_p(pic, v));
return pic_bool_value(pic, pic_port_p(pic, v, NULL));
}
static pic_value

8
lib/proc.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"
#include "vm.h"
@ -41,7 +42,6 @@ arg_error(pic_state *pic, int actual, bool varg, int expected)
pic_error(pic, msg, 0);
}
#define MIN(x,y) ((x) < (y) ? (x) : (y))
#define GET_PROC(pic) (pic->ci->fp[0])
#define GET_ARG(pic,n) (pic->ci->fp[(n)+1])
@ -126,7 +126,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
*proc = GET_PROC(pic);
format++; /* skip '&' */
}
for (i = 0; i < MIN(paramc + optc, argc); ++i) {
for (i = 0; i < argc && i < paramc + optc; ++i) {
c = *format++;
if (c == '|') {
@ -189,7 +189,7 @@ pic_get_args(pic_state *pic, const char *format, ...)
e = (c == c2 ? va_arg(ap, bool *) : &dummy); \
\
v = GET_ARG(pic, i); \
switch (pic_type(pic, v)) { \
switch (value_type(pic, v)) { \
case PIC_TYPE_FLOAT: \
*n = pic_float(pic, v); \
*e = false; \
@ -233,7 +233,9 @@ pic_get_args(pic_state *pic, const char *format, ...)
OBJ_CASE('l', proc)
OBJ_CASE('v', vec)
OBJ_CASE('d', dict)
#define pic_port_p(pic,v) pic_port_p(pic,v,NULL)
OBJ_CASE('p', port)
#undef pic_port_p
OBJ_CASE('r', rec)
default:

1
lib/record.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
pic_value

2
lib/state.c
View File

@ -3,7 +3,7 @@
*/
#include "picrin.h"
#include "picrin/extra.h"
#include "value.h"
#include "object.h"
#include "state.h"

1
lib/string.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
struct rope {

1
lib/symbol.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"

261
lib/value.c
View File

@ -1,261 +0,0 @@
/**
* See Copyright Notice in picrin.h
*/
#include "picrin.h"
#include "object.h"
#if PIC_NAN_BOXING
/**
* value representation by nan-boxing:
* float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF
* ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP
* int : 111111111111TTTT 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII
* char : 111111111111TTTT 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC
*/
#define pic_init_value(v,vtype) (v = (0xfff0000000000000ul | ((uint64_t)(vtype) << 48)))
int
pic_vtype(pic_state *PIC_UNUSED(pic), pic_value v)
{
return 0xfff0 >= (v >> 48) ? PIC_TYPE_FLOAT : ((v >> 48) & 0xf);
}
double
pic_float(pic_state *PIC_UNUSED(pic), pic_value v)
{
union { double f; uint64_t i; } u;
u.i = v;
return u.f;
}
int
pic_int(pic_state *PIC_UNUSED(pic), pic_value v)
{
union { int i; unsigned u; } u;
u.u = v & 0xfffffffful;
return u.i;
}
char
pic_char(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v & 0xfffffffful;
}
struct object *
pic_obj_ptr(pic_value v)
{
return (struct object *)(0xfffffffffffful & v);
}
#else
#define pic_init_value(v,vtype) ((v).type = (vtype), (v).u.data = NULL)
int
pic_vtype(pic_state *PIC_UNUSED(pic), pic_value v)
{
return (int)(v.type);
}
double
pic_float(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.u.f;
}
int
pic_int(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.u.i;
}
char
pic_char(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.u.c;
}
struct object *
pic_obj_ptr(pic_value v)
{
return (struct object *)(v.u.data);
}
#endif
#if PIC_NAN_BOXING
pic_value
pic_obj_value(void *ptr)
{
pic_value v;
pic_init_value(v, PIC_IVAL_END);
v |= 0xfffffffffffful & (uint64_t)ptr;
return v;
}
pic_value
pic_float_value(pic_state *PIC_UNUSED(pic), double f)
{
union { double f; uint64_t i; } u;
if (f != f) {
return 0x7ff8000000000000ul;
} else {
u.f = f;
return u.i;
}
}
pic_value
pic_int_value(pic_state *PIC_UNUSED(pic), int i)
{
pic_value v;
pic_init_value(v, PIC_TYPE_INT);
v |= (unsigned)i;
return v;
}
pic_value
pic_char_value(pic_state *PIC_UNUSED(pic), char c)
{
pic_value v;
pic_init_value(v, PIC_TYPE_CHAR);
v |= (unsigned char)c;
return v;
}
#else
pic_value
pic_obj_value(void *ptr)
{
pic_value v;
pic_init_value(v, PIC_IVAL_END);
v.u.data = ptr;
return v;
}
pic_value
pic_float_value(pic_state *PIC_UNUSED(pic), double f)
{
pic_value v;
pic_init_value(v, PIC_TYPE_FLOAT);
v.u.f = f;
return v;
}
pic_value
pic_int_value(pic_state *PIC_UNUSED(pic), int i)
{
pic_value v;
pic_init_value(v, PIC_TYPE_INT);
v.u.i = i;
return v;
}
pic_value
pic_char_value(pic_state *PIC_UNUSED(pic), char c)
{
pic_value v;
pic_init_value(v, PIC_TYPE_CHAR);
v.u.c = c;
return v;
}
#endif
#define DEFVAL(name, type) \
pic_value name(pic_state *PIC_UNUSED(pic)) { \
pic_value v; \
pic_init_value(v, type); \
return v; \
}
DEFVAL(pic_nil_value, PIC_TYPE_NIL)
DEFVAL(pic_eof_object, PIC_TYPE_EOF)
DEFVAL(pic_true_value, PIC_TYPE_TRUE)
DEFVAL(pic_false_value, PIC_TYPE_FALSE)
DEFVAL(pic_undef_value, PIC_TYPE_UNDEF)
DEFVAL(pic_invalid_value, PIC_TYPE_INVALID)
int
pic_type(pic_state *PIC_UNUSED(pic), pic_value v)
{
int tt = pic_vtype(pic, v);
if (tt < PIC_IVAL_END) {
return tt;
}
return ((struct basic *)pic_obj_ptr(v))->tt;
}
const char *
pic_typename(pic_state *pic, int type)
{
switch (type) {
case PIC_TYPE_NIL:
return "null";
case PIC_TYPE_TRUE:
case PIC_TYPE_FALSE:
return "boolean";
case PIC_TYPE_FLOAT:
return "float";
case PIC_TYPE_INT:
return "int";
case PIC_TYPE_SYMBOL:
return "symbol";
case PIC_TYPE_CHAR:
return "char";
case PIC_TYPE_EOF:
return "eof-object";
case PIC_TYPE_UNDEF:
return "undefined";
case PIC_TYPE_INVALID:
return "invalid";
case PIC_TYPE_PAIR:
return "pair";
case PIC_TYPE_STRING:
return "string";
case PIC_TYPE_VECTOR:
return "vector";
case PIC_TYPE_BLOB:
return "bytevector";
case PIC_TYPE_PORT:
return "port";
case PIC_TYPE_ERROR:
return "error";
case PIC_TYPE_ID:
return "identifier";
case PIC_TYPE_CXT:
return "context";
case PIC_TYPE_FUNC:
case PIC_TYPE_IREP:
return "procedure";
case PIC_TYPE_ENV:
return "environment";
case PIC_TYPE_DATA:
return "data";
case PIC_TYPE_DICT:
return "dictionary";
case PIC_TYPE_WEAK:
return "ephemeron";
case PIC_TYPE_RECORD:
return "record";
case PIC_TYPE_CP:
return "checkpoint";
default:
pic_error(pic, "pic_typename: invalid type given", 1, pic_int_value(pic, type));
}
}

305
lib/value.h Normal file
View File

@ -0,0 +1,305 @@
/**
* See Copyright Notice in picrin.h
*/
#ifndef PICRIN_VALUE_H
#define PICRIN_VALUE_H
#if defined(__cplusplus)
extern "C" {
#endif
#ifndef INLINE
# if GENERATE_EXTERNAL_DEFINITION
# define INLINE
# else
# define INLINE
# endif
#endif
#define INLINE PIC_STATIC_INLINE
enum {
PIC_TYPE_INVALID = 1,
PIC_TYPE_FLOAT = 2,
PIC_TYPE_INT = 3,
PIC_TYPE_CHAR = 4,
PIC_TYPE_EOF = 5,
PIC_TYPE_UNDEF = 6,
PIC_TYPE_TRUE = 8,
PIC_TYPE_NIL = 7,
PIC_TYPE_FALSE = 9,
PIC_IVAL_END = 10,
/* -------------------- */
PIC_TYPE_STRING = 16,
PIC_TYPE_VECTOR = 17,
PIC_TYPE_BLOB = 18,
PIC_TYPE_PORT = 20,
PIC_TYPE_ERROR = 21,
PIC_TYPE_ID = 22,
PIC_TYPE_ENV = 23,
PIC_TYPE_DATA = 24,
PIC_TYPE_DICT = 25,
PIC_TYPE_WEAK = 26,
PIC_TYPE_RECORD = 27,
PIC_TYPE_SYMBOL = 28,
PIC_TYPE_PAIR = 29,
PIC_TYPE_CXT = 30,
PIC_TYPE_CP = 31,
PIC_TYPE_FUNC = 32,
PIC_TYPE_IREP = 33
};
PIC_STATIC_INLINE int obj_tt(void *); /* defined in object.h */
#if !PIC_NAN_BOXING
PIC_STATIC_INLINE pic_value
make_value(int type)
{
pic_value v;
v.type = type;
v.u.data = NULL;
return v;
}
PIC_STATIC_INLINE struct object *
obj_ptr(pic_value v)
{
return (struct object *)(v.u.data);
}
PIC_STATIC_INLINE bool
obj_p(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.type > PIC_IVAL_END;
}
PIC_STATIC_INLINE pic_value
pic_obj_value(void *ptr)
{
pic_value v = make_value(obj_tt(ptr));
v.u.data = ptr;
return v;
}
PIC_STATIC_INLINE int
value_type(pic_state *PIC_UNUSED(pic), pic_value v)
{
return (int)(v.type);
}
INLINE int
pic_int(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.u.i;
}
INLINE double
pic_float(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.u.f;
}
INLINE char
pic_char(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.u.c;
}
INLINE pic_value
pic_int_value(pic_state *PIC_UNUSED(pic), int i)
{
pic_value v = make_value(PIC_TYPE_INT);
v.u.i = i;
return v;
}
INLINE pic_value
pic_float_value(pic_state *PIC_UNUSED(pic), double f)
{
pic_value v = make_value(PIC_TYPE_FLOAT);
v.u.f = f;
return v;
}
INLINE pic_value
pic_char_value(pic_state *PIC_UNUSED(pic), char c)
{
pic_value v = make_value(PIC_TYPE_CHAR);
v.u.c = c;
return v;
}
#else /* NAN_BOXING */
/**
* value representation by nan-boxing:
* float : FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF FFFFFFFFFFFFFFFF
* ptr : 111111111111TTTT PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP PPPPPPPPPPPPPPPP
* int : 111111111111TTTT 0000000000000000 IIIIIIIIIIIIIIII IIIIIIIIIIIIIIII
* char : 111111111111TTTT 0000000000000000 CCCCCCCCCCCCCCCC CCCCCCCCCCCCCCCC
*/
PIC_STATIC_INLINE pic_value
make_value(int type)
{
pic_value v;
v.v = 0xfff0000000000000ul | ((uint64_t)(type) << 48);
return v;
}
PIC_STATIC_INLINE struct object *
obj_ptr(pic_value v)
{
return (struct object *)(0xfffffffffffful & v.v);
}
PIC_STATIC_INLINE bool
obj_p(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.v > ((0xfff0ul + (0xf & PIC_IVAL_END)) << 48);
}
PIC_STATIC_INLINE pic_value
pic_obj_value(void *ptr)
{
pic_value v = make_value(PIC_IVAL_END);
v.v |= 0xfffffffffffful & (uint64_t)ptr;
return v;
}
PIC_STATIC_INLINE int
value_type(pic_state *PIC_UNUSED(pic), pic_value v)
{
int tt = 0xfff0 >= (v.v >> 48) ? PIC_TYPE_FLOAT : ((v.v >> 48) & 0xf);
if (tt == PIC_IVAL_END) {
return obj_tt(obj_ptr(v));
}
return tt;
}
INLINE int
pic_int(pic_state *PIC_UNUSED(pic), pic_value v)
{
union { int i; unsigned u; } u;
u.u = v.v & 0xfffffffful;
return u.i;
}
INLINE double
pic_float(pic_state *PIC_UNUSED(pic), pic_value v)
{
union { double f; uint64_t i; } u;
u.i = v.v;
return u.f;
}
INLINE char
pic_char(pic_state *PIC_UNUSED(pic), pic_value v)
{
return v.v & 0xfffffffful;
}
INLINE pic_value
pic_int_value(pic_state *PIC_UNUSED(pic), int i)
{
pic_value v = make_value(PIC_TYPE_INT);
v.v |= (unsigned)i;
return v;
}
INLINE pic_value
pic_float_value(pic_state *PIC_UNUSED(pic), double f)
{
union { double f; uint64_t i; } u;
pic_value v;
if (f != f) {
v.v = 0x7ff8000000000000ul;
} else {
u.f = f;
v.v = u.i;
}
return v;
}
INLINE pic_value
pic_char_value(pic_state *PIC_UNUSED(pic), char c)
{
pic_value v = make_value(PIC_TYPE_CHAR);
v.v |= (unsigned char)c;
return v;
}
#endif /* NAN_BOXING end */
#define DEFVAL(name, type) \
INLINE pic_value name(pic_state *PIC_UNUSED(pic)) { \
return make_value(type); \
}
DEFVAL(pic_nil_value, PIC_TYPE_NIL)
DEFVAL(pic_eof_object, PIC_TYPE_EOF)
DEFVAL(pic_true_value, PIC_TYPE_TRUE)
DEFVAL(pic_false_value, PIC_TYPE_FALSE)
DEFVAL(pic_undef_value, PIC_TYPE_UNDEF)
DEFVAL(pic_invalid_value, PIC_TYPE_INVALID)
INLINE pic_value
pic_bool_value(pic_state *PIC_UNUSED(pic), bool b)
{
return make_value(b ? PIC_TYPE_TRUE : PIC_TYPE_FALSE);
}
#define DEFPRED(name, type) \
INLINE bool name(pic_state *pic, pic_value obj) { \
return value_type(pic, obj) == type; \
}
DEFPRED(pic_invalid_p, PIC_TYPE_INVALID)
DEFPRED(pic_float_p, PIC_TYPE_FLOAT)
DEFPRED(pic_int_p, PIC_TYPE_INT)
DEFPRED(pic_char_p, PIC_TYPE_CHAR)
DEFPRED(pic_eof_p, PIC_TYPE_EOF)
DEFPRED(pic_undef_p, PIC_TYPE_UNDEF)
DEFPRED(pic_true_p, PIC_TYPE_TRUE)
DEFPRED(pic_nil_p, PIC_TYPE_NIL)
DEFPRED(pic_false_p, PIC_TYPE_FALSE)
DEFPRED(pic_str_p, PIC_TYPE_STRING)
DEFPRED(pic_vec_p, PIC_TYPE_VECTOR)
DEFPRED(pic_blob_p, PIC_TYPE_BLOB)
DEFPRED(pic_error_p, PIC_TYPE_ERROR)
DEFPRED(pic_dict_p, PIC_TYPE_DICT)
DEFPRED(pic_weak_p, PIC_TYPE_WEAK)
DEFPRED(pic_env_p, PIC_TYPE_ENV)
DEFPRED(pic_rec_p, PIC_TYPE_RECORD)
DEFPRED(pic_sym_p, PIC_TYPE_SYMBOL)
DEFPRED(pic_pair_p, PIC_TYPE_PAIR)
DEFPRED(pic_cp_p, PIC_TYPE_CP)
DEFPRED(pic_func_p, PIC_TYPE_FUNC)
DEFPRED(pic_irep_p, PIC_TYPE_IREP)
INLINE bool
pic_bool_p(pic_state *pic, pic_value obj)
{
return pic_true_p(pic, obj) || pic_false_p(pic, obj);
}
INLINE bool
pic_proc_p(pic_state *pic, pic_value o)
{
return pic_func_p(pic, o) || pic_irep_p(pic, o);
}
INLINE bool
pic_id_p(pic_state *pic, pic_value o)
{
return value_type(pic, o) == PIC_TYPE_ID || pic_sym_p(pic, o);
}
#if defined(__cplusplus)
}
#endif
#endif

1
lib/var.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
#include "state.h"

1
lib/vector.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
pic_value

11
lib/weak.c
View File

@ -3,6 +3,7 @@
*/
#include "picrin.h"
#include "value.h"
#include "object.h"
KHASH_DEFINE(weak, struct object *, pic_value, kh_ptr_hash_func, kh_ptr_hash_equal)
@ -25,7 +26,7 @@ pic_weak_ref(pic_state *pic, pic_value weak, pic_value key)
khash_t(weak) *h = &pic_weak_ptr(pic, weak)->hash;
int it;
it = kh_get(weak, h, pic_obj_ptr(key));
it = kh_get(weak, h, obj_ptr(key));
if (it == kh_end(h)) {
pic_error(pic, "element not found for given key", 1, key);
}
@ -39,7 +40,7 @@ pic_weak_set(pic_state *pic, pic_value weak, pic_value key, pic_value val)
int ret;
int it;
it = kh_put(weak, h, pic_obj_ptr(key), &ret);
it = kh_put(weak, h, obj_ptr(key), &ret);
kh_val(h, it) = val;
}
@ -48,7 +49,7 @@ pic_weak_has(pic_state *pic, pic_value weak, pic_value key)
{
khash_t(weak) *h = &pic_weak_ptr(pic, weak)->hash;
return kh_get(weak, h, pic_obj_ptr(key)) != kh_end(h);
return kh_get(weak, h, obj_ptr(key)) != kh_end(h);
}
void
@ -57,7 +58,7 @@ pic_weak_del(pic_state *pic, pic_value weak, pic_value key)
khash_t(weak) *h = &pic_weak_ptr(pic, weak)->hash;
int it;
it = kh_get(weak, h, pic_obj_ptr(key));
it = kh_get(weak, h, obj_ptr(key));
if (it == kh_end(h)) {
pic_error(pic, "element not found for given key", 1, key);
}
@ -73,7 +74,7 @@ weak_call(pic_state *pic)
n = pic_get_args(pic, "o|o", &key, &val);
if (! pic_obj_p(pic, key)) {
if (! obj_p(pic, key)) {
pic_error(pic, "attempted to set a non-object key", 1, key);
}