mirror of
https://github.com/ashinn/chibi-scheme.git
synced 2025-07-11 15:07:34 +02:00
adding string-contains
This commit is contained in:
parent
60a1b968c0
commit
167c1c3dde
2 changed files with 12 additions and 1 deletions
|
@ -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;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
|
@ -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"))
|
||||||
|
|
Loading…
Add table
Reference in a new issue