unoidl2

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/unoidl2.git/
Log | Files | Refs

unoidl2.c (9250B)

      1 /*
      2    This file is part of unoidl2.
      3 
      4    unoidl2 is free software: you can redistribute it and/or modify
      5    it under the terms of the GNU General Public License as published by
      6    the Free Software Foundation, either version 3 of the License, or
      7    (at your option) any later version.
      8 
      9    unoidl2 is distributed in the hope that it will be useful,
     10    but WITHOUT ANY WARRANTY; without even the implied warranty of
     11    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     12    GNU General Public License for more details.
     13 
     14    You should have received a copy of the GNU General Public License
     15    along with unoidl2.  If not, see <http://www.gnu.org/licenses/>.
     16 */
     17 
     18 #include "unoidl2.h"
     19 #include "parse.c.h"
     20 
     21 #include <stdlib.h>
     22 #include <stdio.h>
     23 #include <string.h>
     24 
     25 #define HSIZE 1100000
     26 
     27 #define NCHARA 256
     28 
     29 struct any {
     30   enum {CONS, TOKEN, INUM, CHARA, SYM1, SYM2} tag;
     31   union {
     32     struct {
     33       struct any *car;
     34       struct any *cdr;
     35     } c;
     36     struct {
     37       Kind kind;
     38       struct any *sym1;
     39     } t;
     40     int inum;
     41   } u;
     42 };
     43 
     44 Any heap;
     45 int ncells = 0;
     46 
     47 Any xalloc() {
     48   Any x = &heap[ncells];
     49   ncells++;
     50   if(HSIZE <= ncells) {
     51     fprintf(stderr, "Error: heap exhausted\n");
     52     exit(-1);
     53   }
     54   return x;
     55 }
     56 
     57 Any NIL;
     58 Any T;
     59 
     60 Any set(Any x, Any v) {return x->u.c.car = v;}
     61 Any con(Any x, Any v) {return x->u.c.cdr = v;}
     62 
     63 Any cons(Any car, Any cdr) {
     64   Any x = xalloc();
     65   x->tag = CONS;
     66   set(x, car);
     67   con(x, cdr);
     68   return x;
     69 }
     70 
     71 static Any chara_from;
     72 static Any root1;
     73 
     74 static Any chara(int x) {return &chara_from[x];}
     75 
     76 Any intern1(char *x) {
     77   Any p = root1;
     78   for(; *x; x++) {
     79     Any k = chara(*x);
     80     Any r = find(k, cdr(p), equal, caar);
     81     if(NIL == r) {
     82       con(p, cons(r = list1(cons(k, p)), cdr(p)));
     83       r->tag = SYM1;
     84     }
     85     p = r;
     86   }
     87   return p;
     88 }
     89 
     90 Any mk(Kind kind, char *token) {
     91   Any x = xalloc();
     92   x->tag = TOKEN;
     93   x->u.t.kind = kind;
     94   x->u.t.sym1 = intern1(token);
     95   return x;
     96 }
     97 
     98 Any mkinum(int n) {
     99   Any x = xalloc();
    100   x->tag = INUM;
    101   x->u.inum = n;
    102   return x;
    103 }
    104 
    105 int consp(Any x) {return CONS == x->tag;}
    106 Any car(Any x) {return x->u.c.car;}
    107 Any cdr(Any x) {return x->u.c.cdr;}
    108 Kind kind(Any x) {return x->u.t.kind;}
    109 Any sym1(Any x) {return x->u.t.sym1;}
    110 int inum(Any x) {return x->u.inum;}
    111 Any cons3(Any a, Any b, Any c) {return cons(a, cons(b, c));}
    112 Any cons4(Any a, Any b, Any c, Any d) {return cons(a, cons(b, cons(c, d)));}
    113 
    114 Any cons5(Any a, Any b, Any c, Any d, Any e) {
    115   return cons(a, cons(b, cons(c, cons(d, e))));
    116 }
    117 
    118 Any cons6(Any a, Any b, Any c, Any d, Any e, Any f) {
    119   return cons(a, cons(b, cons(c, cons(d, cons(e, f)))));
    120 }
    121 
    122 Any cons7(Any a, Any b, Any c, Any d, Any e, Any f, Any g) {
    123   return cons(a, cons(b, cons(c, cons(d, cons(e, cons(f, g))))));
    124 }
    125 
    126 Any list1(Any a) {return cons(a, NIL);}
    127 Any list2(Any a, Any b) {return cons3(a, b, NIL);}
    128 Any list3(Any a, Any b, Any c) {return cons4(a, b, c, NIL);}
    129 Any list4(Any a, Any b, Any c, Any d) {return cons5(a, b, c, d, NIL);}
    130 Any list5(Any a, Any b, Any c, Any d, Any e) {return cons6(a, b, c, d, e, NIL);}
    131 
    132 Any list6(Any a, Any b, Any c, Any d, Any e, Any f) {
    133   return cons7(a, b, c, d, e, f, NIL);
    134 }
    135 
    136 Any nconc2(Any a, Any b) {
    137   if(NIL == a)
    138     return b;
    139   Any x, d;
    140   for(x = a, d = cdr(x); NIL != d; x = d, d = cdr(x));
    141   con(x, b);
    142   return a;
    143 }
    144 
    145 Any    cadr(Any x) {return             car(cdr(x));}
    146 Any    cddr(Any x) {return             cdr(cdr(x));}
    147 Any   caddr(Any x) {return         car(cdr(cdr(x)));}
    148 Any   cdddr(Any x) {return         cdr(cdr(cdr(x)));}
    149 Any  cadddr(Any x) {return     car(cdr(cdr(cdr(x))));}
    150 Any  cddddr(Any x) {return     cdr(cdr(cdr(cdr(x))));}
    151 Any caddddr(Any x) {return car(cdr(cdr(cdr(cdr(x)))));}
    152 Any cdddddr(Any x) {return cdr(cdr(cdr(cdr(cdr(x)))));}
    153 
    154 Any    caar(Any x) {return             car(car(x));}
    155 
    156 int equal_(Any x, Any y) {
    157   if(x == y) return 1;
    158   if(NIL == x) return NIL == y;
    159   switch(x->tag) {
    160   case CONS:
    161     for(; NIL != x && NIL != y; x = cdr(x), y = cdr(y))
    162       if(!equal_(car(x), car(y))) return 0;
    163     return NIL == x && NIL == y;
    164   case TOKEN:
    165     return TOKEN == y->tag && kind(x) == kind(y) && sym1(x) == sym1(y);
    166   case INUM:
    167     return INUM == y->tag && inum(x) == inum(y);
    168   }
    169   return 0;
    170 }
    171 
    172 Any equal(Any x, Any y) {return equal_(x, y) ? T : NIL;}
    173 
    174 void print_sym1(Any x) {
    175   Any kp = car(x);
    176   if(NIL != kp) {
    177     Any k = car(kp);
    178     Any p = cdr(kp);
    179     print_sym1(p);
    180     print(k);
    181   }
    182 }
    183 
    184 static char *print_sym2_sep = ".";
    185 
    186 static void print_sym2(Any x) {
    187   Any kpv = car(x);
    188   if(NIL != kpv) {
    189     Any k = car(kpv);
    190     Any p = cadr(kpv);
    191     print_sym2(p);
    192     if(NIL != car(p)) printf("%s", print_sym2_sep);
    193     print_sym1(k);
    194   }
    195 }
    196 
    197 void print_sym2_custom(Any x, char *sep) {
    198   char *s = print_sym2_sep;
    199   print_sym2_sep = sep;
    200   print_sym2(x);
    201   print_sym2_sep = s;
    202 }
    203 
    204 Any print(Any x) {
    205   if(NIL == x)
    206     printf("NIL");
    207   else
    208     switch(x->tag) {
    209     case CONS:
    210       printf("(");
    211       print(car(x));
    212       for(Any d = cdr(x); NIL != d; d = cdr(d)) {
    213         printf(" ");
    214         if(consp(d))
    215           print(car(d));
    216         else {
    217           printf(". ");
    218           print(d);
    219           break;
    220         }
    221       }
    222       printf(")");
    223       break;
    224     case TOKEN:
    225       print_sym1(sym1(x));
    226       break;
    227     case INUM:
    228       printf("%d", x->u.inum);
    229       break;
    230     case CHARA:
    231       printf("%c", x->u.inum);
    232       break;
    233     case SYM1:
    234       print_sym1(x);
    235       break;
    236     case SYM2:
    237       print_sym2(x);
    238       break;
    239       /* default: error? */
    240     }
    241   return x;
    242 }
    243 
    244 Any some(Fn1 test, Any lst) {
    245   for(; NIL != lst; lst = cdr(lst)) {
    246     Any x = test(car(lst));
    247     if(NIL != x) return x;
    248   }
    249   return NIL;
    250 }
    251 
    252 Any mapc(Fn1 fn, Any x) {
    253   Any z = NIL;
    254   for(Any y = x; NIL != y; y = cdr(y))
    255     z = fn(car(y));
    256   return z;
    257 }
    258 
    259 Any mapcx(void *env, Any (*fn)(void *env, Any e), Any x) {
    260   Any z = NIL;
    261   for(Any y = x; NIL != y; y = cdr(y))
    262     z = fn(env, car(y));
    263   return z;
    264 }
    265 
    266 Any find(Any elt, Any lst, Fn2 cmp, Fn1 key) {
    267   for(; NIL != lst; lst = cdr(lst)) {
    268     Any x = car(lst);
    269     if(NIL != cmp(elt, key(x))) return x;
    270   }
    271   return NIL;
    272 }
    273 
    274 Any reverse(Any x, Any a) {
    275   return NIL == x ? a : reverse(cdr(x), cons(car(x), a));
    276 }
    277 
    278 Any id(Any x) {return x;}
    279 
    280 Any mk_relative(Any x) {
    281   Any h = NIL != cdr(x) ? mk(ABSOLUTE, "absolute") : mk(RELATIVE, "relative");
    282   return cons(h, x);
    283   //return cons(mk(RELATIVE, "relative"), $1);
    284 }
    285 
    286 Any intern2rel(Any k, Any p) {
    287   Any r = find(k, cdr(p), equal, caar);
    288   if(NIL == r) {
    289     con(p, cons(r = list1(list2(k, p)), cdr(p)));
    290     r->tag = SYM2;
    291   }
    292   return r;
    293 }
    294 
    295 Any root2;
    296 
    297 Any intern2abs(Any x) {
    298   Any p = root2;
    299   for(; NIL != x; x = cdr(x))
    300     p = intern2rel(sym1(car(x)), p);
    301   return p;
    302 }
    303 
    304 Any get2(Any x) {return cddr(car(x));}
    305 static Any set2(Any x, Any v) {return con(cdr(car(x)), v);}
    306 Any sym2p(Any x) {return cadr(car(x));}
    307 Any sym2k(Any x) {return caar(x);}
    308 
    309 
    310 static Any module2;
    311 Any subst2_x;
    312 
    313 static Any subst2(Any v) {
    314   Any w;
    315   if(consp(v)) {
    316     switch(kind(car(v))) {
    317     case CONST:
    318       w = module2;
    319       module2 = sym2p(module2);
    320       subst2(caddr(v));
    321       module2 = w;
    322       mapc(subst2, cdddr(v));
    323       break;
    324     case RELATIVE: //(relative XInterface)
    325       w = cdr(v);
    326       set(w, intern2rel(sym1(car(w)), module2));
    327       break;
    328     case ABSOLUTE: //(absolute com sun star uno XInterface)
    329       w = cdr(v);
    330       set(w, intern2abs(w));
    331       con(w, NIL);
    332       break;
    333     default:
    334       mapc(subst2, v);
    335     }
    336   }
    337   return v;
    338 }
    339 
    340 Any build2(Any x) {
    341   Any p, z;
    342   switch(kind(car(x))) {
    343   case MODULE:
    344     p = module2;
    345     z = intern2rel(sym1(cadr(x)), p);
    346     module2 = z;
    347     Any v = get2(z);
    348     if(NIL == v) set2(z, car(x));
    349     mapc(build2, cddr(x));
    350     module2 = p;
    351     break;
    352   case CONSTANTS:
    353     p = module2;
    354     z = intern2rel(sym1(cadr(x)), p);
    355     module2 = z;
    356     if(NIL != get2(z)) printf("@@@ build2 error: duplicate ");
    357     set(cdr(x), z);
    358     set2(z, x);
    359     mapc(build2, cdddr(x));
    360     module2 = p;
    361     break;
    362   case DEFINTERFACE:
    363   case EXCEPTION:
    364   case ENUM:
    365   case SERVICE:
    366   case STRUCT:
    367   case CONST:
    368   case SINGLETON:
    369   case TYPEDEF:
    370   case DEFTEMPLATE:
    371     z = intern2rel(sym1(cadr(x)), module2);
    372     if(NIL != get2(z)) printf("@@@ build2 error: duplicate ");
    373     set(cdr(x), z);
    374     subst2_x = z;
    375     set2(z, subst2(x));
    376     break;
    377   case INTERFACE: break; // TODO eg XMultiComponentFactory?
    378   default:
    379     printf("@@@ build2 error: ");
    380     print(x);
    381     printf("\n");
    382   }
    383   return z;
    384 }
    385 
    386 Fn1 walk2_fn;
    387 
    388 Any walk2(Any x) {
    389   Any c = cdr(x);
    390   Any kpv = car(x);
    391   Any k = car(kpv);
    392   Any p = cadr(kpv);
    393   Any v = cddr(kpv);
    394   if(NIL == v) {
    395     mapc(walk2, c);
    396   } else if(MODULE == kind(v)) {
    397     mapc(walk2, c);
    398   } else if(NIL == c) {
    399     walk2_fn(v);
    400   } else {
    401     if(CONSTANTS != kind(car(v))) {
    402       printf("@@@ walk2 error: unexpected children ");
    403       print(x);
    404       printf("\n");
    405     }
    406     walk2_fn(v);
    407   }
    408   return x;
    409 }
    410 
    411 void init() {
    412   heap = calloc(HSIZE, sizeof(struct any));
    413   NIL = xalloc();
    414   NIL->tag = CONS;
    415   set(NIL, NIL);
    416   con(NIL, NIL);
    417   for(int i = 0; i < NCHARA; i++) {
    418     Any x = mkinum(i);
    419     x->tag = CHARA;
    420     if(0 == i) chara_from = x;
    421   }
    422   root1 = list1(NIL);
    423   T = xalloc();
    424   T->tag = TOKEN;
    425   T->u.t.kind = 0;
    426   T->u.t.sym1 = intern1("T");
    427   root2 = list1(NIL);
    428   module2 = root2;
    429 }