Mercurial > hg > xemacs-beta

comparison src/symbols.c @ 5560:58b38d5b32d0

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Implement print-circle, allowing recursive and circular structures to be read. src/ChangeLog addition: 2011-09-04 Aidan Kehoe <kehoea@parhasard.net> * alloc.c: * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT_1): * alloc.c (ALLOC_FROB_BLOCK_LISP_OBJECT): * alloc.c (cons_print_preprocess): * alloc.c (vector_print_preprocess): * alloc.c (vector_nsubst_structures_descend): * alloc.c (Fmake_symbol): * alloc.c (UNMARK_symbol): * alloc.c (sweep_symbols): * alloc.c (reinit_alloc_objects_early): * alloc.c (reinit_alloc_early): * bytecode.c: * bytecode.c (compiled_function_print_preprocess): * bytecode.c (compiled_function_nsubst_structures_descend): * bytecode.c (set_compiled_function_arglist): * bytecode.c (set_compiled_function_interactive): * bytecode.c (bytecode_objects_create): * chartab.c: * chartab.c (print_preprocess_mapper): * chartab.c (nsubst_structures_mapper): * chartab.c (char_table_nsubst_structures_descend): * chartab.c (chartab_objects_create): * elhash.c: * elhash.c (nsubst_structures_map_hash_table): * elhash.c (hash_table_nsubst_structures_descend): * elhash.c (print_preprocess_mapper): * elhash.c (hash_table_print_preprocess): * elhash.c (inchash_eq): * elhash.c (hash_table_objects_create): * elhash.c (syms_of_elhash): * elhash.h: * emacs.c (main_1): * fns.c: * fns.c (check_eq_nokey): * fns.c (Fnsubst): * fns.c (syms_of_fns): * lisp.h: * lisp.h (struct Lisp_Symbol): * lisp.h (IN_OBARRAY): * lisp.h (struct): * lisp.h (PRINT_PREPROCESS): * lread.c (read1): * lrecord.h: * lrecord.h (struct lrecord_implementation): * lrecord.h (DEFINE_DUMPABLE_MODULE_LISP_OBJECT): * print.c: * print.c (PRINT_CIRCLE_LIMIT): * print.c (print_continuous_numbering_changed): * print.c (print_prepare): * print.c (print_finish): * print.c (Fprin1_to_string): * print.c (print_cons): * print.c (print_preprocess_inchash_eq): * print.c (print_preprocess): * print.c (print_sort_get_numbers): * print.c (print_sort_compare_ordinals): * print.c (print_gensym_or_circle): * print.c (nsubst_structures_descend): * print.c (nsubst_structures): * print.c (print_internal): * print.c (print_symbol): * print.c (vars_of_print): * rangetab.c: * rangetab.c (range_table_print_preprocess): * rangetab.c (range_table_nsubst_structures_descend): * rangetab.c (rangetab_objects_create): * rangetab.c (syms_of_rangetab): * symbols.c: * symbols.c (symbol_print_preprocess): * symbols.c (Fintern): * symbols.c (Funintern): * symbols.c (reinit_symbol_objects_early): * symbols.c (init_symbols_once_early): * symsinit.h: Implement print-circle, printing circular structures in a readable fashion, and treating them appropriately on read. This is by means of two new object methods, print_preprocess (detecting circularities), and nsubst_structures_descend (replacing placeholders with the read objects). Expose the substitution to Lisp via #'nsubst and its new :descend-structures keyword. Store information as to whether symbols are interned in obarray or not in their header, making checking for keywords and uninterned symbols (and thus printing) cheaper. Default print_gensym to t, as Common Lisp does, and as a more-than-decade old comment suggests. lisp/ChangeLog addition: 2011-09-04 Aidan Kehoe <kehoea@parhasard.net> * bytecomp.el (byte-compile-output-file-form): * bytecomp.el (byte-compile-output-docform): Bind print-circle, print-continuous-numbering in these functions, now those variables are available. * lisp.el (forward-sexp): * lisp.el (backward-sexp): Recognise leading #N= as being part of an expression. tests/ChangeLog addition: 2011-09-04 Aidan Kehoe <kehoea@parhasard.net> * automated/lisp-reader-tests.el: * automated/lisp-tests.el (literal-with-uninterned): * automated/symbol-tests.el (foo): Test print-circle, for printing (mutually-)recursive and circular structures. Bind print-continuous-numbering where appropriate.
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 04 Sep 2011 19:51:35 +0100
parents 0af042a0c116
children 56144c8593a8
comparison
equal deleted inserted replaced
5559:f3ab0c29c246 5560:58b38d5b32d0
137 symbol_remprop (Lisp_Object symbol, Lisp_Object property) 137 symbol_remprop (Lisp_Object symbol, Lisp_Object property)
138 { 138 {
139 return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME); 139 return external_remprop (&XSYMBOL (symbol)->plist, property, 0, ERROR_ME);
140 } 140 }
141 141
142 static void
143 symbol_print_preprocess (Lisp_Object UNUSED (symbol),
144 Lisp_Object UNUSED (print_number_table),
145 Elemcount * UNUSED (seen_object_count))
146 {
147 /* This method is empty; symbols are handled specially in
148 print_preprocess, because print_preprocess_inchash_eq() is conditional
149 for them, rather than a given. */
150 }
151
142 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("symbol", symbol, 152 DEFINE_DUMPABLE_FROB_BLOCK_LISP_OBJECT ("symbol", symbol,
143 mark_symbol, print_symbol, 153 mark_symbol, print_symbol,
144 0, 0, 0, symbol_description, 154 0, 0, 0, symbol_description,
145 Lisp_Symbol); 155 Lisp_Symbol);
146 156
248 XSYMBOL_NEXT (symbol) = XSYMBOL (*ptr); 258 XSYMBOL_NEXT (symbol) = XSYMBOL (*ptr);
249 else 259 else
250 XSYMBOL_NEXT (symbol) = 0; 260 XSYMBOL_NEXT (symbol) = 0;
251 *ptr = object; 261 *ptr = object;
252 262
263 XSYMBOL (object)->u.v.package_count = 1;
264 XSYMBOL (object)->u.v.first_package_id = (EQ (obarray, Vobarray)) ? 1 : 2;
265
253 if (string_byte (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray)) 266 if (string_byte (XSYMBOL_NAME (symbol), 0) == ':' && EQ (obarray, Vobarray))
254 { 267 {
255 /* The LISP way is to put keywords in their own package, but we 268 /* The LISP way is to put keywords in their own package, but we
256 don't have packages, so we do something simpler. Someday, 269 don't have packages, so we do something simpler. Someday,
257 maybe we'll have packages and then this will be reworked. 270 maybe we'll have packages and then this will be reworked.
327 340
328 hash = oblookup_last_bucket_number; 341 hash = oblookup_last_bucket_number;
329 342
330 if (EQ (XVECTOR_DATA (obarray)[hash], tem)) 343 if (EQ (XVECTOR_DATA (obarray)[hash], tem))
331 { 344 {
345 unsigned int package_count = XSYMBOL (tem)->u.v.package_count;
332 if (XSYMBOL (tem)->next) 346 if (XSYMBOL (tem)->next)
333 XVECTOR_DATA (obarray)[hash] = wrap_symbol (XSYMBOL (tem)->next); 347 XVECTOR_DATA (obarray)[hash] = wrap_symbol (XSYMBOL (tem)->next);
334 else 348 else
335 XVECTOR_DATA (obarray)[hash] = Qzero; 349 XVECTOR_DATA (obarray)[hash] = Qzero;
350 if (package_count > 0)
351 {
352 if (1 == package_count)
353 {
354 XSYMBOL (tem)->u.v.first_package_id = 0;
355 }
356 XSYMBOL (tem)->u.v.package_count = package_count - 1;
357 }
336 } 358 }
337 else 359 else
338 { 360 {
339 Lisp_Object tail, following; 361 Lisp_Object tail, following;
340 362
343 tail = following) 365 tail = following)
344 { 366 {
345 following = wrap_symbol (XSYMBOL (tail)->next); 367 following = wrap_symbol (XSYMBOL (tail)->next);
346 if (EQ (following, tem)) 368 if (EQ (following, tem))
347 { 369 {
370 unsigned int package_count = XSYMBOL (tem)->u.v.package_count;
348 XSYMBOL (tail)->next = XSYMBOL (following)->next; 371 XSYMBOL (tail)->next = XSYMBOL (following)->next;
372
373 if (package_count > 0)
374 {
375 if (1 == package_count)
376 {
377 XSYMBOL (tem)->u.v.first_package_id = 0;
378 }
379 XSYMBOL (tem)->u.v.package_count = package_count - 1;
380 }
349 break; 381 break;
350 } 382 }
351 } 383 }
352 } 384 }
353 return Qt; 385 return Qt;
3534 reinit_symbol_objects_early (void) 3566 reinit_symbol_objects_early (void)
3535 { 3567 {
3536 OBJECT_HAS_METHOD (symbol, getprop); 3568 OBJECT_HAS_METHOD (symbol, getprop);
3537 OBJECT_HAS_METHOD (symbol, putprop); 3569 OBJECT_HAS_METHOD (symbol, putprop);
3538 OBJECT_HAS_METHOD (symbol, remprop); 3570 OBJECT_HAS_METHOD (symbol, remprop);
3571 OBJECT_HAS_METHOD (symbol, print_preprocess);
3539 OBJECT_HAS_NAMED_METHOD (symbol, plist, Fsymbol_plist); 3572 OBJECT_HAS_NAMED_METHOD (symbol, plist, Fsymbol_plist);
3540 OBJECT_HAS_NAMED_METHOD (symbol, setplist, Fsetplist); 3573 OBJECT_HAS_NAMED_METHOD (symbol, setplist, Fsetplist);
3541 } 3574 }
3542 3575
3543 void 3576 void
3555 called the first time. */ 3588 called the first time. */
3556 Qnil = Fmake_symbol (make_string_nocopy ((const Ibyte *) "nil", 3)); 3589 Qnil = Fmake_symbol (make_string_nocopy ((const Ibyte *) "nil", 3));
3557 XSTRING_PLIST (XSYMBOL (Qnil)->name) = Qnil; 3590 XSTRING_PLIST (XSYMBOL (Qnil)->name) = Qnil;
3558 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihilo */ 3591 XSYMBOL (Qnil)->value = Qnil; /* Nihil ex nihilo */
3559 XSYMBOL (Qnil)->plist = Qnil; 3592 XSYMBOL (Qnil)->plist = Qnil;
3593 XSYMBOL (Qnil)->u.v.package_count = 1;
3594 XSYMBOL (Qnil)->u.v.first_package_id = 1;
3560 3595
3561 Vobarray = make_vector (OBARRAY_SIZE, Qzero); 3596 Vobarray = make_vector (OBARRAY_SIZE, Qzero);
3562 initial_obarray = Vobarray; 3597 initial_obarray = Vobarray;
3563 staticpro (&initial_obarray); 3598 staticpro (&initial_obarray);
3564 /* Intern nil in the obarray */ 3599 /* Intern nil in the obarray */