mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-06 07:30:28 +02:00
Code Activity

Moved up the eval-case section.

Browse source
This commit is contained in:
Keisuke Nishida 2001-04-14 12:29:54 +00:00
parent c4d0cddd4c
commit a54e6fa326
1 changed files with 34 additions and 34 deletions
Download patch file Download diff file Expand all files Collapse all files

68
ice-9/boot-9.scm
View file

@ -1954,6 +1954,40 @@
;; {EVAL-CASE}
;;
;; (eval-case ((situation*) forms)* (else forms)?)
;;
;; Evaluate certain code based on the situation that eval-case is used
;; in. The only defined situation right now is `load-toplevel' which
;; triggers for code evaluated at the top-level, for example from the
;; REPL or when loading a file.
(define eval-case
(procedure->memoizing-macro
(lambda (exp env)
(define (toplevel-env? env)
(or (not (pair? env)) (not (pair? (car env)))))
(define (syntax)
(error "syntax error in eval-case"))
(let loop ((clauses (cdr exp)))
(cond
((null? clauses)
#f)
((not (list? (car clauses)))
(syntax))
((eq? 'else (caar clauses))
(or (null? (cdr clauses))
(syntax))
(cons 'begin (cdar clauses)))
((not (list? (caar clauses)))
(syntax))
((and (toplevel-env? env)
(memq 'load-toplevel (caar clauses)))
(cons 'begin (cdar clauses)))
(else
(loop (cdr clauses))))))))
;;; {Macros}
@ -2537,40 +2571,6 @@
`(lambda ,(cdr first) ,@rest))))
`(define ,name (defmacro:syntax-transformer ,transformer))))
;; EVAL-CASE
;;
;; (eval-case ((situation*) forms)* (else forms)?)
;;
;; Evaluate certain code based on the situation that eval-case is used
;; in. The only defined situation right now is `load-toplevel' which
;; triggers for code evaluated at the top-level, for example from the
;; REPL or when loading a file.
(define eval-case
(procedure->memoizing-macro
(lambda (exp env)
(define (toplevel-env? env)
(or (not (pair? env)) (not (pair? (car env)))))
(define (syntax)
(error "syntax error in eval-case"))
(let loop ((clauses (cdr exp)))
(cond
((null? clauses)
#f)
((not (list? (car clauses)))
(syntax))
((eq? 'else (caar clauses))
(or (null? (cdr clauses))
(syntax))
(cons 'begin (cdar clauses)))
((not (list? (caar clauses)))
(syntax))
((and (toplevel-env? env)
(memq 'load-toplevel (caar clauses)))
(cons 'begin (cdar clauses)))
(else
(loop (cdr clauses))))))))
;;; {Module System Macros}
;;;