mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

allow interpretation of load-toplevel as compile-toplevel

Browse source 
* 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'.
This commit is contained in:
Andy Wingo 2008-05-15 11:17:00 +02:00
parent e009240547
commit bd76c6d3ea
1 changed files with 5 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

8
module/language/scheme/translate.scm
View file

@ -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)