source: abuse/tags/pd/macabuse/src/lisp_opt.c @ 49

Last change on this file since 49 was 49, checked in by Sam Hocevar, 11 years ago
  • Imported original public domain release, for future reference.
  • Property svn:keywords set to Id
File size: 3.5 KB
Line 
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
10void *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
17void *if_1progn,*if_2progn,*if_12progn,*not_symbol;
18
19void *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
83void 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}
Note: See TracBrowser for help on using the repository browser.