Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-11 06:57:33 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding string-contains

Browse source
This commit is contained in:
Alex Shinn 2011-04-05 01:09:04 +09:00
parent 60a1b968c0
commit 167c1c3dde
2 changed files with 12 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
lib/chibi/ast.c
View file

@ -203,6 +203,15 @@ static sexp sexp_gc_op (sexp ctx sexp_api_params(self, n)) {
return sexp_make_unsigned_integer(ctx, sum_freed); return sexp_make_unsigned_integer(ctx, sum_freed);
} }
static sexp sexp_string_contains (sexp ctx sexp_api_params(self, n), sexp x, sexp y) {
const char *res;
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, x);
sexp_assert_type(ctx, sexp_stringp, SEXP_STRING, y);
res = strstr(sexp_string_data(x), sexp_string_data(y));
return res ? sexp_make_fixnum(res-sexp_string_data(x)) : SEXP_FALSE;
}
#define sexp_define_type(ctx, name, tag) \ #define sexp_define_type(ctx, name, tag) \
sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag)); sexp_env_define(ctx, env, sexp_intern(ctx, name, -1), sexp_type_by_index(ctx, tag));
@ -295,6 +304,7 @@ sexp sexp_init_library (sexp ctx sexp_api_params(self, n), sexp env) {
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(ctx, env, "gc", 0, sexp_gc_op); sexp_define_foreign(ctx, env, "gc", 0, sexp_gc_op);
sexp_define_foreign(ctx, env, "string-contains", 2, sexp_string_contains);
return SEXP_VOID; return SEXP_VOID;
} }

3
lib/chibi/ast.module
View file

@ -29,7 +29,8 @@
procedure-code procedure-vars procedure-name procedure-code procedure-vars procedure-name
bytecode-name bytecode-literals bytecode-name bytecode-literals
type? type-name type-cpl type-parent type-slots type? type-name type-cpl type-parent type-slots
object-size integer->immediate gc) object-size integer->immediate gc
string-contains)
(import-immutable (scheme)) (import-immutable (scheme))
(include-shared "ast") (include-shared "ast")
(include "ast.scm")) (include "ast.scm"))