klisp

commit 827ae80a4e0a6a27f605ea2fec842152e6c7feac
parent b4d756cb224e4706fc7d9bb69509645f0a151ce9
Author: Andres Navarro <canavarro82@gmail.com>
Date:   Mon, 19 Dec 2011 19:38:08 -0300

Bugfix: #:rename clauses now also import the bindings that aren't renamed. Also added a check to avoid renamings that create repeated symbols.

Diffstat:
M
src/kgmodules.c
 | 
37
++++++++++++++++++++++++++++++++-----
M
src/tests/modules.k
 | 
1
+

2 files changed, 33 insertions(+), 5 deletions(-)
diff --git a/src/kgmodules.c b/src/kgmodules.c
@@ -618,16 +618,42 @@ static TValue extract_import_bindings(klisp_State *K, TValue imports)
                 krooted_tvs_pop(K); krooted_tvs_pop(K);
             } else if (kkeyword_cstr_cmp(keyw, "rename") == 0) {
                 check_distinct_symbols(K, clause);
+                /* env is for renamed symbols info */
+                TValue env = kmake_empty_environment(K);
+                krooted_tvs_push(K, env);
+
+                /* remember all renamed symbols info first */
+                for (TValue ls = rest; !ttisnil(ls); ls = kcdr(ls)) {
+                    TValue p = kcar(ls);
+                    kadd_binding(K, env, kcar(p), kcar(kcdr(p)));
+                }
+
+                /* now we can construct the list and env */
                 TValue nmls = kcons(K, KNIL, KNIL);
                 TValue nmls_lp = nmls;
                 krooted_tvs_push(K, nmls);
                 TValue nmenv = kmake_empty_environment(K);
                 krooted_tvs_push(K, nmenv);
 
-                for (TValue ls = rest; !ttisnil(ls); ls = kcdr(ls)) {
-                    TValue p = kcar(ls);
-                    TValue si = kcar(p);
-                    TValue se = kcar(kcdr(p));
+
+                /* add all renamed symbols first */
+                for (TValue ls = mls; !ttisnil(ls); ls = kcdr(ls)) {
+                    TValue si = kcar(ls);
+                    TValue se;
+                    if (kbinds(K, env, si)) /* renamed binding */
+                        se = kget_binding(K, env, si);
+                    else se = si;
+
+                    /* check that symbol wasn't already defined
+                       (can happen if a binding is renamed to another binding
+                       of the same module and that other binding isn't itself 
+                       renamed) */
+                    if (kbinds(K, nmenv, se)) {
+                        klispE_throw_simple_with_irritants(
+                            K, "imported a symbol twice in #:rename clause", 
+                            1, se);
+                        return KINERT;
+                    }
 
                     np = kcons(K, se, KNIL);
                     kset_cdr(nmls_lp, np);
@@ -635,9 +661,10 @@ static TValue extract_import_bindings(klisp_State *K, TValue imports)
 
                     kadd_binding(K, nmenv, se, kget_binding(K, menv, si));
                 }
+
                 mls = kcdr(nmls);
                 menv = nmenv;
-                krooted_tvs_pop(K); krooted_tvs_pop(K);
+                krooted_tvs_pop(K); krooted_tvs_pop(K); krooted_tvs_pop(K);
             }
         }
 
diff --git a/src/tests/modules.k b/src/tests/modules.k
@@ -109,6 +109,7 @@
 ($check-error ($fresh ($import-module! (#:rename (mod-a) (1 2)))))
 ($check-error ($fresh ($import-module! (#:rename (mod-a) p))))
 ($check-error ($fresh ($import-module! (#:rename (mod-a)))))
+($check-error ($fresh ($import-module! (#:rename (mod-a) (p q))) r))
 
 ($check equal? ($fresh ($import-module! (#:only (mod-b 1 2 x) u)) u) 4)
 ($check equal? ($fresh ($import-module! (#:only (mod-b 1 2 x) p)) p) 1)