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