RakuAST: allow constants in rakudoc configs

- move the literalization of configs to CHECK time - adapt deparsing of ::Doc::Block accordingly - fix .(w|s)orry-ad-hoc methods on ::Doc - add $!resolved-config attribute to ::Doc::Block - recursively visit ::Doc::Block.paragraphs for config literalization - allow optional literalization of resolved ::Var::Lexical - add literalization of ::VarDeclaration::Constant Sadly, this does not allow 'my constant foo = 42' to work, as these are ASTed as ::Term::Name. I guess we need a ::Term::Name::Constant?
rakudo · Jun 18, 2023 · 5b45629 · 5b45629
1 parent 9a5fe3d
commit 5b45629
Show file tree

Hide file tree

Showing 6 changed files with 108 additions and 63 deletions.
diff --git a/src/Raku/Actions.nqp b/src/Raku/Actions.nqp
@@ -2778,27 +2778,19 @@ class Raku::Actions is HLL::Actions does Raku::CommonActions {
             for $doc-configuration -> $/ {
                 for $<colonpair> -> $/ {
                     my $key := ~$<identifier>;
-                    if $<num> -> $int {                # :42bar
-                        my @result := nqp::radix(10,~$int,0,0x02);
-                        $config{$key} := nqp::hllizefor(@result[0],'Raku');
+                    if $<num> -> $int {
+                        $config{$key} := RakuAST::IntLiteral.new(+$int);
                     }
                     elsif $<coloncircumfix> -> $ccf {  # :bar("foo",42)
-                        my $value := $ccf.ast.literalize;
-                        if $value.defined {
-                            $config{$key} := $value;
-                        }
-                        else {
-                            nqp::die("'$ccf' is not constant");
-                        }
+                        $config{$key} := $ccf.ast;
                     }
-                    elsif $<var> {                     # :$bar
-                        nqp::die("cannot handle variables in RakuDoc config");
+                    elsif $<var> -> $var {             # :$bar
+                        $config{$key} := $var.ast;
                     }
                     else {                             # :!bar | :bar
-                        $config{$key} :=
-                          $*R.resolve-lexical-constant-in-setting(
-                            $<neg> ?? 'False' !! 'True'
-                          ).compile-time-value;
+                        $config{$key} := (
+                          $<neg> ?? RakuAST::Term::False !! RakuAST::Term::True
+                        ).new;
                     }
                 }
             }

diff --git a/src/Raku/ast/doc-block.rakumod b/src/Raku/ast/doc-block.rakumod
@@ -13,23 +13,21 @@ class RakuAST::Doc
     method visit-children(Code $visitor) { self.must-define("visit-children") }
 
     method worry-ad-hoc(Str $payload) {
-        if $*RESOLVER -> $resolver {
-            $resolver.add-worry:
-              $resolver.build-exception: 'X::AdHoc', :$payload;
-        }
-        else {
-            nqp::say($payload)
-        }
+        my $resolver := $*RESOLVER;
+        $resolver
+          ?? $resolver.add-worry(
+               $resolver.build-exception: 'X::AdHoc', :$payload
+             )
+          !! nqp::say($payload);
     }
 
     method sorry-ad-hoc(Str $payload) {
-        if $*RESOLVER -> $resolver {
-            $resolver.add-sorry:
-              $resolver.build-exception: 'X::AdHoc', :$payload;
-        }
-        else {
-            nqp::die($payload);
-        }
+        my $resolver := $*RESOLVER;
+        $resolver
+          ?? $resolver.add-sorry(
+               $resolver.build-exception: 'X::AdHoc', :$payload
+             )
+          !! nqp::die($payload);
     }
 }
 
@@ -62,12 +60,13 @@ class RakuAST::Doc::Block
   is RakuAST::Doc
   is RakuAST::CheckTime
 {
-    has str  $.type;         # the type (e.g. "doc", "head", "item", etc)
-    has int  $.level;        # the level (default "", or numeric 1..N)
-    has Hash $!config;       # the config hash (e.g. :numbered, :allow<B>)
-    has Bool $.abbreviated;  # bool: true if =item rather than =begin item
-    has List $!paragraphs;   # the actual content
-    has int  $!pod-index;
+    has str  $.type;             # the type (e.g. "doc", "head", "item", etc)
+    has int  $.level;            # the level (default "", or numeric 1..N)
+    has Hash $!config;           # the config hash (e.g. :numbered, :allow<B>)
+    has Bool $.abbreviated;      # bool: true if =item rather than =begin item
+    has List $!paragraphs;       # the actual content
+    has int  $!pod-index;        # index in $=pod
+    has Mu   $!resolved-config;  # HLL-resolved config
 
     method new(Str :$type!,
                Int :$level,
@@ -132,7 +131,8 @@ class RakuAST::Doc::Block
     method visit-children(Code $visitor) {
         for $!paragraphs {
             if nqp::istype($_,RakuAST::Doc::Block) {
-                # no action
+                my $*INNER-BLOCK := True;
+                $visitor($_);
             }
             elsif nqp::istype($_,RakuAST::Node) {
                 $visitor($_);
@@ -145,16 +145,25 @@ class RakuAST::Doc::Block
       RakuAST::IMPL::QASTContext $context
     ) {
         my $*RESOLVER := $resolver;
-        my $cu        := $resolver.find-attach-target('compunit');
-        if $!type eq 'data' {
-            my $store := $cu.data-content;
-            my $data  := self.Str.trim-trailing;
-
-            (my $key := $!config<key>)
-              ?? $store.ASSIGN-KEY($key, $data)
-              !! $store.push($data);
+        my $failed := self.literalize-config;
+        if $failed {
+            self.sorry-ad-hoc("'$failed' is not constant in configuration");
+        }
+
+        # in an outermost block
+        unless $*INNER-BLOCK {
+            my $cu := $resolver.find-attach-target('compunit');
+            if $!type eq 'data' {
+                my $store := $cu.data-content;
+                my $data  := self.Str.trim-trailing;
+
+                (my $key := $!config<key>)
+                  ?? $store.ASSIGN-KEY($key, $data)
+                  !! $store.push($data);
+            }
+            $cu.set-pod-content($!pod-index, self.podify);
         }
-        $cu.set-pod-content($!pod-index, self.podify);
+
         True
     }
 }

diff --git a/src/core.c/RakuAST/Deparse.pm6 b/src/core.c/RakuAST/Deparse.pm6
@@ -702,13 +702,17 @@ class RakuAST::Deparse {
         my str $config = $ast.config.sort({
             .key eq 'numbered' ?? '' !! .key  # numbered always first
         }).map({
-            if .key eq 'numbered' {
-                $abbreviated ?? '#' !! ':numbered'
+            my str $key = .key;
+            if $key eq 'numbered' && $abbreviated {
+                '#'
             }
             else {
-                nqp::istype(.value,Bool)
-                  ?? (.value ?? ':' !! ':!') ~ .key
-                  !! .raku
+                my $deparsed := self.deparse(.value);
+                $deparsed eq 'True'
+                  ?? ":$key"
+                  !! $deparsed eq 'False'
+                    ?? ":!$key"
+                    !! ":$key$deparsed"
             }
         }).join(' ');
         $config = $config
@@ -1980,6 +1984,7 @@ class RakuAST::Deparse {
 
     # handles most phasers
     multi method deparse(RakuAST::StatementPrefix::Phaser:D $ast --> Str:D) {
+        my $*DELIMITER = '';
         self.syn-phaser($ast.type) ~ ' ' ~ self.deparse($ast.blorst).chomp
     }
 

diff --git a/src/core.c/RakuAST/Fixups.pm6 b/src/core.c/RakuAST/Fixups.pm6
@@ -608,7 +608,10 @@ augment class RakuAST::Doc::Block {
         # originally verbatim, but may need postprocessing
         elsif $type eq 'code' | 'input' | 'output' {
             my int $offset = $spaces.chars;
-            my str @allow  = nqp::hllizefor($config<allow>,'Raku') // ();
+
+            # get any allowed setting
+            my str @allow;
+            @allow = $_ with $config<allow> andthen .literalize;
 
             if $offset || @allow {
                 for @paragraphs -> $pod is copy {
@@ -1145,6 +1148,27 @@ in line '$line'",
     multi method Str(RakuAST::Doc::Block:D:) {
         self.paragraphs.map(*.Str).join
     }
+
+    # Post-process any unresolved asts in the config
+    method literalize-config() {
+        my $config   := self.config;
+        my %resolved := $config.Hash;
+        %resolved.deepmap({
+            if nqp::istype($_,RakuAST::Node) {
+                my $value := .literalize;
+                $value.defined
+                  ?? ($_ = $value)       # ok, update in hash
+                  !! (return .DEPARSE);  # failed, stop now, and return
+            }
+        });
+        nqp::bindattr(self, RakuAST::Doc::Block, '$!resolved-config',
+          %resolved.Map);
+        Nil
+    }
+
+    method resolved-config() {
+        nqp::getattr(self, RakuAST::Doc::Block, '$!resolved-config') // Map.new
+    }
 }
 
 augment class RakuAST::Type::Enum {

diff --git a/src/core.c/RakuAST/LegacyPodify.pm6 b/src/core.c/RakuAST/LegacyPodify.pm6
@@ -212,7 +212,7 @@ class RakuAST::LegacyPodify {
               if $type eq 'defn';
         }
 
-        my $config   := $ast.config;
+        my $config   := $ast.resolved-config;
         my $contents := no-last-nl($ast.paragraphs).map({
             if nqp::istype($_,Str) {
                 if sanitize(.trim-leading) -> $contents {
@@ -242,15 +242,15 @@ class RakuAST::LegacyPodify {
                    )
                 !! $type eq 'config' && $ast.abbreviated
                   ?? Pod::Config.new(
-                       :type($ast.paragraphs.head), :config($ast.config)
+                       :type($ast.paragraphs.head), :$config
                      )
                   !! Pod::Block::Named.new(:name($type), :$config, :$contents)
           !! $contents  # no type means just a string
     }
 
     method podify-table(RakuAST::Doc::Block:D $ast) {
         my @rows    = $ast.paragraphs.grep(RakuAST::Doc::Row);
-        my $config := $ast.config;
+        my $config := $ast.resolved-config // Map.new;
 
         # Make sure that all rows have the same number of cells
         my $nr-columns := @rows.map(*.cells.elems).max;
@@ -316,13 +316,14 @@ class RakuAST::LegacyPodify {
         @contents.pop while @contents.tail eq "\n";
         @contents.push("\n");
 
-        ::("Pod::Block::$type.tc()").new: :@contents, :config($ast.config)
+        ::("Pod::Block::$type.tc()").new:
+          :@contents, :config($ast.resolved-config)
     }
 
     method podify-implicit-code(RakuAST::Doc::Block:D $ast) {
         Pod::Block::Code.new:
           :contents($ast.paragraphs.head.trim)
-          :config($ast.config)
+          :config($ast.resolved-config)
     }
 
     method podify-defn(RakuAST::Doc::Block:D $ast) {
@@ -340,7 +341,8 @@ class RakuAST::LegacyPodify {
               !! .podify
         }
 
-        Pod::Defn.new: :$term, :@contents, :config($ast.config)
+        Pod::Defn.new:
+          :$term, :@contents, :config($ast.resolved-config)
     }
 
     multi method podify(RakuAST::Doc::Declarator:D $ast, $WHEREFORE) {

diff --git a/src/core.c/RakuAST/Literalize.pm6 b/src/core.c/RakuAST/Literalize.pm6
@@ -49,7 +49,7 @@ augment class RakuAST::Node {
               !! op($left,$right)
         }
         else {
-            CannotLiteralize.new.throw
+            CannotLiteralize.new.throw;
         }
     }
 
@@ -63,7 +63,7 @@ augment class RakuAST::Node {
             op(self.operands.map(*.literalize))
         }
         else {
-            CannotLiteralize.new.throw
+            CannotLiteralize.new.throw;
         }
     }
 
@@ -72,7 +72,7 @@ augment class RakuAST::Node {
             op(self.operand.literalize)
         }
         else {
-            CannotLiteralize.new.throw
+            CannotLiteralize.new.throw;
         }
     }
 
@@ -120,6 +120,10 @@ augment class RakuAST::Node {
         self.compile-time-value
     }
 
+    multi method literalize(RakuAST::Declaration::External:D:) {
+        CannotLiteralize.new.throw;
+    }
+
 #- F ---------------------------------------------------------------------------
 
     multi method literalize(RakuAST::FatArrow:D:) {
@@ -156,7 +160,7 @@ augment class RakuAST::Node {
 
     multi method literalize(RakuAST::Statement::Expression:D:) {
         if self.condition-modifier // self.loop-modifier {
-            CannotLiteralize.new.throw
+            CannotLiteralize.new.throw;
         }
         else {
             self.expression.literalize
@@ -195,7 +199,12 @@ augment class RakuAST::Node {
 #- Var -------------------------------------------------------------------------
 
     multi method literalize(RakuAST::Var::Lexical:D:) {
-        CannotLiteralize.new.throw
+        with self.resolution andthen try .compile-time-value {
+            $_
+        }
+        else {
+            CannotLiteralize.new.throw;
+        }
     }
 
     multi method literalize(RakuAST::Var::Compiler::File:D:) {
@@ -205,6 +214,10 @@ augment class RakuAST::Node {
     multi method literalize(RakuAST::Var::Compiler::Line:D:) {
         self.line
     }
+
+    multi method literalize(RakuAST::VarDeclaration::Constant:D:) {
+        self.compile-time-value
+    }
 }
 
 # vim: expandtab shiftwidth=4