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. # Both of these are also accessed directly inside optimizer when
  6. # optimizing param typechecks with where clauses
  7. method !SET-SELF(\type,\values) {
  8. nqp::stmts(
  9. ($!type = type),
  10. nqp::if(
  11. nqp::iseq_s($!type,"any")
  12. || nqp::iseq_s($!type,"all")
  13. || nqp::iseq_s($!type,"none")
  14. || nqp::iseq_s($!type,"one"),
  15. nqp::stmts(
  16. ($!storage := nqp::if(
  17. nqp::isconcrete(
  18. $_ := nqp::getattr(values.eager.list,List,'$!reified')),
  19. $_,
  20. nqp::create(IterationBuffer))),
  21. self
  22. ),
  23. Failure.new("Junction can only have 'any', 'all', 'none', 'one' type")
  24. )
  25. )
  26. }
  27. # Swap 2 Junctions in place if they need to be for an infix operation
  28. # on the two Junctions. Returns a truthy (0|1)value if the Junctions
  29. # were of the same type and can be merged.
  30. method INFIX-TWO(Junction:U: Junction:D \a, Junction:D \b) {
  31. nqp::if(
  32. nqp::iseq_s(
  33. (my $atype := nqp::getattr(nqp::decont(a),Junction,'$!type')),
  34. (my $btype := nqp::getattr(nqp::decont(b),Junction,'$!type'))
  35. ),
  36. nqp::isne_s($atype,"one"), # same
  37. nqp::if( # not same
  38. (nqp::iseq_s($btype,"all") || nqp::iseq_s($btype,"none"))
  39. && (nqp::iseq_s($atype,"any") || nqp::iseq_s($atype,"one")),
  40. nqp::stmts( # need to be swapped
  41. (my $tmp := nqp::decont(a)),
  42. (a = b),
  43. (b = $tmp),
  44. 0 # not same, now swapped
  45. )
  46. )
  47. )
  48. }
  49. proto method new(|) {*}
  50. multi method new(Junction: \values, Str :$type!) {
  51. nqp::create(Junction)!SET-SELF($type,values)
  52. }
  53. multi method new(Junction: Str:D \type, \values) {
  54. nqp::create(Junction)!SET-SELF(type,values)
  55. }
  56. method defined(Junction:D:) {
  57. nqp::p6bool(
  58. nqp::stmts(
  59. (my int $elems = nqp::elems($!storage)),
  60. (my int $i),
  61. nqp::if(
  62. nqp::iseq_s($!type,'any'),
  63. nqp::stmts(
  64. nqp::while(
  65. nqp::islt_i($i,$elems)
  66. && nqp::isfalse(nqp::atpos($!storage,$i).defined),
  67. ($i = nqp::add_i($i,1))
  68. ),
  69. nqp::islt_i($i,$elems)
  70. ),
  71. nqp::if(
  72. nqp::iseq_s($!type,'all'),
  73. nqp::stmts(
  74. nqp::while(
  75. nqp::islt_i($i,$elems)
  76. && nqp::atpos($!storage,$i).defined,
  77. ($i = nqp::add_i($i,1))
  78. ),
  79. nqp::iseq_i($i,$elems)
  80. ),
  81. nqp::if(
  82. nqp::iseq_s($!type,'none'),
  83. nqp::stmts(
  84. nqp::while(
  85. nqp::islt_i($i,$elems)
  86. && nqp::isfalse(nqp::atpos($!storage,$i).defined),
  87. ($i = nqp::add_i($i,1))
  88. ),
  89. nqp::iseq_i($i,$elems)
  90. ),
  91. nqp::stmts( # $!type eq 'one'
  92. (my int $seen = 0),
  93. ($i = nqp::sub_i($i,1)), # increment in condition
  94. nqp::while(
  95. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  96. && nqp::isle_i($seen,1),
  97. nqp::if(
  98. nqp::atpos($!storage,$i).defined,
  99. ($seen = nqp::add_i($seen,1))
  100. )
  101. ),
  102. nqp::iseq_i($seen,1)
  103. )
  104. )
  105. )
  106. )
  107. )
  108. )
  109. }
  110. multi method Bool(Junction:D:) {
  111. nqp::p6bool(
  112. nqp::stmts(
  113. (my int $elems = nqp::elems($!storage)),
  114. (my int $i),
  115. nqp::if(
  116. nqp::iseq_s($!type,'any'),
  117. nqp::stmts(
  118. nqp::while(
  119. nqp::islt_i($i,$elems)
  120. && nqp::isfalse(nqp::atpos($!storage,$i)),
  121. ($i = nqp::add_i($i,1))
  122. ),
  123. nqp::islt_i($i,$elems)
  124. ),
  125. nqp::if(
  126. nqp::iseq_s($!type,'all'),
  127. nqp::stmts(
  128. nqp::while(
  129. nqp::islt_i($i,$elems)
  130. && nqp::atpos($!storage,$i),
  131. ($i = nqp::add_i($i,1))
  132. ),
  133. nqp::iseq_i($i,$elems)
  134. ),
  135. nqp::if(
  136. nqp::iseq_s($!type,'none'),
  137. nqp::stmts(
  138. nqp::while(
  139. nqp::islt_i($i,$elems)
  140. && nqp::isfalse(nqp::atpos($!storage,$i)),
  141. ($i = nqp::add_i($i,1))
  142. ),
  143. nqp::iseq_i($i,$elems)
  144. ),
  145. nqp::stmts( # $!type eq 'one'
  146. (my int $seen = 0),
  147. ($i = nqp::sub_i($i,1)), # increment in condition
  148. nqp::while(
  149. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  150. && nqp::isle_i($seen,1),
  151. nqp::if(
  152. nqp::atpos($!storage,$i),
  153. ($seen = nqp::add_i($seen,1))
  154. )
  155. ),
  156. nqp::iseq_i($seen,1)
  157. )
  158. )
  159. )
  160. )
  161. )
  162. )
  163. }
  164. multi method ACCEPTS(Junction:U: Mu:D \topic) {
  165. nqp::p6bool(nqp::istype(topic, Junction));
  166. }
  167. multi method ACCEPTS(Junction:U: Any \topic) {
  168. nqp::p6bool(nqp::istype(topic, Junction));
  169. }
  170. multi method ACCEPTS(Junction:D: Mu \topic) {
  171. nqp::p6bool(
  172. nqp::stmts(
  173. (my int $elems = nqp::elems($!storage)),
  174. (my int $i),
  175. nqp::if(
  176. nqp::iseq_s($!type,'any'),
  177. nqp::stmts(
  178. nqp::while(
  179. nqp::islt_i($i,$elems)
  180. && nqp::isfalse(nqp::atpos($!storage,$i).ACCEPTS(topic)),
  181. ($i = nqp::add_i($i,1))
  182. ),
  183. nqp::islt_i($i,$elems)
  184. ),
  185. nqp::if(
  186. nqp::iseq_s($!type,'all'),
  187. nqp::stmts(
  188. nqp::while(
  189. nqp::islt_i($i,$elems)
  190. && nqp::atpos($!storage,$i).ACCEPTS(topic),
  191. ($i = nqp::add_i($i,1))
  192. ),
  193. nqp::iseq_i($i,$elems)
  194. ),
  195. nqp::if(
  196. nqp::iseq_s($!type,'none'),
  197. nqp::stmts(
  198. nqp::while(
  199. nqp::islt_i($i,$elems)
  200. && nqp::isfalse(
  201. nqp::atpos($!storage,$i).ACCEPTS(topic)
  202. ),
  203. ($i = nqp::add_i($i,1))
  204. ),
  205. nqp::iseq_i($i,$elems)
  206. ),
  207. nqp::stmts( # $!type eq 'one'
  208. (my int $seen),
  209. ($i = nqp::sub_i($i,1)), # increment in condition
  210. nqp::while(
  211. nqp::islt_i(($i = nqp::add_i($i,1)),$elems)
  212. && nqp::isle_i($seen,1),
  213. nqp::if(
  214. nqp::atpos($!storage,$i).ACCEPTS(topic),
  215. ($seen = nqp::add_i($seen,1))
  216. )
  217. ),
  218. nqp::iseq_i($seen,1)
  219. )
  220. )
  221. )
  222. )
  223. )
  224. )
  225. }
  226. multi method Str(Junction:D:) {
  227. nqp::stmts(
  228. (my $storage := nqp::bindattr(
  229. (my $junction := nqp::clone(self)),
  230. Junction,
  231. '$!storage',
  232. nqp::clone(nqp::getattr(self,Junction,'$!storage'))
  233. )),
  234. (my int $elems = nqp::elems($storage)),
  235. (my int $i = -1),
  236. nqp::while(
  237. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  238. nqp::unless(
  239. nqp::istype(nqp::atpos($storage,$i),Str),
  240. nqp::bindpos($storage,$i,nqp::atpos($storage,$i).Str)
  241. )
  242. ),
  243. $junction
  244. )
  245. }
  246. multi method gist(Junction:D:) {
  247. my int $elems = nqp::elems($!storage);
  248. my int $i = -1;
  249. my $gists := nqp::setelems(nqp::list_s,$elems);
  250. nqp::bindpos_s($gists,$i,nqp::atpos($!storage,$i).gist)
  251. while nqp::islt_i(++$i,$elems);
  252. $!type ~ '(' ~ nqp::join(', ',$gists) ~ ')'
  253. }
  254. multi method perl(Junction:D:) {
  255. my int $elems = nqp::elems($!storage);
  256. my int $i = -1;
  257. my $perls := nqp::setelems(nqp::list_s,$elems);
  258. nqp::bindpos_s($perls,$i,nqp::atpos($!storage,$i).perl)
  259. while nqp::islt_i(++$i,$elems);
  260. $!type ~ '(' ~ nqp::join(', ',$perls) ~ ')'
  261. }
  262. method CALL-ME(|c) {
  263. self.AUTOTHREAD(
  264. -> $obj, |c { $obj(|c) },
  265. self, |c);
  266. }
  267. method sink(Junction:D: --> Nil) {
  268. my int $elems = nqp::elems($!storage);
  269. my int $i = -1;
  270. nqp::atpos($!storage,$i).sink while nqp::islt_i(++$i,$elems);
  271. }
  272. # Helper method for handling those cases where auto-threading doesn't cut it.
  273. # Call the given Callable with each of the Junction values, and return a
  274. # Junction with the results of the calls.
  275. method THREAD(&call) {
  276. my $values := nqp::getattr(self,Junction,'$!storage');
  277. my int $i = -1;
  278. my int $elems = nqp::elems($values);
  279. my $result := nqp::setelems(nqp::list,$elems);
  280. nqp::while(
  281. nqp::islt_i(++$i,$elems),
  282. nqp::bindpos($result,$i,call(nqp::atpos($values,$i)))
  283. );
  284. nqp::p6bindattrinvres(nqp::clone(self),Junction,'$!storage',$result)
  285. }
  286. method AUTOTHREAD(&call, |args) {
  287. my Mu $positionals := nqp::getattr(nqp::decont(args),Capture,'@!list');
  288. sub thread_junction(int $pos) {
  289. my $junction := nqp::decont(nqp::atpos($positionals, $pos));
  290. my $storage := nqp::getattr($junction,Junction,'$!storage');
  291. my int $elems = nqp::elems($storage);
  292. my $result := nqp::setelems(nqp::list,$elems);
  293. my int $i = -1;
  294. nqp::while(
  295. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  296. # Next line is Officially Naughty, since captures are
  297. # meant to be immutable. But hey, it's our capture to
  298. # be naughty with...
  299. nqp::stmts(
  300. nqp::bindpos($positionals,$pos,nqp::atpos($storage,$i)),
  301. nqp::bindpos($result,$i,call(|args))
  302. )
  303. );
  304. nqp::p6bindattrinvres(
  305. nqp::clone($junction),Junction,'$!storage',$result)
  306. }
  307. # Look for a junctional arg in the positionals.
  308. # we have to autothread the first all or none junction before
  309. # doing any one or any junctions.
  310. my int $first_any_one = -1;
  311. my int $elems = nqp::elems($positionals);
  312. my int $i = -1;
  313. while nqp::islt_i(++$i,$elems) {
  314. # Junctional positional argument?
  315. my Mu $arg := nqp::atpos($positionals, $i);
  316. if nqp::istype($arg,Junction) {
  317. my str $type = nqp::getattr_s(nqp::decont($arg),Junction,'$!type');
  318. nqp::iseq_s($type,'any') || nqp::iseq_s($type,'one')
  319. ?? $first_any_one == -1
  320. ?? ($first_any_one = $i)
  321. !! Nil
  322. !! return thread_junction($i);
  323. }
  324. }
  325. return thread_junction($first_any_one) if $first_any_one >= 0;
  326. # Otherwise, look for one in the nameds.
  327. my Mu $nameds := nqp::getattr(nqp::decont(args), Capture, '%!hash');
  328. my $iter := nqp::iterator($nameds);
  329. while $iter {
  330. if nqp::istype(nqp::iterval(nqp::shift($iter)),Junction) {
  331. my $junction := nqp::decont(nqp::iterval($iter));
  332. my $storage := nqp::getattr($junction,Junction,'$!storage');
  333. my int $elems = nqp::elems($storage);
  334. my $result := nqp::setelems(nqp::list,$elems);
  335. my int $i = -1;
  336. while nqp::islt_i(++$i,$elems) {
  337. # also naughty, like above
  338. nqp::bindkey($nameds,nqp::iterkey_s($iter),nqp::atpos($storage,$i));
  339. nqp::bindpos($result,$i,call(|args));
  340. }
  341. my $threaded := nqp::clone(nqp::decont($junction));
  342. nqp::bindattr($threaded,Junction,'$!storage',$result);
  343. return $threaded;
  344. }
  345. }
  346. # If we get here, wasn't actually anything to autothread.
  347. call(|args);
  348. }
  349. }
  350. proto sub any(|) is pure {*}
  351. #multi sub any(@values) { @values.any } # this breaks S02-literals/radix.t
  352. multi sub any(+values) { values.any }
  353. proto sub all(|) is pure {*}
  354. multi sub all(@values) { @values.all }
  355. multi sub all(+values) { values.all }
  356. proto sub one(|) is pure {*}
  357. multi sub one(@values) { @values.one }
  358. multi sub one(+values) { values.one }
  359. proto sub none(|) is pure {*}
  360. multi sub none(@values) { @values.none }
  361. multi sub none(+values) { values.none }
  362. proto sub infix:<|>(|) is pure {*}
  363. multi sub infix:<|>(+values) { values.any }
  364. proto sub infix:<&>(|) is pure {*}
  365. multi sub infix:<&>(+values) { values.all }
  366. proto sub infix:<^>(|) is pure {*}
  367. multi sub infix:<^>(+values) is pure { values.one }
  368. multi sub infix:<~>(Str:D $a, Junction:D $b) {
  369. nqp::if(
  370. $a,
  371. nqp::stmts( # something to concat with
  372. (my $storage := nqp::bindattr(
  373. (my $junction := nqp::clone($b)),
  374. Junction,
  375. '$!storage',
  376. nqp::clone(nqp::getattr($b,Junction,'$!storage'))
  377. )),
  378. (my int $elems = nqp::elems($storage)),
  379. (my int $i = -1),
  380. nqp::while(
  381. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  382. nqp::bindpos($storage,$i,
  383. nqp::if(
  384. nqp::istype((my $val := nqp::atpos($storage,$i)),Junction),
  385. infix:<~>($a,$val),
  386. nqp::concat($a,nqp::if(nqp::istype($val,Str),$val,$val.Str))
  387. )
  388. )
  389. ),
  390. $junction
  391. ),
  392. $b.Str # nothing to concat with
  393. )
  394. }
  395. multi sub infix:<~>(Junction:D $a, Str:D $b) {
  396. nqp::if(
  397. $b,
  398. nqp::stmts( # something to concat with
  399. (my $storage := nqp::bindattr(
  400. (my $junction := nqp::clone($a)),
  401. Junction,
  402. '$!storage',
  403. nqp::clone(nqp::getattr($a,Junction,'$!storage'))
  404. )),
  405. (my int $elems = nqp::elems($storage)),
  406. (my int $i = -1),
  407. nqp::while(
  408. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  409. nqp::bindpos($storage,$i,
  410. nqp::if(
  411. nqp::istype((my $val := nqp::atpos($storage,$i)),Junction),
  412. infix:<~>($val,$b),
  413. nqp::concat(nqp::if(nqp::istype($val,Str),$val,$val.Str),$b)
  414. )
  415. )
  416. ),
  417. $junction
  418. ),
  419. $a.Str # nothing to concat with
  420. )
  421. }
  422. multi sub infix:<~>(Junction:D \a, Junction:D \b) {
  423. nqp::stmts( # basic setup
  424. (my int $mergable = Junction.INFIX-TWO(my $a = a, my $b = b)),
  425. (my $astor := nqp::getattr(nqp::decont($a),Junction,'$!storage')),
  426. (my $bstor := nqp::getattr(nqp::decont($b),Junction,'$!storage')),
  427. (my int $aelems = nqp::elems($astor)),
  428. (my int $belems = nqp::elems($bstor)),
  429. (my int $i = -1),
  430. (my $seen := nqp::hash),
  431. (my $outer := nqp::bindattr( # outer eigenstates
  432. (my $junction := nqp::clone(nqp::decont($a))),
  433. Junction,
  434. '$!storage',
  435. nqp::if(
  436. $mergable,
  437. nqp::list,
  438. nqp::setelems(nqp::list,$aelems)
  439. )
  440. )),
  441. nqp::while( # outer loop
  442. nqp::islt_i(($i = nqp::add_i($i,1)),$aelems),
  443. nqp::stmts(
  444. (my $aval := nqp::if(
  445. nqp::istype(nqp::atpos($astor,$i),Str),
  446. nqp::atpos($astor,$i),
  447. nqp::atpos($astor,$i).Str
  448. )),
  449. (my int $j = -1),
  450. nqp::if(
  451. $mergable,
  452. nqp::while( # merge eigenstates
  453. nqp::islt_i(($j = nqp::add_i($j,1)),$belems),
  454. nqp::unless(
  455. nqp::existskey(
  456. $seen,
  457. (my $concat := nqp::concat(
  458. $aval,
  459. nqp::if(
  460. nqp::istype(nqp::atpos($bstor,$j),Str),
  461. nqp::atpos($bstor,$j),
  462. nqp::atpos($bstor,$j).Str,
  463. )
  464. ))
  465. ),
  466. nqp::bindkey( # new one, remember
  467. $seen,
  468. nqp::push($outer,$concat),
  469. 1
  470. )
  471. )
  472. ),
  473. nqp::stmts( # cannot merge eigenstates
  474. (my $inner := nqp::bindattr(
  475. nqp::bindpos($outer,$i,nqp::clone(nqp::decont($b))),
  476. Junction,
  477. '$!storage',
  478. nqp::setelems(nqp::list,$belems)
  479. )),
  480. nqp::while(
  481. nqp::islt_i(($j = nqp::add_i($j,1)),$belems),
  482. nqp::bindpos(
  483. $inner,
  484. $j,
  485. nqp::concat(
  486. $aval,
  487. nqp::if(
  488. nqp::istype(nqp::atpos($bstor,$j),Str),
  489. nqp::atpos($bstor,$j),
  490. nqp::atpos($bstor,$j).Str,
  491. )
  492. )
  493. )
  494. )
  495. )
  496. )
  497. )
  498. ),
  499. $junction
  500. )
  501. }
  502. nqp::p6setautothreader( -> |c {
  503. Junction.AUTOTHREAD(|c)
  504. } );
  505. Mu.HOW.setup_junction_fallback(Junction, -> $name, |c {
  506. Junction.AUTOTHREAD(
  507. -> \obj, |c { obj."$name"(|c) },
  508. |c);
  509. } );