comparison src/intervals.c @ 28269:fd13be8ae190

Changes towards better type safety regarding intervals, primarily regarding the "parent" handle. These just separate out the different usages based on the type of parent (interval vs lisp object); later changes will do type checking and enforcement. * intervals.h (NULL_INTERVAL): Cast to INTERVAL type. (INT_LISPLIKE): New macro. (NULL_INTERVAL_P): Use it. (INTERVAL_HAS_PARENT, INTERVAL_HAS_OBJECT, SET_INTERVAL_PARENT, SET_INTERVAL_OBJECT, INTERVAL_PARENT, COPY_INTERVAL_PARENT, GET_INTERVAL_OBJECT, INTERVAL_PARENT_OR_NULL): New macros. * alloc.c (make_interval, gc_sweep): Use new macros; eliminate all explicit references to "parent" field of struct interval and associated unclean type conversions. * intervals.c (create_root_interval, root_interval, rotate_right, rotate_left, balance_possible_root_interval, split_interval_right, split_interval_left, interval_start_pos, find_interval, next_interval, previous_interval, update_interval, adjust_intervals_for_insertion, delete_node, delete_interval, adjust_intervals_for_deletion, merge_interval_right, merge_interval_left, reproduce_tree, graft_intervals_into_buffer, copy_intervals_to_string): Likewise. * intervals.h (AM_LEFT_CHILD, AM_RIGHT_CHILD, RESET_INTERVAL): Likewise. * syntax.c (update_syntax_table): Likewise. * intervals.c (reproduce_tree_obj): New function, like reproduce_tree but takes a Lisp_Object for the parent. Declare with prototype. (graft_intervals_into_buffer): Use it when appropriate. (reproduce_tree): Declare with prototype. (balance_possible_root_interval): Check that the parent is a lisp object before trying to examine its type.

28268:33f65d22f2a8

#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))

#define min(x, y) ((x) < (y) ? (x) : (y))

Lisp_Object merge_properties_sticky ();

/* Utility functions for intervals.  */


/* Create the root interval of some object, a buffer or string.  */

      new->total_length = XSTRING (parent)->size;
      XSTRING (parent)->intervals = new;
      new->position = 0;
    }

  new->parent = (INTERVAL) XFASTINT (parent);

  return new;
}

/* Make the interval TARGET have exactly the properties of SOURCE */

     INTERVAL interval;
{
  register INTERVAL i = interval;

  while (! ROOT_INTERVAL_P (i))
    i = i->parent;

  return i;
}
#endif


  /* Deal with any Parent of A;  make it point to B.  */
  if (! ROOT_INTERVAL_P (interval))
    {
      if (AM_LEFT_CHILD (interval))
	interval->parent->left = B;
      else
	interval->parent->right = B;
    }
  B->parent = interval->parent;

  /* Make B the parent of A */
  i = B->right;
  B->right = interval;
  interval->parent = B;

  /* Make A point to c */
  interval->left = i;
  if (! NULL_INTERVAL_P (i))
    i->parent = interval;

  /* A's total length is decreased by the length of B and its left child.  */
  interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);

  /* B must have the same total length of A.  */

  /* Deal with any parent of A;  make it point to B.  */
  if (! ROOT_INTERVAL_P (interval))
    {
      if (AM_LEFT_CHILD (interval))
	interval->parent->left = B;
      else
	interval->parent->right = B;
    }
  B->parent = interval->parent;

  /* Make B the parent of A */
  i = B->left;
  B->left = interval;
  interval->parent = B;

  /* Make A point to c */
  interval->right = i;
  if (! NULL_INTERVAL_P (i))
    i->parent = interval;

  /* A's total length is decreased by the length of B and its right child.  */
  interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);

  /* B must have the same total length of A.  */

static INLINE INTERVAL
balance_possible_root_interval (interval)
     register INTERVAL interval;
{
  Lisp_Object parent;

  if (interval->parent == NULL_INTERVAL)
    return interval;

  XSETFASTINT (parent, (EMACS_INT) interval->parent);
  interval = balance_an_interval (interval);

  if (BUFFERP (parent))
    BUF_INTERVALS (XBUFFER (parent)) = interval;
  else if (STRINGP (parent))
    XSTRING (parent)->intervals = interval;

  return interval;
}

