init.cpp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543
  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_tail",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi_tail},
  99. {"Tuple","phi_tail_x",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi_tail_x},
  100. {"Array","phi_splitting",{"ArtinMonoidFamilyA","Integer","ArtinWordA"},(void*)mf_phi_splitting},
  101. {"ArtinWordA","right_complement",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_complement},
  102. {"ArtinWordA","right_denominator",{"ArtinMonoidFamilyA"},(void*)mt_right_denominator},
  103. {"ArtinWordA","right_lcm",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_lcm},
  104. {"ArtinWordA","right_lcm_complement",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_lcm_complement},
  105. {"ArtinWordA","right_gcd",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_gcd},
  106. {"Tuple","right_gcd_x",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_gcd_x},
  107. {"ArtinWordA","right_numerator",{"ArtinMonoidFamilyA"},(void*)mt_right_numerator},
  108. {"ArtinWordA","right_reverse",{"ArtinMonoidFamilyA","ArtinWordA"},(void*)mt_right_reverse},
  109. {"ArtinWordA","right_reverse",{"ArtinMonoidFamilyA","ArtinWordA","ArtinWordA"},(void*)mt_right_reverse2},
  110. //ArtinWordA
  111. {"Integer","length",{"ArtinWordA"},(void*)word_length},
  112. {"ArtinWordA","inverse",{"ArtinWordA"},(void*)word_inverse},
  113. //DualMonoidFamilyA
  114. {"DualWordA","garside_element",{"DualMonoidFamilyA","Integer"},(void*)mf_garside_element},
  115. {"Boolean","is_left_divisible",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_left_divisible},
  116. {"Tuple","is_left_divisible_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_left_divisible_x},
  117. {"Boolean","is_right_divisible",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_right_divisible},
  118. {"Tuple","is_right_divisible_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_is_right_divisible_x},
  119. {"DualWordA","left_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_complement},
  120. {"DualWordA","left_denominator",{"DualMonoidFamilyA"},(void*)mt_left_denominator},
  121. {"DualWordA","left_lcm",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_lcm},
  122. {"DualWordA","left_lcm_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_lcm_complement},
  123. {"DualWordA","left_gcd",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_gcd},
  124. {"Tuple","left_gcd_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_gcd_x},
  125. {"DualWordA","left_numerator",{"DualMonoidFamilyA"},(void*)mt_left_numerator},
  126. {"DualWordA","left_reverse",{"DualMonoidFamilyA","DualWordA"},(void*)mt_left_reverse},
  127. {"DualWordA","left_reverse",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_left_reverse2},
  128. {"DualWordA","phi",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi},
  129. {"DualWordA","phi",{"DualMonoidFamilyA","Integer","DualWordA","Integer"},(void*)mf_phi_power},
  130. {"DualWordA","phi_tail",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi_tail},
  131. {"Tuple","phi_tail_x",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi_tail_x},
  132. {"Array","phi_splitting",{"DualMonoidFamilyA","Integer","DualWordA"},(void*)mf_phi_splitting},
  133. {"DualWordA","right_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_complement},
  134. {"DualWordA","right_denominator",{"DualMonoidFamilyA"},(void*)mt_right_denominator},
  135. {"DualWordA","right_lcm",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_lcm},
  136. {"DualWordA","right_lcm_complement",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_lcm_complement},
  137. {"DualWordA","right_gcd",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_gcd},
  138. {"Tuple","right_gcd_x",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_gcd_x},
  139. {"DualWordA","right_numerator",{"DualMonoidFamilyA"},(void*)mt_right_numerator},
  140. {"DualWordA","right_reverse",{"DualMonoidFamilyA","DualWordA"},(void*)mt_right_reverse},
  141. {"DualWordA","right_reverse",{"DualMonoidFamilyA","DualWordA","DualWordA"},(void*)mt_right_reverse2},
  142. //DualWordA
  143. {"Integer","length",{"DualWordA"},(void*)word_length},
  144. {"ArtinWordA","inverse",{"DualWordA"},(void*)word_inverse},
  145. //MonoidFamily
  146. {"Integer","generators_number",{"MonoidFamily","Integer"},(void*)mf_generators_number},
  147. //Word
  148. {"Integer","length",{"Word"},(void*)word_length},
  149. {"Word","inverse",{"Word"},(void*)word_inverse},
  150. FUNC_SENTINEL
  151. };
  152. Gomu::Module::Symbol symbols[]={
  153. {"a0","ArtinWordA",(void*)&empty_word},
  154. {"a1","ArtinWordA",(void*)&x1},
  155. {"a2","ArtinWordA",(void*)&x2},
  156. {"a3","ArtinWordA",(void*)&x3},
  157. {"a4","ArtinWordA",(void*)&x4},
  158. {"A1","ArtinWordA",(void*)&X1},
  159. {"A2","ArtinWordA",(void*)&X2},
  160. {"A3","ArtinWordA",(void*)&X3},
  161. {"A4","ArtinWordA",(void*)&X4},
  162. {"a00","DualWordA",(void*)&empty_word},
  163. {"a12","DualWordA",(void*)&x12},
  164. {"a13","DualWordA",(void*)&x13},
  165. {"a23","DualWordA",(void*)&x23},
  166. {"a14","DualWordA",(void*)&x14},
  167. {"a24","DualWordA",(void*)&x24},
  168. {"a34","DualWordA",(void*)&x34},
  169. {"a15","DualWordA",(void*)&x15},
  170. {"a25","DualWordA",(void*)&x25},
  171. {"a35","DualWordA",(void*)&x35},
  172. {"a45","DualWordA",(void*)&x45},
  173. {"A12","DualWordA",(void*)&X12},
  174. {"A13","DualWordA",(void*)&X13},
  175. {"A23","DualWordA",(void*)&X23},
  176. {"A14","DualWordA",(void*)&X14},
  177. {"A24","DualWordA",(void*)&X24},
  178. {"A34","DualWordA",(void*)&X34},
  179. {"A15","DualWordA",(void*)&X15},
  180. {"A25","DualWordA",(void*)&X25},
  181. {"A35","DualWordA",(void*)&X35},
  182. {"A45","DualWordA",(void*)&X45},
  183. {"ArtinA","ArtinMonoidFamilyA",(void*)&ArtinA_mf},
  184. {"DualA","DualMonoidFamilyA",(void*)&DualA_mf},
  185. SYMB_SENTINEL
  186. };
  187. };
  188. //*************************
  189. //* Fonctions definitions *
  190. //*************************
  191. //--------------------------------------------
  192. // Word garside_element(MonoidFamily,Integer)
  193. //--------------------------------------------
  194. void* mf_garside_element(void* m,void* r){
  195. MonoidFamily* monoid=(MonoidFamily*)m;
  196. if(not monoid->has_garside_element())
  197. RuntimeError("Monoid doesn't have Garside element");
  198. return (void*)(new Word(monoid->garside_element(Gomu::get_slong(r))));
  199. }
  200. //-------------------------------------
  201. // Word phi(MonoidFamily,Integer,Word)
  202. //-------------------------------------
  203. void* mf_phi(void* m,void* r,void* w){
  204. MonoidFamily* monoid=(MonoidFamily*)m;
  205. if(not monoid->has_garside_automorphism())
  206. RuntimeError("Monoid has not Garside automorphism");
  207. size_t rank=Gomu::get_slong(r);
  208. return new Word(monoid->phi(rank,*(Word*)w));
  209. }
  210. //---------------------------------------------
  211. // Word phi(MonoidFamily,Integer,Word,Integer)
  212. //---------------------------------------------
  213. void* mf_phi_power(void* m,void* r,void* w,void* p){
  214. MonoidFamily* monoid=(MonoidFamily*)m;
  215. if(not monoid->has_garside_automorphism())
  216. RuntimeError("Monoid has not Garside automorphism");
  217. size_t rank=Gomu::get_slong(r);
  218. int power=Gomu::get_slong(p);
  219. return new Word(monoid->phi(rank,*(Word*)w,power));
  220. }
  221. //------------------------------------------
  222. // Word phi_tail(MonoidFamily,Integer,Word)
  223. //------------------------------------------
  224. void* mf_phi_tail(void* m,void* r,void* w){
  225. MonoidFamily* monoid=(MonoidFamily*)m;
  226. if(not monoid->has_garside_automorphism())
  227. RuntimeError("Monoid has not Garside automorphism");
  228. size_t rank=Gomu::get_slong(r);
  229. return new Word(monoid->phi_tail(rank,*(Word*)w));
  230. }
  231. //---------------------------------------------------
  232. // (Word,Word) phi_tail_x(MonoidFamily,Integer,Word)
  233. //---------------------------------------------------
  234. void* mf_phi_tail_x(void* m,void* r,void* w){
  235. MonoidFamily* monoid=(MonoidFamily*)m;
  236. if(not monoid->has_garside_automorphism())
  237. RuntimeError("Monoid has not Garside automorphism");
  238. size_t rank=Gomu::get_slong(r);
  239. pair<Word,Word> p=monoid->phi_tail_x(rank,*(Word*)w);
  240. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  241. Gomu::Type* type=(Gomu::Type*)monoid->data;
  242. res->tab[0]=Gomu::Value(type,new Word(p.first));
  243. res->tab[1]=Gomu::Value(type,new Word(p.second));
  244. return (void*)res;
  245. }
  246. //------------------------------------------------------
  247. // Array[Word] phi_splitting(MonoidFamily,Integer,Word)
  248. //------------------------------------------------------
  249. void* mf_phi_splitting(void* m,void* r,void* w){
  250. MonoidFamily* monoid=(MonoidFamily*)m;
  251. size_t rank=Gomu::get_slong(r);
  252. Array<Word> a=monoid->phi_splitting(rank,*(Word*)w);
  253. Gomu::ArrayValue* res=new Gomu::ArrayValue(a.size());
  254. res->type=(Gomu::Type*)monoid->data;
  255. for(size_t i=0;i<res->size;++i){
  256. res->tab[i]=(void*)(new Word(a.read(i)));
  257. }
  258. return (void*)res;
  259. }
  260. //--------------------------------------------------
  261. // Boolean is_left_divisible(MonoidTrait,Word,Word)
  262. //--------------------------------------------------
  263. void* mt_is_left_divisible(void* m,void* a,void* b){
  264. MonoidTrait* monoid=(MonoidTrait*)m;
  265. return Gomu::to_boolean(monoid->is_left_divisible(*(Word*)a,*(Word*)b));
  266. }
  267. //---------------------------------------------------------------
  268. // pair<Boolean,Word> is_left_divisible_x(MonoidTrait,Word,Word)
  269. //---------------------------------------------------------------
  270. void* mt_is_left_divisible_x(void* m,void* a,void* b){
  271. MonoidTrait* monoid=(MonoidTrait*)m;
  272. pair<bool,Word> p=monoid->is_left_divisible_x(*(Word*)a,*(Word*)b);
  273. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  274. res->tab[0]=Gomu::Value(Gomu::type_boolean,Gomu::to_boolean(p.first));
  275. res->tab[1]=Gomu::Value((Gomu::Type*)monoid->data,new Word(p.second));
  276. return (void*)res;
  277. }
  278. //-----------------------------------------------
  279. // bool is_right_divisible(MonoidTrait,Word,Word)
  280. //-----------------------------------------------
  281. void* mt_is_right_divisible(void* m,void* a,void* b){
  282. MonoidTrait* monoid=(MonoidTrait*)m;
  283. return Gomu::to_boolean(monoid->is_right_divisible(*(Word*)a,*(Word*)b));
  284. }
  285. //----------------------------------------------------------------
  286. // pair<Boolean,Word> is_right_divisible_x(MonoidTrait,Word,Word)
  287. //----------------------------------------------------------------
  288. void* mt_is_right_divisible_x(void* m,void* a,void* b){
  289. MonoidTrait* monoid=(MonoidTrait*)m;
  290. pair<bool,Word> p=monoid->is_right_divisible_x(*(Word*)a,*(Word*)b);
  291. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  292. res->tab[0]=Gomu::Value(Gomu::type_boolean,Gomu::to_boolean(p.first));
  293. res->tab[1]=Gomu::Value((Gomu::Type*)monoid->data,new Word(p.second));
  294. return (void*)res;
  295. }
  296. //---------------------------------------------
  297. // Word left_complement(MonoidTrait,Word,Word)
  298. //---------------------------------------------
  299. void* mt_left_complement(void* m,void* a,void* b){
  300. MonoidTrait* monoid=(MonoidTrait*)m;
  301. Word* u=(Word*)a;
  302. Word* v=(Word*)b;
  303. if(u->size()!=1 or v->size()!=1) RuntimeError("Words must be of length 1");
  304. return new Word(monoid->left_complement(u->array[0],v->array[0]));
  305. }
  306. //------------------------------------
  307. // Word left_denominator(MonoidTrait)
  308. //------------------------------------
  309. void* mt_left_denominator(void* m){
  310. MonoidTrait* monoid=(MonoidTrait*)m;
  311. if(not monoid->has_left_complement())
  312. RuntimeError("Monoid is not left complemented");
  313. return new Word(monoid->left_denominator());
  314. }
  315. //---------------------------------------
  316. // Word left_gcd(MonoidTrait,Word,Word)
  317. //---------------------------------------
  318. void* mt_left_gcd(void* m,void* a,void *b){
  319. MonoidTrait* monoid=(MonoidTrait*)m;
  320. return new Word(monoid->left_gcd(*(Word*)a,*(Word*)b));
  321. }
  322. //-----------------------------------------------
  323. // (Word,Word) left_gcd_x(MonoidTrait,Word,Word)
  324. //-----------------------------------------------
  325. void* mt_left_gcd_x(void* m,void* a,void *b){
  326. MonoidTrait* monoid=(MonoidTrait*)m;
  327. pair<Word,Word> p=monoid->left_gcd_x(*(Word*)a,*(Word*)b);
  328. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  329. Gomu::Type* type=(Gomu::Type*)monoid->data;
  330. res->tab[0]=Gomu::Value(type,new Word(p.first));
  331. res->tab[1]=Gomu::Value(type,new Word(p.second));
  332. return (void*)res;
  333. }
  334. //--------------------------------------
  335. // Word left_lcm(MonoidTrait,Word,Word)
  336. //--------------------------------------
  337. void* mt_left_lcm(void* m,void* a,void *b){
  338. MonoidTrait* monoid=(MonoidTrait*)m;
  339. return new Word(monoid->left_lcm(*(Word*)a,*(Word*)b));
  340. }
  341. //-------------------------------------------------
  342. // Word left_lcm_complement(MonoidTrait,Word,Word)
  343. //-------------------------------------------------
  344. void* mt_left_lcm_complement(void* m,void* a,void *b){
  345. MonoidTrait* monoid=(MonoidTrait*)m;
  346. return new Word(monoid->left_lcm_complement(*(Word*)a,*(Word*)b));
  347. }
  348. //----------------------------------
  349. // Word left_numerator(MonoidTrait)
  350. //----------------------------------
  351. void* mt_left_numerator(void* m){
  352. MonoidTrait* monoid=(MonoidTrait*)m;
  353. if(not monoid->has_left_complement())
  354. RuntimeError("Monoid is not left complemented");
  355. return new Word(monoid->left_numerator());
  356. }
  357. //-------------------------------------
  358. // Word left_reverse(MonoidTrait,Word)
  359. //-------------------------------------
  360. void* mt_left_reverse(void* m,void* w){
  361. MonoidTrait* monoid=(MonoidTrait*)m;
  362. if(not monoid->has_left_complement())
  363. RuntimeError("Monoid is not left complemented");
  364. return (void*)new Word(monoid->left_reverse(*(Word*)w));
  365. }
  366. //------------------------------------------
  367. // Word left_reverse(MonoidTrait,Word,Word)
  368. //------------------------------------------
  369. void* mt_left_reverse2(void* m,void* num,void* den){
  370. MonoidTrait* monoid=(MonoidTrait*)m;
  371. if(not monoid->has_left_complement())
  372. RuntimeError("Monoid is not left complemented");
  373. return (void*)new Word(monoid->left_reverse(*(Word*)num,*(Word*)den));
  374. }
  375. //----------------------------------------------
  376. // Word right_complement(MonoidTrait,Word,Word)
  377. //----------------------------------------------
  378. void* mt_right_complement(void* m,void* a,void* b){
  379. MonoidTrait* monoid=(MonoidTrait*)m;
  380. Word* u=(Word*)a;
  381. Word* v=(Word*)b;
  382. if(u->size()!=1 or v->size()!=1) RuntimeError("Words must be of length 1");
  383. return new Word(monoid->right_complement(u->array[0],v->array[0]));
  384. }
  385. //-------------------------------------
  386. // Word right_denominator(MonoidTrait)
  387. //-------------------------------------
  388. void* mt_right_denominator(void* m){
  389. MonoidTrait* monoid=(MonoidTrait*)m;
  390. if(not monoid->has_right_complement())
  391. RuntimeError("Monoid is not right complemented");
  392. return new Word(monoid->right_denominator());
  393. }
  394. //---------------------------------------
  395. // Word right_gcd(MonoidTrait,Word,Word)
  396. //---------------------------------------
  397. void* mt_right_gcd(void* m,void* a,void *b){
  398. MonoidTrait* monoid=(MonoidTrait*)m;
  399. return new Word(monoid->right_gcd(*(Word*)a,*(Word*)b));
  400. }
  401. //-----------------------------------------------
  402. // (Word,Word) right_gcd_x(MonoidTrait,Word,Word)
  403. //-----------------------------------------------
  404. void* mt_right_gcd_x(void* m,void* a,void *b){
  405. MonoidTrait* monoid=(MonoidTrait*)m;
  406. pair<Word,Word> p=monoid->right_gcd_x(*(Word*)a,*(Word*)b);
  407. Gomu::TupleValue* res=new Gomu::TupleValue(2);
  408. Gomu::Type* type=(Gomu::Type*)monoid->data;
  409. res->tab[0]=Gomu::Value(type,new Word(p.first));
  410. res->tab[1]=Gomu::Value(type,new Word(p.second));
  411. return (void*)res;
  412. }
  413. //---------------------------------------
  414. // Word right_lcm(MonoidTrait,Word,Word)
  415. //---------------------------------------
  416. void* mt_right_lcm(void* m,void* a,void *b){
  417. MonoidTrait* monoid=(MonoidTrait*)m;
  418. return new Word(monoid->right_lcm(*(Word*)a,*(Word*)b));
  419. }
  420. //--------------------------------------------------
  421. // Word right_lcm_complement(MonoidTrait,Word,Word)
  422. //--------------------------------------------------
  423. void* mt_right_lcm_complement(void* m,void* a,void *b){
  424. MonoidTrait* monoid=(MonoidTrait*)m;
  425. return new Word(monoid->right_lcm_complement(*(Word*)a,*(Word*)b));
  426. }
  427. //-----------------------------------
  428. // Word right_numerator(MonoidTrait)
  429. //-----------------------------------
  430. void* mt_right_numerator(void* m){
  431. MonoidTrait* monoid=(MonoidTrait*)m;
  432. if(not monoid->has_right_complement())
  433. RuntimeError("Monoid is not right complemented");
  434. return new Word(monoid->right_numerator());
  435. }
  436. //--------------------------------------
  437. // Word right_reverse(MonoidTrait,Word)
  438. //--------------------------------------
  439. void* mt_right_reverse(void* m,void* w){
  440. MonoidTrait* monoid=(MonoidTrait*)m;
  441. if(not monoid->has_right_complement())
  442. RuntimeError("Monoid is not right complemented");
  443. return (void*)new Word(monoid->right_reverse(*(Word*)w));
  444. }
  445. //-------------------------------------------
  446. // Word right_reverse(MonoidTrair,Word,Word)
  447. //-------------------------------------------
  448. void* mt_right_reverse2(void* m,void* den,void* num){
  449. MonoidTrait* monoid=(MonoidTrait*)m;
  450. if(not monoid->has_right_complement())
  451. RuntimeError("Monoid is not right complemented");
  452. return (void*)new Word(monoid->right_reverse(*(Word*)den,*(Word*)num));
  453. }
  454. //-----------------------
  455. // Word word(ArrayValue)
  456. //-----------------------
  457. void* word_from_array(void* arr){
  458. Gomu::ArrayValue* array=(Gomu::ArrayValue*)arr;
  459. if(array->type!=Gomu::type_integer)
  460. RuntimeError("An array of integer is needed");
  461. size_t size=array->size;
  462. Word* res=new Word(size);
  463. for(size_t i=0;i<size;++i){
  464. res->write(i,Gomu::get_slong(array->tab[i]));
  465. }
  466. return res;
  467. }