1. my class Junction { # declared in BOOTSTRAP
  2. # class Junction is Mu
  3. # has Mu $!storage; # elements of Junction
  4. # has str $!type; # type of Junction
  5. method !SET-SELF(\type,\values) {
  6. nqp::stmts(
  7. ($!type = type),
  8. nqp::if(
  9. nqp::iseq_s($!type,"any")
  10. || nqp::iseq_s($!type,"all")
  11. || nqp::iseq_s($!type,"none")
  12. || nqp::iseq_s($!type,"one"),
  13. nqp::stmts(
  14. ($!storage := nqp::if(
  15. nqp::attrinited((my $L := values.eager.list),List,'$!reified'),
  16. nqp::getattr($L,List,'$!reified'),
  17. nqp::create(IterationBuffer)
  18. )),
  19. self
  20. ),
  21. Failure.new("Junction can only have 'any', 'all', 'none', 'one' type")
  22. )
  23. )
  24. }
  25. multi method new(Junction: \values, Str :$type!) {
  26. nqp::create(Junction)!SET-SELF($type,values)
  27. }
  28. multi method new(Junction: Str:D \type, \values) {
  29. nqp::create(Junction)!SET-SELF(type,values)
  30. }
  31. method defined(Junction:D:) {
  32. nqp::stmts(
  33. (my int $elems = nqp::elems($!storage)),
  34. (my int $i = 0),
  35. nqp::if(
  36. nqp::iseq_s($!type,'any'),
  37. nqp::stmts(
  38. nqp::while(
  39. (nqp::islt_i($i,$elems)
  40. && nqp::if(nqp::atpos($!storage,$i).defined,0,1)),
  41. ($i = nqp::add_i($i,1))
  42. ),
  43. nqp::p6bool(nqp::islt_i($i,$elems))
  44. ),
  45. nqp::if(
  46. nqp::iseq_s($!type,'all'),
  47. nqp::stmts(
  48. nqp::while(
  49. (nqp::islt_i($i,$elems)
  50. && nqp::atpos($!storage,$i).defined),
  51. ($i = nqp::add_i($i,1))
  52. ),
  53. nqp::p6bool(nqp::iseq_i($i,$elems))
  54. ),
  55. nqp::if(
  56. nqp::iseq_s($!type,'none'),
  57. nqp::stmts(
  58. nqp::while(
  59. (nqp::islt_i($i,$elems)
  60. && nqp::if(nqp::atpos($!storage,$i).defined,0,1)),
  61. ($i = nqp::add_i($i,1))
  62. ),
  63. nqp::p6bool(nqp::iseq_i($i,$elems))
  64. ),
  65. nqp::stmts( # $!type eq 'one'
  66. (my int $seen = 0),
  67. ($i = nqp::sub_i($i,1)), # increment in condition
  68. nqp::while(
  69. (nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  70. && nqp::isle_i($seen,1)),
  71. nqp::if(
  72. nqp::atpos($!storage,$i).defined,
  73. ($seen = nqp::add_i($seen,1))
  74. )
  75. ),
  76. nqp::p6bool(nqp::iseq_i($seen,1))
  77. )
  78. )
  79. )
  80. )
  81. )
  82. }
  83. multi method Bool(Junction:D:) {
  84. nqp::stmts(
  85. (my int $elems = nqp::elems($!storage)),
  86. (my int $i = 0),
  87. nqp::if(
  88. nqp::iseq_s($!type,'any'),
  89. nqp::stmts(
  90. nqp::while(
  91. (nqp::islt_i($i,$elems)
  92. && nqp::if(nqp::atpos($!storage,$i),0,1)),
  93. ($i = nqp::add_i($i,1))
  94. ),
  95. nqp::p6bool(nqp::islt_i($i,$elems))
  96. ),
  97. nqp::if(
  98. nqp::iseq_s($!type,'all'),
  99. nqp::stmts(
  100. nqp::while(
  101. (nqp::islt_i($i,$elems)
  102. && nqp::atpos($!storage,$i)),
  103. ($i = nqp::add_i($i,1))
  104. ),
  105. nqp::p6bool(nqp::iseq_i($i,$elems))
  106. ),
  107. nqp::if(
  108. nqp::iseq_s($!type,'none'),
  109. nqp::stmts(
  110. nqp::while(
  111. (nqp::islt_i($i,$elems)
  112. && nqp::if(nqp::atpos($!storage,$i),0,1)),
  113. ($i = nqp::add_i($i,1))
  114. ),
  115. nqp::p6bool(nqp::iseq_i($i,$elems))
  116. ),
  117. nqp::stmts( # $!type eq 'one'
  118. (my int $seen = 0),
  119. ($i = nqp::sub_i($i,1)), # increment in condition
  120. nqp::while(
  121. (nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  122. && nqp::isle_i($seen,1)),
  123. nqp::if(
  124. nqp::atpos($!storage,$i),
  125. ($seen = nqp::add_i($seen,1))
  126. )
  127. ),
  128. nqp::p6bool(nqp::iseq_i($seen,1))
  129. )
  130. )
  131. )
  132. )
  133. )
  134. }
  135. multi method ACCEPTS(Junction:U: Mu:D \topic) {
  136. nqp::p6bool(nqp::istype(topic, Junction));
  137. }
  138. multi method ACCEPTS(Junction:U: Any \topic) {
  139. nqp::p6bool(nqp::istype(topic, Junction));
  140. }
  141. multi method ACCEPTS(Junction:D: Mu \topic) {
  142. nqp::stmts(
  143. (my int $elems = nqp::elems($!storage)),
  144. (my int $i = 0),
  145. nqp::if(
  146. nqp::iseq_s($!type,'any'),
  147. nqp::stmts(
  148. nqp::while(
  149. (nqp::islt_i($i,$elems)
  150. && nqp::if(nqp::atpos($!storage,$i).ACCEPTS(topic),0,1)),
  151. ($i = nqp::add_i($i,1))
  152. ),
  153. nqp::p6bool(nqp::islt_i($i,$elems))
  154. ),
  155. nqp::if(
  156. nqp::iseq_s($!type,'all'),
  157. nqp::stmts(
  158. nqp::while(
  159. (nqp::islt_i($i,$elems)
  160. && nqp::atpos($!storage,$i).ACCEPTS(topic)),
  161. ($i = nqp::add_i($i,1))
  162. ),
  163. nqp::p6bool(nqp::iseq_i($i,$elems))
  164. ),
  165. nqp::if(
  166. nqp::iseq_s($!type,'none'),
  167. nqp::stmts(
  168. nqp::while(
  169. (nqp::islt_i($i,$elems)
  170. && nqp::if(nqp::atpos($!storage,$i).ACCEPTS(topic),0,1)),
  171. ($i = nqp::add_i($i,1))
  172. ),
  173. nqp::p6bool(nqp::iseq_i($i,$elems))
  174. ),
  175. nqp::stmts( # $!type eq 'one'
  176. (my int $seen = 0),
  177. ($i = nqp::sub_i($i,1)), # increment in condition
  178. nqp::while(
  179. (nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  180. && nqp::isle_i($seen,1)),
  181. nqp::if(
  182. nqp::atpos($!storage,$i).ACCEPTS(topic),
  183. ($seen = nqp::add_i($seen,1))
  184. )
  185. ),
  186. nqp::p6bool(nqp::iseq_i($seen,1))
  187. )
  188. )
  189. )
  190. )
  191. )
  192. }
  193. multi method Str(Junction:D:) {
  194. self.perl
  195. }
  196. multi method gist(Junction:D:) {
  197. my int $elems = nqp::elems($!storage);
  198. my int $i = -1;
  199. my $gists := nqp::setelems(nqp::list_s,$elems);
  200. nqp::bindpos_s($gists,$i,nqp::atpos($!storage,$i).gist)
  201. while nqp::islt_i(++$i,$elems);
  202. $!type ~ '(' ~ nqp::join(', ',$gists) ~ ')'
  203. }
  204. multi method perl(Junction:D:) {
  205. my int $elems = nqp::elems($!storage);
  206. my int $i = -1;
  207. my $perls := nqp::setelems(nqp::list_s,$elems);
  208. nqp::bindpos_s($perls,$i,nqp::atpos($!storage,$i).perl)
  209. while nqp::islt_i(++$i,$elems);
  210. $!type ~ '(' ~ nqp::join(', ',$perls) ~ ')'
  211. }
  212. method CALL-ME(|c) {
  213. self.AUTOTHREAD(
  214. -> $obj, |c { $obj(|c) },
  215. self, |c);
  216. }
  217. method sink(Junction:D: --> Nil) {
  218. my int $elems = nqp::elems($!storage);
  219. my int $i = -1;
  220. nqp::atpos($!storage,$i).sink while nqp::islt_i(++$i,$elems);
  221. }
  222. method AUTOTHREAD(&call, |args) {
  223. my Mu $positionals := nqp::getattr(nqp::decont(args),Capture,'@!list');
  224. sub thread_junction(int $pos) {
  225. my $junction := nqp::decont(nqp::atpos($positionals, $pos));
  226. my $storage := nqp::getattr($junction,Junction,'$!storage');
  227. my int $elems = nqp::elems($storage);
  228. my $result := nqp::setelems(nqp::list,$elems);
  229. my int $i = -1;
  230. nqp::while(
  231. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  232. # Next line is Officially Naughty, since captures are
  233. # meant to be immutable. But hey, it's our capture to
  234. # be naughty with...
  235. nqp::stmts(
  236. nqp::bindpos($positionals,$pos,nqp::atpos($storage,$i)),
  237. nqp::bindpos($result,$i,call(|args))
  238. )
  239. );
  240. nqp::p6bindattrinvres(
  241. nqp::clone($junction),Junction,'$!storage',$result)
  242. }
  243. # Look for a junctional arg in the positionals.
  244. # we have to autothread the first all or none junction before
  245. # doing any one or any junctions.
  246. my int $first_any_one = -1;
  247. my int $elems = nqp::elems($positionals);
  248. my int $i = -1;
  249. while nqp::islt_i(++$i,$elems) {
  250. # Junctional positional argument?
  251. my Mu $arg := nqp::atpos($positionals, $i);
  252. if nqp::istype($arg,Junction) {
  253. my str $type = nqp::getattr_s(nqp::decont($arg),Junction,'$!type');
  254. nqp::iseq_s($type,'any') || nqp::iseq_s($type,'one')
  255. ?? $first_any_one == -1
  256. ?? ($first_any_one = $i)
  257. !! Nil
  258. !! return thread_junction($i);
  259. }
  260. }
  261. return thread_junction($first_any_one) if $first_any_one >= 0;
  262. # Otherwise, look for one in the nameds.
  263. my Mu $nameds := nqp::getattr(nqp::decont(args), Capture, '%!hash');
  264. my $iter := nqp::iterator($nameds);
  265. while $iter {
  266. my \tmp = nqp::shift($iter);
  267. if nqp::istype(nqp::iterval(tmp),Junction) {
  268. my $junction := nqp::decont(nqp::iterval(tmp));
  269. my $storage := nqp::getattr($junction,Junction,'$!storage');
  270. my int $elems = nqp::elems($storage);
  271. my $result := nqp::setelems(nqp::list,$elems);
  272. my int $i = -1;
  273. while nqp::islt_i(++$i,$elems) {
  274. # also naughty, like above
  275. nqp::bindkey($nameds,nqp::iterkey_s(tmp),nqp::atpos($storage,$i));
  276. nqp::bindpos($result,$i,call(|args));
  277. }
  278. my $threaded := nqp::clone(nqp::decont($junction));
  279. nqp::bindattr($threaded,Junction,'$!storage',$result);
  280. return $threaded;
  281. }
  282. }
  283. # If we get here, wasn't actually anything to autothread.
  284. call(|args);
  285. }
  286. }
  287. sub any (+values) is pure { values.any }
  288. sub all (+values) is pure { values.all }
  289. sub one (+values) is pure { values.one }
  290. sub none(+values) is pure { values.none }
  291. sub infix:<|>(+values) is pure { values.any }
  292. sub infix:<&>(+values) is pure { values.all }
  293. sub infix:<^>(+values) is pure { values.one }
  294. sub AUTOTHREAD(|c) {
  295. Junction.AUTOTHREAD(|c)
  296. }
  297. sub AUTOTHREAD_METHOD($name, |c) {
  298. Junction.AUTOTHREAD(
  299. -> \obj, |c { obj."$name"(|c) },
  300. |c);
  301. }
  302. nqp::p6setautothreader(&AUTOTHREAD);
  303. Mu.HOW.setup_junction_fallback(Junction, &AUTOTHREAD_METHOD);