Defines
#define	CAR(x) ((x)->unode.a[2])
#define	CDR(x) ((x)->unode.a[3])
#define	POS(x) (((atom_ex_t)(x))->unode_ex.a[4])
#define	IS_LIST(x) (ID(x)==LIST_ID)
#define	IS_EMPTY(a) ((a)==empty_list)
#define	IS_NOT_EMPTY(a) ((a)!=empty_list)
#define	CAR_OFFSET 8
Functions
atom_t	new_list (atom_t car, atom_t cdr)
	creates a new list atom
atom_t	new_list_ex (atom_t car, atom_t cdr)
	creates a new extended list atom
void	delete_list (atom_t a)
	deletes list atom
void	dump_list (atom_t a, int level)
	dumps list atom
void	append (atom_t element, atom_t first, atom_t last)
	appends atom to list
void	append_ex (atom_t element, atom_t first, atom_t last)
	appends atom to extended node of a list
atom_t	copy_append (atom_t list, atom_t element)
	creates a copy of list and append element to end
atom_t	behead (atom_t a)
	removes the head of a list
atom_t	list_copy_n (atom_t a, unsigned int n)
	copies a list, but no more than n elents
atom_t	list_copy_but_last (atom_t a)
	copies a list, but without last element
int	list_length (atom_t a)
	returns count of list elements
atom_t	get_at_list (atom_t a, int n)
	returns element at specified position in list
Variables
atom_t	empty_list
	single instance of empty list [ ]
int	print_width_limit
	integer of PRINTWIDTHLIMIT
int	print_depth_limit
	integer of PRINTDEPTHLIMIT
Flags for lists
These bitmask flags determine whether a token is the first on a line (`FLAG_NEWLINE`), token is after or before a whitespace, and whether the node start a subexpression `(..)`.
#define	FLAG_NEWLINE 0x0001
#define	FLAG_AFTER_SPACE 0x0002
#define	FLAG_BEFORE_SPACE 0x0004
#define	FLAG_EXPRESSION 0x0008
#define	FLAG_TOKENIZED_DATA 0x0010
#define	FLAG_TOKENIZED_COMMANDS 0x0020
#define	FLAG_EXTENDED_NODE 0x0040
#define	FLAG_WAS_LIST_CONST 0x0080
#define	IS_EXPRESSION(a) GET_FLAGS(a,FLAG_EXPRESSION)
#define	IS_EXTENDED(a) GET_FLAGS(a,FLAG_EXTENDED_NODE)

Define Documentation

#define FLAG_NEWLINE 0x0001

#define FLAG_AFTER_SPACE 0x0002

#define FLAG_BEFORE_SPACE 0x0004

#define FLAG_EXPRESSION 0x0008

#define FLAG_TOKENIZED_DATA 0x0010

#define FLAG_TOKENIZED_COMMANDS 0x0020

#define FLAG_EXTENDED_NODE 0x0040

#define FLAG_WAS_LIST_CONST 0x0080

#define IS_EXPRESSION ( a ) GET_FLAGS(a,FLAG_EXPRESSION)

#define IS_EXTENDED ( a ) GET_FLAGS(a,FLAG_EXTENDED_NODE)

#define CAR ( x ) ((x)->unode.a[2])

#define CDR ( x ) ((x)->unode.a[3])

#define POS ( x ) (((atom_ex_t)(x))->unode_ex.a[4])

#define IS_LIST ( x ) (ID(x)==LIST_ID)

#define IS_EMPTY ( a ) ((a)==empty_list)

#define IS_NOT_EMPTY ( a ) ((a)!=empty_list)

#define CAR_OFFSET 8

Function Documentation

atom_t new_list	(	atom_t	car,
		atom_t	cdr
	)

Parameters:

car	value associated with the new list node
cdr	next node of the list

Returns:: list atom

Creates a list atom with reference count 1. The reference counts of car and cdr are not changed.

