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

Making sexp_make_primitive_env available from Scheme.

Browse source 
Adding the (chibi primitive) module to access this directly.
This commit is contained in:
Alex Shinn 2013-09-29 11:05:54 +09:00
parent eb4adcc9dd
commit 86d9957ae9
4 changed files with 59 additions and 47 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
eval.c
View file

@ -1976,7 +1976,7 @@ sexp sexp_make_null_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp version) {
return e; return e;
} }
sexp sexp_make_primitive_env (sexp ctx, sexp version) { sexp sexp_make_primitive_env_op (sexp ctx, sexp self, sexp_sint_t n, sexp version) {
int i; int i;
sexp_gc_var4(e, op, sym, name); sexp_gc_var4(e, op, sym, name);
sexp_gc_preserve4(ctx, e, op, sym, name); sexp_gc_preserve4(ctx, e, op, sym, name);

5
include/chibi/eval.h
View file

@ -89,7 +89,7 @@ SEXP_API sexp sexp_exception_type_op (sexp ctx, sexp self, sexp_sint_t n, sexp e
SEXP_API sexp sexp_make_env_op (sexp context, sexp self, sexp_sint_t n); SEXP_API sexp sexp_make_env_op (sexp context, sexp self, sexp_sint_t n);
SEXP_API sexp sexp_make_null_env_op (sexp context, sexp self, sexp_sint_t n, sexp version); SEXP_API sexp sexp_make_null_env_op (sexp context, sexp self, sexp_sint_t n, sexp version);
SEXP_API sexp sexp_env_cell_define (sexp ctx, sexp env, sexp name, sexp value, sexp* varenv); SEXP_API sexp sexp_env_cell_define (sexp ctx, sexp env, sexp name, sexp value, sexp* varenv);
SEXP_API sexp sexp_make_primitive_env (sexp context, sexp version); SEXP_API sexp sexp_make_primitive_env_op (sexp context, sexp self, sexp_sint_t n, sexp version);
SEXP_API sexp sexp_make_standard_env_op (sexp context, sexp self, sexp_sint_t n, sexp version); SEXP_API sexp sexp_make_standard_env_op (sexp context, sexp self, sexp_sint_t n, sexp version);
SEXP_API void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value); SEXP_API void sexp_set_parameter (sexp ctx, sexp env, sexp name, sexp value);
SEXP_API sexp sexp_load_standard_ports (sexp context, sexp env, FILE* in, FILE* out, FILE* err, int no_close); SEXP_API sexp sexp_load_standard_ports (sexp context, sexp env, FILE* in, FILE* out, FILE* err, int no_close);
@ -240,7 +240,8 @@ SEXP_API int sexp_rest_unused_p (sexp lambda);
#define sexp_make_procedure(ctx, f, n, b, v) sexp_make_procedure_op(ctx, NULL, 4, f, n, b, v) #define sexp_make_procedure(ctx, f, n, b, v) sexp_make_procedure_op(ctx, NULL, 4, f, n, b, v)
#define sexp_make_env(ctx) sexp_make_env_op(ctx, NULL, 0) #define sexp_make_env(ctx) sexp_make_env_op(ctx, NULL, 0)
#define sexp_make_null_env(ctx, v) sexp_make_null_env_op(ctx, NULL, 0, v) #define sexp_make_null_env(ctx, v) sexp_make_null_env_op(ctx, NULL, 0, v)
#define sexp_make_standard_env(ctx) sexp_make_standard_env_op(ctx, NULL, 0) #define sexp_make_primitive_env(ctx, v) sexp_make_primitive_env_op(ctx, NULL, 1, v)
#define sexp_make_standard_env(ctx, v) sexp_make_standard_env_op(ctx, NULL, 1, v)
#define sexp_add_module_directory(ctx, d, a) sexp_add_module_directory_op(ctx, NULL, 1, d, a) #define sexp_add_module_directory(ctx, d, a) sexp_add_module_directory_op(ctx, NULL, 1, d, a)
#define sexp_eval(ctx, x, e) sexp_eval_op(ctx, NULL, 2, x, e) #define sexp_eval(ctx, x, e) sexp_eval_op(ctx, NULL, 2, x, e)
#define sexp_load(ctx, f, e) sexp_load_op(ctx, NULL, 2, f, e) #define sexp_load(ctx, f, e) sexp_load_op(ctx, NULL, 2, f, e)

22
lib/meta.scm
View file

@ -153,6 +153,10 @@
(else (error "couldn't find include" f))))) (else (error "couldn't find include" f)))))
files)) files))
;; catch cyclic references ;; catch cyclic references
(cond
((procedure? meta)
(meta env))
(else
(module-meta-data-set! (module-meta-data-set!
mod mod
`((error "module attempted to reference itself while loading" ,name))) `((error "module attempted to reference itself while loading" ,name)))
@ -192,7 +196,7 @@
meta)) meta))
(module-meta-data-set! mod meta) (module-meta-data-set! mod meta)
(warn-undefs env #f) (warn-undefs env #f)
env)) env))))
(define (environment . ls) (define (environment . ls)
(let ((env (make-environment))) (let ((env (make-environment)))
@ -310,10 +314,16 @@
(error "couldn't find module" (car ls)))))))))))) (error "couldn't find module" (car ls))))))))))))
(define *modules* (define *modules*
(list (cons '(chibi) (make-module #f (interaction-environment) (list
'((include "init-7.scm")))) (cons '(chibi)
(cons '(scheme) (make-module #f (interaction-environment) '())) (make-module #f (interaction-environment) '((include "init-7.scm"))))
(cons '(meta) (make-module #f (current-environment) '())) (cons '(chibi primitive)
(cons '(srfi 0) (make-module (list 'cond-expand) (make-module #f #f (lambda (env) (primitive-environment 7))))
(cons '(scheme)
(make-module #f (interaction-environment) '()))
(cons '(meta)
(make-module #f (current-environment) '()))
(cons '(srfi 0)
(make-module (list 'cond-expand)
(current-environment) (current-environment)
(list (list 'export 'cond-expand)))))) (list (list 'export 'cond-expand))))))

1
opcodes.c
View file

@ -166,6 +166,7 @@ _FN1(SEXP_VOID, _I(SEXP_IPORT), "close-input-port", 0, sexp_close_port_op),
_FN1(SEXP_VOID, _I(SEXP_OPORT), "close-output-port", 0, sexp_close_port_op), _FN1(SEXP_VOID, _I(SEXP_OPORT), "close-output-port", 0, sexp_close_port_op),
_FN0(_I(SEXP_ENV), "make-environment", 0, sexp_make_env_op), _FN0(_I(SEXP_ENV), "make-environment", 0, sexp_make_env_op),
_FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "null-environment", 0, sexp_make_null_env_op),
_FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "primitive-environment", 0, sexp_make_primitive_env_op),
_FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op), _FN1(_I(SEXP_ENV), _I(SEXP_FIXNUM), "scheme-report-environment", 0, sexp_make_standard_env_op),
_FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op), _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "compile", (sexp)"interaction-environment", sexp_compile_op),
_FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "generate", (sexp)"interaction-environment", sexp_generate_op), _FN2OPTP(_I(SEXP_OBJECT), _I(SEXP_OBJECT), _I(SEXP_ENV), "generate", (sexp)"interaction-environment", sexp_generate_op),