1. my class Parameter { # declared in BOOTSTRAP
  2. # class Parameter is Any
  3. # has str $!variable_name
  4. # has @!named_names
  5. # has @!type_captures
  6. # has int $!flags
  7. # has Mu $!nominal_type
  8. # has @!post_constraints
  9. # has Mu $!coerce_type
  10. # has str $!coerce_method
  11. # has Signature $!sub_signature
  12. # has Code $!default_value
  13. # has Mu $!container_descriptor;
  14. # has Mu $!attr_package;
  15. # has Mu $!why;
  16. my constant $SIG_ELEM_BIND_CAPTURE = 1;
  17. my constant $SIG_ELEM_BIND_PRIVATE_ATTR = 2;
  18. my constant $SIG_ELEM_BIND_PUBLIC_ATTR = 4;
  19. my constant $SIG_ELEM_SLURPY_POS = 8;
  20. my constant $SIG_ELEM_SLURPY_NAMED = 16;
  21. my constant $SIG_ELEM_SLURPY_LOL = 32;
  22. my constant $SIG_ELEM_INVOCANT = 64;
  23. my constant $SIG_ELEM_MULTI_INVOCANT = 128;
  24. my constant $SIG_ELEM_IS_RW = 256;
  25. my constant $SIG_ELEM_IS_COPY = 512;
  26. my constant $SIG_ELEM_IS_RAW = 1024;
  27. my constant $SIG_ELEM_IS_OPTIONAL = 2048;
  28. my constant $SIG_ELEM_ARRAY_SIGIL = 4096;
  29. my constant $SIG_ELEM_HASH_SIGIL = 8192;
  30. my constant $SIG_ELEM_IS_CAPTURE = 32768;
  31. my constant $SIG_ELEM_UNDEFINED_ONLY = 65536;
  32. my constant $SIG_ELEM_DEFINED_ONLY = 131072;
  33. my constant $SIG_ELEM_SLURPY_ONEARG = 16777216;
  34. my constant $SIG_ELEM_CODE_SIGIL = 33554432;
  35. my constant $SIG_ELEM_IS_NOT_POSITIONAL = $SIG_ELEM_SLURPY_POS
  36. +| $SIG_ELEM_SLURPY_NAMED
  37. +| $SIG_ELEM_IS_CAPTURE;
  38. my constant $SIG_ELEM_IS_SLURPY = $SIG_ELEM_SLURPY_POS
  39. +| $SIG_ELEM_SLURPY_NAMED
  40. +| $SIG_ELEM_SLURPY_LOL
  41. +| $SIG_ELEM_SLURPY_ONEARG;
  42. my constant $SIG_ELEM_IS_NOT_READONLY = $SIG_ELEM_IS_RW
  43. +| $SIG_ELEM_IS_COPY
  44. +| $SIG_ELEM_IS_RAW;
  45. method name() {
  46. nqp::isnull_s($!variable_name) ?? Nil !! $!variable_name
  47. }
  48. method usage-name() {
  49. nqp::iseq_i(nqp::index('@$%&',nqp::substr($!variable_name,0,1)),-1)
  50. ?? $!variable_name
  51. !! nqp::substr($!variable_name,1)
  52. }
  53. method sigil() {
  54. nqp::bitand_i($!flags,$SIG_ELEM_IS_CAPTURE)
  55. ?? '|'
  56. !! nqp::isnull_s($!variable_name)
  57. ?? nqp::bitand_i($!flags,$SIG_ELEM_ARRAY_SIGIL)
  58. ?? '@'
  59. !! nqp::bitand_i($!flags,$SIG_ELEM_HASH_SIGIL)
  60. ?? '%'
  61. !! nqp::bitand_i($!flags,$SIG_ELEM_CODE_SIGIL)
  62. ?? '&'
  63. !! nqp::bitand_i($!flags,$SIG_ELEM_IS_RAW)
  64. ?? '\\'
  65. !! '$'
  66. !! nqp::bitand_i($!flags,$SIG_ELEM_IS_RAW) && nqp::iseq_i(
  67. nqp::index('@$%&',nqp::substr($!variable_name,0,1)),-1)
  68. ?? '\\'
  69. !! nqp::substr($!variable_name,0,1)
  70. }
  71. method twigil() {
  72. nqp::bitand_i($!flags,$SIG_ELEM_BIND_PUBLIC_ATTR)
  73. ?? '.'
  74. !! nqp::bitand_i($!flags,$SIG_ELEM_BIND_PRIVATE_ATTR)
  75. ?? '!'
  76. !! ''
  77. }
  78. method modifier() {
  79. nqp::bitand_i($!flags,$SIG_ELEM_DEFINED_ONLY)
  80. ?? ':D'
  81. !! nqp::bitand_i($!flags,$SIG_ELEM_UNDEFINED_ONLY)
  82. ?? ':U'
  83. !! ''
  84. }
  85. method constraint_list() {
  86. nqp::isnull(@!post_constraints) ?? () !!
  87. nqp::hllize(@!post_constraints)
  88. }
  89. method constraints() {
  90. all(nqp::isnull(@!post_constraints) ?? () !!
  91. nqp::hllize(@!post_constraints))
  92. }
  93. method type() { $!nominal_type }
  94. method named_names() {
  95. nqp::if(
  96. @!named_names && (my int $elems = nqp::elems(@!named_names)),
  97. nqp::stmts(
  98. (my $buf := nqp::setelems(nqp::create(IterationBuffer),$elems)),
  99. (my int $i = -1),
  100. nqp::while(
  101. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  102. nqp::bindpos($buf,$i,nqp::atpos_s(@!named_names,$i))
  103. ),
  104. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$buf)
  105. ),
  106. nqp::create(List)
  107. )
  108. }
  109. method named() {
  110. nqp::p6bool(
  111. @!named_names || nqp::bitand_i($!flags,$SIG_ELEM_SLURPY_NAMED)
  112. )
  113. }
  114. method positional() {
  115. nqp::p6bool(
  116. nqp::isnull(@!named_names)
  117. && nqp::iseq_i(nqp::bitand_i($!flags,$SIG_ELEM_IS_NOT_POSITIONAL),0)
  118. )
  119. }
  120. method slurpy() {
  121. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_IS_SLURPY))
  122. }
  123. method optional() {
  124. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_IS_OPTIONAL))
  125. }
  126. method raw() {
  127. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_IS_RAW))
  128. }
  129. method capture() {
  130. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_IS_CAPTURE))
  131. }
  132. method rw() {
  133. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_IS_RW))
  134. }
  135. method onearg() {
  136. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_SLURPY_ONEARG))
  137. }
  138. method copy() {
  139. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_IS_COPY))
  140. }
  141. method readonly() {
  142. nqp::p6bool(
  143. nqp::iseq_i(nqp::bitand_i($!flags,$SIG_ELEM_IS_NOT_READONLY),0)
  144. )
  145. }
  146. method invocant() {
  147. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_INVOCANT))
  148. }
  149. method multi-invocant() {
  150. nqp::p6bool(nqp::bitand_i($!flags,$SIG_ELEM_MULTI_INVOCANT))
  151. }
  152. method default() {
  153. nqp::isnull($!default_value)
  154. ?? Any
  155. !! nqp::istype($!default_value,Code)
  156. ?? $!default_value
  157. !! { $!default_value }
  158. }
  159. method type_captures() {
  160. nqp::if(
  161. @!type_captures && (my int $elems = nqp::elems(@!type_captures)),
  162. nqp::stmts(
  163. (my $buf := nqp::setelems(nqp::create(IterationBuffer),$elems)),
  164. (my int $i = -1),
  165. nqp::while(
  166. nqp::islt_i(($i = nqp::add_i($i,1)),$elems),
  167. nqp::bindpos($buf,$i,nqp::atpos_s(@!type_captures,$i))
  168. ),
  169. nqp::p6bindattrinvres(nqp::create(List),List,'$!reified',$buf)
  170. ),
  171. nqp::create(List)
  172. )
  173. }
  174. method !flags() { $!flags }
  175. multi method ACCEPTS(Parameter:D: Parameter:D \other) {
  176. # we're us
  177. my \o := nqp::decont(other);
  178. return True if self =:= o;
  179. # nominal type is acceptable
  180. if $!nominal_type.ACCEPTS(nqp::getattr(o,Parameter,'$!nominal_type')) {
  181. my $oflags := nqp::getattr(o,Parameter,'$!flags');
  182. # flags are not same, so we need to look more in depth
  183. if nqp::isne_i($!flags,$oflags) {
  184. # here not defined only, or both defined only
  185. return False
  186. unless nqp::isle_i(
  187. nqp::bitand_i($!flags,$SIG_ELEM_DEFINED_ONLY),
  188. nqp::bitand_i($oflags,$SIG_ELEM_DEFINED_ONLY))
  189. # here not undefined only, or both undefined only
  190. && nqp::isle_i(
  191. nqp::bitand_i($!flags,$SIG_ELEM_UNDEFINED_ONLY),
  192. nqp::bitand_i($oflags,$SIG_ELEM_UNDEFINED_ONLY))
  193. # here is rw, or both is rw
  194. && nqp::isle_i(
  195. nqp::bitand_i($!flags,$SIG_ELEM_IS_RW),
  196. nqp::bitand_i($oflags,$SIG_ELEM_IS_RW))
  197. # other is optional, or both are optional
  198. && nqp::isle_i(
  199. nqp::bitand_i($oflags,$SIG_ELEM_IS_OPTIONAL),
  200. nqp::bitand_i($!flags,$SIG_ELEM_IS_OPTIONAL))
  201. # other is slurpy positional, or both are slurpy positional
  202. && nqp::isle_i(
  203. nqp::bitand_i($oflags,$SIG_ELEM_SLURPY_POS),
  204. nqp::bitand_i($!flags,$SIG_ELEM_SLURPY_POS))
  205. # other is slurpy named, or both are slurpy named
  206. && nqp::isle_i(
  207. nqp::bitand_i($oflags,$SIG_ELEM_SLURPY_NAMED),
  208. nqp::bitand_i($!flags,$SIG_ELEM_SLURPY_NAMED))
  209. # other is slurpy one arg, or both are slurpy one arg
  210. && nqp::isle_i(
  211. nqp::bitand_i($oflags,$SIG_ELEM_SLURPY_ONEARG),
  212. nqp::bitand_i($!flags,$SIG_ELEM_SLURPY_ONEARG))
  213. # here is part of MMD, or both are part of MMD
  214. && nqp::isle_i(
  215. nqp::bitand_i($!flags,$SIG_ELEM_MULTI_INVOCANT),
  216. nqp::bitand_i($oflags,$SIG_ELEM_MULTI_INVOCANT));
  217. }
  218. }
  219. # nominal type not same
  220. else {
  221. return False;
  222. }
  223. # have nameds here
  224. my $onamed_names := nqp::getattr(o,Parameter,'@!named_names');
  225. if @!named_names {
  226. # nameds there
  227. if $onamed_names {
  228. # too many nameds there, can never be subset
  229. my int $elems = nqp::elems(@!named_names);
  230. return False
  231. if nqp::isgt_i(nqp::elems($onamed_names),$elems);
  232. # set up lookup hash
  233. my $lookup := nqp::hash;
  234. my int $i = -1;
  235. nqp::bindkey($lookup,nqp::atpos_s(@!named_names,$i),1)
  236. while nqp::islt_i(++$i,$elems);
  237. # make sure the other nameds are all here
  238. $elems = nqp::elems($onamed_names);
  239. $i = -1;
  240. return False unless
  241. nqp::existskey($lookup,nqp::atpos_s($onamed_names,$i))
  242. while nqp::islt_i(++$i,$elems);
  243. }
  244. }
  245. # no nameds here, but we do there (implies not a subset)
  246. elsif $onamed_names {
  247. return False;
  248. }
  249. # we have sub sig and not the same
  250. my $osub_signature := nqp::getattr(o,Parameter,'$!sub_signature');
  251. if $!sub_signature {
  252. return False
  253. unless $osub_signature
  254. && $!sub_signature.ACCEPTS($osub_signature);
  255. }
  256. # no sub sig, but other has one
  257. elsif $osub_signature {
  258. return False;
  259. }
  260. # we have a post constraint
  261. if nqp::islist(@!post_constraints) {
  262. # callable means runtime check, so no match
  263. return False
  264. if nqp::istype(nqp::atpos(@!post_constraints,0),Callable);
  265. # other doesn't have a post constraint
  266. my Mu $opc := nqp::getattr(o,Parameter,'@!post_constraints');
  267. return False unless nqp::islist($opc);
  268. # other post constraint is a Callable, so runtime check, so no match
  269. return False if nqp::istype(nqp::atpos($opc,0),Callable);
  270. # not same literal value
  271. return False
  272. unless nqp::atpos(@!post_constraints,0).ACCEPTS(
  273. nqp::atpos($opc,0));
  274. }
  275. # we don't, other *does* have a post constraint
  276. elsif nqp::islist(nqp::getattr(o,Parameter,'@!post_constraints')) {
  277. return False;
  278. }
  279. # it's a match!
  280. True;
  281. }
  282. multi method perl(Parameter:D: Mu:U :$elide-type = Any, :&where = -> $ { 'where { ... }' }) {
  283. my $perl = '';
  284. my $rest = '';
  285. my $type = $!nominal_type.^name;
  286. my $modifier = self.modifier;
  287. $perl ~= "::$_ " for @($.type_captures);
  288. if $!flags +& $SIG_ELEM_ARRAY_SIGIL or
  289. $!flags +& $SIG_ELEM_HASH_SIGIL or
  290. $!flags +& $SIG_ELEM_CODE_SIGIL {
  291. $type ~~ / .*? \[ <( .* )> \] $$/;
  292. $perl ~= $/ ~ $modifier if $/;
  293. }
  294. elsif $modifier or
  295. !nqp::eqaddr(nqp::decont($!nominal_type), nqp::decont($elide-type)) {
  296. $perl ~= $type ~ $modifier;
  297. }
  298. my $name = $.name;
  299. if $name {
  300. if $!flags +& $SIG_ELEM_IS_CAPTURE {
  301. $name = '|' ~ $name;
  302. } elsif $!flags +& $SIG_ELEM_IS_RAW {
  303. $name = '\\' ~ $name without '@$%&'.index(substr($name,0,1));
  304. }
  305. } else {
  306. if $!flags +& $SIG_ELEM_IS_CAPTURE {
  307. $name = '|';
  308. } elsif $!flags +& $SIG_ELEM_ARRAY_SIGIL {
  309. $name = '@';
  310. } elsif $!flags +& $SIG_ELEM_HASH_SIGIL {
  311. $name = '%';
  312. } elsif $!flags +& $SIG_ELEM_CODE_SIGIL {
  313. $name = '&';
  314. } else {
  315. $name = '$';
  316. }
  317. }
  318. my $default = self.default();
  319. if self.slurpy {
  320. $name = ($!flags +& $SIG_ELEM_SLURPY_ONEARG ?? '+' !! ($!flags +& $SIG_ELEM_SLURPY_LOL ?? "**" !! "*") ~ $name);
  321. } elsif self.named {
  322. my $name1 := substr($name,1);
  323. if @(self.named_names).first({$_ && $_ eq $name1}) {
  324. $name = ':' ~ $name;
  325. }
  326. for @(self.named_names).grep({$_ && $_ ne $name1}) {
  327. $name = ':' ~ $_ ~ '(' ~ $name ~ ')';
  328. }
  329. $name ~= '!' unless self.optional;
  330. } elsif self.optional && !$default {
  331. $name ~= '?';
  332. }
  333. if $!flags +& $SIG_ELEM_IS_RW {
  334. $rest ~= ' is rw';
  335. } elsif $!flags +& $SIG_ELEM_IS_COPY {
  336. $rest ~= ' is copy';
  337. }
  338. if $!flags +& $SIG_ELEM_IS_RAW {
  339. # Do not emit cases of anonymous '\' which we cannot reparse
  340. # This is all due to unspace.
  341. $rest ~= ' is raw' unless $name.starts-with('\\');
  342. }
  343. unless nqp::isnull($!sub_signature) {
  344. my $sig = $!sub_signature.perl();
  345. $sig ~~ s/^^ ':'//;
  346. $rest ~= ' ' ~ $sig;
  347. }
  348. unless nqp::isnull(@!post_constraints) {
  349. my $where = &where(self);
  350. return Nil without $where;
  351. $rest ~= " $where";
  352. }
  353. $rest ~= " = $!default_value.perl()" if $default;
  354. if $name or $rest {
  355. $perl ~= ($perl ?? ' ' !! '') ~ $name;
  356. }
  357. $perl ~ $rest;
  358. }
  359. method sub_signature(Parameter:D:) {
  360. nqp::isnull($!sub_signature) ?? Any !! $!sub_signature
  361. }
  362. method set_why($why --> Nil) {
  363. $!why := $why;
  364. }
  365. method set_default(Code:D $default --> Nil) {
  366. $!default_value := $default;
  367. }
  368. }
  369. multi sub infix:<eqv>(Parameter:D \a, Parameter:D \b) {
  370. # we're us
  371. return True if a =:= b;
  372. # different container type
  373. return False unless a.WHAT =:= b.WHAT;
  374. # different nominal or coerce type
  375. my $acoerce := nqp::getattr(a,Parameter,'$!coerce_type');
  376. my $bcoerce := nqp::getattr(b,Parameter,'$!coerce_type');
  377. return False
  378. unless nqp::iseq_s(
  379. nqp::getattr(a,Parameter,'$!nominal_type').^name,
  380. nqp::getattr(b,Parameter,'$!nominal_type').^name
  381. )
  382. && nqp::iseq_s(
  383. nqp::isnull($acoerce) ?? "" !! $acoerce.^name,
  384. nqp::isnull($bcoerce) ?? "" !! $bcoerce.^name
  385. );
  386. # different flags
  387. return False
  388. if nqp::isne_i(
  389. nqp::getattr(a,Parameter,'$!flags'),
  390. nqp::getattr(b,Parameter,'$!flags')
  391. );
  392. # first is named
  393. if a.named {
  394. # other is not named
  395. return False unless b.named;
  396. # not both actually have a name (e.g. *%_ doesn't)
  397. my $anames := nqp::getattr(a.named_names,List,'$!reified');
  398. my $bnames := nqp::getattr(b.named_names,List,'$!reified');
  399. my int $adefined = nqp::defined($anames);
  400. return False if nqp::isne_i($adefined,nqp::defined($bnames));
  401. # not same basic name
  402. return False
  403. if $adefined
  404. && nqp::isne_s(nqp::atpos($anames,0),nqp::atpos($bnames,0));
  405. }
  406. # unnamed vs named
  407. elsif b.named {
  408. return False;
  409. }
  410. # first has a post constraint
  411. my Mu $pca := nqp::getattr(a,Parameter,'@!post_constraints');
  412. if nqp::islist($pca) {
  413. # callable means runtime check, so no match
  414. return False if nqp::istype(nqp::atpos($pca,0),Callable);
  415. # second doesn't have a post constraint
  416. my Mu $pcb := nqp::getattr(b,Parameter,'@!post_constraints');
  417. return False unless nqp::islist($pcb);
  418. # second is a Callable, so runtime check, so no match
  419. return False if nqp::istype(nqp::atpos($pcb,0),Callable);
  420. # not same literal value
  421. return False unless nqp::atpos($pca,0) eqv nqp::atpos($pcb,0);
  422. }
  423. # first doesn't, second *does* have a post constraint
  424. elsif nqp::islist(nqp::getattr(b,Parameter,'@!post_constraints')) {
  425. return False;
  426. }
  427. # it's a match
  428. True
  429. }