init.cpp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547
  1. /**
  2. * This file is part of Gomu.
  3. *
  4. * Copyright 2016 by Jean Fromentin <jean.fromentin@math.cnrs.fr>
  5. *
  6. * Gomu is free software: you can redistribute it and/or modify
  7. * it under the terms of the GNU General Public License as published by
  8. * the Free Software Foundation, either version 3 of the License, or
  9. * (at your option) any later version.
  10. *
  11. * Gomu is distributed in the hope that it will be useful,
  12. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  14. * GNU General Public License for more details.
  15. *
  16. * You should have received a copy of the GNU General Public License
  17. * along with Gomu. If not, see <http://www.gnu.org/licenses/>.
  18. */
  19. #include "init.hpp"
  20. //******************
  21. //* Global objects *
  22. //******************
  23. Gomu::Type* type_ArtinWordA;
  24. Gomu::Type* type_DualWordA;
  25. Gomu::Type* type_monoid_family;
  26. Gomu::Type* type_word;
  27. //*************************
  28. //* Extension inilisation *
  29. //*************************
  30. extern "C"{
  31. Word empty_word;
  32. Word x1({1});
  33. Word x2({2});
  34. Word x3({3});
  35. Word x4({4});
  36. Word X1({-1});
  37. Word X2({-2});
  38. Word X3({-3});
  39. Word X4({-4});
  40. Word x12({generator(1,2)});
  41. Word x13({generator(1,3)});
  42. Word x23({generator(2,3)});
  43. Word x14({generator(1,4)});
  44. Word x24({generator(2,4)});
  45. Word x34({generator(3,4)});
  46. Word x15({generator(1,5)});
  47. Word x25({generator(2,5)});
  48. Word x35({generator(3,5)});
  49. Word x45({generator(4,5)});
  50. Word X12({(Generator)(-generator(1,2))});
  51. Word X13({(Generator)(-generator(1,3))});
  52. Word X23({(Generator)(-generator(2,3))});
  53. Word X14({(Generator)(-generator(1,4))});
  54. Word X24({(Generator)(-generator(2,4))});
  55. Word X34({(Generator)(-generator(3,4))});
  56. Word X15({(Generator)(-generator(1,5))});
  57. Word X25({(Generator)(-generator(2,5))});
  58. Word X35({(Generator)(-generator(3,5))});
  59. Word X45({(Generator)(-generator(4,5))});
  60. void init(){
  61. braids_init();
  62. }
  63. Gomu::Module::Type types[]={
  64. {"ArtinWordA",ArtinWordA_display,word_delete,word_copy,word_compare,&type_ArtinWordA},
  65. {"DualWordA",DualWordA_display,word_delete,word_copy,word_compare,&type_DualWordA},
  66. {"ArtinMonoidFamilyA",mf_display,mf_delete,Gomu::no_copy,Gomu::no_comp,&type_monoid_family},
  67. {"DualMonoidFamilyA",mf_display,mf_delete,Gomu::no_copy,Gomu::no_comp,&type_monoid_family},
  68. {"MonoidFamily",mf_display,mf_delete,Gomu::no_copy,Gomu::no_comp,&type_monoid_family},
  69. {"Word",word_display,word_delete,word_copy,word_compare,&type_word},
  70. TYPE_SENTINEL
  71. };
  72. Gomu::Module::Function functions[]={
  73. {"ArtinWordA","operator*",{"ArtinWordA","ArtinWordA"},(void*)word_concatenate},
  74. {"DualWordA","operator*",{"DualWordA","DualWordA"},(void*)word_concatenate},
  75. {"Boolean","operator===",{"ArtinWordA","ArtinWordA"},(void*)ArtinWordA_equivalent},
  76. {"Boolean","operator===",{"DualWordA","DualWordA"},(void*)DualWordA_equivalent},
  77. {"Word","word",{"Array"},(void*)word_from_array},
  78. FUNC_SENTINEL
  79. };
  80. Gomu::Module::Function member_functions[]={
  81. //ArtinMonoidFamilyA
  82. {"ArtinWordA","garside_element",{"ArtinMonoidFamilyA","Integer"},(void*)mf_garside_element},
  83. {"Boolean","is_left_divisible",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_is_left_divisible},
  84. {"Tuple","is_left_divisible_x",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_is_left_divisible_x},
  85. {"Boolean","is_right_divisible",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_is_right_divisible},
  86. {"Tuple","is_right_divisible_x",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_is_right_divisible_x},
  87. {"ArtinWordA","left_complement",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_left_complement},
  88. {"ArtinWordA","left_denominator",{"ArtinMonoidFamilyA"},(void*)mt_left_denominator},
  89. {"ArtinWordA","left_lcm",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_left_lcm},
  90. {"ArtinWordA","left_lcm_complement",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_left_lcm_complement},
  91. {"ArtinWordA","left_gcd",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_left_gcd},
  92. {"Tuple","left_gcd_x",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_left_gcd_x},
  93. {"ArtinWordA","left_numerator",{"ArtinMonoidFamilyA"},(void*)mt_left_numerator},
  94. {"ArtinWordA","left_reverse",{"ArtinMonoidFamilyA","ArtinWordA"},(void*)mt_left_reverse},
  95. {"ArtinWordA","left_reverse",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_left_reverse2},
  96. {"ArtinWordA","phi",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi},
  97. {"ArtinWordA","phi",{"ArtinMonoidFamilyA","Integer","ArtinWordA","Integer"},(void*)mf_phi_power},
  98. {"ArtinWordA","phi_normal_form",{"ArtinMonoidFamilyA","ArtinWordA"},(void*)mf_phi_normal},
  99. {"ArtinWordA","phi_tail",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi_tail},
  100. {"Tuple","phi_tail_x",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi_tail_x},
  101. {"Array","phi_splitting",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi_splitting},
  102. {"Integer","rank",{"ArtinMonoidFamilyA","ArtinWordA"},(void*)mf_rank},
  103. {"ArtinWordA","right_complement",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_complement},
  104. {"ArtinWordA","right_denominator",{"ArtinMonoidFamilyA"},(void*)mt_right_denominator},
  105. {"ArtinWordA","right_lcm",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_lcm},
  106. {"ArtinWordA","right_lcm_complement",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_lcm_complement},
  107. {"ArtinWordA","right_gcd",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_gcd},
  108. {"Tuple","right_gcd_x",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_gcd_x},
  109. {"ArtinWordA","right_numerator",{"ArtinMonoidFamilyA"},(void*)mt_right_numerator},
  110. {"ArtinWordA","right_reverse",{"ArtinMonoidFamilyA","ArtinWordA"},(void*)mt_right_reverse},
  111. {"ArtinWordA","right_reverse",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_reverse2},
  112. //ArtinWordA
  113. {"Integer","length",{"ArtinWordA"},(void*)word_length},
  114. {"ArtinWordA","inverse",{"ArtinWordA"},(void*)word_inverse},
  115. //DualMonoidFamilyA
  116. {"DualWordA","garside_element",{"DualMonoidFamilyA","Integer"},(void*)mf_garside_element},
  117. {"Boolean","is_left_divisible",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_left_divisible},
  118. {"Tuple","is_left_divisible_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_left_divisible_x},
  119. {"Boolean","is_right_divisible",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_right_divisible},
  120. {"Tuple","is_right_divisible_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_right_divisible_x},
  121. {"DualWordA","left_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_complement},
  122. {"DualWordA","left_denominator",{"DualMonoidFamilyA"},(void*)mt_left_denominator},
  123. {"DualWordA","left_lcm",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_lcm},
  124. {"DualWordA","left_lcm_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_lcm_complement},
  125. {"DualWordA","left_gcd",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_gcd},
  126. {"Tuple","left_gcd_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_gcd_x},
  127. {"DualWordA","left_numerator",{"DualMonoidFamilyA"},(void*)mt_left_numerator},
  128. {"DualWordA","left_reverse",{"DualMonoidFamilyA","DualWordA"},(void*)mt_left_reverse},
  129. {"DualWordA","left_reverse",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_reverse2},
  130. {"DualWordA","phi",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi},
  131. {"DualWordA","phi",{"DualMonoidFamilyA","Integer","DualWordA","Integer"},(void*)mf_phi_power},
  132. {"DualWordA","phi_normal_form",{"DualMonoidFamilyA","DualWordA"},(void*)mf_phi_normal},
  133. {"DualWordA","phi_tail",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi_tail},
  134. {"Tuple","phi_tail_x",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi_tail_x},
  135. {"Array","phi_splitting",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi_splitting},
  136. {"Integer","rank",{"DualMonoidFamilyA","DualWordA"},(void*)mf_rank},
  137. {"DualWordA","right_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_complement},
  138. {"DualWordA","right_denominator",{"DualMonoidFamilyA"},(void*)mt_right_denominator},
  139. {"DualWordA","right_lcm",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_lcm},
  140. {"DualWordA","right_lcm_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_lcm_complement},
  141. {"DualWordA","right_gcd",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_gcd},
  142. {"Tuple","right_gcd_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_gcd_x},
  143. {"DualWordA","right_numerator",{"DualMonoidFamilyA"},(void*)mt_right_numerator},
  144. {"DualWordA","right_reverse",{"DualMonoidFamilyA","DualWordA"},(void*)mt_right_reverse},
  145. {"DualWordA","right_reverse",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_reverse2},
  146. //DualWordA
  147. {"Integer","length",{"DualWordA"},(void*)word_length},
  148. {"ArtinWordA","inverse",{"DualWordA"},(void*)word_inverse},
  149. //MonoidFamily
  150. {"Integer","generators_number",{"MonoidFamily","Integer"},(void*)mf_generators_number},
  151. //Word
  152. {"Integer","length",{"Word"},(void*)word_length},
  153. {"Word","inverse",{"Word"},(void*)word_inverse},
  154. FUNC_SENTINEL
  155. };
  156. Gomu::Module::Symbol symbols[]={
  157. {"a0","ArtinWordA",(void*)&empty_word},
  158. {"a1","ArtinWordA",(void*)&x1},
  159. {"a2","ArtinWordA",(void*)&x2},
  160. {"a3","ArtinWordA",(void*)&x3},
  161. {"a4","ArtinWordA",(void*)&x4},
  162. {"A1","ArtinWordA",(void*)&X1},
  163. {"A2","ArtinWordA",(void*)&X2},
  164. {"A3","ArtinWordA",(void*)&X3},
  165. {"A4","ArtinWordA",(void*)&X4},
  166. {"a00","DualWordA",(void*)&empty_word},
  167. {"a12","DualWordA",(void*)&x12},
  168. {"a13","DualWordA",(void*)&x13},
  169. {"a23","DualWordA",(void*)&x23},
  170. {"a14","DualWordA",(void*)&x14},
  171. {"a24","DualWordA",(void*)&x24},
  172. {"a34","DualWordA",(void*)&x34},
  173. {"a15","DualWordA",(void*)&x15},
  174. {"a25","DualWordA",(void*)&x25},
  175. {"a35","DualWordA",(void*)&x35},
  176. {"a45","DualWordA",(void*)&x45},
  177. {"A12","DualWordA",(void*)&X12},
  178. {"A13","DualWordA",(void*)&X13},
  179. {"A23","DualWordA",(void*)&X23},
  180. {"A14","DualWordA",(void*)&X14},
  181. {"A24","DualWordA",(void*)&X24},
  182. {"A34","DualWordA",(void*)&X34},
  183. {"A15","DualWordA",(void*)&X15},
  184. {"A25","DualWordA",(void*)&X25},
  185. {"A35","DualWordA",(void*)&X35},
  186. {"A45","DualWordA",(void*)&X45},
  187. {"ArtinA","ArtinMonoidFamilyA",(void*)&ArtinA_mf},
  188. {"DualA","DualMonoidFamilyA",(void*)&DualA_mf},
  189. SYMB_SENTINEL
  190. };
  191. };
  192. //*************************
  193. //* Fonctions definitions *
  194. //*************************
  195. //--------------------------------------------
  196. // Word garside_element(MonoidFamily,Integer)
  197. //--------------------------------------------
  198. void* mf_garside_element(void* m,void* r){
  199. MonoidFamily* monoid=(MonoidFamily*)m;
  200. if(not monoid->has_garside_element())
  201. RuntimeError("Monoid doesn't have Garside element");
  202. return (void*)(new Word(monoid->garside_element(Gomu::get_slong(r))));
  203. }
  204. //-------------------------------------
  205. // Word phi(MonoidFamily,Integer,Word)
  206. //-------------------------------------
  207. void* mf_phi(void* m,void* r,void* w){
  208. MonoidFamily* monoid=(MonoidFamily*)m;
  209. if(not monoid->has_garside_automorphism())
  210. RuntimeError("Monoid has not Garside automorphism");
  211. size_t rank=Gomu::get_slong(r);
  212. return new Word(monoid->phi(rank,*(Word*)w));
  213. }
  214. //---------------------------------------------
  215. // Word phi(MonoidFamily,Integer,Word,Integer)
  216. //---------------------------------------------
  217. void* mf_phi_power(void* m,void* r,void* w,void* p){
  218. MonoidFamily* monoid=(MonoidFamily*)m;
  219. if(not monoid->has_garside_automorphism())
  220. RuntimeError("Monoid has not Garside automorphism");
  221. size_t rank=Gomu::get_slong(r);
  222. int power=Gomu::get_slong(p);
  223. return new Word(monoid->phi(rank,*(Word*)w,power));
  224. }
  225. //------------------------------------------
  226. // Word phi_tail(MonoidFamily,Integer,Word)
  227. //------------------------------------------
  228. void* mf_phi_tail(void* m,void* r,void* w){
  229. MonoidFamily* monoid=(MonoidFamily*)m;
  230. if(not monoid->has_garside_automorphism())
  231. RuntimeError("Monoid has not Garside automorphism");
  232. size_t rank=Gomu::get_slong(r);
  233. return new Word(monoid->phi_tail(rank,*(Word*)w));
  234. }
  235. //---------------------------------------------------
  236. // (Word,Word) phi_tail_x(MonoidFamily,Integer,Word)
  237. //---------------------------------------------------
  238. void* mf_phi_tail_x(void* m,void* r,void* w){
  239. MonoidFamily* monoid=(MonoidFamily*)m;
  240. if(not monoid->has_garside_automorphism())
  241. RuntimeError("Monoid has not Garside automorphism");
  242. size_t rank=Gomu::get_slong(r);
  243. pair<Word,Word> p=monoid->phi_tail_x(rank,*(Word*)w);
  244. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  245. Gomu::Type* type=(Gomu::Type*)monoid->data;
  246. res->tab[0]=Gomu::Value(type,new Word(p.first));
  247. res->tab[1]=Gomu::Value(type,new Word(p.second));
  248. return (void*)res;
  249. }
  250. //------------------------------------------------------
  251. // Array[Word] phi_splitting(MonoidFamily,Integer,Word)
  252. //------------------------------------------------------
  253. void* mf_phi_splitting(void* m,void* r,void* w){
  254. MonoidFamily* monoid=(MonoidFamily*)m;
  255. size_t rank=Gomu::get_slong(r);
  256. Array<Word> a=monoid->phi_splitting(rank,*(Word*)w);
  257. Gomu::ArrayValue* res=new Gomu::ArrayValue(a.size());
  258. res->type=(Gomu::Type*)monoid->data;
  259. for(size_t i=0;i<res->size;++i){
  260. res->tab[i]=(void*)(new Word(a.read(i)));
  261. }
  262. return (void*)res;
  263. }
  264. //--------------------------------------------------
  265. // Boolean is_left_divisible(MonoidTrait,Word,Word)
  266. //--------------------------------------------------
  267. void* mt_is_left_divisible(void* m,void* a,void* b){
  268. MonoidTrait* monoid=(MonoidTrait*)m;
  269. return Gomu::to_boolean(monoid->is_left_divisible(*(Word*)a,*(Word*)b));
  270. }
  271. //---------------------------------------------------------------
  272. // pair<Boolean,Word> is_left_divisible_x(MonoidTrait,Word,Word)
  273. //---------------------------------------------------------------
  274. void* mt_is_left_divisible_x(void* m,void* a,void* b){
  275. MonoidTrait* monoid=(MonoidTrait*)m;
  276. pair<bool,Word> p=monoid->is_left_divisible_x(*(Word*)a,*(Word*)b);
  277. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  278. res->tab[0]=Gomu::Value(Gomu::type_boolean,Gomu::to_boolean(p.first));
  279. res->tab[1]=Gomu::Value((Gomu::Type*)monoid->data,new Word(p.second));
  280. return (void*)res;
  281. }
  282. //-----------------------------------------------
  283. // bool is_right_divisible(MonoidTrait,Word,Word)
  284. //-----------------------------------------------
  285. void* mt_is_right_divisible(void* m,void* a,void* b){
  286. MonoidTrait* monoid=(MonoidTrait*)m;
  287. return Gomu::to_boolean(monoid->is_right_divisible(*(Word*)a,*(Word*)b));
  288. }
  289. //----------------------------------------------------------------
  290. // pair<Boolean,Word> is_right_divisible_x(MonoidTrait,Word,Word)
  291. //----------------------------------------------------------------
  292. void* mt_is_right_divisible_x(void* m,void* a,void* b){
  293. MonoidTrait* monoid=(MonoidTrait*)m;
  294. pair<bool,Word> p=monoid->is_right_divisible_x(*(Word*)a,*(Word*)b);
  295. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  296. res->tab[0]=Gomu::Value(Gomu::type_boolean,Gomu::to_boolean(p.first));
  297. res->tab[1]=Gomu::Value((Gomu::Type*)monoid->data,new Word(p.second));
  298. return (void*)res;
  299. }
  300. //---------------------------------------------
  301. // Word left_complement(MonoidTrait,Word,Word)
  302. //---------------------------------------------
  303. void* mt_left_complement(void* m,void* a,void* b){
  304. MonoidTrait* monoid=(MonoidTrait*)m;
  305. Word* u=(Word*)a;
  306. Word* v=(Word*)b;
  307. if(u->size()!=1 or v->size()!=1) RuntimeError("Words must be of length 1");
  308. return new Word(monoid->left_complement(u->array[0],v->array[0]));
  309. }
  310. //------------------------------------
  311. // Word left_denominator(MonoidTrait)
  312. //------------------------------------
  313. void* mt_left_denominator(void* m){
  314. MonoidTrait* monoid=(MonoidTrait*)m;
  315. if(not monoid->has_left_complement())
  316. RuntimeError("Monoid is not left complemented");
  317. return new Word(monoid->left_denominator());
  318. }
  319. //---------------------------------------
  320. // Word left_gcd(MonoidTrait,Word,Word)
  321. //---------------------------------------
  322. void* mt_left_gcd(void* m,void* a,void *b){
  323. MonoidTrait* monoid=(MonoidTrait*)m;
  324. return new Word(monoid->left_gcd(*(Word*)a,*(Word*)b));
  325. }
  326. //-----------------------------------------------
  327. // (Word,Word) left_gcd_x(MonoidTrait,Word,Word)
  328. //-----------------------------------------------
  329. void* mt_left_gcd_x(void* m,void* a,void *b){
  330. MonoidTrait* monoid=(MonoidTrait*)m;
  331. pair<Word,Word> p=monoid->left_gcd_x(*(Word*)a,*(Word*)b);
  332. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  333. Gomu::Type* type=(Gomu::Type*)monoid->data;
  334. res->tab[0]=Gomu::Value(type,new Word(p.first));
  335. res->tab[1]=Gomu::Value(type,new Word(p.second));
  336. return (void*)res;
  337. }
  338. //--------------------------------------
  339. // Word left_lcm(MonoidTrait,Word,Word)
  340. //--------------------------------------
  341. void* mt_left_lcm(void* m,void* a,void *b){
  342. MonoidTrait* monoid=(MonoidTrait*)m;
  343. return new Word(monoid->left_lcm(*(Word*)a,*(Word*)b));
  344. }
  345. //-------------------------------------------------
  346. // Word left_lcm_complement(MonoidTrait,Word,Word)
  347. //-------------------------------------------------
  348. void* mt_left_lcm_complement(void* m,void* a,void *b){
  349. MonoidTrait* monoid=(MonoidTrait*)m;
  350. return new Word(monoid->left_lcm_complement(*(Word*)a,*(Word*)b));
  351. }
  352. //----------------------------------
  353. // Word left_numerator(MonoidTrait)
  354. //----------------------------------
  355. void* mt_left_numerator(void* m){
  356. MonoidTrait* monoid=(MonoidTrait*)m;
  357. if(not monoid->has_left_complement())
  358. RuntimeError("Monoid is not left complemented");
  359. return new Word(monoid->left_numerator());
  360. }
  361. //-------------------------------------
  362. // Word left_reverse(MonoidTrait,Word)
  363. //-------------------------------------
  364. void* mt_left_reverse(void* m,void* w){
  365. MonoidTrait* monoid=(MonoidTrait*)m;
  366. if(not monoid->has_left_complement())
  367. RuntimeError("Monoid is not left complemented");
  368. return (void*)new Word(monoid->left_reverse(*(Word*)w));
  369. }
  370. //------------------------------------------
  371. // Word left_reverse(MonoidTrait,Word,Word)
  372. //------------------------------------------
  373. void* mt_left_reverse2(void* m,void* num,void* den){
  374. MonoidTrait* monoid=(MonoidTrait*)m;
  375. if(not monoid->has_left_complement())
  376. RuntimeError("Monoid is not left complemented");
  377. return (void*)new Word(monoid->left_reverse(*(Word*)num,*(Word*)den));
  378. }
  379. //----------------------------------------------
  380. // Word right_complement(MonoidTrait,Word,Word)
  381. //----------------------------------------------
  382. void* mt_right_complement(void* m,void* a,void* b){
  383. MonoidTrait* monoid=(MonoidTrait*)m;
  384. Word* u=(Word*)a;
  385. Word* v=(Word*)b;
  386. if(u->size()!=1 or v->size()!=1) RuntimeError("Words must be of length 1");
  387. return new Word(monoid->right_complement(u->array[0],v->array[0]));
  388. }
  389. //-------------------------------------
  390. // Word right_denominator(MonoidTrait)
  391. //-------------------------------------
  392. void* mt_right_denominator(void* m){
  393. MonoidTrait* monoid=(MonoidTrait*)m;
  394. if(not monoid->has_right_complement())
  395. RuntimeError("Monoid is not right complemented");
  396. return new Word(monoid->right_denominator());
  397. }
  398. //---------------------------------------
  399. // Word right_gcd(MonoidTrait,Word,Word)
  400. //---------------------------------------
  401. void* mt_right_gcd(void* m,void* a,void *b){
  402. MonoidTrait* monoid=(MonoidTrait*)m;
  403. return new Word(monoid->right_gcd(*(Word*)a,*(Word*)b));
  404. }
  405. //-----------------------------------------------
  406. // (Word,Word) right_gcd_x(MonoidTrait,Word,Word)
  407. //-----------------------------------------------
  408. void* mt_right_gcd_x(void* m,void* a,void *b){
  409. MonoidTrait* monoid=(MonoidTrait*)m;
  410. pair<Word,Word> p=monoid->right_gcd_x(*(Word*)a,*(Word*)b);
  411. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  412. Gomu::Type* type=(Gomu::Type*)monoid->data;
  413. res->tab[0]=Gomu::Value(type,new Word(p.first));
  414. res->tab[1]=Gomu::Value(type,new Word(p.second));
  415. return (void*)res;
  416. }
  417. //---------------------------------------
  418. // Word right_lcm(MonoidTrait,Word,Word)
  419. //---------------------------------------
  420. void* mt_right_lcm(void* m,void* a,void *b){
  421. MonoidTrait* monoid=(MonoidTrait*)m;
  422. return new Word(monoid->right_lcm(*(Word*)a,*(Word*)b));
  423. }
  424. //--------------------------------------------------
  425. // Word right_lcm_complement(MonoidTrait,Word,Word)
  426. //--------------------------------------------------
  427. void* mt_right_lcm_complement(void* m,void* a,void *b){
  428. MonoidTrait* monoid=(MonoidTrait*)m;
  429. return new Word(monoid->right_lcm_complement(*(Word*)a,*(Word*)b));
  430. }
  431. //-----------------------------------
  432. // Word right_numerator(MonoidTrait)
  433. //-----------------------------------
  434. void* mt_right_numerator(void* m){
  435. MonoidTrait* monoid=(MonoidTrait*)m;
  436. if(not monoid->has_right_complement())
  437. RuntimeError("Monoid is not right complemented");
  438. return new Word(monoid->right_numerator());
  439. }
  440. //--------------------------------------
  441. // Word right_reverse(MonoidTrait,Word)
  442. //--------------------------------------
  443. void* mt_right_reverse(void* m,void* w){
  444. MonoidTrait* monoid=(MonoidTrait*)m;
  445. if(not monoid->has_right_complement())
  446. RuntimeError("Monoid is not right complemented");
  447. return (void*)new Word(monoid->right_reverse(*(Word*)w));
  448. }
  449. //-------------------------------------------
  450. // Word right_reverse(MonoidTrair,Word,Word)
  451. //-------------------------------------------
  452. void* mt_right_reverse2(void* m,void* den,void* num){
  453. MonoidTrait* monoid=(MonoidTrait*)m;
  454. if(not monoid->has_right_complement())
  455. RuntimeError("Monoid is not right complemented");
  456. return (void*)new Word(monoid->right_reverse(*(Word*)den,*(Word*)num));
  457. }
  458. //-----------------------
  459. // Word word(ArrayValue)
  460. //-----------------------
  461. void* word_from_array(void* arr){
  462. Gomu::ArrayValue* array=(Gomu::ArrayValue*)arr;
  463. if(array->type!=Gomu::type_integer)
  464. RuntimeError("An array of integer is needed");
  465. size_t size=array->size;
  466. Word* res=new Word(size);
  467. for(size_t i=0;i<size;++i){
  468. res->write(i,Gomu::get_slong(array->tab[i]));
  469. }
  470. return res;
  471. }