/* Balance the interval tree TREE.  Balancing is by weight

  INTERVAL new = make_interval ();
  int position = interval->position;
  int new_length = LENGTH (interval) - offset;

  new->position = position + offset;
  new->parent = interval;

  if (NULL_RIGHT_CHILD (interval))
    {
      interval->right = new;
      new->total_length = new_length;
    }
  else
    {
      /* Insert the new node between INTERVAL and its right child.  */
      new->right = interval->right;
      interval->right->parent = new;
      interval->right = new;
      new->total_length = new_length + new->right->total_length;
      balance_an_interval (new);
    }
  

  INTERVAL new = make_interval ();
  int new_length = offset;

  new->position = interval->position;
  interval->position = interval->position + offset;
  new->parent = interval;

  if (NULL_LEFT_CHILD (interval))
    {
      interval->left = new;
      new->total_length = new_length;
    }
  else
    {
      /* Insert the new node between INTERVAL and its left child.  */
      new->left = interval->left;
      new->left->parent = new;
      interval->left = new;
      new->total_length = new_length + new->left->total_length;
      balance_an_interval (new);
    }
  

  Lisp_Object parent;

  if (NULL_INTERVAL_P (source))
    return 0;

  XSETFASTINT (parent, (EMACS_INT) source->parent);
  if (BUFFERP (parent))
    return BUF_BEG (XBUFFER (parent));
  return 0;
}

     register int position;
{
  /* The distance from the left edge of the subtree at TREE
                    to POSITION.  */
  register int relative_position;
  Lisp_Object parent;

  if (NULL_INTERVAL_P (tree))
    return NULL_INTERVAL;

  XSETFASTINT (parent, (EMACS_INT) tree->parent);
  relative_position = position;
  if (BUFFERP (parent))
    relative_position -= BUF_BEG (XBUFFER (parent));

  if (relative_position > TOTAL_LENGTH (tree))
    abort ();			/* Paranoia */

  tree = balance_possible_root_interval (tree);

  while (! NULL_PARENT (i))
    {
      if (AM_LEFT_CHILD (i))
	{
	  i = i->parent;
	  i->position = next_position;
	  return i;
	}

      i = i->parent;
    }

  return NULL_INTERVAL;
}

  i = interval;
  while (! NULL_PARENT (i))
    {
      if (AM_RIGHT_CHILD (i))
	{
	  i = i->parent;

	  i->position = interval->position - LENGTH (i);
	  return i;
	}
      i = i->parent;
    }

  return NULL_INTERVAL;
}

	      i = i->left;		/* Move to the left child */
	    }
	  else if (NULL_PARENT (i)) 
	    error ("Point before start of properties");
	  else  
	      i = i->parent;
	  continue;
	}
      else if (pos >= INTERVAL_LAST_POS (i))
	{
	  /* Move right. */

	      i = i->right;		/* Move to the right child */
	    }
	  else if (NULL_PARENT (i)) 
	    error ("Point after end of properties");
	  else 
	      i = i->parent;
	  continue;
	}
      else 
	return i;
    }

  int offset;
  
  if (TOTAL_LENGTH (tree) == 0)	/* Paranoia */
    abort ();

  XSETFASTINT (parent, (EMACS_INT) tree->parent);
  offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);

  /* If inserting at point-max of a buffer, that position will be out
     of range.  Remember that buffer positions are 1-based.  */
  if (position >= TOTAL_LENGTH (tree) + offset)

	prev = previous_interval (i);

      /* Even if we are positioned between intervals, we default
	 to the left one if it exists.  We extend it now and split
	 off a part later, if stickiness demands it.  */
      for (temp = prev ? prev : i;! NULL_INTERVAL_P (temp); temp = temp->parent)
	{
	  temp->total_length += length;
	  temp = balance_possible_root_interval (temp);
	}
      

    }

  /* Otherwise just extend the interval.  */
  else
    {
      for (temp = i; ! NULL_INTERVAL_P (temp); temp = temp->parent)
	{
	  temp->total_length += length;
	  temp = balance_possible_root_interval (temp);
	}
    }

    {
      this = this->left;
      this->total_length += migrate_amt;
    }
  this->left = migrate;
  migrate->parent = this;

  return i->right;
}

