Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 05:39:18 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding object->integer utility

Browse source
This commit is contained in:
Alex Shinn 2015-07-22 23:10:14 +09:00
parent b9b222b2b3
commit 1313daaf15
2 changed files with 9 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
lib/chibi/ast.c
View file

@ -298,11 +298,15 @@ static sexp sexp_object_size (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
static sexp sexp_integer_to_immediate (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp dflt) { static sexp sexp_integer_to_immediate (sexp ctx, sexp self, sexp_sint_t n, sexp i, sexp dflt) {
sexp x = (sexp)sexp_unbox_fixnum(i); sexp x = (sexp)sexp_unbox_fixnum(i);
sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i); sexp_assert_type(ctx, sexp_fixnump, SEXP_FIXNUM, i);
if (sexp_pointerp(x)) if (!x || sexp_pointerp(x))
return dflt; return dflt;
return x; return x;
} }
static sexp sexp_object_to_integer (sexp ctx, sexp self, sexp_sint_t n, sexp x) {
return sexp_make_integer(ctx, (sexp_uint_t)x);
}
static sexp sexp_make_lambda_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp params, sexp body, sexp locals) { static sexp sexp_make_lambda_op (sexp ctx, sexp self, sexp_sint_t n, sexp name, sexp params, sexp body, sexp locals) {
sexp res = sexp_alloc_type(ctx, lambda, SEXP_LAMBDA); sexp res = sexp_alloc_type(ctx, lambda, SEXP_LAMBDA);
sexp_lambda_name(res) = name; sexp_lambda_name(res) = name;
@ -559,6 +563,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_type(ctx, "Lam", SEXP_LAMBDA); sexp_define_type(ctx, "Lam", SEXP_LAMBDA);
sexp_define_type(ctx, "Cnd", SEXP_CND); sexp_define_type(ctx, "Cnd", SEXP_CND);
sexp_define_type(ctx, "Set", SEXP_SET); sexp_define_type(ctx, "Set", SEXP_SET);
sexp_define_type(ctx, "Set-Syn", SEXP_SET_SYN);
sexp_define_type(ctx, "Ref", SEXP_REF); sexp_define_type(ctx, "Ref", SEXP_REF);
sexp_define_type(ctx, "Seq", SEXP_SEQ); sexp_define_type(ctx, "Seq", SEXP_SEQ);
sexp_define_type(ctx, "Lit", SEXP_LIT); sexp_define_type(ctx, "Lit", SEXP_LIT);
@ -654,6 +659,7 @@ sexp sexp_init_library (sexp ctx, sexp self, sexp_sint_t n, sexp env, const char
sexp_define_foreign(ctx, env, "core-code", 1, sexp_core_code_op); sexp_define_foreign(ctx, env, "core-code", 1, sexp_core_code_op);
sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size); sexp_define_foreign(ctx, env, "object-size", 1, sexp_object_size);
sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE); sexp_define_foreign_opt(ctx, env, "integer->immediate", 2, sexp_integer_to_immediate, SEXP_FALSE);
sexp_define_foreign_opt(ctx, env, "object->integer", 1, sexp_object_to_integer, SEXP_FALSE);
sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op); sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);
sexp_define_foreign(ctx, env, "gc-count", 0, sexp_gc_count_op); sexp_define_foreign(ctx, env, "gc-count", 0, sexp_gc_count_op);
sexp_define_foreign(ctx, env, "gc-usecs", 0, sexp_gc_usecs_op); sexp_define_foreign(ctx, env, "gc-usecs", 0, sexp_gc_usecs_op);

4
lib/chibi/ast.sld
View file

@ -5,7 +5,7 @@
Object Input-Port Output-Port Opcode Procedure Bytecode Macro Env Object Input-Port Output-Port Opcode Procedure Bytecode Macro Env
Number Bignum Flonum Integer Complex Char Boolean Number Bignum Flonum Integer Complex Char Boolean
Symbol String Byte-Vector Vector Pair File-Descriptor Symbol String Byte-Vector Vector Pair File-Descriptor
Context Lam Cnd Set Ref Seq Lit Sc Exception Core Context Lam Cnd Set Set-Syn Ref Seq Lit Sc Exception Core
syntactic-closure? lambda? cnd? set? ref? seq? lit? type? core? syntactic-closure? lambda? cnd? set? ref? seq? lit? type? core?
environment? bytecode? exception? macro? context? file-descriptor? environment? bytecode? exception? macro? context? file-descriptor?
syntactic-closure-expr syntactic-closure-env syntactic-closure-vars syntactic-closure-expr syntactic-closure-env syntactic-closure-vars
@ -34,7 +34,7 @@
extend-env env-parent env-parent-set! env-lambda env-lambda-set! extend-env env-parent env-parent-set! env-lambda env-lambda-set!
env-define! env-push! env-syntactic? env-syntactic?-set! core-code env-define! env-push! env-syntactic? env-syntactic?-set! core-code
type-name type-cpl type-parent type-slots type-num-slots type-printer type-name type-cpl type-parent type-slots type-num-slots type-printer
object-size integer->immediate gc gc-usecs gc-count object-size object->integer integer->immediate gc gc-usecs gc-count
atomically thread-list abort atomically thread-list abort
string-contains string-cursor-copy! errno integer->error-string string-contains string-cursor-copy! errno integer->error-string
flatten-dot update-free-vars! setenv unsetenv safe-setenv) flatten-dot update-free-vars! setenv unsetenv safe-setenv)