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

Comment out unused definitions of 'do' and 'case' in psyntax.scm

Browse source 
* module/ice-9/psyntax.scm (do, case): Comment out these definitions,
  which are never used and immediately replaced by definitions in
  boot-9.scm.

* module/ice-9/psyntax-pp.scm: Regenerate.
This commit is contained in:
Mark H Weaver 2012-03-04 12:01:10 -05:00
parent 1948b38d88
commit 3fafc52afb
2 changed files with 7 additions and 137 deletions
Download patch file Download diff file Expand all files Collapse all files

137
module/ice-9/psyntax-pp.scm
View file

@ -2641,83 +2641,6 @@
"source expression failed to match any pattern"
tmp-1)))))))
(define do
(make-syntax-transformer
'do
'macro
(lambda (orig-x)
(let ((tmp-1 orig-x))
(let ((tmp ($sc-dispatch
tmp-1
'(_ #(each (any any . any)) (any . each-any) . each-any))))
(if tmp
(apply (lambda (var init step e0 e1 c)
(let ((tmp-1 (map (lambda (v s)
(let ((tmp-1 s))
(let ((tmp ($sc-dispatch tmp-1 '())))
(if tmp
(apply (lambda () v) tmp)
(let ((tmp ($sc-dispatch tmp-1 '(any))))
(if tmp
(apply (lambda (e) e) tmp)
(syntax-violation 'do "bad step expression" orig-x s)))))))
var
step)))
(let ((tmp ($sc-dispatch tmp-1 'each-any)))
(if tmp
(apply (lambda (step)
(let ((tmp e1))
(let ((tmp-1 ($sc-dispatch tmp '())))
(if tmp-1
(apply (lambda ()
(list '#(syntax-object let ((top)) (hygiene guile))
'#(syntax-object doloop ((top)) (hygiene guile))
(map list var init)
(list '#(syntax-object if ((top)) (hygiene guile))
(list '#(syntax-object not ((top)) (hygiene guile)) e0)
(cons '#(syntax-object begin ((top)) (hygiene guile))
(append
c
(list (cons '#(syntax-object
doloop
((top))
(hygiene guile))
step)))))))
tmp-1)
(let ((tmp-1 ($sc-dispatch tmp '(any . each-any))))
(if tmp-1
(apply (lambda (e1 e2)
(list '#(syntax-object let ((top)) (hygiene guile))
'#(syntax-object doloop ((top)) (hygiene guile))
(map list var init)
(list '#(syntax-object if ((top)) (hygiene guile))
e0
(cons '#(syntax-object begin ((top)) (hygiene guile))
(cons e1 e2))
(cons '#(syntax-object begin ((top)) (hygiene guile))
(append
c
(list (cons '#(syntax-object
doloop
((top))
(hygiene guile))
step)))))))
tmp-1)
(syntax-violation
#f
"source expression failed to match any pattern"
tmp)))))))
tmp)
(syntax-violation
#f
"source expression failed to match any pattern"
tmp-1)))))
tmp)
(syntax-violation
#f
"source expression failed to match any pattern"
tmp-1)))))))
(define quasiquote
(make-syntax-transformer
'quasiquote
@ -3101,66 +3024,6 @@
"expression not valid outside of quasiquote"
x))))
(define case
(make-syntax-transformer
'case
'macro
(lambda (x)
(let ((tmp-1 x))
(let ((tmp ($sc-dispatch tmp-1 '(_ any any . each-any))))
(if tmp
(apply (lambda (e m1 m2)
(let ((tmp (let f ((clause m1) (clauses m2))
(if (null? clauses)
(let ((tmp-1 clause))
(let ((tmp ($sc-dispatch
tmp-1
'(#(free-id #(syntax-object else ((top)) (hygiene guile)))
any
.
each-any))))
(if tmp
(apply (lambda (e1 e2)
(cons '#(syntax-object begin ((top)) (hygiene guile)) (cons e1 e2)))
tmp)
(let ((tmp ($sc-dispatch tmp-1 '(each-any any . each-any))))
(if tmp
(apply (lambda (k e1 e2)
(list '#(syntax-object if ((top)) (hygiene guile))
(list '#(syntax-object memv ((top)) (hygiene guile))
'#(syntax-object t ((top)) (hygiene guile))
(list '#(syntax-object quote ((top)) (hygiene guile))
k))
(cons '#(syntax-object begin ((top)) (hygiene guile))
(cons e1 e2))))
tmp)
(syntax-violation 'case "bad clause" x clause))))))
(let ((tmp (f (car clauses) (cdr clauses))))
(let ((rest tmp))
(let ((tmp clause))
(let ((tmp ($sc-dispatch tmp '(each-any any . each-any))))
(if tmp
(apply (lambda (k e1 e2)
(list '#(syntax-object if ((top)) (hygiene guile))
(list '#(syntax-object memv ((top)) (hygiene guile))
'#(syntax-object t ((top)) (hygiene guile))
(list '#(syntax-object quote ((top)) (hygiene guile))
k))
(cons '#(syntax-object begin ((top)) (hygiene guile))
(cons e1 e2))
rest))
tmp)
(syntax-violation 'case "bad clause" x clause))))))))))
(let ((body tmp))
(list '#(syntax-object let ((top)) (hygiene guile))
(list (list '#(syntax-object t ((top)) (hygiene guile)) e))
body))))
tmp)
(syntax-violation
#f
"source expression failed to match any pattern"
tmp-1)))))))
(define make-variable-transformer
(lambda (proc)
(if (procedure? proc)

7
module/ice-9/psyntax.scm
View file

@ -2815,6 +2815,9 @@
(binding (car bindings)))
#'(let (binding) body))))))))
;; This definition of 'do' is never used, as it is immediately
;; replaced by the definition in boot-9.scm.
#;
(define-syntax do
(lambda (orig-x)
(syntax-case orig-x ()
@ -2988,6 +2991,10 @@
"expression not valid outside of quasiquote"
x)))
;; This definition of 'case' is never used, as it is immediately
;; replaced by the definition in boot-9.scm. This version lacks
;; R7RS-mandated support for '=>'.
#;
(define-syntax case
(lambda (x)
(syntax-case x ()