[comp.lang.scheme] Fixes for extend-syntax for mit-scheme 7.1

greg@vis.UUCP (04/15/91)

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----|

markf@zurich.ai.mit.edu (Mark Friedman) (04/16/91)

Please excuse me for sending this MIT Scheme specific message to this
group, but I am responding to a message originally sent to this group.
I have referred followups to comp.lang.scheme.c.

In article <9104150751.AA14915@ifsrad> greg@vis.UUCP writes:

   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):

I have placed a version of extend-syntax which fixes the bugs that
Greg fixed as well as fixing some other things in
archive/scheme-library/unsupported/CScheme/extend-syntax.scm available
for anonymous FTP from altdorf.ai.mit.edu.  

This version allows you to load a file which contains an extand-syntax
form and have it be available for use in that file, other files and in
your REP loops (i.e. anyplace that uses a syntax table that is a child
of user-initial-syntax-table). It also doesn't require all of your
macros transformation functions to contain a copy of the SYNTAX-MATCH?
procedure.

No warrantees expressed or implied.

-Mark
--

Mark Friedman
MIT Artificial Intelligence Lab
545 Technology Sq.
Cambridge, Ma. 02139

markf@zurich.ai.mit.edu