Ticket #1131: 0001-Resolve-variable-in-set-using-lookup-when-variable-i.patch

File 0001-Resolve-variable-in-set-using-lookup-when-variable-i.patch, 2.6 KB (added by sjamaan, 3 years ago)

Initial fix for compiler (interpreter still broken)

  • core.scm 

    From 8388c9416a2a99e667d80c546901a4d930ed1d69 Mon Sep 17 00:00:00 2001
From: Peter Bex <peter@more-magic.net>
Date: Sun, 11 Apr 2021 12:52:20 +0200
Subject: [PATCH] Resolve variable in set! using "lookup" when variable is not
 global

This allows dropping the lookup in ##sys#current-environment
from ##sys#alias-global-hook because lookups when setting variables
now match lookups when dereferencing variables.

This currently only works inside the compiler; there is still a
problem in the interpreter causing the test to fail.
---
 core.scm               |  5 +++--
 modules.scm            |  2 +-
 tests/module-tests.scm | 22 ++++++++++++++++++++++
 3 files changed, 26 insertions(+), 3 deletions(-)

diff --git a/core.scm b/core.scm
index 492a23a7..e3e173a4 100644
    a b  
    11741174                                         ((assq var0 (##sys#current-environment))
    11751175                                          (warning
    11761176                                           (sprintf "~aassignment to imported value binding `~S'"
    1177                                             (if ln (sprintf "(~a) - " ln) "") var0)))))
    1178                                  `(set! ,var ,(walk val e var0 (memq var e) h ln #f))))))
     1177                                             (if ln (sprintf "(~a) - " ln) "") var0)))))
     1178                                 (let ((var (lookup var)))
     1179                                   `(set! ,var ,(walk val e var0 (memq var e) h ln #f)))))))
    11791180
    11801181                        ((##core#debug-event)
    11811182                         `(##core#debug-event

  • modules.scm 

    diff --git a/modules.scm b/modules.scm
index 29fb92e5..8393654f 100644
    a b  
    804804          (else sym)))
    805805  (cond ((keyword? sym) sym)
    806806        ((namespaced-symbol? sym) sym)
    807         ((assq sym (##sys#current-environment)) =>
     807        #;((assq sym (##sys#current-environment)) =>
    808808         (lambda (a)
    809809           (let ((sym2 (cdr a)))
    810810             (dm "(ALIAS) in current environment " sym " -> " sym2)

  • tests/module-tests.scm 

    diff --git a/tests/module-tests.scm b/tests/module-tests.scm
index ec447e45..5054ee8a 100644
    a b  
    380380   (import (scheme) (chicken module))
    381381   (eq? (current-module) 'm33)))
    382382
     383;; #1131 Undefined variables for macros from other modules should not
     384;; be looked up in the current environment
     385(module undef (undefined)
     386  (import scheme)
     387  (define undefined 1))
     388
     389(module expando (do-it)
     390  (import scheme)
     391  (define-syntax do-it
     392    (syntax-rules ()
     393      ((_)
     394       (let-syntax ((final
     395                     (syntax-rules ()
     396                       ((_ ?x) ?x))))
     397         (final undefined))))))
     398
     399(import undef expando)
     400;; Should fail, not return 1, because the let-syntax expansion should
     401;; rename introduced identifiers from its SE (but input should be
     402;; looked up here)
     403(assert-error "Undefined variable should be undefined" (do-it))
     404
    383405(test-end "modules")
    384406
    385407(test-exit)