/* Delete interval I from its tree by calling `delete_node'

    abort ();

  if (ROOT_INTERVAL_P (i))
    {
      Lisp_Object owner;
      XSETFASTINT (owner, (EMACS_INT) i->parent);
      parent = delete_node (i);
      if (! NULL_INTERVAL_P (parent))
	parent->parent = (INTERVAL) XFASTINT (owner);

      if (BUFFERP (owner))
	BUF_INTERVALS (XBUFFER (owner)) = parent;
      else if (STRINGP (owner))
	XSTRING (owner)->intervals = parent;

	abort ();

      return;
    }

  parent = i->parent;
  if (AM_LEFT_CHILD (i))
    {
      parent->left = delete_node (i);
      if (! NULL_INTERVAL_P (parent->left))
	parent->left->parent = parent;
    }
  else
    {
      parent->right = delete_node (i);
      if (! NULL_INTERVAL_P (parent->right))
	parent->right->parent = parent;
    }
}

/* Find the interval in TREE corresponding to the relative position
   FROM and delete as much as possible of AMOUNT from that interval.

  register int left_to_delete = length;
  register INTERVAL tree = BUF_INTERVALS (buffer);
  Lisp_Object parent;
  int offset;

  XSETFASTINT (parent, (EMACS_INT) tree->parent);
  offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);

  if (NULL_INTERVAL_P (tree))
    return;

  while (! NULL_PARENT (successor))	   /* It's above us.  Subtract as
					      we ascend.  */
    {
      if (AM_LEFT_CHILD (successor))
	{
	  successor = successor->parent;
	  delete_interval (i);
	  return successor;
	}

      successor = successor->parent;
      successor->total_length -= absorb;
    }

  /* This must be the rightmost or last interval and cannot
     be merged right.  The caller should have known.  */

  while (! NULL_PARENT (predecessor))	/* It's above us.  Go up,
				   subtracting ABSORB.  */
    {
      if (AM_RIGHT_CHILD (predecessor))
	{
	  predecessor = predecessor->parent;
	  delete_interval (i);
	  return predecessor;
	}

      predecessor = predecessor->parent;
      predecessor->total_length -= absorb;
    }

  /* This must be the leftmost or first interval and cannot
     be merged left.  The caller should have known.  */

{
  register INTERVAL t = make_interval ();

  bcopy (source, t, INTERVAL_SIZE);
  copy_properties (source, t);
  t->parent = parent;
  if (! NULL_LEFT_CHILD (source))
    t->left = reproduce_tree (source->left, t);
  if (! NULL_RIGHT_CHILD (source))
    t->right = reproduce_tree (source->right, t);

	 simply copy over the interval structure.  */
      if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
	{
	  Lisp_Object buf;
	  XSETBUFFER (buf, buffer);
	  BUF_INTERVALS (buffer) = reproduce_tree (source, buf);
	  BUF_INTERVALS (buffer)->position = 1;

	  /* Explicitly free the old tree here?  */

	  return;

    /* If the buffer contains only the new string, but
       there was already some interval tree there, then it may be
       some zero length intervals.  Eventually, do something clever
       about inserting properly.  For now, just waste the old intervals.  */
    {
      BUF_INTERVALS (buffer) = reproduce_tree (source, tree->parent);
      BUF_INTERVALS (buffer)->position = 1;
      /* Explicitly free the old tree here.  */

      return;
    }

  INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
					   position, length);
  if (NULL_INTERVAL_P (interval_copy))
    return;

  interval_copy->parent = (INTERVAL) XFASTINT (string);
  XSTRING (string)->intervals = interval_copy;
}

/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
   Assume they have identical characters.  */

28269:fd13be8ae190

#define TMEM(sym, set) (CONSP (set) ? ! NILP (Fmemq (sym, set)) : ! NILP (set))

#define min(x, y) ((x) < (y) ? (x) : (y))

