00001
00002
00003
00004
00005
00006
00007
00008
00009
00010
00011
00012
00013 #include <mmxlight/mmxlight_glue.hpp>
00014 #include <mmxlight/base_evaluator.hpp>
00015 namespace mmx {
00016
00017
00018
00019
00020
00021 generic
00022 mmx_type_table () {
00023 vector<generic> v= all_type_names ();
00024 table<generic,generic> t (as<generic> (false));
00025 for (nat i=0; i<N(v); i++) t[v[i]]= as<generic> (true);
00026 return as<generic> (t);
00027 }
00028
00029 generic
00030 mmx_type (const generic& g) {
00031 if (N(g) != 2) return wrong_nr_args (g);
00032 generic r= eval (g[1]);
00033 if (is<exception> (r)) return r;
00034 return type_name (type (r));
00035 }
00036
00037 bool
00038 mmx_is_type (const generic& g) {
00039 vector<generic> v= all_type_names ();
00040 for (nat i=0; i<N(v); i++)
00041 if (g == v[i]) return true;
00042 if (is_func (g, GEN_ALIAS_TYPE))
00043 return mmx_is_type (g[1]);
00044 if (is_func (g, GEN_TUPLE_TYPE))
00045 return mmx_is_type (g[1]);
00046 return false;
00047 }
00048
00049 generic
00050 mmx_type_name (const int& i) {
00051 nat id= (nat) i;
00052 return type_name (id);
00053 }
00054
00055
00056
00057
00058
00059 generic
00060 mmx_symbol_table () {
00061 environment env= get_environment (current_ev);
00062 while (!is_nil (env->next)) env= env->next;
00063 list<string> sl= env -> completion_list ();
00064 table<generic,generic> t (as<generic> (false));
00065 while (!is_nil (sl)) {
00066 generic v= car (sl);
00067 t[v]= as<generic> (true);
00068 sl= cdr (sl);
00069 }
00070 return as<generic> (t);
00071 }
00072
00073 bool
00074 mmx_is_defined (const generic& g) {
00075 environment env= get_environment (current_ev);
00076 return env->contains (g);
00077 }
00078
00079 generic
00080 mmx_definition (const generic& g) {
00081 environment env= get_environment (current_ev);
00082 ASSERT (env->contains (g), "symbol not defined");
00083 return env[g];
00084 }
00085
00086
00087
00088
00089
00090 generic
00091 mmx_function_name (const routine& fun) {
00092 return fun->name;
00093 }
00094
00095 generic
00096 mmx_function_body (const routine& fun) {
00097 generic g= fun->function_body ();
00098 if (is_func (g, GEN_SQTUPLE)) {
00099 vector<generic> v;
00100 for (nat i=1; i<N(g); i++) v << g[i];
00101 return as<generic> (v);
00102 }
00103 else return as<generic> (vec (g));
00104 }
00105
00106 generic
00107 mmx_function_type (const routine& fun) {
00108 generic g= fun->function_type ();
00109 if (is_func (g, GEN_SQTUPLE)) {
00110 vector<generic> v;
00111 for (nat i=1; i<N(g); i++) v << g[i];
00112 return as<generic> (v);
00113 }
00114 else return as<generic> (vec (g));
00115 }
00116
00117 generic
00118 mmx_function_forms (const routine& fun) {
00119 vector<generic> r;
00120 vector<routine> v= fun->meanings ();
00121 if (N(v) == 0) r << as<generic> (fun);
00122 else for (nat i=0; i<N(v); i++) r << as<generic> (v[i]);
00123 return as<generic> (r);
00124 }
00125
00126
00127
00128
00129
00130 generic mmx_conv (const generic& x, const generic& y) { return convert (x,y); }
00131 generic mmx_neg (const generic& x) { return -x; }
00132 generic mmx_sqr (const generic& x) { return square (x); }
00133 generic mmx_inv (const generic& x) { return invert (x); }
00134 generic mmx_add (const generic& x, const generic& y) { return x + y; }
00135 generic mmx_sub (const generic& x, const generic& y) { return x - y; }
00136 generic mmx_mul (const generic& x, const generic& y) { return x * y; }
00137 generic mmx_div (const generic& x, const generic& y) { return x / y; }
00138 generic mmx_add_int (const generic& x, const int& y) { return x + y; }
00139 generic mmx_sub_int (const generic& x, const int& y) { return x - y; }
00140 generic mmx_mul_int (const generic& x, const int& y) { return x * y; }
00141 generic mmx_div_int (const generic& x, const int& y) { return x / y; }
00142 generic mmx_int_add (const int& x, const generic& y) { return x + y; }
00143 generic mmx_int_sub (const int& x, const generic& y) { return x - y; }
00144 generic mmx_int_mul (const int& x, const generic& y) { return x * y; }
00145 generic mmx_int_div (const int& x, const generic& y) { return x / y; }
00146
00147
00148
00149
00150
00151 void
00152 glue_inspect () {
00153 define ("type_table", mmx_type_table);
00154 define_primitive ("type", mmx_type);
00155 define ("type?", mmx_is_type);
00156 define ("type_name", mmx_type_name);
00157
00158 define ("symbol_table", mmx_symbol_table);
00159 define ("defined?", mmx_is_defined);
00160 define ("definition", mmx_definition);
00161
00162 define ("function_name", mmx_function_body);
00163 define ("function_type", mmx_function_type);
00164 define ("function_body", mmx_function_body);
00165 define ("function_forms", mmx_function_forms);
00166
00167 define ("conv", mmx_conv);
00168 define ("neg", mmx_neg);
00169 define ("sqr", mmx_sqr);
00170 define ("inv", mmx_inv);
00171 define ("add", mmx_add);
00172 define ("sub", mmx_sub);
00173 define ("mul", mmx_mul);
00174 define ("div", mmx_div);
00175 define ("add_int", mmx_add_int);
00176 define ("sub_int", mmx_sub_int);
00177 define ("mul_int", mmx_mul_int);
00178 define ("div_int", mmx_div_int);
00179 define ("int_add", mmx_int_add);
00180 define ("int_sub", mmx_int_sub);
00181 define ("int_mul", mmx_int_mul);
00182 define ("int_div", mmx_int_div);
00183 }
00184
00185 }