* 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'.
(else (syntax-error ,loc (format #f "bad ~A" ',sym) ,exp)))))))
`(list ,@(map make1 body)))
(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
(define primitive-syntax-table
(make-pmatch-transformers
e l retrans
(else
(pmatch (car in)
((else . ,body)
(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)))
(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))
runtime
body))
((,keys . ,body) (guard (list? keys) (and-map symbol? keys))
(if (memq k seen)
(syntax-error l "eval-case condition seen twice" k)))
keys)
(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)
(primitive-eval `(begin ,@body)))
(loop (append keys seen)
(cdr in)