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 #include <mmxlight/shell.hpp>
00016 #include <basix/timer.hpp>
00017 #include <basix/system.hpp>
00018 #include <basix/cpp_syntax.hpp>
00019 #include <basix/mmx_syntax.hpp>
00020 #include <basix/math_syntax.hpp>
00021 #include <basix/threads.hpp>
00022 namespace mmx {
00023
00024 static table<string,string> include_cache ("");
00025
00026
00027
00028
00029
00030 static string
00031 mmx_relative_name (const string& name) {
00032 static string file_var ("current_file");
00033 if (!current_ev->contains (gen (file_var)))
00034 current_ev->set (file_var, as<generic> (string ("")));
00035 return relative_name (as<string> (current_ev->get (gen (file_var))), name);
00036 }
00037
00038 static string
00039 mmx_resolve_name (const string& name) {
00040 static string file_var ("current_file");
00041 if (!current_ev->contains (gen (file_var)))
00042 current_ev->set (file_var, as<generic> (string ("")));
00043 return resolve_name (as<string> (current_ev->get (gen (file_var))), name);
00044 }
00045
00046 static string
00047 mmx_strip_preamble (const string& s) {
00048 string preamble= "#!/usr/bin/env mmx-light\n";
00049 if (N(s) >= N(preamble) && s (0, N(preamble)) == preamble)
00050 return s (N(preamble)-1, N(s));
00051 return s;
00052 }
00053
00054 generic
00055 mmx_is_readable (const generic& x) {
00056 if (N(x) != 2) return wrong_nr_args (x);
00057 generic name= eval_as<string> (x[1]);
00058 if (is<exception> (name) || !is<string> (name)) return name;
00059 string file_name= mmx_resolve_name (as<string> (name));
00060 return as<generic> (file_name != "" && file_exists (file_name));
00061 }
00062
00063 static generic
00064 mmx_load_file (const generic& x) {
00065 if (N(x) != 2) return wrong_nr_args (x);
00066 generic name= eval_as<string> (x[1]);
00067 if (is<exception> (name) || !is<string> (name)) return name;
00068 string file_name= mmx_resolve_name (as<string> (name));
00069 ASSERT (file_name != "", "file " * as<string> (name) * " not found");
00070 string ucontents;
00071 if (load ("$MMX_LOAD_PATH", file_name, ucontents))
00072 ERROR ("file " * file_name * " could not be loaded");
00073 string contents= mmx_strip_preamble (ucontents);
00074 store_file_source (file_name, contents);
00075 return gen (GEN_TUPLE, as<generic> (file_name), as<generic> (contents));
00076 }
00077
00078 generic
00079 mmx_load_string (const generic& x) {
00080 generic name_contents= mmx_load_file (x);
00081 if (is<exception> (name_contents)) return name_contents;
00082 return name_contents[2];
00083 }
00084
00085 generic
00086 mmx_save_string (const generic& x) {
00087 if (N(x) != 3) return wrong_nr_args (x);
00088 generic name= eval_as<string> (x[1]);
00089 if (is<exception> (name) || !is<string> (name)) return name;
00090 generic contents= eval_as<string> (x[2]);
00091 if (is<exception> (contents) || !is<string> (contents)) return contents;
00092 string file_name= mmx_relative_name (as<string> (name));
00093 if (save (file_name, as<string> (contents)))
00094 ERROR ("file " * file_name * " not writable");
00095 return void_value ();
00096 }
00097
00098 generic
00099 mmx_load_directory (const generic& x) {
00100 if (N(x) != 2) return wrong_nr_args (x);
00101 generic name= eval_as<string> (x[1]);
00102 if (is<exception> (name) || !is<string> (name)) return name;
00103 string dir_name= mmx_relative_name (as<string> (name));
00104 vector<string> dir;
00105 if (load_directory (dir_name, dir))
00106 ERROR ("directory " * dir_name * " not found");
00107 vector<generic> gdir;
00108 for (nat i=0; i<N(dir); i++)
00109 gdir << as<generic> (dir[i]);
00110 return as<generic> (gdir);
00111 }
00112
00113 generic
00114 mmx_update_string (const generic& x) {
00115 if (N(x) != 3) return wrong_nr_args (x);
00116 generic name= eval_as<string> (x[1]);
00117 if (is<exception> (name) || !is<string> (name)) return name;
00118 generic contents= eval_as<string> (x[2]);
00119 if (is<exception> (contents) || !is<string> (contents)) return contents;
00120 string old_contents;
00121 string new_contents= as<string> (contents);
00122 string file_name= mmx_resolve_name (as<string> (name));
00123 ASSERT (file_name != "", "file " * as<string> (name) * " not found");
00124 if (load (file_name, old_contents))
00125 old_contents= (new_contents == ""? string ("x"): string (""));
00126 if (new_contents != old_contents)
00127 if (save (file_name, new_contents))
00128 ERROR ("file " * file_name * " not writable");
00129 return void_value ();
00130 }
00131
00132 generic
00133 mmx_parse (const generic& x) {
00134 generic name_contents= mmx_load_file (x);
00135 if (is<exception> (name_contents)) return name_contents;
00136 string file_name= as<string> (name_contents[1]);
00137 string contents = as<string> (name_contents[2]);
00138 return mmx_parse (file_name, contents);
00139 }
00140
00141 generic
00142 mmx_do_include (const generic& x, bool always) {
00143 static string file_var ("current_file");
00144 generic name_contents= mmx_load_file (x);
00145 if (is<exception> (name_contents)) return name_contents;
00146 string file_name= as<string> (name_contents[1]);
00147 string contents = as<string> (name_contents[2]);
00148 if (always || include_cache[file_name] != contents) {
00149 include_cache[file_name]= contents;
00150 generic y = mmx_parse (file_name, contents);
00151 string cur_file = as<string> (current_ev->get (gen (file_var)));
00152 current_ev->set (gen (file_var), as<generic> (file_name));
00153 generic r= eval (y);
00154 current_ev->set (gen (file_var), as<generic> (cur_file));
00155 if (is<exception> (r)) return r;
00156
00157 }
00158 return void_value ();
00159 }
00160
00161 generic
00162 mmx_include (const generic& x) {
00163 return mmx_do_include (x, false);
00164 }
00165
00166 generic
00167 mmx_reinclude (const generic& x) {
00168 return mmx_do_include (x, true);
00169 }
00170
00171 generic
00172 mmx_supports (const generic& x) {
00173 if (N(x) != 2) return wrong_nr_args (x);
00174 generic r= eval_as<string> (x[1]);
00175 if (is<exception> (r) || !is<string> (r)) return r;
00176 string name= as<string> (r);
00177 return as<generic> (dl_exists (name));
00178 }
00179
00180 generic
00181 mmx_used (const generic& x) {
00182 if (N(x) != 2) return wrong_nr_args (x);
00183 generic r= eval_as<string> (x[1]);
00184 if (is<exception> (r) || !is<string> (r)) return r;
00185 string name= as<string> (r);
00186 return as<generic> (dl_linked (name));
00187 }
00188
00189 generic
00190 mmx_use (const generic& x) {
00191 if (N(x) != 2) return wrong_nr_args (x);
00192 generic r= eval_as<string> (x[1]);
00193 if (is<exception> (r) || !is<string> (r)) return r;
00194 string name= as<string> (r);
00195 dl_link (name);
00196 verify_if_unknown_types (get_environment (current_ev));
00197 return void_value ();
00198 }
00199
00200 int
00201 mmx_system (const string& s) {
00202 return mmx::system (s);
00203 }
00204
00205
00206
00207
00208
00209 string
00210 flatten_as_tm_snippet (const generic& g) {
00211 return flatten_as_tm (g);
00212 }
00213
00214 string
00215 flatten_as_tm_document (const generic& g, const string& style) {
00216 return flatten_as_tm (g, style);
00217 }
00218
00219 vector<generic>
00220 mmx_tokenize (const string& s, const string& sep, const bool& flag) {
00221 return as<vector<generic> > (tokenize (s, sep, flag));
00222 }
00223
00224 string
00225 mmx_recompose (const vector<generic>& v, const string& sep, const bool& flag) {
00226 return recompose (as<vector<string> > (v), sep, flag);
00227 }
00228
00229 int
00230 simple_loop (const int& i, const int& j) {
00231 threads_simple_loop (i, j);
00232 return 0;
00233 }
00234
00235 generic
00236 mmx_foobar () {
00237 return generic ((nat) 1);
00238 }
00239
00240
00241
00242
00243
00244 void
00245 glue_system () {
00246 define ("relative_name", relative_name);
00247 define ("resolve_name", resolve_name);
00248 define ("follow_link", follow_link);
00249 define ("path_name", path_name);
00250 define_primitive ("readable?", mmx_is_readable);
00251 define ("file?", file_is_file);
00252 define ("directory?", file_is_directory);
00253 define ("last_modified", file_last_modified);
00254 define_primitive ("load", mmx_load_string);
00255 define_primitive ("save", mmx_save_string);
00256 define_primitive ("update", mmx_update_string);
00257 define_primitive ("parse", mmx_parse);
00258 define_primitive ("include", mmx_include);
00259 define_primitive ("reinclude", mmx_reinclude);
00260 define_primitive ("load_directory", mmx_load_directory);
00261 define_primitive ("supports?", mmx_supports);
00262 define_primitive ("used?", mmx_used);
00263 define_primitive ("use", mmx_use);
00264
00265 define ("flatten_as_cpp", flatten_as_cpp);
00266 define ("flatten_as_mmx", flatten_as_mmx);
00267 define ("flatten_as_tm", flatten_as_tm_snippet);
00268 define ("flatten_as_tm", flatten_as_tm_document);
00269
00270 define ("get_env", get_env);
00271
00272 define ("system", mmx_system);
00273 define ("eval_system", eval_system);
00274 define ("prefix_dir", prefix_dir);
00275 define ("user_dir", user_dir);
00276 define ("sysconf_dir", user_dir);
00277 define ("file_exists?", file_exists);
00278 define ("strip_directory", strip_directory);
00279 define ("get_directory", get_directory);
00280 define ("strip_extension", strip_extension);
00281 define ("get_extension", get_extension);
00282 define ("get_number_threads", threads_get_number);
00283 define ("set_number_threads", threads_set_number);
00284 define ("get_number_cores", get_number_cores);
00285 define ("tokenize", mmx_tokenize);
00286 define ("recompose", mmx_recompose);
00287 define ("simple_loop", simple_loop);
00288 define ("foobar", mmx_foobar);
00289 define ("time", mmx_var_time);
00290 }
00291
00292 }
