Ticket #816: 0001-Always-add-default-core-macros-to-syntax-env-in-inte.patch

File 0001-Always-add-default-core-macros-to-syntax-env-in-inte.patch, 3.6 KB (added by sjamaan, 12 years ago)

Always add core macros to syntax env of internal compiler syntax

  • compiler-syntax.scm 

    From 72d5564a795aca3d31b15cd10e59d592d995ac5a Mon Sep 17 00:00:00 2001
From: Peter Bex <peter.bex@xs4all.nl>
Date: Sat, 21 Apr 2012 20:18:19 +0200
Subject: [PATCH] Always add default core macros to syntax env in internal
 compiler-syntax so that even when the user doesn't import
 scheme the macros will expand correctly

---
 compiler-syntax.scm     |    9 +++++----
 tests/scrutiny.expected |    6 +++---
 tests/syntax-tests.scm  |    6 ++++++
 3 files changed, 14 insertions(+), 7 deletions(-)

diff --git a/compiler-syntax.scm b/compiler-syntax.scm
index 85aae77..65a80db 100644
    a b  
    4646  (let ((t (cons (##sys#ensure-transformer
    4747                  (##sys#er-transformer transformer)
    4848                  (car names))
    49                  se)))
     49                 (append se ##sys#default-macro-environment))))
    5050    (for-each
    5151     (lambda (name)
    5252       (##sys#put! name '##compiler#compiler-syntax t) )
    … …  
    6666        (%loop (r 'for-each-loop))
    6767        (%proc (gensym))
    6868        (%begin (r 'begin))
     69        (%quote (r 'quote))
    6970        (%and (r 'and))
    7071        (%pair? (r 'pair?))
    7172        (%lambda (r 'lambda))
    … …  
    7677          `(,%let ((,%proc ,(cadr x))
    7778                   ,@(map list vars lsts))
    7879                  ,@(map (lambda (var)
    79                            `(##core#check (##sys#check-list ,var 'for-each)))
     80                           `(##core#check (##sys#check-list ,var (,%quote for-each))))
    8081                         vars)
    8182                  (,%let ,%loop ,(map list vars vars)
    8283                         (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))
    … …  
    8990        x)))
    9091
    9192(define-internal-compiler-syntax ((map ##sys#map #%map) x r c)
    92   (pair?)
     93  (pair? cons)
    9394  (let ((%let (r 'let))
    9495        (%if (r 'if))
    9596        (%loop (r 'map-loop))
    … …  
    113114                   (,%proc ,(cadr x))
    114115                   ,@(map list vars lsts))                 
    115116                  ,@(map (lambda (var)
    116                            `(##core#check (##sys#check-list ,var 'map)))
     117                           `(##core#check (##sys#check-list ,var (,%quote map))))
    117118                         vars)
    118119                  (,%let ,%loop ,(map list vars vars)
    119120                         (,%if (,%and ,@(map (lambda (v) `(,%pair? ,v)) vars))

  • tests/scrutiny.expected 

    diff --git a/tests/scrutiny.expected b/tests/scrutiny.expected
index 31eeb2b..f4200af 100644
    a b Warning: at toplevel: 
    3737  (scrutiny-tests.scm:28) in procedure call to `+', expected argument #2 of type `number', but was given an argument of type `symbol'
    3838
    3939Warning: at toplevel:
    40   assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a123) (procedure car ((pair a123 *)) a123))'
     40  assignment of value of type `fixnum' to toplevel variable `car' does not match declared type `(forall (a124) (procedure car ((pair a124 *)) a124))'
    4141
    4242Warning: at toplevel:
    4343  expected in `let' binding of `g8' a single result, but were given 2 results
    … … Warning: at toplevel: 
    4747
    4848Note: in toplevel procedure `foo':
    4949  expected value of type boolean in conditional but were given a value of type
    50   `(procedure bar29 () *)' which is always true:
     50  `(procedure bar30 () *)' which is always true:
    5151
    52 (if bar29 3 (##core#undefined))
     52(if bar30 3 (##core#undefined))
    5353
    5454Warning: in toplevel procedure `foo2':
    5555  (scrutiny-tests.scm:57) in procedure call to `string-append', expected argument #1 of type `string', but was given an argument of type `number'

  • tests/syntax-tests.scm 

    diff --git a/tests/syntax-tests.scm b/tests/syntax-tests.scm
index c1a2fa8..cad0d39 100644
    a b take 
    974974  (import (prefix chicken c/) (prefix scheme s/))
    975975  (c/case-lambda ((a) a))
    976976  (c/ensure s/even? 2))
     977
     978
     979;; #816: compiler-syntax should obey hygiene in its rewrites
     980(module foo ()
     981  (import (prefix (only scheme map lambda list) ~))
     982  (~map (~lambda (y) y) (~list 1)))
     983 No newline at end of file