1. class Version {
  2. has $!parts;
  3. has int $!plus;
  4. has str $!string;
  5. method !SET-SELF(\parts,\plus,\string) {
  6. $!parts := nqp::getattr(parts,List,'$!reified');
  7. $!plus = plus;
  8. $!string = string;
  9. self
  10. }
  11. multi method new(Version:) {
  12. # "v" highlander
  13. INIT nqp::create(Version)!SET-SELF(nqp::list,0,"") # should be once
  14. }
  15. multi method new(Version: Whatever) {
  16. # "v*" highlander
  17. INIT nqp::create(Version)!SET-SELF(nqp::list(*),-1,"*") # should be once
  18. }
  19. multi method new(Version: @parts, Str:D $string, Int() $plus = 0) {
  20. nqp::create(self)!SET-SELF(@parts.eager,$plus,$string)
  21. }
  22. method !SLOW-NEW(str $s) {
  23. # we comb the version string for /:r '*' || \d+ || <.alpha>+/, which
  24. # will become our parts. The `*` becomes a Whatever, numbers Numeric,
  25. # and the rest of the parts remain as strings
  26. nqp::stmts(
  27. (my int $pos),
  28. (my int $chars = nqp::chars($s)),
  29. (my int $mark),
  30. (my $strings := nqp::list_s),
  31. (my $parts := nqp::list),
  32. nqp::while(
  33. nqp::islt_i($pos, $chars),
  34. nqp::if(
  35. nqp::eqat($s, '*', $pos),
  36. nqp::stmts( # Whatever portion
  37. nqp::push_s($strings, '*'),
  38. nqp::push($parts, * ),
  39. ($pos = nqp::add_i($pos, 1))),
  40. nqp::if(
  41. nqp::iscclass(nqp::const::CCLASS_NUMERIC, $s, $pos),
  42. nqp::stmts( # we're at the start of a numeric portion
  43. ($mark = $pos),
  44. ($pos = nqp::add_i($pos, 1)),
  45. nqp::while( # seek the end of numeric portion
  46. nqp::islt_i($pos, $chars)
  47. && nqp::iscclass(nqp::const::CCLASS_NUMERIC, $s, $pos),
  48. ($pos = nqp::add_i($pos, 1))),
  49. nqp::push($parts, # grab numeric portion
  50. nqp::atpos(
  51. nqp::radix(
  52. 10,
  53. nqp::push_s($strings, nqp::substr($s, $mark,
  54. nqp::sub_i($pos, $mark))),
  55. 0, 0),
  56. 0))),
  57. nqp::if( # same idea as for numerics, except for <.alpha> class
  58. nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $s, $pos)
  59. || nqp::iseq_i(nqp::ord($s, $pos), 95),
  60. nqp::stmts( # we're at the start of a alpha portion
  61. ($mark = $pos),
  62. ($pos = nqp::add_i($pos, 1)),
  63. nqp::while( # seek the end of alpha portion
  64. nqp::islt_i($pos, $chars)
  65. && (nqp::iscclass(nqp::const::CCLASS_ALPHABETIC, $s, $pos)
  66. || nqp::iseq_i(nqp::ord($s, $pos), 95)),
  67. ($pos = nqp::add_i($pos, 1))),
  68. nqp::push($parts, # grab alpha portion
  69. nqp::push_s($strings, nqp::substr($s, $mark,
  70. nqp::sub_i($pos, $mark))))),
  71. ($pos = nqp::add_i($pos, 1)))))),
  72. nqp::if(
  73. nqp::elems($strings), # return false if we didn't get any parts
  74. nqp::stmts(
  75. (my int $plus = nqp::eqat($s, '+',
  76. nqp::sub_i(nqp::chars($s), 1))),
  77. nqp::create(self)!SET-SELF($parts, $plus,
  78. nqp::concat(nqp::join('.', $strings), $plus ?? '+' !! '')))))
  79. }
  80. # highlander cache
  81. my $v6; my $v6c; my $vplus;
  82. multi method new(Version: Str() $s) {
  83. nqp::if(
  84. nqp::iseq_s($s, '6'), # highlanderize most common
  85. ($v6 //= nqp::create(Version)!SET-SELF(nqp::list(6),0,"6")),
  86. nqp::if(
  87. nqp::iseq_s($s, '6.c'),
  88. ($v6c //= nqp::create(Version)!SET-SELF(nqp::list(6,"c"),0,"6.c")),
  89. nqp::unless(
  90. self!SLOW-NEW($s),
  91. nqp::if(
  92. nqp::eqat($s, '+', nqp::sub_i(nqp::chars($s),1)),
  93. ($vplus //= nqp::create(Version)!SET-SELF(nqp::list,1,"")),
  94. self.new))))
  95. }
  96. multi method Str(Version:D:) { $!string }
  97. multi method gist(Version:D:) { nqp::concat("v",$!string) }
  98. multi method perl(Version:D:) {
  99. if nqp::chars($!string) {
  100. my int $first = nqp::ord($!string);
  101. nqp::isge_i($first,48) && nqp::isle_i($first,57) # "0" <= x <= "9"
  102. ?? nqp::concat("v",$!string)
  103. !! self.^name ~ ".new('$!string')"
  104. }
  105. else {
  106. self.^name ~ ".new"
  107. }
  108. }
  109. multi method ACCEPTS(Version:D: Version:D $other) {
  110. my $oparts := nqp::getattr(nqp::decont($other),Version,'$!parts');
  111. my int $oelems = nqp::isnull($oparts) ?? 0 !! nqp::elems($oparts);
  112. my int $elems = nqp::elems($!parts);
  113. my int $max-elems = nqp::if(nqp::isge_i($oelems,$elems), $oelems, $elems);
  114. my int $i = -1;
  115. while nqp::islt_i(++$i,$max-elems) {
  116. my $v := nqp::if(nqp::isge_i($i,$elems), Whatever, nqp::atpos($!parts,$i));
  117. # if whatever here, no more check this iteration
  118. unless nqp::istype($v,Whatever) {
  119. my $o := nqp::if(nqp::isge_i($i,$oelems), 0, nqp::atpos($oparts,$i));
  120. # if whatever there, no more to check this iteration
  121. unless nqp::istype($o,Whatever) {
  122. return nqp::p6bool($!plus) if $o after $v;
  123. return False if $o before $v;
  124. }
  125. }
  126. }
  127. True;
  128. }
  129. method Capture() { die X::Cannot::Capture.new: :what(self) }
  130. multi method WHICH(Version:D:) {
  131. nqp::box_s(
  132. nqp::concat(
  133. nqp::if(
  134. nqp::eqaddr(self.WHAT,Version),
  135. 'Version|',
  136. nqp::concat(nqp::unbox_s(self.^name), '|')
  137. ),
  138. $!string
  139. ),
  140. ValueObjAt
  141. )
  142. }
  143. method parts() { nqp::hllize($!parts) }
  144. method plus() { nqp::p6bool($!plus) }
  145. }
  146. multi sub infix:<eqv>(Version:D \a, Version:D \b) {
  147. nqp::p6bool(
  148. nqp::eqaddr(nqp::decont(a),nqp::decont(b))
  149. || (nqp::eqaddr(a.WHAT,b.WHAT)
  150. && nqp::iseq_s(
  151. nqp::getattr_s(nqp::decont(a),Version,'$!string'),
  152. nqp::getattr_s(nqp::decont(b),Version,'$!string')
  153. ))
  154. )
  155. }
  156. multi sub infix:<cmp>(Version:D \a, Version:D \b) {
  157. nqp::if(
  158. nqp::eqaddr(nqp::decont(a),nqp::decont(b)), # we're us
  159. Same,
  160. nqp::stmts(
  161. (my \ia := nqp::iterator(nqp::getattr(nqp::decont(a),Version,'$!parts'))),
  162. (my \ib := nqp::iterator(nqp::getattr(nqp::decont(b),Version,'$!parts'))),
  163. (my ($ret, $a-part, $b-part)),
  164. nqp::while(
  165. ia, # check from left
  166. nqp::stmts(
  167. ($a-part := nqp::shift(ia)),
  168. ($b-part := ib ?? nqp::shift(ib) !! 0),
  169. nqp::if(
  170. ($ret := nqp::if(
  171. nqp::istype($a-part,Str) && nqp::istype($b-part,Int),
  172. Less,
  173. nqp::if(
  174. nqp::istype($a-part,Int) && nqp::istype($b-part,Str),
  175. More,
  176. ($a-part cmp $b-part)))),
  177. return $ret))),
  178. nqp::while(
  179. ib, # check from right
  180. nqp::stmts(
  181. ($a-part := 0),
  182. ($b-part := nqp::shift(ib)),
  183. nqp::if(
  184. ($ret := nqp::if(
  185. nqp::istype($a-part,Str) && nqp::istype($b-part,Int),
  186. Less,
  187. nqp::if(
  188. nqp::istype($a-part,Int) && nqp::istype($b-part,Str),
  189. More,
  190. ($a-part cmp $b-part)))),
  191. return $ret))),
  192. ( nqp::getattr_i(nqp::decont(a),Version,'$!plus')
  193. cmp nqp::getattr_i(nqp::decont(b),Version,'$!plus'))))
  194. }
  195. multi sub infix:«<=>»(Version:D \a, Version:D \b) { a cmp b }
  196. multi sub infix:«<» (Version:D \a, Version:D \b) { a cmp b == Less }
  197. multi sub infix:«<=» (Version:D \a, Version:D \b) { a cmp b != More }
  198. multi sub infix:«==» (Version:D \a, Version:D \b) { a cmp b == Same }
  199. multi sub infix:«!=» (Version:D \a, Version:D \b) { a cmp b != Same }
  200. multi sub infix:«>=» (Version:D \a, Version:D \b) { a cmp b != Less }
  201. multi sub infix:«>» (Version:D \a, Version:D \b) { a cmp b == More }