Newsgroups: comp.lang.scheme
Path: utzoo!utgpu!news-server.csri.toronto.edu!rpi!zaphod.mps.ohio-state.edu!think.com!mintaka!bloom-beacon!dont-send-mail-to-path-lines
From: greg@vis.UUCP
Subject: Fixes for extend-syntax for mit-scheme 7.1
Message-ID: <9104150751.AA14915@ifsrad>
Sender: daemon@athena.mit.edu (Mr Background)
Organization: The Internet
Date: 15 Apr 91 07:51:12 GMT
Lines: 128

I assume that the mit-extend-syntax.ss included in syntax.sha in the
repository works in earlier versions of mit-scheme.  Here are the
changes I made to get it to work with 7.1 (context diff):

*** mit-extend-syntax.ss	Mon Apr 15 00:45:16 1991
--- syntax.sha/mit-extend-syntax.ss	Sun Apr 14 00:02:42 1991
***************
*** 6,29 ****
  ;;; The following functions were added:
  ;;;  gensym, duplicate-symbols, box, unbox, set-box!.
  
- ;;; mit-extend-syntax.ss
- ;;; 15 April, 1991
- ;;; Discovered that mit-extend-syntax.ss from the repository
- ;;; (inside of syntax.sha) does not work in mit-scheme 7.1(beta)
- ;;; Here were the problems:
- ;;; (1) The original relied on the return values of failed unless and when
- ;;;     macros which were implemented on top of no-alternative if which
- ;;;     returns no-value.  Having '() be the alternative seems to fix it.
- ;;; (2) The original used some keywords as variable names: cond, access
- ;;; J. Greg Davidson, Institute for Software Research and Development,
- ;;;  vis!greg@ucsd.edu
  
- 
  (define gensym generate-uninterned-symbol)
  
! (define-macro (unless condition . e1 ) `(if ,condition '() (begin ,@e1)))
  
! (define-macro (when condition . e1) `(if ,condition (begin ,@e1) '()))
  
  (define-macro (kerror msg-line . args)
    `(begin
--- 6,17 ----
  ;;; The following functions were added:
  ;;;  gensym, duplicate-symbols, box, unbox, set-box!.
  
  
  (define gensym generate-uninterned-symbol)
  
! (define-macro (unless cond . e1 ) `(if (not ,cond) (begin ,@e1)))
  
! (define-macro (when cond . e1) `(if ,cond (begin ,@e1) ))
  
  (define-macro (kerror msg-line . args)
    `(begin
***************
*** 89,103 ****
    (define duplicate-symbols
      (lambda ( list )
        (unless (null? list)
! 	      (when (memq (car list) (cdr list))
! 		    (cons (car list)
  			  ( duplicate-symbols (cdr list)))))))
    
    
    
    (define id
!     (lambda (name access-foo control)
!       (list name access-foo control)))
    (define id-name car)
    (define id-access cadr)
    (define id-control caddr)
--- 80,93 ----
     (define duplicate-symbols
          (lambda ( list )
                  (unless (null? list)
!                          (when (memq (car list) (cdr list)) (cons (car list)
                                ( duplicate-symbols (cdr list)))))))
   
   
  
     (define id
!       (lambda (name access control)
!          (list name access control)))
     (define id-name car)
     (define id-access cadr)
     (define id-control caddr)
***************
*** 125,142 ****
        (cdddr cadddr . cddddr)))
    
    (define add-car
!     (lambda (access-foo)
!       (let ((x (and (pair? access-foo) (assq (car access-foo) c...rs))))
  	(if (null? x)
! 	    `(car ,access-foo)
! 	    `(,(cadr x) ,@(cdr access-foo))))))
    
    (define add-cdr
!     (lambda (access-foo)
!       (let ((x (and (pair? access-foo) (assq (car access-foo) c...rs))))
  	(if (null? x)
! 	    `(cdr ,access-foo)
! 	    `(,(cddr x) ,@(cdr access-foo))))))
    
    
    (define checkpat
--- 115,132 ----
          (cdddr cadddr . cddddr)))
  
     (define add-car
!       (lambda (access)
!          (let ((x (and (pair? access) (assq (car access) c...rs))))
              (if (null? x)
!                 `(car ,access)
!                 `(,(cadr x) ,@(cdr access))))))
  
     (define add-cdr
!       (lambda (access)
!          (let ((x (and (pair? access) (assq (car access) c...rs))))
              (if (null? x)
!                 `(cdr ,access)
!                 `(,(cddr x) ,@(cdr access))))))
  
  
     (define checkpat



_Greg


J. Greg Davidson	Institute for Software Research and Development
+1 (619) 452-8059       6231 Branting Street  San Diego, CA  92122  USA
 
greg@vis.com				ucbvax--| telesoft--|
vis!greg@nosc.mil			decvax--+---ucsd----+--vis
vis!greg@ucsd.edu		 	 ihnp4--|   nosc----|