mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-04-30 20:00:19 +02:00
Code Activity

(void) -> (begin)

Browse source 
* module/language/scheme/translate.scm (expand-macro, trans-pair): Remove
  support for the scheme form, '(void). Replace it by (begin). What was
  Keisuke thinking? :)
This commit is contained in:
Andy Wingo 2008-05-14 11:19:06 +02:00
parent 540d9d871e
commit c78279fc40
1 changed files with 9 additions and 16 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -85,7 +85,7 @@
(let ((public-if (module-public-interface module))) (let ((public-if (module-public-interface module)))
(module-use! (&compile-time-module) public-if)) (module-use! (&compile-time-module) public-if))
(syntax-error #f "invalid `use-syntax' form" e))) (syntax-error #f "invalid `use-syntax' form" e)))
'(void)) '(begin))
((begin let let* letrec lambda quote quasiquote if and or ((begin let let* letrec lambda quote quasiquote if and or
set! cond case eval-case define do) set! cond case eval-case define do)
@ -152,18 +152,11 @@
(define (trans:x x) (trans e l x)) (define (trans:x x) (trans e l x))
(define (trans:pair x) (trans-pair e l (car x) (cdr x))) (define (trans:pair x) (trans-pair e l (car x) (cdr x)))
(define (trans:body body) (trans-body e l body)) (define (trans:body body) (trans-body e l body))
(define (make:void) (make-ghil-void e l))
(define (bad-syntax) (define (bad-syntax)
(syntax-error l (format #f "bad ~A" head) (cons head tail))) (syntax-error l (format #f "bad ~A" head) (cons head tail)))
;; have to use a case first, because pmatch treats e.g. (quote foo) ;; have to use a case first, because pmatch treats e.g. (quote foo)
;; and (unquote foo) specially ;; and (unquote foo) specially
(case head (case head
;; (void)
((void)
(pmatch tail
(() (make:void))
(else (bad-syntax))))
;; (quote OBJ) ;; (quote OBJ)
((quote) ((quote)
(pmatch tail (pmatch tail
@ -196,7 +189,7 @@
(eval-at-compile-time (cons head tail)) (eval-at-compile-time (cons head tail))
;; FIXME: We need to evaluate them in the runtime module as well. ;; FIXME: We need to evaluate them in the runtime module as well.
(make:void)) (trans:x '(begin)))
((set!) ((set!)
(pmatch tail (pmatch tail
@ -215,7 +208,7 @@
((if) ((if)
(pmatch tail (pmatch tail
((,test ,then) ((,test ,then)
(make-ghil-if e l (trans:x test) (trans:x then) (make:void))) (make-ghil-if e l (trans:x test) (trans:x then) (trans:x '(begin))))
((,test ,then ,else) ((,test ,then ,else)
(make-ghil-if e l (trans:x test) (trans:x then) (trans:x else))) (make-ghil-if e l (trans:x test) (trans:x then) (trans:x else)))
(else (bad-syntax)))) (else (bad-syntax))))
@ -276,7 +269,7 @@
;; (cond (CLAUSE BODY...) ...) ;; (cond (CLAUSE BODY...) ...)
((cond) ((cond)
(pmatch tail (pmatch tail
(() (make:void)) (() (trans:x '(begin)))
(((else . ,body)) (trans:body body)) (((else . ,body)) (trans:body body))
(((,test) . ,rest) (trans:pair `(or ,test (cond ,@rest)))) (((,test) . ,rest) (trans:pair `(or ,test (cond ,@rest))))
(((,test => ,proc) . ,rest) (((,test => ,proc) . ,rest)
@ -294,7 +287,7 @@
;; FIXME hygiene! ;; FIXME hygiene!
`(let ((_t ,exp)) `(let ((_t ,exp))
,(let loop ((ls clauses)) ,(let loop ((ls clauses))
(cond ((null? ls) '(void)) (cond ((null? ls) '(begin))
((eq? (caar ls) 'else) `(begin ,@(cdar ls))) ((eq? (caar ls) 'else) `(begin ,@(cdar ls)))
(else `(if (memv _t ',(caar ls)) (else `(if (memv _t ',(caar ls))
(begin ,@(cdar ls)) (begin ,@(cdar ls))
@ -313,9 +306,9 @@
;; FIXME hygiene! ;; FIXME hygiene!
`(letrec ((_l (lambda ,sym `(letrec ((_l (lambda ,sym
(if ,test (if ,test
(let () (void) ,@result) (begin ,@result)
(let () (void) ,@body (begin ,@body
(_l ,@(map next sym update))))))) (_l ,@(map next sym update)))))))
(_l ,@val))))) (_l ,@val)))))
(else (bad-syntax)))) (else (bad-syntax))))
@ -332,7 +325,7 @@
((eval-case) ((eval-case)
(let loop ((x tail)) (let loop ((x tail))
(pmatch x (pmatch x
(() (make:void)) (() (trans:x '(begin)))
(((else . ,body)) (trans:pair `(begin ,@body))) (((else . ,body)) (trans:pair `(begin ,@body)))
(((,keys . ,body) . ,rest) (guard (list? keys) (and-map symbol? keys)) (((,keys . ,body) . ,rest) (guard (list? keys) (and-map symbol? keys))
(if (memq 'load-toplevel keys) (if (memq 'load-toplevel keys)