From bd76c6d3ea5b61e4481072e09f9f59ed5003fe70 Mon Sep 17 00:00:00 2001 From: Andy Wingo Date: Thu, 15 May 2008 11:17:00 +0200 Subject: [PATCH] allow interpretation of load-toplevel as compile-toplevel * module/language/scheme/translate.scm (*the-compile-toplevel-symbol*) (primitive-syntax-table): Existing eval-case invocations in boot-9.scm only have `load-toplevel', not `load-toplevel' and `compile-toplevel' as they should. Allow for interpreting `load-toplevel' as `compile-toplevel'. --- module/language/scheme/translate.scm | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/module/language/scheme/translate.scm b/module/language/scheme/translate.scm index 1da175410..11a9f9e9b 100644 --- a/module/language/scheme/translate.scm +++ b/module/language/scheme/translate.scm @@ -113,6 +113,8 @@ (else (syntax-error ,loc (format #f "bad ~A" ',sym) ,exp))))))) `(list ,@(map make1 body))) +(define *the-compile-toplevel-symbol* 'load-toplevel) + (define primitive-syntax-table (make-pmatch-transformers e l retrans @@ -257,9 +259,9 @@ (else (pmatch (car in) ((else . ,body) - (if (and toplevel? (not (memq 'compile-toplevel seen))) + (if (and toplevel? (not (memq *the-compile-toplevel-symbol* seen))) (primitive-eval `(begin ,@body))) - (if (memq (if toplevel? 'load-toplevel 'evaluate) seen) + (if (memq (if toplevel? *the-compile-toplevel-symbol* 'evaluate) seen) runtime body)) ((,keys . ,body) (guard (list? keys) (and-map symbol? keys)) @@ -267,7 +269,7 @@ (if (memq k seen) (syntax-error l "eval-case condition seen twice" k))) keys) - (if (and toplevel? (memq 'compile-toplevel keys)) + (if (and toplevel? (memq *the-compile-toplevel-symbol* keys)) (primitive-eval `(begin ,@body))) (loop (append keys seen) (cdr in) -- 2.20.1