1. class Compiler does Systemic {
  2. has Str $.id;
  3. has Str $.release;
  4. has Str $!build-date;
  5. has Str $.codename;
  6. BEGIN my $id = nqp::sha1(
  7. $*W.handle.Str
  8. ~ nqp::atkey(nqp::getcurhllsym('$COMPILER_CONFIG'), 'source-digest')
  9. );
  10. submethod BUILD (
  11. :$!name = 'rakudo',
  12. :$!auth = 'The Perl Foundation',
  13. :$version,
  14. :$release,
  15. :$build-date,
  16. :$codename
  17. --> Nil
  18. ) {
  19. # XXX Various issues with this stuff on JVM
  20. my Mu $compiler := nqp::getcurhllsym('$COMPILER_CONFIG');
  21. $!id = nqp::p6box_s(nqp::ifnull(nqp::atkey($compiler,'id'),$id));
  22. # looks like: 2018.01-50-g8afd791c1
  23. $!version = $version
  24. // Version.new(nqp::atkey($compiler, 'version'));
  25. $!release =
  26. $release // nqp::p6box_s(nqp::atkey($compiler, 'release-number'));
  27. $!build-date =
  28. $build-date // nqp::p6box_s(nqp::atkey($compiler, 'build-date'));
  29. $!codename =
  30. $codename // nqp::p6box_s(nqp::atkey($compiler, 'codename'));
  31. }
  32. method build-date() {
  33. DateTime.new($!build-date)
  34. }
  35. method verbose-config(:$say) {
  36. my $compiler := nqp::getcomp("perl6");
  37. my $backend := $compiler.backend;
  38. my $name := $backend.name;
  39. my $items := nqp::list_s;
  40. nqp::push_s($items,$name ~ '::' ~ .key ~ '=' ~ .value)
  41. for $backend.config;
  42. my $language := $compiler.language;
  43. nqp::push_s($items,$language ~ '::' ~ .key ~ '=' ~ .value)
  44. for $compiler.config;
  45. nqp::push_s(
  46. $items,
  47. 'repo::chain=' ~ (try $*REPO.repo-chain.map( *.gist ).join(" ")) // ''
  48. );
  49. nqp::push_s($items,"distro::$_={ $*DISTRO."$_"() // '' }")
  50. for <auth desc is-win name path-sep release signature version>;
  51. nqp::push_s($items,"kernel::$_={ $*KERNEL."$_"() // '' }")
  52. for <arch archname auth bits desc
  53. hardware name release signature version>;
  54. try {
  55. require System::Info;
  56. my $sysinfo = System::Info.new;
  57. nqp::push_s($items,"sysinfo::{ .name }={ $sysinfo.$_ // '' }")
  58. for $sysinfo.^methods.grep: { .count == 1 && .name ne 'new' };
  59. }
  60. my str $string = nqp::join("\n",Rakudo::Sorting.MERGESORT-str($items));
  61. if $say {
  62. nqp::say($string);
  63. Nil
  64. }
  65. else {
  66. my %config;
  67. my $iter := nqp::iterator($items);
  68. while $iter {
  69. my ($main,$key,$value) = nqp::shift($iter).split(<:: =>);
  70. %config.AT-KEY($main).AT-KEY($key) = $value
  71. }
  72. %config but role {
  73. has $!string = $string;
  74. proto method Str() { $!string }
  75. proto method gist() { $!string }
  76. }
  77. }
  78. }
  79. }