Skip to content

Commit

Permalink
RakuAST: add deparsing for Type::Subset and some refactoring
Browse files Browse the repository at this point in the history 
- allow an "of" named argument for programmatical uses
- pass on RakuAST:: classes in traits rather than Match objects
- handle traits in .new, checking for any "of" traits
- remove the $!current-package attribute, it is not needed
- no longer is Attaching, as there is nothing to attach anymore
- create the meta object at BEGIN time
- add Type::Subset candidate in RakuAST/Deparse
  • Loading branch information
@lizmat
lizmat committed Feb 12, 2023
1 parent 1f0fe64 commit b915dd3
Show file tree
Hide file tree
Showing 3 changed files with 72 additions and 63 deletions.
4 changes: 3 additions & 1 deletion src/Raku/Actions.nqp
View file
Expand Up @@ -1712,9 +1712,11 @@ class Raku::Actions is HLL::Actions does Raku::CommonActions {
my $decl := self.r('Type', 'Subset').new(
:name($<longname>.ast),
:where($<EXPR> ?? $<EXPR>.ast !! Mu),
:traits($<trait>),
:scope($*SCOPE)
);
for $<trait> {
$decl.add-trait($_.ast);
}
$decl.IMPL-CHECK($*R, $*CU.context, 1);
self.attach: $/, $decl;
}
Expand Down
113 changes: 55 additions & 58 deletions src/Raku/ast/type.rakumod
View file
Expand Up @@ -317,25 +317,39 @@ class RakuAST::Type::Subset
is RakuAST::BeginTime
is RakuAST::TraitTarget
is RakuAST::StubbyMeta
is RakuAST::Attaching
is RakuAST::PackageInstaller
{
has RakuAST::Name $.name;
has RakuAST::Name $.name;
has RakuAST::Trait::Of $.of;
has RakuAST::Expression $.where;
has RakuAST::Declaration $.of;
has RakuAST::Package $!current-package;

method new(RakuAST::Name :$name!, RakuAST::Expression :$where, List :$traits, str :$scope) {
has Mu $!meta;

method new(
str :$scope,
RakuAST::Name :$name!,
RakuAST::Trait::Of :$of,
RakuAST::Expression :$where,
List :$traits
) {
my $obj := nqp::create(self);
nqp::bindattr($obj, RakuAST::Type::Subset, '$!name', $name);
nqp::bindattr($obj, RakuAST::Type::Subset, '$!where', $where);
nqp::bindattr_s($obj, RakuAST::Declaration, '$!scope', $scope);
for $obj.IMPL-UNWRAP-LIST($traits) {
$obj.add-trait($_.ast);
}
nqp::bindattr($obj, RakuAST::Type::Subset, '$!name', $name);
nqp::bindattr($obj, RakuAST::Type::Subset, '$!of', $of) if $of;
nqp::bindattr($obj, RakuAST::Type::Subset, '$!where', $where) if $where;
$obj.handle-traits($traits) if $traits;
$obj
}

method handle-traits($traits) {
for self.IMPL-UNWRAP-LIST($traits) {
nqp::istype($_, RakuAST::Trait::Of)
?? $!of
?? nqp::die("Cannot declare more than one 'of' trait per subset")
!! nqp::bindattr(self, RakuAST::Type::Subset, '$!of', $_)
!! self.add-trait($_);
}
}

method default-scope() { 'our' }

method allowed-scopes() { self.IMPL-WRAP-LIST(['my', 'our']) }
Expand All @@ -351,20 +365,15 @@ class RakuAST::Type::Subset
method visit-children(Code $visitor) {
$visitor($!name);
$visitor($!where) if $!where;
# External constants break if visited with missing IMPL-QAST-DECL. Adding a sensible IMPL-QAST-DECL
# results in lexical declarations for things like Int, which will break if added more than once.
$visitor($!of) if $!of && !nqp::istype($!of, RakuAST::Declaration::External::Constant);
# Below fails with No such method 'apply-sink' for invocant of type 'GLOBALish'
#$visitor($!current-package);
# External constants break if visited with missing IMPL-QAST-DECL.
# Adding a sensible IMPL-QAST-DECL results in lexical declarations
# for things like Int, which will break if added more than once.
$visitor($!of) if $!of; # && !nqp::istype($!of, RakuAST::Declaration::External::Constant);
}

method is-lexical() { True }
method is-simple-lexical-declaration() { False }

method attach(RakuAST::Resolver $resolver) {
nqp::bindattr(self, RakuAST::Type::Subset, '$!current-package', $resolver.current-package);
}

method IMPL-EXPR-QAST(RakuAST::IMPL::QASTContext $context) {
my $value := self.meta-object;
$context.ensure-sc($value);
Expand All @@ -383,17 +392,7 @@ class RakuAST::Type::Subset
method PERFORM-BEGIN-AFTER-CHILDREN(RakuAST::Resolver $resolver, RakuAST::IMPL::QASTContext $context) {
self.apply-traits($resolver, $context, self);

for self.IMPL-UNWRAP-LIST(self.traits) {
if nqp::istype($_, RakuAST::Trait::Of) {
if $!of {
nqp::die("Cannot declare more than one 'of' trait per subset");
}
my $of-type := $resolver.resolve-name-constant($_.type.name);
nqp::bindattr(self, RakuAST::Type::Subset, '$!of', $of-type);
}
}

my $block;
my $block := $!where;
if $!where && !$!where.IMPL-CURRIED && (!nqp::istype($!where, RakuAST::Code) || nqp::istype($!where, RakuAST::RegexThunk)) {
$block := RakuAST::Block.new(
body => RakuAST::Blockoid.new(
Expand All @@ -418,20 +417,32 @@ class RakuAST::Type::Subset
),
);
$block.IMPL-CHECK($resolver, $context, False);
nqp::bindattr(self, RakuAST::Type::Subset, '$!where', $block);
}

my $type-object := self.stubbed-meta-object;
$type-object.HOW.set_name(
$type-object,
$!name.qualified-with(
RakuAST::Name.from-identifier-parts(
|nqp::split('::', $!current-package.HOW.name($!current-package))
)
).canonicalize(:colonpairs(0))
) if !nqp::eqaddr($!current-package, $resolver.get-global);

self.IMPL-INSTALL-PACKAGE($resolver, self.scope, $!name, $type-object, $!current-package);
# set up the meta object
my $package := $resolver.current-package;
my $meta := self.stubbed-meta-object;
$meta.HOW.set_name(
$meta,
$!name.qualified-with(
RakuAST::Name.from-identifier-parts(
|nqp::split('::', $package.HOW.name($package))
)
).canonicalize(:colonpairs(0))
) unless nqp::eqaddr($package, $resolver.get-global);

$meta.HOW.set_of($meta, $!of.compile-time-value) if $!of;
$meta.HOW.set_where(
$meta,
$block.IMPL-CURRIED
?? $block.IMPL-CURRIED.meta-object
!! $block.compile-time-value
) if $block;
nqp::bindattr(self, RakuAST::Type::Subset, '$!meta', $meta);

self.IMPL-INSTALL-PACKAGE(
$resolver, self.scope, $!name, $meta, $package
);
}

method PRODUCE-STUBBED-META-OBJECT() {
Expand All @@ -442,19 +453,5 @@ class RakuAST::Type::Subset
)
}

method PRODUCE-META-OBJECT() {
my $type := self.stubbed-meta-object;
if $!of {
$type.HOW.set_of($type, $!of.compile-time-value);
}
if $!where {
$type.HOW.set_where(
$type,
$!where.IMPL-CURRIED
?? $!where.IMPL-CURRIED.meta-object
!! $!where.compile-time-value
);
}
$type
}
method PRODUCE-META-OBJECT() { $!meta }
}
18 changes: 14 additions & 4 deletions src/core.c/RakuAST/Deparse.pm6
View file
Expand Up @@ -269,13 +269,11 @@ class RakuAST::Deparse {
~ $.square-close
}

method !typish-trait(RakuAST::Trait:D $ast --> Str:D) {
method !typish-trait($ast --> Str:D) {
$ast.IMPL-TRAIT-NAME ~ ' ' ~ self.deparse($ast.type)
}

method !method-call(
RakuAST::Call::Methodish:D $ast, str $dot, $macroish?
--> Str:D) {
method !method-call($ast, str $dot, $macroish? --> Str:D) {
my $name := (nqp::istype($_,Str) ?? $_ !! self.deparse($_))
with $ast.name;

Expand Down Expand Up @@ -1807,6 +1805,18 @@ class RakuAST::Deparse {
self.deparse($ast.name) ~ '[' ~ self.deparse($ast.args) ~ ']'
}

multi method deparse(RakuAST::Type::Subset:D $ast --> Str:D) {
my str @parts = 'subset';

@parts.unshift($ast.scope) if $ast.scope;
@parts.push(self.deparse($ast.name));
@parts.push(self.deparse($_)) with $ast.of;
@parts.push(self.deparse($_)) for $ast.traits;
@parts.push('where ' ~ self.deparse($_)) with $ast.where;

@parts.join(' ')
}

#- Var -------------------------------------------------------------------------

multi method deparse(RakuAST::Var::Attribute:D $ast --> Str:D) {
Expand Down

0 comments on commit b915dd3

Please sign in to comment.