Removing old *meta-env* hack - `import' is now copied from (meta) and runs directly without eval.

Syntax may now also be bound with (define-syntax macro1 macro2), and likewise with let-syntax.

eval.c

@@ -746,29 +746,33 @@ static sexp analyze_define (sexp ctx, sexp x) {
 
 static sexp analyze_bind_syntax (sexp ls, sexp eval_ctx, sexp bind_ctx) {
   sexp res = SEXP_VOID, name;
-  sexp_gc_var2(proc, mac);
+  sexp_gc_var1(mac);
-  sexp_gc_preserve2(eval_ctx, proc, mac);
+  sexp_gc_preserve1(eval_ctx, mac);
   for ( ; sexp_pairp(ls); ls=sexp_cdr(ls)) {
     if (! (sexp_pairp(sexp_car(ls)) && sexp_pairp(sexp_cdar(ls))
            && sexp_nullp(sexp_cddar(ls)))) {
       res = sexp_compile_error(eval_ctx, "bad syntax binding", sexp_car(ls));
     } else {
-      proc = sexp_eval(eval_ctx, sexp_cadar(ls), NULL);
+      if (sexp_idp(sexp_cadar(ls)))
-      if (sexp_procedurep(proc)) {
+        mac = sexp_env_ref(sexp_context_env(eval_ctx), sexp_cadar(ls), SEXP_FALSE);
+      else
+        mac = sexp_eval(eval_ctx, sexp_cadar(ls), NULL);
+      if (sexp_procedurep(mac)) {
+        mac = sexp_make_macro(eval_ctx, mac, sexp_context_env(bind_ctx));
+      } else if (!(sexp_macrop(mac)||sexp_corep(mac))) {
+        res = (sexp_exceptionp(mac) ? mac
+               : sexp_compile_error(eval_ctx, "non-procedure macro", mac));
+        break;
+      }
       name = sexp_caar(ls);
       if (sexp_synclop(name) && sexp_env_global_p(sexp_context_env(bind_ctx)))
         name = sexp_synclo_expr(name);
-        mac = sexp_make_macro(eval_ctx, proc, sexp_context_env(bind_ctx));
+      if (sexp_macrop(mac) && sexp_pairp(sexp_cadar(ls)))
         sexp_macro_source(mac) = sexp_pair_source(sexp_cadar(ls));
       sexp_env_define(eval_ctx, sexp_context_env(bind_ctx), name, mac);
-      } else {
-        res = (sexp_exceptionp(proc) ? proc
-               : sexp_compile_error(eval_ctx, "non-procedure macro:", proc));
-        break;
     }
   }
-  }
+  sexp_gc_release1(eval_ctx);
-  sexp_gc_release2(eval_ctx);
   return res;
 }
 
@@ -1954,7 +1958,6 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
   /* load and bind config env */
 #if SEXP_USE_MODULES
   if (!sexp_exceptionp(tmp)) {
-    sym = sexp_intern(ctx, "*meta-env*", -1);
     if (!sexp_envp(tmp=sexp_global(ctx, SEXP_G_META_ENV))) {
       tmp = sexp_make_env(ctx);
       if (! sexp_exceptionp(tmp)) {
@@ -1963,11 +1966,15 @@ sexp sexp_load_standard_env (sexp ctx, sexp e, sexp version) {
         op = sexp_load_module_file(ctx, sexp_meta_file, tmp);
         if (sexp_exceptionp(op))
           sexp_print_exception(ctx, op, sexp_current_error_port(ctx));
-        sexp_env_define(ctx, tmp, sym, tmp);
       }
     }
+    if (!sexp_exceptionp(tmp)) {
+      sym = sexp_intern(ctx, "repl-import", -1);
+      tmp = sexp_env_ref(tmp, sym, SEXP_VOID);
+      sym = sexp_intern(ctx, "import", -1);
       sexp_env_define(ctx, e, sym, tmp);
     }
+  }
 #endif
   sexp_gc_release3(ctx);
   return sexp_exceptionp(tmp) ? tmp : e;

lib/chibi/repl.scm

@@ -77,9 +77,7 @@
          (module (cond ((memq 'module: o) => cadr) (else #f)))
          (env (if module
                   (module-env
-                   (if (module? module)
+                   (if (module? module) module (load-module module)))
-                       module
-                       (eval `(load-module ',module) *meta-env*)))
                   (interaction-environment)))
          (history-file
           (cond ((memq 'history-file: o) => cadr)
@@ -95,7 +93,7 @@
          (raw? (cond ((memq 'raw?: o) => cadr)
                      (else (member (get-environment-variable "TERM")
                                    '("emacs" "dumb"))))))
-    (let lp ((module module) (env env) (meta-env *meta-env*))
+    (let lp ((module module) (env env) (meta-env (load-module '(meta))))
       (let* ((prompt
               (string-append (if module (write-to-string module) "") "> "))
              (line

lib/chibi/repl.sld

@@ -1,7 +1,7 @@
 
 (define-library (chibi repl)
   (export repl)
-  (import (scheme)
+  (import (scheme) (only (meta) load-module)
           (chibi ast) (chibi io) (chibi process) (chibi term edit-line)
           (srfi 18) (srfi 38) (srfi 98))
   (include "repl.scm"))

lib/init-7.scm

@@ -846,32 +846,6 @@
     ((guard (var (test . handler) ...) body ...)
      (guard (var (test . handler) ... (else (raise var))) body ...))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; modules
-
-(define *meta-env* #f)
-
-(define-syntax import
-  (er-macro-transformer
-   (lambda (expr rename compare)
-     (let lp ((ls (cdr expr)) (res '()))
-       (cond
-        ((null? ls)
-         (cons 'begin (reverse res)))
-        (else
-         (let ((mod+imps (eval `(resolve-import ',(car ls)) *meta-env*)))
-           (if (pair? mod+imps)
-               (lp (cdr ls)
-                   (cons `(%import
-                           #f
-                           (vector-ref
-                            (eval '(load-module ',(car mod+imps)) *meta-env*)
-                            1)
-                           ',(cdr mod+imps)
-                           #f)
-                         res))
-               (error "couldn't find module" (car ls))))))))))
-
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; SRFI-0
 

lib/meta.scm

@@ -31,10 +31,12 @@
 (define (module-name-prefix name)
   (string-concatenate (reverse (cdr (cdr (module-name->strings name '()))))))
 
-(define (load-module-definition name)
+(define load-module-definition
+  (let ((meta-env (current-environment)))
+    (lambda (name)
       (let* ((file (module-name->file name))
              (path (find-module-file file)))
-    (if path (load path *meta-env*))))
+        (if path (load path meta-env))))))
 
 (define (find-module name)
   (cond
@@ -154,8 +156,11 @@
   (er-macro-transformer
    (lambda (expr rename compare)
      (let ((name (cadr expr))
-           (body (cddr expr)))
+           (body (cddr expr))
-       `(let ((tmp *this-module*))
+           (tmp (rename 'tmp))
+           (this-module (rename '*this-module*))
+           (modules (rename '*modules*)))
+       `(let ((,tmp ,this-module))
           (define (rewrite-export x)
             (if (pair? x)
                 (if (and (= 3 (length x))
@@ -163,17 +168,17 @@
                     (cons (caddr x) (cadr x))
                     (error "invalid module export" x))
                 x))
-          (set! *this-module* '())
+          (set! ,this-module '())
           ,@body
-          (set! *this-module* (reverse *this-module*))
+          (set! ,this-module (reverse ,this-module))
           (let ((exports
-                 (cond ((assq 'export *this-module*)
+                 (cond ((assq 'export ,this-module)
                         => (lambda (x) (map rewrite-export (cdr x))))
                        (else '()))))
-            (set! *modules*
+            (set! ,modules
-                  (cons (cons ',name (make-module exports #f *this-module*))
+                  (cons (cons ',name (make-module exports #f ,this-module))
-                        *modules*)))
+                        ,modules)))
-          (set! *this-module* tmp))))))
+          (set! ,this-module ,tmp))))))
 
 (define-syntax define-library define-library-transformer)
 (define-syntax module define-library-transformer)
@@ -184,8 +189,10 @@
      `(define-syntax ,(cadr expr)
         (er-macro-transformer
          (lambda (expr rename compare)
-           `(set! *this-module* (cons ',expr *this-module*))))))))
+           (let ((this-module (rename '*this-module*)))
+             `(set! ,this-module (cons ',expr ,this-module)))))))))
 
+(define-syntax orig-begin begin)
 (define-config-primitive import)
 (define-config-primitive import-immutable)
 (define-config-primitive export)
@@ -195,6 +202,30 @@
 (define-config-primitive body)
 (define-config-primitive begin)
 
+;; The `import' binding used by (scheme) and (scheme base), etc.
+(define-syntax repl-import
+  (er-macro-transformer
+   (let ((meta-env (current-environment)))
+     (lambda (expr rename compare)
+       (let lp ((ls (cdr expr)) (res '()))
+         (cond
+          ((null? ls)
+           (cons (rename 'orig-begin) (reverse res)))
+          (else
+           (let ((mod+imps (resolve-import (car ls))))
+             (cond
+              ((pair? mod+imps)
+               (lp (cdr ls)
+                   (cons `(,(rename '%import)
+                           #f
+                           (,(rename 'module-env)
+                            (,(rename 'load-module) ',(car mod+imps)))
+                           ',(cdr mod+imps)
+                           #f)
+                         res)))
+              (else
+               (error "couldn't find module" (car ls))))))))))))
+
 (define *modules*
   (list (cons '(scheme) (make-module #f (interaction-environment)
                                      '((include "init.scm"))))