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