Mercurial > hg > xemacs-beta

comparison src/chartab.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 6506fcb40fcf
children 309e5631e4c8
comparison
equal deleted inserted replaced
5559:f3ab0c29c246 5560:58b38d5b32d0
91 */ 91 */
92 92
93 /************************************************************************/ 93 /************************************************************************/
94 /* Char Table object */ 94 /* Char Table object */
95 /************************************************************************/ 95 /************************************************************************/
96
97 static int
98 print_preprocess_mapper (struct chartab_range * UNUSED (range),
99 Lisp_Object UNUSED (table), Lisp_Object val,
100 void *extra_arg)
101 {
102 print_preprocess (val, ((preprocess_info_t *) extra_arg)->table,
103 ((preprocess_info_t *) extra_arg)->count);
104 return 0;
105 }
106
107 static void
108 char_table_print_preprocess (Lisp_Object object, Lisp_Object print_number_table,
109 Elemcount *seen_object_count)
110 {
111 struct chartab_range ctr = { CHARTAB_RANGE_ALL, 0, Qnil, 0 };
112 preprocess_info_t preprocess_info = { print_number_table, seen_object_count };
113 map_char_table (object, &ctr, print_preprocess_mapper, &preprocess_info);
114 }
115
116 static void decode_char_table_range (Lisp_Object range,
117 struct chartab_range *outrange);
118
119 static int
120 nsubst_structures_mapper (struct chartab_range * range, Lisp_Object table,
121 Lisp_Object value, void *extra_arg)
122 {
123 Lisp_Object number_table
124 = ((nsubst_structures_info_t *) extra_arg)->number_table;
125 Lisp_Object new_ = ((nsubst_structures_info_t *) extra_arg)->new_;
126 Lisp_Object old = ((nsubst_structures_info_t *) extra_arg)->old;
127 Boolint test_not_unboundp
128 = ((nsubst_structures_info_t *) extra_arg)->test_not_unboundp;
129 struct chartab_range changed = { range->type, range->ch, range->charset,
130 range->row };
131
132 switch (range->type)
133 {
134 case CHARTAB_RANGE_ALL:
135 {
136 if (EQ (old, Qt) == test_not_unboundp)
137 {
138 decode_char_table_range (new_, &changed);
139
140 put_char_table (table, range, Qunbound);
141 put_char_table (table, &changed, value);
142 }
143 break;
144 }
145 case CHARTAB_RANGE_CHARSET:
146 {
147 if (EQ (old, range->charset) == test_not_unboundp)
148 {
149 CHECK_CHARSET (new_);
150 changed.charset = new_;
151
152 put_char_table (table, range, Qunbound);
153 put_char_table (table, &changed, value);
154 }
155 else assert (!HAS_OBJECT_METH_P (range->charset,
156 nsubst_structures_descend));
157 break;
158 }
159 case CHARTAB_RANGE_ROW:
160 {
161 if (EQ (old, make_int (range->row)) == test_not_unboundp)
162 {
163 CHECK_INT (new_);
164 changed.row = XINT (new_);
165
166 put_char_table (table, range, Qunbound);
167 put_char_table (table, &changed, value);
168 }
169 break;
170 }
171 case CHARTAB_RANGE_CHAR:
172 {
173 if (EQ (old, make_char (range->ch)) == test_not_unboundp)
174 {
175 CHECK_CHAR (new_);
176 changed.ch = XCHAR (new_);
177
178 put_char_table (table, range, Qunbound);
179 put_char_table (table, &changed, value);
180 }
181 break;
182 }
183 }
184
185 if (EQ (old, value) == test_not_unboundp)
186 {
187 put_char_table (table, &changed, new_);
188 }
189 else if (LRECORDP (value) &&
190 HAS_OBJECT_METH_P (value, nsubst_structures_descend))
191 {
192 nsubst_structures_descend (new_, old, value, number_table,
193 test_not_unboundp);
194 }
195
196 return 0;
197 }
198
199 static void
200 char_table_nsubst_structures_descend (Lisp_Object new_, Lisp_Object old,
201 Lisp_Object object,
202 Lisp_Object number_table,
203 Boolint test_not_unboundp)
204 {
205 struct chartab_range ctr = { CHARTAB_RANGE_ALL, 0, Qnil, 0 };
206 nsubst_structures_info_t nsubst_structures_info
207 = { number_table, new_, old, object, test_not_unboundp };
208
209 map_char_table (object, &ctr, nsubst_structures_mapper,
210 &nsubst_structures_info);
211 }
96 212
97 #ifdef MULE 213 #ifdef MULE
98 214
99 static Lisp_Object 215 static Lisp_Object
100 mark_char_table_entry (Lisp_Object obj) 216 mark_char_table_entry (Lisp_Object obj)
1888 } 2004 }
1889 #endif /* MULE */ 2005 #endif /* MULE */
1890 2006
1891 2007
1892 void 2008 void
2009 chartab_objects_create (void)
2010 {
2011 OBJECT_HAS_METHOD (char_table, print_preprocess);
2012 OBJECT_HAS_METHOD (char_table, nsubst_structures_descend);
2013 }
2014
2015 void
1893 syms_of_chartab (void) 2016 syms_of_chartab (void)
1894 { 2017 {
1895 INIT_LISP_OBJECT (char_table); 2018 INIT_LISP_OBJECT (char_table);
1896 2019
1897 #ifdef MULE 2020 #ifdef MULE