00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013
00014
00015
00016
00017
00018
00019
00020
00021
00022
00023
00024
00025
00026
00027
00028
00029
00030
00031
00032
00033
00034
00035
00036
00037
00038
00039
00040
00041
00042
00043
00044
00045
00046
00047
00048
00049
00050
00051
00052
00053
00054
00055
00056
00057
00058
00059
00060
00061
00062
00063
00064
00065
00066
00067
00068
00069
00070
00071
00072
00073
00074
00075
00076
00077
00078
00079
00080
00081
00082
00083
00084
00085
00086
00087
00088
00089
00090
00091
00092
00093
00094
00095
00096
00097
00098
00099
00100
00101
00102
00103
00104
00105 #include <stdlib.h>
00106 #include "list.hh"
00107 #include "compatibility.hh"
00108 #include <map>
00109 #include <cstdlib>
00110
00111
00112 Sym CONS = symbol("cons");
00113 Sym NIL = symbol("nil");
00114
00115
00116 Tree nil = tree(NIL);
00117
00118
00119
00120
00121
00122
00123 static bool printlist (Tree l, FILE* out)
00124 {
00125 if (isList(l)) {
00126
00127 char sep = '(';
00128
00129 do {
00130 fputc(sep, out); sep = ',';
00131 print(hd(l));
00132 l = tl(l);
00133 } while (isList(l));
00134
00135 if (! isNil(l)) {
00136 fprintf(out, " . ");
00137 print(l, out);
00138 }
00139
00140 fputc(')', out);
00141 return true;
00142
00143 } else if (isNil(l)) {
00144
00145 fprintf(out, "nil");
00146 return true;
00147
00148 } else {
00149
00150 return false;
00151 }
00152 }
00153
00154 void print (Tree t, FILE* out)
00155 {
00156 int i; double f; Sym s; void* p;
00157
00158 if (printlist(t, out)) return;
00159
00160 Node n = t->node();
00161 if (isInt(n, &i)) fprintf (out, "%d", i);
00162 else if (isDouble(n, &f)) fprintf (out, "%f", f);
00163 else if (isSym(n, &s)) fprintf (out, "%s", name(s));
00164 else if (isPointer(n, &p)) fprintf (out, "#%p", p);
00165
00166 int k = t->arity();
00167 if (k > 0) {
00168 char sep = '[';
00169 for (int i=0; i<k; i++) {
00170 fputc(sep, out); sep = ',';
00171 print(t->branch(i), out);
00172 }
00173 fputc(']', out);
00174 }
00175 }
00176
00177
00178
00179
00180
00181
00182 Tree nth (Tree l, int i)
00183 {
00184 while (isList(l)) {
00185 if (i == 0) return hd(l);
00186 l = tl(l);
00187 i--;
00188 }
00189 return nil;
00190 }
00191
00192 Tree replace(Tree l, int i, Tree e)
00193 {
00194 return (i==0) ? cons(e,tl(l)) : cons( hd(l), replace(tl(l),i-1,e) );
00195 }
00196
00197
00198 int len (Tree l)
00199 {
00200 int n = 0;
00201 while (isList(l)) { l = tl(l); n++; }
00202 return n;
00203 }
00204
00205
00206
00207
00208
00209
00210 Tree rconcat (Tree l, Tree q)
00211 {
00212 while (isList(l)) { q = cons(hd(l),q); l = tl(l); }
00213 return q;
00214 }
00215
00216 Tree concat (Tree l, Tree q)
00217 {
00218 return rconcat(reverse(l), q);
00219 }
00220
00221 Tree lrange (Tree l, int i, int j)
00222 {
00223 Tree r = nil;
00224 int c = j;
00225 while (c>i) r = cons( nth(l,--c), r);
00226 return r;
00227 }
00228
00229
00230
00231
00232
00233 static Tree rmap (tfun f, Tree l)
00234 {
00235 Tree r = nil;
00236 while (isList(l)) { r = cons(f(hd(l)),r); l = tl(l); }
00237 return r;
00238 }
00239
00240 Tree reverse (Tree l)
00241 {
00242 Tree r = nil;
00243 while (isList(l)) { r = cons(hd(l),r); l = tl(l); }
00244 return r;
00245 }
00246
00247 Tree lmap (tfun f, Tree l)
00248 {
00249 return reverse(rmap(f,l));
00250 }
00251
00252 Tree reverseall (Tree l)
00253 {
00254 return isList(l) ? rmap(reverseall, l) : l;
00255 }
00256
00257
00258
00259
00260
00261
00262 bool isElement (Tree e, Tree l)
00263 {
00264 while (isList(l)) {
00265 if (hd(l) == e) return true;
00266 if (hd(l) > e) return false;
00267 l = tl(l);
00268 }
00269 return false;
00270 }
00271
00272 Tree addElement(Tree e, Tree l)
00273 {
00274 if (isList(l)) {
00275 if (e < hd(l)) {
00276 return cons(e,l);
00277 } else if (e == hd(l)) {
00278 return l;
00279 } else {
00280 return cons(hd(l), addElement(e,tl(l)));
00281 }
00282 } else {
00283 return cons(e,nil);
00284 }
00285 }
00286
00287 Tree remElement(Tree e, Tree l)
00288 {
00289 if (isList(l)) {
00290 if (e < hd(l)) {
00291 return l;
00292 } else if (e == hd(l)) {
00293 return tl(l);
00294 } else {
00295 return cons(hd(l), remElement(e,tl(l)));
00296 }
00297 } else {
00298 return nil;
00299 }
00300 }
00301
00302 Tree singleton (Tree e)
00303 {
00304 return list1(e);
00305 }
00306
00307 Tree list2set (Tree l)
00308 {
00309 Tree s = nil;
00310 while (isList(l)) {
00311 s = addElement(hd(l),s);
00312 l = tl(l);
00313 }
00314 return s;
00315 }
00316
00317 Tree setUnion (Tree A, Tree B)
00318 {
00319 if (isNil(A)) return B;
00320 if (isNil(B)) return A;
00321
00322 if (hd(A) == hd(B)) return cons(hd(A), setUnion(tl(A),tl(B)));
00323 if (hd(A) < hd(B)) return cons(hd(A), setUnion(tl(A),B));
00324 return cons(hd(B), setUnion(A,tl(B)));
00325 }
00326
00327 Tree setIntersection (Tree A, Tree B)
00328 {
00329 if (isNil(A)) return A;
00330 if (isNil(B)) return B;
00331 if (hd(A) == hd(B)) return cons(hd(A), setIntersection(tl(A),tl(B)));
00332 if (hd(A) < hd(B)) return setIntersection(tl(A),B);
00333 return setIntersection(A,tl(B));
00334 }
00335
00336 Tree setDifference (Tree A, Tree B)
00337 {
00338 if (isNil(A)) return A;
00339 if (isNil(B)) return A;
00340 if (hd(A) == hd(B)) return setDifference(tl(A),tl(B));
00341 if (hd(A) < hd(B)) return cons(hd(A), setDifference(tl(A),B));
00342 return setDifference(A,tl(B));
00343 }
00344
00345
00346
00347
00348
00349
00350
00351 Tree pushEnv (Tree key, Tree val, Tree env)
00352 {
00353 return cons (cons(key,val), env);
00354 }
00355
00356 bool searchEnv (Tree key, Tree& v, Tree env)
00357 {
00358 while (isList(env)) {
00359 if (hd(hd(env)) == key) {
00360 v = tl(hd(env));
00361 return true;
00362 }
00363 env = tl(env);
00364 }
00365 return false;
00366 }
00367
00368
00369
00370
00371
00372
00373 static bool findKey (Tree pl, Tree key, Tree& val)
00374 {
00375 if (isNil(pl)) return false;
00376 if (left(hd(pl)) == key) { val= right(hd(pl)); return true; }
00377 return findKey (tl(pl), key, val);
00378 }
00379
00380 static Tree updateKey (Tree pl, Tree key, Tree val)
00381 {
00382 if (isNil(pl)) return cons ( cons(key,val), nil );
00383 if (left(hd(pl)) == key) return cons ( cons(key,val), tl(pl) );
00384 return cons ( hd(pl), updateKey( tl(pl), key, val ));
00385 }
00386
00387 static Tree removeKey (Tree pl, Tree key)
00388 {
00389 if (isNil(pl)) return nil;
00390 if (left(hd(pl)) == key) return tl(pl);
00391 return cons (hd(pl), removeKey(tl(pl), key));
00392 }
00393
00394
00395 #if 0
00396 void setProperty (Tree t, Tree key, Tree val)
00397 {
00398 CTree* pl = t->attribut();
00399 if (pl) t->attribut(updateKey(pl, key, val));
00400 else t->attribut(updateKey(nil, key, val));
00401 }
00402
00403 void remProperty (Tree t, Tree key)
00404 {
00405 CTree* pl = t->attribut();
00406 if (pl) t->attribut(removeKey(pl, key));
00407 }
00408
00409 bool getProperty (Tree t, Tree key, Tree& val)
00410 {
00411 CTree* pl = t->attribut();
00412 if (pl) return findKey(pl, key, val);
00413 else return false;
00414 }
00415
00416 #else
00417
00418 void setProperty (Tree t, Tree key, Tree val)
00419 {
00420 t->setProperty(key, val);
00421 }
00422
00423 bool getProperty (Tree t, Tree key, Tree& val)
00424 {
00425 CTree* pl = t->getProperty(key);
00426 if (pl) {
00427 val = pl;
00428 return true;
00429 } else {
00430 return false;
00431 }
00432 }
00433
00434 void remProperty (Tree t, Tree key)
00435 {
00436 exit(1);
00437 }
00438 #endif
00439
00440
00441
00442
00443
00444
00445 Tree tmap (Tree key, tfun f, Tree t)
00446 {
00447
00448 Tree p;
00449
00450 if (getProperty(t, key, p)) {
00451
00452 return (isNil(p)) ? t : p;
00453
00454 } else {
00455
00456 Tree r1=nil;
00457 switch (t->arity()) {
00458
00459 case 0 :
00460 r1 = t;
00461 break;
00462 case 1 :
00463 r1 = tree(t->node(), tmap(key,f,t->branch(0)));
00464 break;
00465 case 2 :
00466 r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)));
00467 break;
00468 case 3 :
00469 r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)),
00470 tmap(key,f,t->branch(2)));
00471 break;
00472 case 4 :
00473 r1 = tree(t->node(), tmap(key,f,t->branch(0)), tmap(key,f,t->branch(1)),
00474 tmap(key,f,t->branch(2)), tmap(key,f,t->branch(3)));
00475 break;
00476 }
00477 Tree r2 = f(r1);
00478 if (r2 == t) {
00479 setProperty(t, key, nil);
00480 } else {
00481 setProperty(t, key, r2);
00482 }
00483 return r2;
00484 }
00485 }
00486
00487
00488
00489
00490
00491
00492
00493
00494
00495
00496 static Tree substkey(Tree t, Tree id, Tree val)
00497 {
00498 char name[256];
00499 snprintf(name, 255, "SUBST<%p,%p,%p> : ", (CTree*)t, (CTree*)id, (CTree*)val);
00500 return tree(unique(name));
00501 }
00502
00503
00504
00505
00506 static Tree subst (Tree t, Tree propkey, Tree id, Tree val)
00507 {
00508 Tree p;
00509
00510 if (t==id) {
00511 return val;
00512
00513 } else if (t->arity() == 0) {
00514 return t;
00515 } else if (getProperty(t, propkey, p)) {
00516 return (isNil(p)) ? t : p;
00517 } else {
00518 Tree r=nil;
00519 switch (t->arity()) {
00520
00521 case 1 :
00522 r = tree(t->node(),
00523 subst(t->branch(0), propkey, id, val));
00524 break;
00525
00526 case 2 :
00527 r = tree(t->node(),
00528 subst(t->branch(0), propkey, id, val),
00529 subst(t->branch(1), propkey, id, val));
00530 break;
00531
00532 case 3 :
00533 r = tree(t->node(),
00534 subst(t->branch(0), propkey, id, val),
00535 subst(t->branch(1), propkey, id, val),
00536 subst(t->branch(2), propkey, id, val));
00537 break;
00538
00539 case 4 :
00540 r = tree(t->node(),
00541 subst(t->branch(0), propkey, id, val),
00542 subst(t->branch(1), propkey, id, val),
00543 subst(t->branch(2), propkey, id, val),
00544 subst(t->branch(3), propkey, id, val));
00545 break;
00546
00547 }
00548 if (r == t) {
00549 setProperty(t, propkey, nil);
00550 } else {
00551 setProperty(t, propkey, r);
00552 }
00553 return r;
00554 }
00555
00556 }
00557
00558
00559 Tree substitute (Tree t, Tree id, Tree val)
00560 {
00561 return subst (t, substkey(t,id,val), id, val);
00562 }
00563
00564
00565
00566
00567