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. multi method new(Version: Str() $s) {
  23. # highlanderize most common
  24. if $s eq '6' {
  25. INIT nqp::create(Version)!SET-SELF(nqp::list(6),0,"6") # should be once
  26. }
  27. elsif $s eq '6.c' {
  28. INIT nqp::create(Version)!SET-SELF(nqp::list(6,"c"),0,"6.c") # should be once
  29. }
  30. # something sensible given
  31. elsif $s.comb(/:r '*' || \d+ || <.alpha>+/).eager -> @s {
  32. my $strings := nqp::getattr(@s,List,'$!reified');
  33. my int $elems = nqp::elems($strings);
  34. my $parts := nqp::setelems(nqp::list,$elems);
  35. my int $i = -1;
  36. while nqp::islt_i(++$i,$elems) {
  37. my str $s = nqp::atpos($strings,$i);
  38. nqp::bindpos($parts,$i, nqp::iseq_s($s,"*")
  39. ?? *
  40. !! (my $numeric = $s.Numeric).defined
  41. ?? nqp::decont($numeric)
  42. !! nqp::unbox_s($s)
  43. );
  44. }
  45. my str $string = nqp::join(".", $strings);
  46. my int $plus = $s.ends-with("+");
  47. nqp::create(self)!SET-SELF($parts,$plus,$plus
  48. ?? nqp::concat($string,"+")
  49. !! $string
  50. )
  51. }
  52. # "v+" highlander
  53. elsif $s.ends-with("+") {
  54. INIT nqp::create(Version)!SET-SELF(nqp::list,1,"") # should be once
  55. }
  56. # get "v" highlander
  57. else {
  58. self.new
  59. }
  60. }
  61. multi method Str(Version:D:) { $!string }
  62. multi method gist(Version:D:) { nqp::concat("v",$!string) }
  63. multi method perl(Version:D:) {
  64. if nqp::chars($!string) {
  65. my int $first = nqp::ord($!string);
  66. nqp::isge_i($first,48) && nqp::isle_i($first,57) # "0" <= x <= "9"
  67. ?? nqp::concat("v",$!string)
  68. !! self.^name ~ ".new('$!string')"
  69. }
  70. else {
  71. self.^name ~ ".new"
  72. }
  73. }
  74. multi method ACCEPTS(Version:D: Version:D $other) {
  75. my $oparts := nqp::getattr(nqp::decont($other),Version,'$!parts');
  76. my $oelems = nqp::isnull($oparts) ?? 0 !! nqp::elems($oparts);
  77. my int $elems = nqp::elems($!parts);
  78. my int $i = -1;
  79. while nqp::islt_i(++$i,$elems) {
  80. my $v := nqp::atpos($!parts,$i);
  81. # if whatever here, no more check this iteration
  82. unless nqp::istype($v,Whatever) {
  83. # nothing left to check, so ok
  84. return True if nqp::isge_i($i,$oelems);
  85. # if whatever there, no more to check this iteration
  86. my $o := nqp::atpos($oparts,$i);
  87. unless nqp::istype($o,Whatever) {
  88. return nqp::p6bool($!plus) if $o after $v;
  89. return False if $o before $v;
  90. }
  91. }
  92. }
  93. True;
  94. }
  95. multi method WHICH(Version:D:) {
  96. nqp::box_s(
  97. nqp::concat(
  98. nqp::if(
  99. nqp::eqaddr(self.WHAT,Version),
  100. 'Version|',
  101. nqp::concat(nqp::unbox_s(self.^name), '|')
  102. ),
  103. $!string
  104. ),
  105. ObjAt
  106. )
  107. }
  108. method parts() { nqp::hllize($!parts) }
  109. method plus() { nqp::p6bool($!plus) }
  110. }
  111. multi sub infix:<eqv>(Version:D \a, Version:D \b) {
  112. nqp::p6bool(
  113. nqp::eqaddr(a,b)
  114. || (nqp::eqaddr(a.WHAT,b.WHAT)
  115. && nqp::iseq_s(
  116. nqp::getattr_s(a,Version,'$!string'),
  117. nqp::getattr_s(b,Version,'$!string')
  118. ))
  119. )
  120. }
  121. multi sub infix:<cmp>(Version:D \a, Version:D \b) {
  122. proto vnumcmp(|) { * }
  123. multi vnumcmp(Str, Int) { Order::Less }
  124. multi vnumcmp(Int, Str) { Order::More }
  125. multi vnumcmp($av, $bv) { $av cmp $bv }
  126. # we're us
  127. if a =:= b {
  128. Same
  129. }
  130. # need to check
  131. else {
  132. my \ia := nqp::iterator(nqp::getattr(nqp::decont(a),Version,'$!parts'));
  133. my \ib := nqp::iterator(nqp::getattr(nqp::decont(b),Version,'$!parts'));
  134. # check from left
  135. while ia {
  136. if vnumcmp(nqp::shift(ia), ib ?? nqp::shift(ib) !! 0) -> $cmp {
  137. return $cmp;
  138. }
  139. }
  140. # check from right
  141. while ib {
  142. if vnumcmp(0, nqp::shift(ib)) -> $cmp {
  143. return $cmp;
  144. }
  145. }
  146. a.plus cmp b.plus
  147. }
  148. }
  149. multi sub infix:«<=>»(Version:D \a, Version:D \b) { a cmp b }
  150. multi sub infix:«<» (Version:D \a, Version:D \b) { a cmp b == Less }
  151. multi sub infix:«<=» (Version:D \a, Version:D \b) { a cmp b != More }
  152. multi sub infix:«==» (Version:D \a, Version:D \b) { a cmp b == Same }
  153. multi sub infix:«!=» (Version:D \a, Version:D \b) { a cmp b != Same }
  154. multi sub infix:«>=» (Version:D \a, Version:D \b) { a cmp b != Less }
  155. multi sub infix:«>» (Version:D \a, Version:D \b) { a cmp b == More }