Ticket #944: 0001-Fix-944-by-making-the-behvior-of-macro-renamed-defin.patch

File 0001-Fix-944-by-making-the-behvior-of-macro-renamed-defin.patch, 3.3 KB (added by sjamaan, 12 years ago)
  • chicken-syntax.scm

    From 44f9bbddddbede4b8b42d76a95da237a80cf0ff9 Mon Sep 17 00:00:00 2001
    From: Peter Bex <peter.bex@xs4all.nl>
    Date: Wed, 31 Oct 2012 22:27:01 +0100
    Subject: [PATCH] Fix #944 by making the behvior of macro-renamed definitions
     inside modules similar to the behavior at toplevel; they
     unhygienically introduce identifiers
    
    ---
     chicken-syntax.scm     |  5 ++++-
     expand.scm             |  6 ++++--
     tests/syntax-tests.scm | 26 +++++++++++++++++++++++++-
     3 files changed, 33 insertions(+), 4 deletions(-)
    
    diff --git a/chicken-syntax.scm b/chicken-syntax.scm
    index 5de86f0..8fd85a3 100644
    a b  
    348348   (##sys#er-transformer
    349349    (lambda (form r c)
    350350      (##sys#check-syntax 'define-values form '(_ #(variable 0) _))
    351       (for-each (cut ##sys#register-export <> (##sys#current-module)) (cadr form))
     351      (for-each (lambda (nm)
     352                  (let ((name (##sys#get nm '##core#macro-alias nm)))
     353                    (##sys#register-export name (##sys#current-module))))
     354                (cadr form))
    352355      `(,(r 'set!-values) ,@(cdr form))))))
    353356
    354357(##sys#extend-macro-environment
  • expand.scm

    diff --git a/expand.scm b/expand.scm
    index 660d1fa..06227e2 100644
    a b  
    981981              (body (cddr form)) )
    982982          (cond ((not (pair? head))
    983983                 (##sys#check-syntax 'define form '(_ symbol . #(_ 0 1)))
    984                  (##sys#register-export head (##sys#current-module))
     984                 (let ((name (or (getp head '##core#macro-alias) head)))
     985                   (##sys#register-export name (##sys#current-module)))
    985986                 (when (c (r 'define) head)
    986987                   (##sys#defjam-error x))
    987988                 `(##core#set!
     
    10051006        (cond ((not (pair? head))
    10061007               (##sys#check-syntax 'define-syntax head 'symbol)
    10071008               (##sys#check-syntax 'define-syntax body '#(_ 1))
    1008                (##sys#register-export head (##sys#current-module))
     1009               (let ((name (or (getp head '##core#macro-alias) head)))
     1010                 (##sys#register-export name (##sys#current-module)))
    10091011               (when (c (r 'define-syntax) head)
    10101012                 (##sys#defjam-error form))
    10111013               `(##core#define-syntax ,head ,(car body)))
  • tests/syntax-tests.scm

    diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
    index cc5f246..6da0277 100644
    a b take 
    10541054    (lambda (e r c) '(quote *)))))
    10551055
    10561056(import rename-builtins)
    1057 (assert (eq? '* (strip-syntax-on-*)))
    1058  No newline at end of file
     1057(assert (eq? '* (strip-syntax-on-*)))
     1058
     1059;; #944: macro-renamed defines mismatch with the names recorded in module
     1060;;       definitions, causing the module to be unresolvable.
     1061
     1062(module foo ()
     1063  (import chicken scheme)
     1064  (define-syntax bar
     1065    (syntax-rules ()
     1066      ((_) (begin (define req 1) (display req) (newline)))))
     1067  (bar))
     1068
     1069;; The fix for the above bug causes the req to be defined at toplevel,
     1070;; unhygienically.  The test below should probably be enabled and this
     1071;; behavior fixed.  R5RS seems to allow the current behavior though (?),
     1072;; and some Schemes (at least Gauche) behave the same way.  I think it's
     1073;; broken, since it's unhygienic.
     1074#;(module foo ()
     1075  (import chicken scheme)
     1076  (define req 1)
     1077  (define-syntax bar
     1078    (syntax-rules ()
     1079      ((_) (begin (define req 2) (display req) (newline)))))
     1080  (bar)
     1081  (assert (eq? req 1)))
     1082 No newline at end of file