• R/O
  • SSH

quipu: Commit

quipu mercurial repository


Commit MetaInfo

Revisiónd5dbd3a1bdb9f79538076dbb9d2b14ccbc2c34da (tree)
Tiempo2020-04-08 08:31:38
AutorAgustina Arzille <avarzille@rise...>
CommiterAgustina Arzille

Log Message

More work on %use interface (incomplete)

Cambiar Resumen

Diferencia incremental

diff -r d9b6054a30d6 -r d5dbd3a1bdb9 builtins.cpp
--- a/builtins.cpp Tue Apr 07 04:09:45 2020 +0000
+++ b/builtins.cpp Tue Apr 07 20:31:38 2020 -0300
@@ -1524,6 +1524,7 @@
15241524 return (interp->retval);
15251525 }
15261526
1527+#if 0
15271528 static inline void
15281529 import_sym (interpreter *interp, package *p,
15291530 object sym, object as = UNBOUND, bool locked = false)
@@ -1653,6 +1654,16 @@
16531654 qp_return (symbol::t);
16541655 }
16551656
1657+#endif
1658+
1659+// (%use name (:as alias) (:pull (:all symbols...)))
1660+static DEFBUILTIN (p_use_fct)
1661+{
1662+ object a1 = argc < 2 ? NIL : argv[1];
1663+ object a2 = argc < 3 ? NIL : argv[2];
1664+ qp_return (pull_pkg (interp, *argv, a1, a2));
1665+}
1666+
16561667 // (%gc)
16571668 static DEFBUILTIN (p_gc)
16581669 {
@@ -1961,7 +1972,7 @@
19611972 { symname_fct, 1, 1 },
19621973 { symval_fct, 1, 2 },
19631974 { sympkg_fct, 1, 1 },
1964- { p_use_fct, 3, 3 },
1975+ { p_use_fct, 1, 3 },
19651976 { p_gc, 0, -1 },
19661977 { p_iter, 1, 3 },
19671978 { exit_fct, 0, 1 },
diff -r d9b6054a30d6 -r d5dbd3a1bdb9 symbol.cpp
--- a/symbol.cpp Tue Apr 07 04:09:45 2020 +0000
+++ b/symbol.cpp Tue Apr 07 20:31:38 2020 -0300
@@ -211,7 +211,8 @@
211211 }
212212
213213 static object
214-pkg_insert (interpreter *interp, package *pkg, object name, uint32_t flags)
214+pkg_insert (interpreter *interp, package *pkg, object name,
215+ uint32_t flags, bool locked = false)
215216 {
216217 interp->aux = pkg->syms;
217218 object *ptr = pkg_lookup (interp, as_array (interp->aux), name);
@@ -225,7 +226,7 @@
225226 // The lookup came up empty - See if we need to insert.
226227 lwlock_guard g;
227228
228- if (!singlethr_p ())
229+ if (!locked && !singlethr_p ())
229230 {
230231 g.set (interp, &pkg->lock);
231232 if (pkg->syms != interp->aux || *ptr != PKG_EMPTY)
@@ -302,7 +303,7 @@
302303 }
303304 }
304305
305- *ptr = sym;
306+ interp->retval = *ptr = sym;
306307
307308 array *symp = as_array (pkg->syms);
308309 if (qp_unlikely (symp->len * 75 <= ++syms_len(symp) * 100))
@@ -1147,7 +1148,7 @@
11471148 static inline object
11481149 pull_list_p (object x, object& name)
11491150 {
1150- if (!cons_p (x))
1151+ if (!xcons_p (x))
11511152 return (UNBOUND);
11521153
11531154 object ret = xcar (x);
@@ -1168,23 +1169,34 @@
11681169 };
11691170
11701171 static inline void
1172+check_sym_flags (interpreter *interp, object s1, object s2)
1173+{
1174+ uint32_t fl1 = as_symbol(s1)->vo_flags;
1175+ uint32_t fl2 = as_symbol(s2)->vo_flags;
1176+
1177+ const uint32_t sym_flg = symbol::special_flag |
1178+ symbol::ctv_flag | symbol::alias_flag;
1179+
1180+ if (symval (s1) == UNBOUND)
1181+ as_symbol(s1)->vo_flags = fl2;
1182+ else if ((fl1 & sym_flg) != (fl2 & sym_flg))
1183+ interp->raise ("pkg-error",
1184+ QP_SPRINTF (interp, "incompatible flags detected when pulling "
1185+ "symbol %Q (const-ness or alias/macro flags)",
1186+ symname (s1)));
1187+}
1188+
1189+static inline void
11711190 update_sym (interpreter *interp, package *p, object sym, bool locked = false)
11721191 {
11731192 object prev = pkg_insert_sym (interp, p, sym, locked);
11741193 if (prev == sym)
11751194 return;
11761195
1177- uint32_t fl1 = as_symbol(prev)->vo_flags;
1178- uint32_t fl2 = as_symbol(sym)->vo_flags;
1196+ check_sym_flags (interp, prev, sym);
11791197
1180- const uint32_t sym_flg = symbol::special_flag |
1181- symbol::ctv_flag | symbol::alias_flag;
1182-
1183- if ((fl1 & sym_flg) != (fl2 & sym_flg))
1184- interp->raise ("pkg-error",
1185- QP_SPRINTF (interp, "incompatible flags detected when pulling "
1186- "symbol %Q (const-ness or alias/macro flags)",
1187- symname (prev)));
1198+ // Symbols are compatible - Update the value.
1199+ symval(prev) = symval (sym);
11881200 }
11891201
11901202 object pull_pkg (interpreter *interp, object name, object arg_1, object arg_2)
@@ -1210,6 +1222,8 @@
12101222 else if (cons_p (arg_2))
12111223 method = pull_some;
12121224 else if (kword_eq (arg_2, "all", 3))
1225+ method = pull_all;
1226+ else
12131227 interp->raise ("arg-error", "third argument must be a list or :all");
12141228
12151229 valref pkg (interp, import_pkg (interp, path, name));
@@ -1225,8 +1239,7 @@
12251239 if (!singlethr_p ())
12261240 g.set (interp, &p->lock);
12271241
1228- for (package::iterator it (interp, p->as_obj ());
1229- it.valid (); ++it)
1242+ for (package::iterator it (interp, *pkg); it.valid (); ++it)
12301243 update_sym (interp, p, *it, true);
12311244 }
12321245 else
@@ -1238,10 +1251,11 @@
12381251 if (nksymbol_p (sx))
12391252 {
12401253 tmp = find_sym (interp, *pkg, symname (sx));
1241- if (!symbol_p (tmp))
1254+ if (!symbol_p (tmp) || symval (tmp) == UNBOUND)
12421255 interp->raise ("pkg-error",
1243- QP_SPRINTF (interp, "symbol %Q could not be found "
1244- "in package %Q", symname (sx), name));
1256+ QP_SPRINTF (interp, "symbol %Q could not be found in "
1257+ "package %Q", symname (sx),
1258+ as_package(*pkg)->name));
12451259
12461260 update_sym (interp, p, tmp, true);
12471261 }
@@ -1256,10 +1270,11 @@
12561270 QP_SPRINTF (interp, "symbol %Q could not be found "
12571271 "in package %Q", symname (sx), name));
12581272
1259- s2 = copy_S (interp, s2, true);
1260- symname(s2) = tmp;
1261- sympkg(s2) = *pkg;
1262- update_sym (interp, p, s2, true);
1273+ tmp = pkg_insert (interp, p, symname (tmp),
1274+ as_symbol(s2)->vo_flags, true);
1275+
1276+ check_sym_flags (interp, tmp, s2);
1277+ symval(tmp) = symval (s2);
12631278 }
12641279 }
12651280 }
Show on old repository browser