Lisp_Object merge_properties_sticky ();
static INTERVAL reproduce_tree P_ ((INTERVAL, INTERVAL));
static INTERVAL reproduce_tree_obj P_ ((INTERVAL, Lisp_Object));

/* Utility functions for intervals.  */


/* Create the root interval of some object, a buffer or string.  */

      new->total_length = XSTRING (parent)->size;
      XSTRING (parent)->intervals = new;
      new->position = 0;
    }

  SET_INTERVAL_OBJECT (new, parent);

  return new;
}

/* Make the interval TARGET have exactly the properties of SOURCE */

     INTERVAL interval;
{
  register INTERVAL i = interval;

  while (! ROOT_INTERVAL_P (i))
    i = INTERVAL_PARENT (i);

  return i;
}
#endif


  /* Deal with any Parent of A;  make it point to B.  */
  if (! ROOT_INTERVAL_P (interval))
    {
      if (AM_LEFT_CHILD (interval))
	INTERVAL_PARENT (interval)->left = B;
      else
	INTERVAL_PARENT (interval)->right = B;
    }
  COPY_INTERVAL_PARENT (B, interval);

  /* Make B the parent of A */
  i = B->right;
  B->right = interval;
  SET_INTERVAL_PARENT (interval, B);

  /* Make A point to c */
  interval->left = i;
  if (! NULL_INTERVAL_P (i))
    SET_INTERVAL_PARENT (i, interval);

  /* A's total length is decreased by the length of B and its left child.  */
  interval->total_length -= B->total_length - LEFT_TOTAL_LENGTH (interval);

  /* B must have the same total length of A.  */

  /* Deal with any parent of A;  make it point to B.  */
  if (! ROOT_INTERVAL_P (interval))
    {
      if (AM_LEFT_CHILD (interval))
	INTERVAL_PARENT (interval)->left = B;
      else
	INTERVAL_PARENT (interval)->right = B;
    }
  COPY_INTERVAL_PARENT (B, interval);

  /* Make B the parent of A */
  i = B->left;
  B->left = interval;
  SET_INTERVAL_PARENT (interval, B);

  /* Make A point to c */
  interval->right = i;
  if (! NULL_INTERVAL_P (i))
    SET_INTERVAL_PARENT (i, interval);

  /* A's total length is decreased by the length of B and its right child.  */
  interval->total_length -= B->total_length - RIGHT_TOTAL_LENGTH (interval);

  /* B must have the same total length of A.  */

static INLINE INTERVAL
balance_possible_root_interval (interval)
     register INTERVAL interval;
{
  Lisp_Object parent;
  int have_parent = 0;

  if (!INTERVAL_HAS_OBJECT (interval) && !INTERVAL_HAS_PARENT (interval))
    return interval;

  if (INTERVAL_HAS_OBJECT (interval))
    {
      have_parent = 1;
      GET_INTERVAL_OBJECT (parent, interval);
    }
  interval = balance_an_interval (interval);

  if (have_parent)
    {
      if (BUFFERP (parent))
	BUF_INTERVALS (XBUFFER (parent)) = interval;
      else if (STRINGP (parent))
	XSTRING (parent)->intervals = interval;
    }

  return interval;
}

