| [2] | 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 | } |
|---|