{
  atom_t a = (atom_t)take_from_pool( &data_pool );

  REF(a)   = 1;
  ID(a)    = LIST_ID;
  CAR(a)   = car;
  CDR(a)   = cdr;
  FLAGS(a) = 0;

  #ifdef SAFEMODE
    assert( car );
    assert( cdr );
  #endif //SAFEMODE

  #ifdef DEBUG_ATOM
    if( IS_EMPTY(cdr) )
      printf("<ATOM>  [%08x] list=[%08x]\n",(int)a,(int)car);
    else
      printf("<ATOM>  [%08x] list=[%08x %08x]\n",(int)a,(int)car,(int)cdr);
  #endif //DEBUG_ATOM

  #ifdef ADVANCED
    stats[ID(a)].allocs++;
    if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
      stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
    stats_free--;
  #endif //ADVANCED

  #ifdef DEBUG_RUNTIME_ATOMS
  if( running_compiled_code )
    {
      outter( TEXT("<RUNTIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif
  #ifdef DEBUG_COMPILETIME_ATOMS
  if( compiling_code )
    {
      outter( TEXT("<COMPILETIME> new  "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif

  return a;
}

atom_t new_list_ex	(	atom_t	car,
		atom_t	cdr
	)

Parameters:

car	value associated with the new list node
cdr	next node of the list

Returns:: list atom

Creates an extended list atom with reference count 1. The reference counts of car and cdr are not changed. The code should be the same as new_list() except that the extended pool is used, and the POS field is set to unbound

{
  atom_t a = (atom_t)take_from_pool( &data_pool_ex ); // extended atom
  //printf("============>new_list_ex at %x\n",(int)a);

  REF(a)   = 1;
  ID(a)    = LIST_ID;
  CAR(a)   = car;
  CDR(a)   = cdr;
  POS(a)   = unbound;         // extended atom
  FLAGS(a) = FLAG_EXTENDED_NODE; // extended atom

  #ifdef SAFEMODE
    assert( car );
    assert( cdr );
  #endif //SAFEMODE

  #ifdef DEBUG_ATOM
    if( IS_EMPTY(cdr) )
      printf("<ATOMX> [%08x] list=[%08x]\n",(int)a,(int)car);
    else
      printf("<ATOMX> [%08x] list=[%08x %08x]\n",(int)a,(int)car,(int)cdr);
  #endif //DEBUG_ATOM

  #ifdef ADVANCED
    stats[ID(a)].allocs++;
    if( stats[ID(a)].max<(stats[ID(a)].allocs-stats[ID(a)].deallocs) )
      stats[ID(a)].max=(stats[ID(a)].allocs-stats[ID(a)].deallocs);
    stats_free--;
  #endif //ADVANCED

  #ifdef DEBUG_RUNTIME_ATOMS
  if( running_compiled_code )
    {
      outter( TEXT("<RUNTIME> newx "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif
  #ifdef DEBUG_COMPILETIME_ATOMS
  if( compiling_code )
    {
      outter( TEXT("<COMPILETIME> newx "), -1 );
      dump_atom_address( a );
      dump_atom( a, 1 );
      outter( TEXT("\n"), -1 );
    }
  #endif

  return a;
}

void delete_list ( atom_t a )

Parameters:

a	atom to delete

Deletes the first node of list atom and its data. If needed deleted the next nodes.

{
  //printf(">>>DELETELIST %x ->",(int)a); dump_atom(a,1); printf("\n");
  while( 1 ) 
    {
      atom_t next = CDR(a);
      //printf(">>>   DEUSE CAR={"); dump_atom(CAR(a),1); printf("}\n");
      DEUSE( CAR(a) );
      //printf(">>>   DONE DEUSE CAR\n");
      if( IS_EXTENDED(a) )
      {
   //printf(">>>   DEUSE POS={");
   //dump_atom(POS(a),1);
   //printf("}\n");
   DEUSE( POS(a) ); 
   return_to_pool( &data_pool_ex, a ); // extended atom
      }
      else
   {
     return_to_pool( &data_pool, a );
   }

      a = next;
      if( IS_EMPTY(a) ) return;

      #ifdef DEBUG_ATOM
        printf("<ATOM>  [%08x] ref-1\n",(int)a);
      #endif //DEBUG_ATOM
      if( --REF(a) ) return;

      #ifdef ADVANCED
   stats[ID(a)].deallocs++;
   stats_free++;
      #endif //ADVANCED
    };
}

void dump_list	(	atom_t	a,
		int	level
	)

Parameters:

a	atom to dump
level	dump level

Dumps list atom through the current outter function.

{
  if( print_depth_limit!=-1 && print_depth_limit<=level )
    {
      outter( TEXT("..."), 3 );
      outter_size += 3;
      return;
    }

  #define DUMP_BUF_SIZE 4
  char_t buf[DUMP_BUF_SIZE];
  int expr;

  expr = IS_EXPRESSION(a);

  #ifdef DEBUG_REF_COUNT
    level=1;
  #endif

  if( expr )
    {
      buf[0] = TEXT('(');
      outter( buf, 1 );
      outter_size += 1;
    }
  else
    if( level ) 
      {
   buf[0] = TEXT('[');
   outter( buf, 1 );
   outter_size += 1;
      }
  #ifdef DEBUG_TOKENS
    printf("\n");
  #endif

  int space = 0;
  int count = 0;

  while( IS_NOT_EMPTY(a) )
    {
      if( space )
   {
     outter( TEXT(" "), 1 );
     outter_size += 1;
   }
      else { space = 1; }

      if( 0<=print_width_limit && print_width_limit<=count )
   {
     outter( TEXT("..."), 3 );
     outter_size += 3;
     break;
   }


  #ifdef DEBUG_REF_COUNT
    if( IS_EMPTY(a) )
      {
   outter( TEXT("{||}"), 2 );
      }
    else
      {
   int n;
   char_t buf[64];
   n = SPRINTF( buf, DUMP_BUF_SIZE, TEXT("|%d|"), REF(a) );
   outter( buf, n );
      }
  #endif

      dump_atom( CAR(a), level+1 );

/*        if( IS_EXTENDED(a) ) */
/*    { */
/*      printf("@{"); */
/*      dump_atom( POS(a), 1 );  */
/*      printf("}");  */
/*    }  */


      #ifdef DEBUG_LIST_FLAGS
      if( GET_FLAGS(a,FLAG_NEWLINE+FLAG_AFTER_SPACE+FLAG_BEFORE_SPACE) )
   { 
     outter(TEXT("{"),1);
     if( GET_FLAGS(a,FLAG_NEWLINE) ) outter(TEXT("New"),3); 
     if( GET_FLAGS(a,FLAG_AFTER_SPACE) ) outter(TEXT("Asp"),3); 
     if( GET_FLAGS(a,FLAG_BEFORE_SPACE) ) outter(TEXT("Bsp"),3); 
     outter(TEXT("}"),1);
   }
      #endif // DEBUG_LIST_FLAGS
      #ifdef DEBUG_LIST_TOKEN_FLAGS
      if( GET_FLAGS(a,FLAG_TOKENIZED_DATA+FLAG_TOKENIZED_COMMANDS) )
   { 
     //outter(TEXT("{"),1);
     if( GET_FLAGS(a,FLAG_TOKENIZED_DATA) ) outter(TEXT("'"),1); 
     if( GET_FLAGS(a,FLAG_TOKENIZED_COMMANDS) ) outter(TEXT("!"),1); 
     //outter(TEXT("}"),1);
   }
      #endif // DEBUG_LIST_FLAGS
      count++;
      a = CDR(a);
    }

  if( expr )
    {
      buf[0] = TEXT(')');
      outter( buf, 1 );
      outter_size += 1;
    }
  else
    if( level ) 
      {
   buf[0] = TEXT(']');
   outter( buf, 1 );
   outter_size += 1;
      }

  #ifdef DEBUG_TOKENS
  printf("\n");
  #endif

#undef DUMP_BUF_SIZE
}

void append	(	atom_t	element,
		atom_t *	first,
		atom_t *	last
	)

Parameters:

element	atom to be appended
first	first node of the list
last	last node of the list

Appends atom element to the end of the list starting with atom first and ending with atom last. If first and last are empty a new list will be created. All reference counts are kept unchanged.

{
  atom_t new = new_list( element, empty_list );

  if( IS_NOT_EMPTY(*first) )
    CDR(*last) = new;
  else
    *first = new;

  *last = new;
}

void append_ex	(	atom_t	element,
		atom_t *	first,
		atom_t *	last
	)

Parameters:

element	atom to be appended
first	first node of the list
last	last node of the list

Appends atom element to the end of the list starting with atom first and ending with atom last. If first and last are empty a new list will be created. All reference counts are kept unchanged. The new node is created as extended atom.

{
  atom_t new = new_list_ex( element, empty_list );

  if( IS_NOT_EMPTY(*first) )
    CDR(*last) = new;
  else
    *first = new;

  *last = new;
}

atom_t copy_append	(	atom_t	list,
		atom_t	element
	)

Parameters:

element	atom to be appended
list	list to be copied

Creates a copy of list and append element to it

{
    atom_t result, iter;

    if (!IS_LIST(list))
    {
        return new_error(ERROR_NOT_A_LIST, list);
    }
    if (IS_EMPTY(list))
    {
        return new_list(USE(element), empty_list);
    }

    result = new_list(USE(CAR(list)), empty_list);
    iter = result;
    list = CDR(list);
    while (IS_NOT_EMPTY(list))
    {
        CDR(iter) = new_list(USE(CAR(list)), empty_list);
        iter = CDR(iter);
        list = CDR(list);
    }
    CDR(iter) = new_list(USE(element), empty_list);

    return result;
}

atom_t behead ( atom_t a )

Parameters:

a	list to be beheaded

Returns:: the list without its head

Removes and deuses the head of a list and returns list's buthead. This functionality is useful for descructive iteration over a list.

{
  atom_t buthead = CDR(a);
  CDR(a) = empty_list;
  DEUSE(a);
  return buthead;
}

atom_t list_copy_n	(	atom_t	a,
		unsigned int	n
	)

Parameters:

a	list
n	max number of elements to be copied

Returns:: the new copy of the list

Copies list, but no more than n elements. New list contains same data - only CDR-s are copied.

{
    atom_t result, iter;

    if (!IS_LIST(a))
    {
        return new_error(ERROR_NOT_A_LIST, a);
    }
    if (IS_EMPTY(a) || n == 0)
    {
        return empty_list;
    }

    result = new_list(USE(CAR(a)), empty_list);
    iter = result;
    a = CDR(a);
    while (IS_NOT_EMPTY(a) && --n)
    {
        CDR(iter) = new_list(USE(CAR(a)), empty_list);
        iter = CDR(iter);
        a = CDR(a);
    }

    return result;
}

atom_t list_copy_but_last ( atom_t a )

Parameters:

a list

Returns:: the new copied list

Copies list, but without its last element. Linearly

{
    atom_t result, iter;

    if (!IS_LIST(a))
    {
        return new_error(ERROR_NOT_A_LIST, a);
    }
    if (IS_EMPTY(a))
    {
        return new_error(ERROR_MISSING_VALUE, a);
    }
    if (IS_EMPTY(CDR(a)))
    {
        return empty_list;
    }

    result = new_list(USE(CAR(a)), empty_list);
    iter = result;
    a = CDR(a);
    while (IS_NOT_EMPTY(CDR(a)))
    {
        CDR(iter) = new_list(USE(CAR(a)), empty_list);
        iter = CDR(iter);
        a = CDR(a);
    }

    return result;
}

int list_length ( atom_t a )

Parameters:

a list

Returns:: the number of elements of list

Returns number of elements in the list.

{
    int res = 0;
    if (!IS_LIST(a))
    {
        return -1;
    }
    while (IS_NOT_EMPTY(a))
    {
        ++res;
        a = CDR(a);
    }
    return res;
}

atom_t get_at_list	(	atom_t	a,
		int	n
	)

Parameters:

a	list
n	position index

Returns:: element at position or last if position is -1

Returns element at specified position in the list. If position is negative returns last element in the list

{
    if (!IS_LIST(a))
    {
        return new_error(ERROR_NOT_A_LIST, a);
    }
    if (IS_EMPTY(a))
    {
        return new_error(ERROR_MISSING_VALUE, a);
    }
    if (n < 0)
    {
        while (IS_NOT_EMPTY(CDR(a)))
            a = CDR(a);
    }
    else
    {
        while (IS_NOT_EMPTY(a) && n--)
            a = CDR(a);
        if (IS_EMPTY(a))
            return new_error(ERROR_MISSING_VALUE, a);
    }
    return CAR(a);
}

Variable Documentation

atom_t empty_list

int print_width_limit

int print_depth_limit

Defines

Functions

Variables

Flags for lists

Define Documentation

Function Documentation

Variable Documentation