Ticket #1735: 0001-Import-modules-sans-their-prefixes.patch

File 0001-Import-modules-sans-their-prefixes.patch, 1.7 KB (added by Idiomdrottning, 3 years ago)

  • modules.scm 

    From 8814df82cf92a1d1d1f637d4bb45bd9b718e935d Mon Sep 17 00:00:00 2001
From: Sandra Snan <sandra.snan@idiomdrottning.org>
Date: Tue, 16 Mar 2021 16:23:31 +0100
Subject: [PATCH 1/2] Import modules sans their prefixes

---
 modules.scm | 20 +++++++++++++++++++-
 1 file changed, 19 insertions(+), 1 deletion(-)

diff --git a/modules.scm b/modules.scm
index 29fb92e5..538866e7 100644
    a b  
    611611  (let ((%only (r 'only))
    612612        (%rename (r 'rename))
    613613        (%except (r 'except))
    614         (%prefix (r 'prefix)))
     614        (%prefix (r 'prefix))
     615        (%sans (r 'sans)))
    615616    (define (warn msg mod id)
    616617      (##sys#warn (string-append msg " in module `" (symbol->string mod) "'") id))
    617618    (define (tostr x)
    … …  
    719720                               (##sys#string-append (tostr prefix) (##sys#symbol->string (car imp))))
    720721                              (cdr imp)))
    721722                           (values name lib `(,head ,spec ,prefix) (map rename impv) (map rename imps) impi)))
     723                        ((c %sans head)
     724                         (##sys#check-syntax loc x '(_ _ _))
     725                         (let-values (((name lib spec impv imps impi) (loop (cadr x)))
     726                                      ((prefix) (strip-syntax (caddr x))))
     727                           (define (rename imp)
     728                             (cons
     729                              (let ((it
     730                                     (let loop ((pref (##sys#string->list (tostr prefix)))
     731                                                (oldn (##sys#string->list (##sys#symbol->string (car imp)))))
     732                                       (cond ((null? oldn) #f)
     733                                             ((null? pref) (##sys#list->string oldn))
     734                                             ((eq? (car pref) (car oldn))
     735                                              (loop (cdr pref) (cdr oldn)))
     736                                             (else #f)))))
     737                                (if it (##sys#string->symbol it) (car imp)))
     738                              (cdr imp)))
     739                           (values name lib `(,head ,spec ,prefix) (map rename impv) (map rename imps) impi)))
    722740                        (else
    723741                         (module-imports (strip-syntax x))))))))))))
    724742