Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
My First Steps with RakuAST...

I might turn this into something bloggable.

Question for Jonathan Worthington:

How easy will it be to get RakuAST for a given piece of Raku?

In the meantime, consider:

#| sub buildAncestryAST (@ancestry)
#|   - @ancestry ($child-type, $parent-type)
#| Returns RakuAST, implementing:
#|  method setBox(BoxAncestry $_) {↲
#|    my $to-parent;↲
#|    $!b = do {↲
#|      when GtkBox {↲
#|          $to-parent = nativecast(GtkContainer, $_);↲
#|          $_;↲
#|      }↲
#|      when GtkOrientable {↲
#|          $!or = $_;↲
#|          $to-parent = nativecast(GtkContainer, $_);↲
#|          nativecast(GtkBox, $_)↲
#|      }↲
#|      default {↲
#|          $to-parent = $_;↲
#|          nativecast(GtkBox, $_);↲
#|      }↲
#|    }↲
#|    self.setContainer($to-parent);↲
#|    $!or //= nativecast(GtkOrientable, $!b);    # For GTK::Roles::Orientable↲
#|  }
sub buildAncestryAST (@ancestry) {

  # $roles.gist.say;

  my @ancestry-names = @ancestry.map({ .^name });

  my $obj-name             = @ancestry-names[0];
  my $parent-name          = @ancestry-names[1];
  my $stripped-obj-name    = $obj-name.subst($prefix, '');
  my $stripped-parent-name = $parent-name.subst($prefix, '');

  # Returns RakuAST, implementing:
  #  $to-parent = nativecast(<PARENT-TYPE>, $_);
  #  nativecast(<SELF-TYPE>, $_);
  sub set-parent {
    (
      RakuAST::ApplyInfix.new(
        left  => RakuAST::Var::Lexical.new('$to-parent'),
        infix => RakuAST::Infix.new('='),
        right => RakuAST::Call::Name.new(
          name => RakuAST::Name.from-identifier('nativecast'),
          args => RakuAST::ArgList.new(
            RakuAST::Type::Simple.new(
              RakuAST::Name.from-identifier($parent-name)
            ),
            RakuAST::Var::Lexical.new('$_')
          )
        )
      ),

      RakuAST::Call::Name.new(
        name => RakuAST::Name.from-identifier('nativecast'),
        args => RakuAST::ArgList.new(
          RakuAST::Type::Simple.new(
            RakuAST::Name.from-identifier($obj-name)
          ),
          RakuAST::Var::Lexical.new('$_')
        )
      )
    )
  }

  #my $roles = @ancestry[0].^roles (-) @ancestry[1].^roles;
  # my $roles = @ancestry.head.^attributes
  my $roles = (GtkOrientable).Array;

  my @role-assigns;

  my @role-blocks = do gather for $roles[] {
    my $attr           = findProperImplementor( .^attributes );
    my $attr-type-name = $attr.type.^name;

    @role-assigns.push: RakuAST::ApplyInfix.new(
      left  => RakuAST::Var::Lexical.new('$!or'),
      infix => RakuAST::MetaInfix::Assign.new( RakuAST::Infix.new('//') ),
      right => RakuAST::Call::Name.new(
        name => RakuAST::Name.from-identifier('nativecast'),
        args => RakuAST::ArgList.new(
          RakuAST::Type::Simple.new(
            RakuAST::Name.from-identifier($attr-type-name)
          ),
          RakuAST::Var::Lexical.new('$_')
        )
      )
    );

    take RakuAST::Statement::When.new(
      condition =>  RakuAST::Type::Simple.new(
        RakuAST::Name.from-identifier($attr-type-name)
      ),
      body => RakuAST::Block.new(
        body => RakuAST::Blockoid.new(
          RakuAST::StatementList.new(
            RakuAST::ApplyInfix.new(
              left  => RakuAST::Var::Lexical.new( $attr.name ),
              infix => RakuAST::Infix.new('='),
              right => RakuAST::Var::Lexical.new('$_')
            ),

            |set-parent
          )
        )
      )
    )
  }

  @role-assigns.gist.say;

  RakuAST::Method.new(
    name      => RakuAST::Name.from-identifier('set' ~ $stripped-obj-name),
    signature => RakuAST::Signature.new(
      parameters => (
        RakuAST::Parameter.new(
          type => RakuAST::Type::Simple.new(
            RakuAST::Name.from-identifier($obj-name ~ 'Ancestry')
          ),
          target => RakuAST::ParameterTarget::Var.new('$_')
        )
      ).Array
    ),
    body      => RakuAST::Blockoid.new(
      RakuAST::StatementList.new(

        RakuAST::VarDeclaration::Simple.new(
          scope => 'my',
          name  => '$to-parent',
        ),

        RakuAST::Statement::Expression.new(
          expression => RakuAST::ApplyInfix.new(
            left  => RakuAST::Var::Lexical.new('$!b'),
            infix => RakuAST::Infix.new('='),
            right => RakuAST::StatementPrefix::Do.new(
              RakuAST::Statement::Expression.new(
                expression => RakuAST::Block.new(
                  body => RakuAST::Blockoid.new(
                    RakuAST::StatementList.new(

                      RakuAST::Statement::When.new(
                        condition => RakuAST::Type::Simple.new(
                          RakuAST::Name.from-identifier($obj-name)
                        ),
                        body => RakuAST::Block.new(
                          body => RakuAST::Blockoid.new(
                            RakuAST::StatementList.new(
                              RakuAST::ApplyInfix.new(
                                left  => RakuAST::Var::Lexical.new('$to-parent'),
                                infix => RakuAST::Infix.new('='),
                                right => RakuAST::Call::Name.new(
                                  name => RakuAST::Name.from-identifier('nativecast'),
                                  args => RakuAST::ArgList.new(
                                    RakuAST::Type::Simple.new(
                                      RakuAST::Name.from-identifier($parent-name)
                                    ),
                                    RakuAST::Var::Lexical.new('$_')
                                  )
                                )
                              ),
                              RakuAST::Var::Lexical.new('$_')
                            )
                          )
                        )
                      ),

                      |@role-blocks,

                      RakuAST::Statement::Default.new(
                        body => RakuAST::Block.new(
                          body => RakuAST::Blockoid.new(
                            RakuAST::StatementList.new(
                              RakuAST::ApplyInfix.new(
                                left  => RakuAST::Var::Lexical.new('$to-parent'),
                                infix => RakuAST::Infix.new('='),
                                right => RakuAST::Var::Lexical.new('$_')
                              ),

                              RakuAST::Call::Name.new(
                                name => RakuAST::Name.from-identifier('nativecast'),
                                args => RakuAST::ArgList.new(
                                  RakuAST::Type::Simple.new(
                                    RakuAST::Name.from-identifier($obj-name)
                                  ),
                                  RakuAST::Var::Lexical.new('$_')
                                )
                              )
                            )
                          )
                        )
                      )
                    )
                  )
                )
              )
            )
          )
        ),

        RakuAST::ApplyPostfix.new(
          operand => RakuAST::Name.from-identifier('self'),
          postfix => RakuAST::Call::Method.new(
            name => RakuAST::Name.from-identifier('set' ~ $stripped-parent-name),
            args => RakuAST::Var::Lexical.new('$to-parent')
          )
        ),
        
        |@role-assigns

      )
    )
  )

}
@Xliff
Copy link
Author

Xliff commented Dec 23, 2021

LOL! I missed the code for GObject, which is different as it must do:

self!setObject($to-parent)

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment