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