Synopsis - Cross-Reference

  1//
  2// Copyright (C) 1997-2000 Shigeru Chiba
  3// Copyright (C) 2000 Stefan Seefeld
  4// Copyright (C) 2000 Stephen Davies
  5// All rights reserved.
  6// Licensed to the public under the terms of the GNU LGPL (>= 2),
  7// see the file COPYING for details.
  8//
  9
 10#include "Synopsis/PTree/operations.hh"
 11
 12namespace Synopsis
 13{
 14namespace PTree
 15{
 16
 17bool operator == (const Node &p, char c)
 18{
 19  return p.is_atom() && p.length() == 1 && *p.position() == c;
 20}
 21
 22bool operator == (const Node &n, const char *str)
 23{
 24  if (!n.is_atom()) return false;
 25  const char *p = n.position();
 26  size_t l = n.length();
 27  size_t i = 0;
 28  for(; i < l; ++i)
 29    if(p[i] != str[i] || str[i] == '\0')
 30      return false;
 31  return str[i] == '\0';
 32}
 33
 34bool operator == (const Node &p, const Node &q)
 35{
 36  if(!p.is_atom() || !q.is_atom()) return false;
 37
 38  size_t plen = p.length();
 39  size_t qlen = q.length();
 40  if(plen == qlen)
 41  {
 42    const char *pstr = p.position();
 43    const char *qstr = q.position();
 44    while(plen-- > 0)
 45      if(pstr[plen] != qstr[plen]) return false;
 46    return true;
 47  }
 48  else return false;
 49}
 50
 51bool equal(const Node &n, const char *str, size_t len)
 52{
 53  if(!n.is_atom()) return false;
 54  const char *p = n.position();
 55  size_t l = n.length();
 56  if(l == len)
 57  {
 58    for(size_t i = 0; i < l; ++i)
 59      if(p[i] != str[i]) return false;
 60    return true;
 61  }
 62  else return false;
 63}
 64
 65bool equal(const Node *p, const Node *q)
 66{
 67  if(p == q) return true;
 68  else if(p == 0 || q == 0) return false;
 69  else if(p->is_atom() || q->is_atom()) return *p == *q;
 70  else return equal(p->car(), q->car()) && equal(p->cdr(), q->cdr());
 71}
 72
 73/*
 74  equiv() returns true even if p and q are lists and all the elements
 75  are equal respectively.
 76*/
 77bool equiv(const Node *p, const Node *q)
 78{
 79  if(p == q) return true;
 80  else if(p == 0 || q == 0) return false;
 81  else if(p->is_atom() || q->is_atom()) return *p == *q;
 82  else
 83  {
 84    while(p != 0 && q != 0)
 85      if(p->car() != q->car())
 86	return false;
 87      else
 88      {
 89	p = p->cdr();
 90	q = q->cdr();
 91      }
 92    return p == 0 && q == 0;
 93  }
 94}
 95
 96const Node *last(const Node *p)
 97{
 98  if(!p) return 0;
 99
100  const Node *next;
101  while((next = p->cdr())) p = next;
102  return p;
103}
104
105Node *last(Node *p)
106{
107  if(!p) return 0;
108
109  Node *next;
110  while((next = p->cdr())) p = next;
111  return p;
112}
113
114const Node *second(const Node *p)
115{
116  if(p)
117  {
118    p = p->cdr();
119    if(p) return p->car();
120  }
121  return 0;
122}
123
124Node *second(Node *p)
125{
126  if(p)
127  {
128    p = p->cdr();
129    if(p) return p->car();
130  }
131  return p;
132}
133
134const Node *third(const Node *p)
135{
136  if(p)
137  {
138    p = p->cdr();
139    if(p)
140    {
141      p = p->cdr();
142      if(p) return p->car();
143    }
144  }
145  return p;
146}
147
148Node *third(Node *p)
149{
150  if(p)
151  {
152    p = p->cdr();
153    if(p)
154    {
155      p = p->cdr();
156      if(p) return p->car();
157    }
158  }
159  return p;
160}
161
162const Node *ca_ar(const Node *p)
163{
164  while(p != 0 && !p->is_atom()) p = p->car();
165  return p;
166}
167
168Node *ca_ar(Node *p)
169{
170  while(p != 0 && !p->is_atom()) p = p->car();
171  return p;
172}
173
174/*
175  length() returns a negative number if p is not a list.
176*/
177int length(const Node *p)
178{
179  int i = 0;
180  if(p && p->is_atom()) return -2; /* p is not a pair */
181  while(p)
182  {
183    ++i;
184    if(p->is_atom()) return -1;	/* p is a pair, but not a list. */
185    else p = p->cdr();
186  }
187  return i;
188}
189
190Node *cons(Node *p, Node *q)
191{
192  return new List(p, q);
193}
194
195List *list() 
196{
197  return 0;
198}
199
200List *list(Node *p)
201{
202  return new PTree::List(p, 0);
203}
204
205List *list(Node *p, Node *q)
206{
207  return new PTree::List(p, new PTree::List(q, 0));
208}
209
210List *list(Node *p1, Node *p2, Node *p3)
211{
212  return new PTree::List(p1, new PTree::List(p2, new PTree::List(p3, 0)));
213}
214
215List *list(Node *p1, Node *p2, Node *p3, Node *p4)
216{
217  return new List(p1, list(p2, p3, p4));
218}
219
220List *list(Node *p1, Node *p2, Node *p3, Node *p4, Node *p5)
221{
222  return nconc(list(p1, p2), list(p3, p4, p5));
223}
224
225List *list(Node *p1, Node *p2, Node *p3, Node *p4, Node *p5,
226	   Node *p6)
227{
228  return nconc(list(p1, p2, p3), list(p4, p5, p6));
229}
230
231List *list(Node *p1, Node *p2, Node *p3, Node *p4, Node *p5,
232	   Node *p6, Node *p7)
233{
234  return nconc(list(p1, p2, p3), list(p4, p5, p6, p7));
235}
236
237List *list(Node *p1, Node *p2, Node *p3, Node *p4, Node *p5,
238	   Node *p6, Node *p7, Node *p8)
239{
240  return nconc(list(p1, p2, p3, p4), list(p5, p6, p7, p8));
241}
242
243Node *copy(Node *p)
244{
245  return append(p, 0);
246}
247
248//   q may be a leaf
249//
250Node *append(Node *p, Node *q)
251{
252  Node *result, *tail;
253  if(!p)
254  {
255    if(q->is_atom())
256      return cons(q, 0);
257    else return q;
258  }
259  result = tail = cons(p->car(), 0);
260  p = p->cdr();
261  while(p != 0)
262  {
263    Node *cell = cons(p->car(), 0);
264    tail->set_cdr(cell);
265    tail = cell;
266    p = p->cdr();
267  }
268  if(q != 0 && q->is_atom()) tail->set_cdr(cons(q, 0));
269  else tail->set_cdr(q);
270  return result;
271}
272
273/*
274  replace_all() substitutes SUBST for all occurences of ORIG in LIST.
275  It recursively searches LIST for ORIG.
276*/
277Node *replace_all(Node *list, Node *orig, Node *subst)
278{
279  if(list && orig && *list == *orig) return subst;
280  else if(list == 0 || list->is_atom()) return list;
281  else
282  {
283    Array newlist;
284    bool changed = false;
285    Node *rest = list;
286    while(rest != 0)
287    {
288      Node *p = rest->car();
289      Node *q = replace_all(p, orig, subst);
290      newlist.append(q);
291      if(p != q) changed = true;
292      rest = rest->cdr();
293    }
294
295    if(changed) return newlist.all();
296    else return list;
297  }
298}
299
300Node *subst(Node *newone, Node *old, Node *tree)
301{
302  if(old == tree) return newone;
303  else if(tree== 0 || tree->is_atom()) return tree;
304  else
305  {
306    Node *head = tree->car();
307    Node *head2 = subst(newone, old, head);
308    Node *tail = tree->cdr();
309    Node *tail2 = tail == 0 ? tail : subst(newone, old, tail);
310    if(head == head2 && tail == tail2) return tree;
311    else return cons(head2, tail2);
312  }
313}
314
315Node *subst(Node *newone1, Node *old1, Node *newone2, Node *old2,
316	    Node *tree)
317{
318  if(old1 == tree) return newone1;
319  else if(old2 == tree) return newone2;
320  else if(tree == 0 || tree->is_atom()) return tree;
321  else
322  {
323    Node *head = tree->car();
324    Node *head2 = subst(newone1, old1, newone2, old2, head);
325    Node *tail = tree->cdr();
326    Node *tail2 = tail == 0 ? tail : subst(newone1, old1, newone2, old2, tail);
327    if(head == head2 && tail == tail2) return tree;
328    else return cons(head2, tail2);
329  }
330}
331
332Node *subst(Node *newone1, Node *old1, Node *newone2, Node *old2,
333	    Node *newone3, Node *old3, Node *tree)
334{
335  if(old1 == tree) return newone1;
336  else if(old2 == tree) return newone2;
337  else if(old3 == tree) return newone3;
338  else if(tree == 0 || tree->is_atom()) return tree;
339  else
340  {
341    Node *head = tree->car();
342    Node *head2 = subst(newone1, old1, newone2, old2,
343			newone3, old3, head);
344    Node *tail = tree->cdr();
345    Node *tail2 = tail == 0 ? tail : subst(newone1, old1, newone2, old2,
346					   newone3, old3, tail);
347    if(head == head2 && tail == tail2) return tree;
348    else return cons(head2, tail2);
349  }
350}
351
352// shallow_subst() doesn't recursively apply substitution to a subtree.
353
354Node *shallow_subst(Node *newone, Node *old, Node *tree)
355{
356  if(old == tree) return newone;
357  else if(tree== 0 || tree->is_atom()) return tree;
358  else
359  {
360    Node *head, *head2;
361    head = tree->car();
362    if(old == head) head2 = newone;
363    else head2 = head;
364
365    Node *tail = tree->cdr();
366    Node *tail2 = (tail == 0) ? tail : shallow_subst(newone, old, tail);
367