Properly implement $*PERL according to spec

This introduces the Perl and Compiler classes
rakudo · May 18, 2014 · 0a6c98c · 0a6c98c
1 parent 3216e73
commit 0a6c98c
Show file tree

Hide file tree

Showing 7 changed files with 82 additions and 18 deletions.
diff --git a/src/core/Compiler.pm b/src/core/Compiler.pm
@@ -0,0 +1,48 @@
+class Compiler does Systemic {
+    has Str $!release;
+    has DateTime $!build-date;
+    has Str $!codename;
+
+    submethod BUILD (
+      :$!name      = 'rakudo',
+      :$!auth      = 'unknown',
+      :$version,
+      :$!signature = Blob,
+      :$!desc      = "",
+      :$release,
+      :$build-date,
+      :$codename,
+    ) {
+# XXX Various issues with this stuff on JVM
+        my Mu $compiler := nqp::getcurhllsym('$COMPILER_CONFIG');
+        $!version = Version.new(
+          $version // nqp::p6box_s(nqp::atkey($compiler, 'version')) );
+        $!release =
+          $release // nqp::p6box_s(nqp::atkey($compiler, 'release-number'));
+        $!build-date = DateTime.new(
+          $build-date // nqp::p6box_s(nqp::atkey($compiler, 'build-date')) );
+        $!codename =
+          $codename // nqp::p6box_s(nqp::atkey($compiler, 'codename'));
+    }
+}
+
+multi postcircumfix:<{ }> (Compiler $d, "name" )   {
+    DEPRECATED('$*PERL.compiler.name', :what('$*PERL<compiler><name>') );
+    $d.name
+}
+multi postcircumfix:<{ }> (Compiler $d, "ver" )   {
+    DEPRECATED('$*PERL.compiler.version', :what('$*PERL<compiler><ver>') );
+    $d.version
+}
+multi postcircumfix:<{ }> (Compiler $d, "release-number" )   {
+    DEPRECATED('$*PERL.compiler.release', :what('$*PERL<compiler><release-number') );
+    $d.release
+}
+multi postcircumfix:<{ }> (Compiler $d, "build-date" )   {
+    DEPRECATED('$*PERL.compiler.build-date', :what('$*PERL<compiler><build-date>') );
+    $d.build-date
+}
+multi postcircumfix:<{ }> (Compiler $d, "codename" )   {
+    DEPRECATED('$*PERL.compiler.codename', :what('$*PERL<compiler><codename>') );
+    $d.build-date
+}
diff --git a/src/core/Perl.pm b/src/core/Perl.pm
@@ -0,0 +1,22 @@
+class Perl does Systemic {
+    has Compiler $.compiler;
+
+    submethod BUILD (
+      :$!name      = 'Perl 6',
+      :$!auth      = "unknown",
+      :$!version   = Version.new("unknown"),
+      :$!signature = Blob,
+      :$!desc      = "",
+      :$!compiler  = Compiler.new,
+    ) { }
+}
+PROCESS::<$PERL> := Perl.new;
+
+multi postcircumfix:<{ }> (Perl $d, "name" )   {
+    DEPRECATED('$*PERL.name', :what('$*PERL<name>') );
+    $d.name
+}
+multi postcircumfix:<{ }> (Perl $d, "compiler" )   {
+    # allow this silently, as we will catch it on accessing the Compiler object
+    $d.compiler
+}
diff --git a/src/core/Systemic.pm b/src/core/Systemic.pm
@@ -10,7 +10,7 @@ role Systemic {
       :$!auth    = "unknown",
       :$!version = Version.new("unknown"),
     ) {}
-    method gist { $!name ~ (" ($!version)" if $!version ne "vunknown") }
+    method gist { $!name ~ (" ($!version)" if $!version.gist ne "vunknown") }
     method Str  { $!name }
 }
 
@@ -29,6 +29,6 @@ role Universal {
       :$!auth    = "unknown",
       :$!version = Version.new("unknown"),
     ) {}
-    method gist { $!name ~ (" ($!version)" if $!version ne "vunknown") }
+    method gist { $!name ~ (" ($!version)" if $!version.gist ne "vunknown") }
     method Str  { $!name }
 }
diff --git a/src/core/terms.pm b/src/core/terms.pm
@@ -57,20 +57,6 @@ sub term:<time>() { nqp::p6box_i(nqp::time_i()) }
 #?endif
     nqp::bindkey(nqp::who(PROCESS), '$VM', $VM);
 
-# XXX Various issues with this stuff on JVM
-    my Mu $compiler := nqp::getcurhllsym('$COMPILER_CONFIG');
-    my $PERL = {
-        name => 'rakudo',
-        compiler => {
-            name => 'rakudo',
-            ver => nqp::p6box_s(nqp::atkey($compiler, 'version')),
-            release-number => nqp::p6box_s(nqp::atkey($compiler, 'release-number')),
-            build-date => nqp::p6box_s(nqp::atkey($compiler, 'build-date')),
-            codename => nqp::p6box_s(nqp::atkey($compiler, 'codename')),
-        }
-    };
-    nqp::bindkey(nqp::who(PROCESS), '$PERL', $PERL);
-
     my @INC;
 #?if jvm
     my $pathsep := $VM<properties><path.separator>;
@@ -99,6 +85,8 @@ sub term:<time>() { nqp::p6box_i(nqp::time_i()) }
 #?endif
          ~ '/languages/perl6';
 
+# XXX Various issues with this stuff on JVM
+    my Mu $compiler := nqp::getcurhllsym('$COMPILER_CONFIG');  # TEMPORARY
     my %CUSTOM_LIB;
     try {
         my $home := %ENV<HOME> // %ENV<HOMEDRIVE> ~ %ENV<HOMEPATH>;

diff --git a/tools/build/Makefile-JVM.in b/tools/build/Makefile-JVM.in
@@ -154,8 +154,10 @@ J_CORE_SOURCES = \
   src/core/Deprecations.pm \
   src/core/Systemic.pm \
   src/core/Distro.pm \
-  src/core/VM.pm \
   src/core/Kernel.pm \
+  src/core/VM.pm \
+  src/core/Compiler.pm \
+  src/core/Perl.pm \
   src/core/Thread.pm \
   src/core/Lock.pm \
   src/core/Semaphore.pm \

diff --git a/tools/build/Makefile-Moar.in b/tools/build/Makefile-Moar.in
@@ -171,6 +171,8 @@ M_CORE_SOURCES = \
   src/core/Distro.pm \
   src/core/Kernel.pm \
   src/core/VM.pm \
+  src/core/Compiler.pm \
+  src/core/Perl.pm \
   src/core/IO/Socket.pm \
   src/core/IO/Socket/INET.pm \
   src/core/IO/Socket/Async.pm \

diff --git a/tools/build/Makefile-Parrot.in b/tools/build/Makefile-Parrot.in
@@ -239,8 +239,10 @@ P_CORE_SOURCES = \
   src/core/Deprecations.pm \
   src/core/Systemic.pm \
   src/core/Distro.pm \
-  src/core/VM.pm \
   src/core/Kernel.pm \
+  src/core/VM.pm \
+  src/core/Compiler.pm \
+  src/core/Perl.pm \
   src/core/OS.pm \
   src/core/core_epilogue.pm \