mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 12:20:20 +02:00
Code Activity

Replace eval-case with eval-when

Browse source 
* module/ice-9/boot-9.scm (eval-when): Replace eval-case with eval-when.
  Eval-when is *much* simpler, and more expressive to boot. Perhaps in
  the future we'll get 'visit and 'revisit too.

* module/ice-9/deprecated.scm (eval-case): Provide mostly-working
  deprecated version of eval-case.

* module/ice-9/boot-9.scm (defmacro, define-macro): Relax condition: we
  can make defmacros that are not at the toplevel now. But in the future
  we should replace this implementation of defmacros with one written in
  syntax-case.
  (define-module, use-modules, use-syntax): Allow at non-toplevel.
  (define-public, defmacro-public, export, re-export): Don't evaluate at
  compile-time, I can't see how that helps things. Allow `export' and
  `re-export' at non-toplevel.

* module/ice-9/getopt-long.scm:
* module/ice-9/i18n.scm:
* module/oop/goops.scm:
* module/oop/goops/compile.scm:
* module/oop/goops/dispatch.scm: Switch to use eval-when, not
  eval-case.

* module/language/scheme/compile-ghil.scm (eval-when): Replace eval-case
  transformer with eval-when transformer. Sooooo much simpler, and it
  will get better once we separate expansion from compilation.

* module/language/scheme/expand.scm (quasiquote): Hm, expand quasiquote
  properly. Not hygienic. Syncase needed.
  (lambda): Handle internal defines with docstrings propertly.
This commit is contained in:
Andy Wingo 2009-03-06 13:29:13 +01:00
parent 07e01c4cf9
commit b15dea6857
9 changed files with 104 additions and 147 deletions
Download patch file Download diff file Expand all files Collapse all files

37
module/language/scheme/compile-ghil.scm
View file

@ -351,36 +351,13 @@
(-> (ref (ghil-var-at-module! e modname sym #f)))))
(define *the-compile-toplevel-symbol* 'compile-toplevel)
(define-scheme-translator eval-case
(,clauses
(retrans
`(begin
;; Compilation of toplevel units is always wrapped in a lambda
,@(let ((toplevel? (ghil-toplevel-env? (ghil-env-parent e))))
(let loop ((seen '()) (in clauses) (runtime '()))
(cond
((null? in) runtime)
(else
(pmatch (car in)
((else . ,body)
(if (and toplevel? (not (memq *the-compile-toplevel-symbol* seen)))
(primitive-eval `(begin ,@body)))
(if (memq (if toplevel? *the-compile-toplevel-symbol* 'evaluate) seen)
runtime
body))
((,keys . ,body) (guard (list? keys) (and-map symbol? keys))
(for-each (lambda (k)
(if (memq k seen)
(syntax-error l "eval-case condition seen twice" k)))
keys)
(if (and toplevel? (memq *the-compile-toplevel-symbol* keys))
(primitive-eval `(begin ,@body)))
(loop (append keys seen)
(cdr in)
(if (memq (if toplevel? 'load-toplevel 'evaluate) keys)
(append runtime body)
runtime)))
(else (syntax-error l "bad eval-case clause" (car in))))))))))))
(define-scheme-translator eval-when
((,when . ,body) (guard (list? when) (and-map symbol? when))
(if (memq 'compile when)
(primitive-eval `(begin . ,body)))
(if (memq 'load when)
(retrans `(begin . ,body))
(retrans `(begin)))))
(define-scheme-translator apply
;; FIXME: not hygienic, relies on @apply not being shadowed

6
module/language/scheme/expand.scm
View file

@ -118,7 +118,8 @@
(-> `(,'quasiquote
,(let lp ((x obj) (level 0))
(cond ((not (apair? x)) x)
((memq (acar x) '(,'unquote ,'unquote-splicing))
;; FIXME: hygiene regarding imported , / ,@ rebinding
((memq (acar x) '(unquote unquote-splicing))
(amatch (acdr x)
((,obj)
(cond
@ -264,6 +265,9 @@
(define-scheme-expander lambda
;; (lambda FORMALS BODY...)
((,formals ,docstring ,body1 . ,body) (guard (string? docstring))
(-> `(lambda ,formals ,docstring ,(expand-internal-defines
(map re-expand (cons body1 body))))))
((,formals . ,body)
(-> `(lambda ,formals ,(expand-internal-defines (map re-expand body))))))