Lhogho  0.0.028
 All Data Structures Files Functions Variables Typedefs Macros Pages
lists.c
Go to the documentation of this file.
1 //
2 // Project: Lhogho
3 // File: lists.c
4 //
5 // Copyright (C) 2007 P.Boytchev
6 //
7 // Revision history:
8 // 2007-06-09 - file created from atoms.c
9 // 2007-08-13 - support for PRINTDEPTHLIMIT, PRINTWIDTHLIMIT
10 // 2007-09-21 - list_copy_n, list_copy_but_last, list_length, get_at_list
11 // 2008-01-17 - extended atoms
12 // 2008-01-23 - Fixed bug #1836433 Example with IFTRUE fails
13 // 2012-09-23 - Added DEBUG_ATOM_LIST macro
14 //
15 //
16 // This program is free software; you can redistribute it and/or modify
17 // it under the terms of the GNU General Public License as published by
18 // the Free Software Foundation; either version 2 of the License, or
19 // (at your option) any later version.
20 //
21 // This program is distributed in the hope that it will be useful,
22 // but WITHOUT ANY WARRANTY; without even the implied warranty of
23 // MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
24 // GNU General Public License for more details.
25 //
26 // You should have received a copy of the GNU General Public License
27 // along with this program; if not, write to the Free Software
28 // Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
29 //
30 
31 
32 
33 #include "globals.h"
34 #ifdef UNICODE_CHARS
35  #include <wchar.h> // UNICODE support: wcslen()
36 #endif //UNICODE_CHARS
37 
38 #include <assert.h> // assert()
39 #include <errno.h> // errno, ENOMEM
40 #include <stdio.h> // fopen(), fread(), fclose()
41 #include <stdlib.h> // malloc()
42 #include <string.h> // memcpy()
43 #include <locale.h> // LC_ALL
44 
45 #include "atoms.h"
46 #include "words.h"
47 #include "lists.h"
48 #include "errors.h"
49 #include "pools.h"
50 #include "unicode.h"
51 #include "translate.h"
52 #include "vars.h"
53 #include "parser.h"
54 #include "options.h"
55 #include "compiler.h"
56 #include "numbers.h"
57 
61 
62 
63 
64 //===================================================
71 //===================================================
73 {
74 
75 // printf("DELETE_LIST(%x) ->",(int)a); dump_atom(a,1); printf("\n");
76 
77  while( 1 )
78  {
79  atom_t next = CDR(a);
80  //printf(">>> DEUSE CAR={"); dump_atom(CAR(a),1); printf("}\n");
81  DEUSE( CAR(a) );
82  //printf(">>> DONE DEUSE CAR\n");
83  if( IS_EXTENDED(a) )
84  {
85  //printf(">>> DEUSE POS={");
86  //dump_atom(POS(a),1);
87  //printf("}\n");
88  DEUSE( POS(a) );
89  return_to_pool( &data_pool_ex, a ); // extended atom
90  }
91  else
92  {
94  }
95 
96  a = next;
97  if( IS_EMPTY(a) ) return;
98 
99  #if defined DEBUG_ATOM || defined DEBUG_ATOM_LIST
100  printf("<ATOM> [%08x] ref-1\n",(int)a);
101  #endif //DEBUG_ATOM
102  if( --REF(a) ) return;
103 
104  #ifdef ADVANCED
105  stats[ID(a)].deallocs++;
106  stats_free++;
107  #endif //ADVANCED
108  };
109 }
110 
111 
112 
113 
114 //===================================================
124 //===================================================
126 {
128 
129  REF(a) = 1;
130  ID(a) = LIST_ID;
131  CAR(a) = car;
132  CDR(a) = cdr;
133  FLAGS(a) = 0;
134 
135  #ifdef SAFEMODE
136  assert( car );
137  assert( cdr );
138  #endif //SAFEMODE
139 
140  #if defined DEBUG_ATOM || defined DEBUG_ATOM_LIST
141  if( IS_EMPTY(cdr) )
142  {
143  printf("<ATOM> [%08x] list=[%08x]",(int)a,(int)car);
144  printf(" CAR="); dumpln(car);
145  }
146  else
147  printf("<ATOM> [%08x] list=[%08x %08x]\n",(int)a,(int)car,(int)cdr);
148  #endif //DEBUG_ATOM
149 
150  #ifdef ADVANCED
151  stats[ID(a)].allocs++;
152  if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
153  stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
154  stats_free--;
155  #endif //ADVANCED
156 
157  #ifdef DEBUG_RUNTIME_ATOMS
159  {
160  outter( TEXT("<RUNTIME> new "), -1 );
161  dump_atom_address( a );
162  dump_atom( a, 1 );
163  outter( TEXT("\n"), -1 );
164  }
165  #endif
166  #ifdef DEBUG_COMPILETIME_ATOMS
167  if( compiling_code )
168  {
169  outter( TEXT("<COMPILETIME> new "), -1 );
170  dump_atom_address( a );
171  dump_atom( a, 1 );
172  outter( TEXT("\n"), -1 );
173  }
174  #endif
175 
176  return a;
177 }
178 
179 
180 
181 
182 //===================================================
194 //===================================================
196 {
197  atom_t a = (atom_t)take_from_pool( &data_pool_ex ); // extended atom
198  //printf("============>new_list_ex at %x\n",(int)a);
199 
200  REF(a) = 1;
201  ID(a) = LIST_ID;
202  CAR(a) = car;
203  CDR(a) = cdr;
204  POS(a) = unbound; // extended atom
205  FLAGS(a) = FLAG_EXTENDED_NODE; // extended atom
206 
207  #ifdef SAFEMODE
208  assert( car );
209  assert( cdr );
210  #endif //SAFEMODE
211 
212  #if defined DEBUG_ATOM || defined DEBUG_ATOM_LIST
213  if( IS_EMPTY(cdr) )
214  printf("<ATOMX> [%08x] list=[%08x]\n",(int)a,(int)car);
215  else
216  printf("<ATOMX> [%08x] list=[%08x %08x]\n",(int)a,(int)car,(int)cdr);
217  #endif //DEBUG_ATOM
218 
219  #ifdef ADVANCED
220  stats[ID(a)].allocs++;
221  if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
222  stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
223  stats_free--;
224  #endif //ADVANCED
225 
226  #ifdef DEBUG_RUNTIME_ATOMS
228  {
229  outter( TEXT("<RUNTIME> newx "), -1 );
230  dump_atom_address( a );
231  dump_atom( a, 1 );
232  outter( TEXT("\n"), -1 );
233  }
234  #endif
235  #ifdef DEBUG_COMPILETIME_ATOMS
236  if( compiling_code )
237  {
238  outter( TEXT("<COMPILETIME> newx "), -1 );
239  dump_atom_address( a );
240  dump_atom( a, 1 );
241  outter( TEXT("\n"), -1 );
242  }
243  #endif
244 
245  return a;
246 }
247 
248 
249 
250 
251 //===================================================
258 //===================================================
259 void dump_list( atom_t a, int level )
260 {
261  if( print_depth_limit!=-1 && print_depth_limit<=level )
262  {
263  outter( TEXT("..."), 3 );
264  outter_size += 3;
265  return;
266  }
267 
268  #define DUMP_BUF_SIZE 4
269  char_t buf[DUMP_BUF_SIZE];
270  int expr;
271 
272  expr = IS_EXPRESSION(a);
273 
274  #ifdef DEBUG_REF_COUNT
275  level=1;
276  #endif
277 
278  if( expr )
279  {
280  buf[0] = TEXT('(');
281  outter( buf, 1 );
282  outter_size += 1;
283  }
284  else
285  if( level )
286  {
287  buf[0] = TEXT('[');
288  outter( buf, 1 );
289  outter_size += 1;
290  }
291  #ifdef DEBUG_TOKENS
292  printf("\n");
293  #endif
294 
295  int space = 0;
296  int count = 0;
297 
298  while( IS_NOT_EMPTY(a) )
299  {
300  if( space )
301  {
302  outter( TEXT(" "), 1 );
303  outter_size += 1;
304  }
305  else { space = 1; }
306 
307  if( 0<=print_width_limit && print_width_limit<=count )
308  {
309  outter( TEXT("..."), 3 );
310  outter_size += 3;
311  break;
312  }
313 
314 
315  #ifdef DEBUG_REF_COUNT
316  if( IS_EMPTY(a) )
317  {
318  outter( TEXT("{||}"), 2 );
319  }
320  else
321  {
322  int n;
323  char_t buf[64];
324  n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT("|%d|"), REF(a) );
325  outter( buf, n );
326  }
327  #endif
328 
329  dump_atom( CAR(a), level+1 );
330 
331 /* if( IS_EXTENDED(a) ) */
332 /* { */
333 /* printf("@{"); */
334 /* dump_atom( POS(a), 1 ); */
335 /* printf("}"); */
336 /* } */
337 
338 
339  #ifdef DEBUG_LIST_FLAGS
341  {
342  outter(TEXT("{"),1);
343  if( GET_FLAGS(a,FLAG_NEWLINE) ) outter(TEXT("New"),3);
344  if( GET_FLAGS(a,FLAG_AFTER_SPACE) ) outter(TEXT("Asp"),3);
345  if( GET_FLAGS(a,FLAG_BEFORE_SPACE) ) outter(TEXT("Bsp"),3);
346  outter(TEXT("}"),1);
347  }
348  #endif // DEBUG_LIST_FLAGS
349  #ifdef DEBUG_LIST_TOKEN_FLAGS
351  {
352  //outter(TEXT("{"),1);
353  if( GET_FLAGS(a,FLAG_TOKENIZED_DATA) ) outter(TEXT("'"),1);
354  if( GET_FLAGS(a,FLAG_TOKENIZED_COMMANDS) ) outter(TEXT("!"),1);
355  //outter(TEXT("}"),1);
356  }
357  #endif // DEBUG_LIST_FLAGS
358  count++;
359  a = CDR(a);
360  }
361 
362  if( expr )
363  {
364  buf[0] = TEXT(')');
365  outter( buf, 1 );
366  outter_size += 1;
367  }
368  else
369  if( level )
370  {
371  buf[0] = TEXT(']');
372  outter( buf, 1 );
373  outter_size += 1;
374  }
375 
376  #ifdef DEBUG_TOKENS
377  printf("\n");
378  #endif
379 
380 #undef DUMP_BUF_SIZE
381 }
382 
383 
384 
385 //===========================================================
396 //===========================================================
397 void append( atom_t element, atom_t *first, atom_t *last )
398 {
399  atom_t new = new_list( element, empty_list );
400 
401  if( IS_NOT_EMPTY(*first) )
402  CDR(*last) = new;
403  else
404  *first = new;
405 
406  *last = new;
407 }
408 
409 
410 
411 //===========================================================
423 //===========================================================
424 void append_ex( atom_t element, atom_t *first, atom_t *last )
425 {
426  atom_t new = new_list_ex( element, empty_list );
427 
428  if( IS_NOT_EMPTY(*first) )
429  CDR(*last) = new;
430  else
431  *first = new;
432 
433  *last = new;
434 }
435 
436 
437 
438 //===========================================================
445 //===========================================================
447 {
448  atom_t result, iter;
449 
450  if (!IS_LIST(list))
451  {
452  return new_error(ERROR_NOT_A_LIST, list);
453  }
454  if (IS_EMPTY(list))
455  {
456  return new_list(USE(element), empty_list);
457  }
458 
459  result = new_list(USE(CAR(list)), empty_list);
460  iter = result;
461  list = CDR(list);
462  while (IS_NOT_EMPTY(list))
463  {
464  CDR(iter) = new_list(USE(CAR(list)), empty_list);
465  iter = CDR(iter);
466  list = CDR(list);
467  }
468  CDR(iter) = new_list(USE(element), empty_list);
469 
470  return result;
471 }
472 
473 
474 //===========================================================
483 //===========================================================
485 {
486  atom_t buthead = CDR(a);
487  CDR(a) = empty_list;
488  DEUSE(a);
489  return buthead;
490 }
491 
492 
493 //===========================================================
500 //===========================================================
502 {
503  int res = 0;
504  if (!IS_LIST(a))
505  {
506  return -1;
507  }
508  while (IS_NOT_EMPTY(a))
509  {
510  ++res;
511  a = CDR(a);
512  }
513  return res;
514 }
515 
516 
517 //===========================================================
526 //===========================================================
527 atom_t list_copy_n (atom_t a, unsigned int n)
528 {
529  atom_t result, iter;
530 
531  if (!IS_LIST(a))
532  {
533  return new_error(ERROR_NOT_A_LIST, a);
534  }
535  if (IS_EMPTY(a) || n == 0)
536  {
537  return empty_list;
538  }
539 
540  result = new_list(USE(CAR(a)), empty_list);
541  iter = result;
542  a = CDR(a);
543  while (IS_NOT_EMPTY(a) && --n)
544  {
545  CDR(iter) = new_list(USE(CAR(a)), empty_list);
546  iter = CDR(iter);
547  a = CDR(a);
548  }
549 
550  return result;
551 }
552 
553 
554 //===========================================================
561 //===========================================================
563 {
564  atom_t result, iter;
565 
566  if (!IS_LIST(a))
567  {
568  return new_error(ERROR_NOT_A_LIST, a);
569  }
570  if (IS_EMPTY(a))
571  {
572  return new_error(ERROR_MISSING_VALUE, a);
573  }
574  if (IS_EMPTY(CDR(a)))
575  {
576  return empty_list;
577  }
578 
579  result = new_list(USE(CAR(a)), empty_list);
580  iter = result;
581  a = CDR(a);
582  while (IS_NOT_EMPTY(CDR(a)))
583  {
584  CDR(iter) = new_list(USE(CAR(a)), empty_list);
585  iter = CDR(iter);
586  a = CDR(a);
587  }
588 
589  return result;
590 }
591 
592 
593 //===========================================================
602 //===========================================================
604 {
605  if (!IS_LIST(a))
606  {
607  return new_error(ERROR_NOT_A_LIST, a);
608  }
609  if (IS_EMPTY(a))
610  {
611  return new_error(ERROR_MISSING_VALUE, a);
612  }
613  if (n < 0)
614  {
615  while (IS_NOT_EMPTY(CDR(a)))
616  a = CDR(a);
617  }
618  else
619  {
620  while (IS_NOT_EMPTY(a) && n--)
621  a = CDR(a);
622  if (IS_EMPTY(a))
623  return new_error(ERROR_MISSING_VALUE, a);
624  }
625  return CAR(a);
626 }
627 

[ HOME | INDEX | ATOMS | VARS | REFERENCE ]
Lhogho Developer's Documentation
Wed Jul 10 2013