/* Balance the interval tree TREE.  Balancing is by weight

  INTERVAL new = make_interval ();
  int position = interval->position;
  int new_length = LENGTH (interval) - offset;

  new->position = position + offset;
  SET_INTERVAL_PARENT (new, interval);

  if (NULL_RIGHT_CHILD (interval))
    {
      interval->right = new;
      new->total_length = new_length;
    }
  else
    {
      /* Insert the new node between INTERVAL and its right child.  */
      new->right = interval->right;
      SET_INTERVAL_PARENT (interval->right, new);
      interval->right = new;
      new->total_length = new_length + new->right->total_length;
      balance_an_interval (new);
    }
  

  INTERVAL new = make_interval ();
  int new_length = offset;

  new->position = interval->position;
  interval->position = interval->position + offset;
  SET_INTERVAL_PARENT (new, interval);

  if (NULL_LEFT_CHILD (interval))
    {
      interval->left = new;
      new->total_length = new_length;
    }
  else
    {
      /* Insert the new node between INTERVAL and its left child.  */
      new->left = interval->left;
      SET_INTERVAL_PARENT (new->left, new);
      interval->left = new;
      new->total_length = new_length + new->left->total_length;
      balance_an_interval (new);
    }
  

  Lisp_Object parent;

  if (NULL_INTERVAL_P (source))
    return 0;

  GET_INTERVAL_OBJECT (parent, source);
  if (BUFFERP (parent))
    return BUF_BEG (XBUFFER (parent));
  return 0;
}

     register int position;
{
  /* The distance from the left edge of the subtree at TREE
                    to POSITION.  */
  register int relative_position;

  if (NULL_INTERVAL_P (tree))
    return NULL_INTERVAL;

  relative_position = position;
  if (INTERVAL_HAS_OBJECT (tree))
    {
      Lisp_Object parent;
      GET_INTERVAL_OBJECT (parent, tree);
      if (BUFFERP (parent))
	relative_position -= BUF_BEG (XBUFFER (parent));
    }

  if (relative_position > TOTAL_LENGTH (tree))
    abort ();			/* Paranoia */

  tree = balance_possible_root_interval (tree);

  while (! NULL_PARENT (i))
    {
      if (AM_LEFT_CHILD (i))
	{
	  i = INTERVAL_PARENT (i);
	  i->position = next_position;
	  return i;
	}

      i = INTERVAL_PARENT (i);
    }

  return NULL_INTERVAL;
}

  i = interval;
  while (! NULL_PARENT (i))
    {
      if (AM_RIGHT_CHILD (i))
	{
	  i = INTERVAL_PARENT (i);

	  i->position = interval->position - LENGTH (i);
	  return i;
	}
      i = INTERVAL_PARENT (i);
    }

  return NULL_INTERVAL;
}

	      i = i->left;		/* Move to the left child */
	    }
	  else if (NULL_PARENT (i)) 
	    error ("Point before start of properties");
	  else  
	      i = INTERVAL_PARENT (i);
	  continue;
	}
      else if (pos >= INTERVAL_LAST_POS (i))
	{
	  /* Move right. */

	      i = i->right;		/* Move to the right child */
	    }
	  else if (NULL_PARENT (i)) 
	    error ("Point after end of properties");
	  else 
	      i = INTERVAL_PARENT (i);
	  continue;
	}
      else 
	return i;
    }

  int offset;
  
  if (TOTAL_LENGTH (tree) == 0)	/* Paranoia */
    abort ();

  GET_INTERVAL_OBJECT (parent, tree);
  offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);

  /* If inserting at point-max of a buffer, that position will be out
     of range.  Remember that buffer positions are 1-based.  */
  if (position >= TOTAL_LENGTH (tree) + offset)

	prev = previous_interval (i);

      /* Even if we are positioned between intervals, we default
	 to the left one if it exists.  We extend it now and split
	 off a part later, if stickiness demands it.  */
      for (temp = prev ? prev : i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
	{
	  temp->total_length += length;
	  temp = balance_possible_root_interval (temp);
	}
      

    }

  /* Otherwise just extend the interval.  */
  else
    {
      for (temp = i; temp; temp = INTERVAL_PARENT_OR_NULL (temp))
	{
	  temp->total_length += length;
	  temp = balance_possible_root_interval (temp);
	}
    }

    {
      this = this->left;
      this->total_length += migrate_amt;
    }
  this->left = migrate;
  SET_INTERVAL_PARENT (migrate, this);

  return i->right;
}

