home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / ABUSESRC.ZIP / AbuseSrc / macabuse / src / lisp_opt.c < prev    next >
Encoding:
C/C++ Source or Header  |  1997-05-20  |  3.6 KB  |  117 lines
  1. #ifdef NO_LIBS
  2. #include "fakelib.hpp"
  3. #else
  4. #include "macs.hpp"
  5. #endif
  6.  
  7. #include "lisp.hpp"
  8. #include "lisp_gc.hpp"
  9.  
  10. void *true_symbol=NULL,*l_undefined,*list_symbol,*string_symbol,     // in lisp_init()
  11.      *quote_symbol,*backquote_symbol,*comma_symbol,*do_symbol,*in_symbol,*aref_symbol,
  12.      *colon_initial_contents,*colon_initial_element,*if_symbol,
  13.      *progn_symbol,*eq_symbol,*zero_symbol,*eq0_symbol,*car_symbol,*cdr_symbol,
  14.      *load_warning;
  15.  
  16.  
  17. void *if_1progn,*if_2progn,*if_12progn,*not_symbol;
  18.  
  19. void *comp_optimize(void *list)
  20. {
  21.   void *return_val=list;
  22.   p_ref r1(list);
  23.   if (list)
  24.   {
  25.     if (CAR(list)==if_symbol)
  26.     {
  27.       void *eval1=lcar(lcdr(lcdr(list)));
  28.       p_ref r2(eval1);
  29.       void *eval2=lcar(lcdr(lcdr(lcdr(list))));
  30.       p_ref r3(eval2);
  31.  
  32.       void *ret=NULL;
  33.       p_ref r1(ret);
  34.       if (lcar(list)==eq_symbol && (lcar(lcdr(list))==zero_symbol))  //  simplify (eq 0 x) -> (eq0 x)
  35.       {
  36.     push_onto_list(lcar(lcdr(lcdr(list))),ret);
  37.     push_onto_list(eq0_symbol,ret);
  38.     return_val=comp_optimize(ret);
  39.       } else if (lcar(list)==eq_symbol && 
  40.          (lcar(lcdr(lcdr(list)))==zero_symbol)) //simplify (eq x 0)-> (eq0 x)
  41.       {
  42.     push_onto_list(lcar(lcdr(list)),ret);
  43.     push_onto_list(eq0_symbol,ret);
  44.     return_val=comp_optimize(ret);
  45.       } else if (lcar(lcar(lcdr(list)))==not_symbol)  // simplify (if (not y) x z) -> (if y z x)
  46.       {      
  47.     push_onto_list(lcar(lcdr(lcdr(list))),ret);
  48.     push_onto_list(lcar(lcdr(lcdr(lcdr(list)))),ret);
  49.     push_onto_list(lcar(lcdr(lcar(lcdr(list)))),ret);
  50.     push_onto_list(if_symbol,ret);
  51.     return_val=comp_optimize(ret);
  52.       } 
  53.       else if (lcar(eval1)==progn_symbol && (eval2==NULL || 
  54.                          item_type(eval2)!=L_CONS_CELL))
  55.       {
  56.     push_onto_list(eval2,ret);
  57.     push_onto_list(lcdr(eval1),ret);
  58.     push_onto_list(lcar(lcdr(list)),ret);
  59.     push_onto_list(if_1progn,ret);
  60.     return_val=comp_optimize(ret);
  61.       } else if (lcar(eval1)==progn_symbol && lcar(eval2)==progn_symbol)
  62.       {
  63.     push_onto_list(lcdr(eval2),ret);
  64.     push_onto_list(lcdr(eval1),ret);
  65.     push_onto_list(lcar(lcdr(list)),ret);
  66.     push_onto_list(if_12progn,ret);
  67.     return_val=comp_optimize(ret);
  68.       } else if (lcar(eval2)==progn_symbol)
  69.       {
  70.     push_onto_list(lcdr(eval2),ret);
  71.     push_onto_list(eval1,ret);
  72.     push_onto_list(lcar(lcdr(list)),ret);
  73.     push_onto_list(if_2progn,ret);
  74.     return_val=comp_optimize(ret);
  75.       }
  76.  
  77.     }
  78.   }
  79.   return return_val;
  80. }
  81.  
  82.  
  83. void l_comp_init()
  84. {
  85.   l_undefined=make_find_symbol(":UNDEFINED");  // this needs to be defined first
  86.   ((lisp_symbol *)l_undefined)->function=NULL;  // collection problems result if we don't do this
  87.   ((lisp_symbol *)l_undefined)->value=NULL;
  88.  
  89.  
  90.   true_symbol=make_find_symbol("T");
  91.  
  92.  
  93.   list_symbol=make_find_symbol("list");
  94.   string_symbol=make_find_symbol("string");
  95.   quote_symbol=make_find_symbol("quote");
  96.   backquote_symbol=make_find_symbol("backquote");
  97.   comma_symbol=make_find_symbol("comma");
  98.   in_symbol=make_find_symbol("in");
  99.   do_symbol=make_find_symbol("do");
  100.   aref_symbol=make_find_symbol("aref");
  101.   colon_initial_contents=make_find_symbol(":initial-contents");
  102.   colon_initial_element=make_find_symbol(":initial-element");
  103.  
  104.   if_1progn=make_find_symbol("if-1progn");
  105.   if_2progn=make_find_symbol("if-2progn");
  106.   if_12progn=make_find_symbol("if-12progn");
  107.   if_symbol=make_find_symbol("if");
  108.   progn_symbol=make_find_symbol("progn");
  109.   not_symbol=make_find_symbol("not");
  110.   eq_symbol=make_find_symbol("eq");
  111.   zero_symbol=make_find_symbol("0");
  112.   eq0_symbol=make_find_symbol("eq0");
  113.   car_symbol=make_find_symbol("car");
  114.   cdr_symbol=make_find_symbol("cdr");
  115.   load_warning=make_find_symbol("load_warning");
  116. }
  117.