/* Delete interval I from its tree by calling `delete_node'

    abort ();

  if (ROOT_INTERVAL_P (i))
    {
      Lisp_Object owner;
      GET_INTERVAL_OBJECT (owner, i);
      parent = delete_node (i);
      if (! NULL_INTERVAL_P (parent))
	SET_INTERVAL_OBJECT (parent, owner);

      if (BUFFERP (owner))
	BUF_INTERVALS (XBUFFER (owner)) = parent;
      else if (STRINGP (owner))
	XSTRING (owner)->intervals = parent;

	abort ();

      return;
    }

  parent = INTERVAL_PARENT (i);
  if (AM_LEFT_CHILD (i))
    {
      parent->left = delete_node (i);
      if (! NULL_INTERVAL_P (parent->left))
	SET_INTERVAL_PARENT (parent->left, parent);
    }
  else
    {
      parent->right = delete_node (i);
      if (! NULL_INTERVAL_P (parent->right))
	SET_INTERVAL_PARENT (parent->right, parent);
    }
}

/* Find the interval in TREE corresponding to the relative position
   FROM and delete as much as possible of AMOUNT from that interval.

  register int left_to_delete = length;
  register INTERVAL tree = BUF_INTERVALS (buffer);
  Lisp_Object parent;
  int offset;

  GET_INTERVAL_OBJECT (parent, tree);
  offset = (BUFFERP (parent) ? BUF_BEG (XBUFFER (parent)) : 0);

  if (NULL_INTERVAL_P (tree))
    return;

  while (! NULL_PARENT (successor))	   /* It's above us.  Subtract as
					      we ascend.  */
    {
      if (AM_LEFT_CHILD (successor))
	{
	  successor = INTERVAL_PARENT (successor);
	  delete_interval (i);
	  return successor;
	}

      successor = INTERVAL_PARENT (successor);
      successor->total_length -= absorb;
    }

  /* This must be the rightmost or last interval and cannot
     be merged right.  The caller should have known.  */

  while (! NULL_PARENT (predecessor))	/* It's above us.  Go up,
				   subtracting ABSORB.  */
    {
      if (AM_RIGHT_CHILD (predecessor))
	{
	  predecessor = INTERVAL_PARENT (predecessor);
	  delete_interval (i);
	  return predecessor;
	}

      predecessor = INTERVAL_PARENT (predecessor);
      predecessor->total_length -= absorb;
    }

  /* This must be the leftmost or first interval and cannot
     be merged left.  The caller should have known.  */

{
  register INTERVAL t = make_interval ();

  bcopy (source, t, INTERVAL_SIZE);
  copy_properties (source, t);
  SET_INTERVAL_PARENT (t, parent);
  if (! NULL_LEFT_CHILD (source))
    t->left = reproduce_tree (source->left, t);
  if (! NULL_RIGHT_CHILD (source))
    t->right = reproduce_tree (source->right, t);

  return t;
}

static INTERVAL
reproduce_tree_obj (source, parent)
     INTERVAL source;
     Lisp_Object parent;
{
  register INTERVAL t = make_interval ();

  bcopy (source, t, INTERVAL_SIZE);
  copy_properties (source, t);
  SET_INTERVAL_OBJECT (t, parent);
  if (! NULL_LEFT_CHILD (source))
    t->left = reproduce_tree (source->left, t);
  if (! NULL_RIGHT_CHILD (source))
    t->right = reproduce_tree (source->right, t);

	 simply copy over the interval structure.  */
      if ((BUF_Z (buffer) - BUF_BEG (buffer)) == TOTAL_LENGTH (source))
	{
	  Lisp_Object buf;
	  XSETBUFFER (buf, buffer);
	  BUF_INTERVALS (buffer) = reproduce_tree_obj (source, buf);
	  BUF_INTERVALS (buffer)->position = 1;

	  /* Explicitly free the old tree here?  */

	  return;

    /* If the buffer contains only the new string, but
       there was already some interval tree there, then it may be
       some zero length intervals.  Eventually, do something clever
       about inserting properly.  For now, just waste the old intervals.  */
    {
      BUF_INTERVALS (buffer) = reproduce_tree (source, INTERVAL_PARENT (tree));
      BUF_INTERVALS (buffer)->position = 1;
      /* Explicitly free the old tree here.  */

      return;
    }

  INTERVAL interval_copy = copy_intervals (BUF_INTERVALS (buffer),
					   position, length);
  if (NULL_INTERVAL_P (interval_copy))
    return;

  SET_INTERVAL_OBJECT (interval_copy, string);
  XSTRING (string)->intervals = interval_copy;
}

/* Return 1 if strings S1 and S2 have identical properties; 0 otherwise.
   Assume they have identical characters.  */