view src/core.c/Mu.pm6 @ 0:c341f82e7ad7 default tip

Rakudo branch in cr.ie.u-ryukyu.ac.jp
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Thu, 26 Dec 2019 16:50:27 +0900
parents
children
line wrap: on
line source

my class X::Cannot::Lazy             { ... }
my class X::Constructor::Positional  { ... }
my class X::Method::NotFound         { ... }
my class X::Method::InvalidQualifier { ... }
my class X::Attribute::Required      { ... }
my class WalkList                    { ... }

my class ValueObjAt is ObjAt { }

my class Mu { # declared in BOOTSTRAP

    method self { self }

    method sink(--> Nil) { }

    method raku(|c) { self.perl(|c) }

    proto method ACCEPTS(|) {*}
    multi method ACCEPTS(Mu:U: Any \topic) {
        nqp::hllbool(nqp::istype(topic, self))
    }
    multi method ACCEPTS(Mu:U: Mu:U \topic) {
        nqp::hllbool(nqp::istype(topic, self))
    }

    method WHERE() {
        nqp::p6box_i(nqp::where(self))
    }

    proto method WHICH(|) {*}
    multi method WHICH(Mu:U: --> ValueObjAt:D) {
        nqp::box_s(
            nqp::concat(
                nqp::concat(nqp::unbox_s(self.^name), '|U'),
                nqp::objectid(self)
            ),
            ValueObjAt
        )
    }
    multi method WHICH(Mu:D: --> ObjAt:D) {
        nqp::box_s(
            nqp::concat(
                nqp::concat(nqp::unbox_s(self.^name), '|'),
                nqp::objectid(self)
            ),
            ObjAt
        )
    }

    proto method iterator(|) {*}
    multi method iterator(Mu:) {
        my $buf := nqp::create(IterationBuffer);
        $buf.push(Mu);
        # note: cannot use R:I.OneValue, as that doesn't (and shouldn't)
        # take Mu for the value to produce, as Mu is used to indicate
        # exhaustion.
        Rakudo::Iterator.ReifiedList($buf)
    }

    proto method split(|) {*}

    method emit {
        emit self;
    }
    method take {
        take self;
    }
    method return-rw(|) {  # same code as control.pm6's return-rw
        my $list := RETURN-LIST(nqp::p6argvmarray());
        nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, $list);
        $list;
    }
    method return(|) {  # same code as control.pm6's return
        my $list := RETURN-LIST(nqp::p6argvmarray());
        nqp::throwpayloadlexcaller(nqp::const::CONTROL_RETURN, nqp::p6recont_ro($list));
        $list;
    }

    proto method WHY(|) {*}
    multi method WHY(Mu:) {
        my Mu $why;

        my role Suggestion[$name] {
            method gist {
                "No documentation available for type '$name'.
Perhaps it can be found at https://docs.perl6.org/type/$name"
            }
        }

        if nqp::can(self.HOW, 'WHY') {
            $why := self.HOW.WHY;
        }

        if $why.defined && !$.defined #`(ie. we're a type object) {
            $why.set_docee(self);
        }
        $why // Nil but Suggestion[self.^name]
    }

    method set_why($why) {
        self.HOW.set_why($why);
    }

    proto method Bool() {*}
    multi method Bool(Mu:U: --> False) { }
    multi method Bool(Mu:D:) { self.defined }

    method so()  { self.Bool }
    method not() { self ?? False !! True }

    proto method defined(|) {*}
    multi method defined(Mu:U: --> False) { }
    multi method defined(Mu:D: --> True)  { }

    proto method new(|) {*}
    multi method new(*%attrinit) {
        nqp::if(
          nqp::eqaddr(
            (my $bless := nqp::findmethod(self,'bless')),
            nqp::findmethod(Mu,'bless')
          ),
          nqp::create(self).BUILDALL(Empty, %attrinit),
          $bless(self,|%attrinit)
        )
    }
    multi method new($, *@) {
        X::Constructor::Positional.new(:type( self )).throw();
    }

    proto method is-lazy (|) {*}
    multi method is-lazy(Mu: --> False) { }

    method CREATE() {
        nqp::create(self)
    }

    method bless(*%attrinit) {
        nqp::create(self).BUILDALL(Empty, %attrinit);
    }

    method BUILDALL(Mu:D: @autovivs, %attrinit) {
        my $init := nqp::getattr(%attrinit,Map,'$!storage');
        # Get the build plan. Note that we do this "low level" to
        # avoid the NQP type getting mapped to a Rakudo one, which
        # would get expensive.
        my $bp := nqp::findmethod(self.HOW,'BUILDALLPLAN')(self.HOW, self);
        my int $count = nqp::elems($bp);
        my int $i = -1;

        nqp::while(
          nqp::islt_i($i = nqp::add_i($i,1),$count),

          nqp::if(
            nqp::istype((my $task := nqp::atpos($bp,$i)),Callable),
            nqp::if(                             # BUILD/TWEAK
              nqp::istype(
                (my $build := nqp::if(
                  nqp::elems($init),
                  $task(self,|%attrinit),
                  $task(self)
                )),
                Failure
              ),
              return $build
            ),

            nqp::if(                             # not just calling
              (my int $code = nqp::atpos($task,0)),

              nqp::if(                           # >0
                nqp::isle_i($code,3),
                nqp::if(                         # 1|2|3
                  nqp::existskey($init,nqp::atpos($task,3)),
                  nqp::if(                       # can initialize
                    nqp::iseq_i($code,1),
                    nqp::bindattr_i(self,        # 1
                      nqp::atpos($task,1),
                      nqp::atpos($task,2),
                      nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3)))
                    ),
                    nqp::if(
                      nqp::iseq_i($code,2),
                      nqp::bindattr_n(self,      # 2
                        nqp::atpos($task,1),
                        nqp::atpos($task,2),
                        nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3)))
                      ),
                      nqp::bindattr_s(self,      # 3
                        nqp::atpos($task,1),
                        nqp::atpos($task,2),
                        nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3)))
                      )
                    )
                  )
                ),

                nqp::if(
                  nqp::iseq_i($code,4),
                  nqp::unless(                   # 4
                    nqp::attrinited(self,
                      nqp::atpos($task,1),
                      nqp::atpos($task,2)
                    ),
                    nqp::if(
                      nqp::istype(nqp::atpos($task,3),Block),
                      nqp::stmts(
                        (my \attr := nqp::getattr(self,
                          nqp::atpos($task,1),
                          nqp::atpos($task,2)
                        )),
                        (attr = nqp::atpos($task,3)(self,attr))
                      ),
                      nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) =
                        nqp::atpos($task,3)
                    )
                  ),

                  nqp::if(
                    nqp::iseq_i($code,5),
                    nqp::if(                     # 5
                      nqp::iseq_i(my int $int = nqp::getattr_i(self,
                        nqp::atpos($task,1),
                        nqp::atpos($task,2)
                      ), 0),
                      nqp::bindattr_i(self,
                        nqp::atpos($task,1),
                        nqp::atpos($task,2),
                        nqp::if(
                          nqp::istype(nqp::atpos($task,3),Block),
                          (nqp::atpos($task,3)(self,$int)),
                          nqp::atpos($task,3)
                        )
                      )
                    ),

                    nqp::if(
                      nqp::iseq_i($code,6),
                      nqp::if(                   # 6
                        nqp::iseq_n(my num $num = nqp::getattr_n(self,
                          nqp::atpos($task,1),
                          nqp::atpos($task,2)
                        ), 0e0),
                        nqp::bindattr_n(self,
                          nqp::atpos($task,1),
                          nqp::atpos($task,2),
                          nqp::if(
                            nqp::istype(nqp::atpos($task,3),Block),
                            (nqp::atpos($task,3)(self,$num)),
                            nqp::atpos($task,3)
                          )
                        )
                      ),

                      nqp::if(
                        nqp::iseq_i($code,7),
                        nqp::if(                 # 7
                          nqp::isnull_s(my str $str = nqp::getattr_s(self,
                            nqp::atpos($task,1),
                            nqp::atpos($task,2)
                          )),
                          nqp::bindattr_s(self,
                            nqp::atpos($task,1),
                            nqp::atpos($task,2),
                            nqp::if(
                              nqp::istype(nqp::atpos($task,3),Block),
                              (nqp::atpos($task,3)(self,$str)),
                              nqp::atpos($task,3)
                            )
                          )
                        ),

                      nqp::if(
                        nqp::iseq_i($code,8),
                        nqp::unless(             # 8
                          nqp::attrinited(self,
                            nqp::atpos($task,1),
                            nqp::atpos($task,2)
                          ),
                          X::Attribute::Required.new(
                            name => nqp::atpos($task,2),
                            why  => nqp::atpos($task,3)
                          ).throw
                        ),

                        nqp::if(
                          nqp::iseq_i($code,9),
                          nqp::bindattr(self,    # 9
                            nqp::atpos($task,1),
                            nqp::atpos($task,2),
                            (nqp::atpos($task,3)())
                          ),
                          nqp::if(
                            nqp::iseq_i($code,11),
                            nqp::if(             # 11
                              nqp::existskey($init,nqp::atpos($task,3)),
                              (nqp::getattr(self,
                                nqp::atpos($task,1),nqp::atpos($task,2))
                                = %attrinit.AT-KEY(nqp::atpos($task,3))),
                              nqp::bindattr(self,
                                nqp::atpos($task,1),nqp::atpos($task,2),
                                nqp::list
                              )
                            ),
                            nqp::if(
                              nqp::iseq_i($code,12),
                              nqp::if(           # 12
                                nqp::existskey($init,nqp::atpos($task,3)),
                                (nqp::getattr(self,
                                  nqp::atpos($task,1),nqp::atpos($task,2))
                                  = %attrinit.AT-KEY(nqp::atpos($task,3))),
                                nqp::bindattr(self,
                                  nqp::atpos($task,1),nqp::atpos($task,2),
                                  nqp::hash
                                )
                              ),
                              die('Invalid ' ~ self.^name ~ ".BUILDALL plan: $code"),
                  ))))))))),

                  nqp::if(                       # 0
                    nqp::existskey($init,nqp::atpos($task,3)),
                    (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2))
                      = %attrinit.AT-KEY(nqp::atpos($task,3))),
                  )
                )
              )
            );
            self
        }

        method BUILD_LEAST_DERIVED(%attrinit) {
            my $init := nqp::getattr(%attrinit,Map,'$!storage');
            # Get the build plan for just this class.
            my $bp := nqp::findmethod(self.HOW,'BUILDPLAN')(self.HOW,self);
            my int $count = nqp::elems($bp);
            my int $i     = -1;

        nqp::while(
          nqp::islt_i($i = nqp::add_i($i,1),$count),

          nqp::if(
            nqp::istype((my $task := nqp::atpos($bp,$i)),Callable),
            nqp::if(                             # BUILD/TWEAK
              nqp::istype(
                (my $build := nqp::if(
                  nqp::elems($init),
                  $task(self,|%attrinit),
                  $task(self)
                )),
                Failure
              ),
              return $build
            ),

            nqp::if(                             # not just calling
              (my int $code = nqp::atpos($task,0)),

              nqp::if(                           # >0
                nqp::isle_i($code,3),
                nqp::if(                         # 1|2|3
                  nqp::existskey($init,nqp::atpos($task,3)),
                  nqp::if(                       # can initialize
                    nqp::iseq_i($code,1),
                    nqp::bindattr_i(self,        # 1
                      nqp::atpos($task,1),
                      nqp::atpos($task,2),
                      nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3)))
                    ),
                    nqp::if(
                      nqp::iseq_i($code,2),
                      nqp::bindattr_n(self,      # 2
                        nqp::atpos($task,1),
                        nqp::atpos($task,2),
                        nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3)))
                      ),
                      nqp::bindattr_s(self,      # 3
                        nqp::atpos($task,1),
                        nqp::atpos($task,2),
                        nqp::decont(%attrinit.AT-KEY(nqp::atpos($task,3)))
                      )
                    )
                  )
                ),

                nqp::if(
                  nqp::iseq_i($code,4),
                  nqp::unless(                   # 4
                    nqp::attrinited(self,
                      nqp::atpos($task,1),
                      nqp::atpos($task,2)
                    ),
                    nqp::if(
                      nqp::istype(nqp::atpos($task,3),Block),
                      nqp::stmts(
                        (my \attr := nqp::getattr(self,
                          nqp::atpos($task,1),
                          nqp::atpos($task,2)
                        )),
                        (attr = nqp::atpos($task,3)(self,attr))
                      ),
                      nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2)) =
                        nqp::atpos($task,3)
                    )
                  ),

                  nqp::if(
                    nqp::iseq_i($code,5),
                    nqp::if(                     # 5
                      nqp::iseq_i(my int $int = nqp::getattr_i(self,
                        nqp::atpos($task,1),
                        nqp::atpos($task,2)
                      ), 0),
                      nqp::bindattr_i(self,
                        nqp::atpos($task,1),
                        nqp::atpos($task,2),
                        nqp::if(
                          nqp::istype(nqp::atpos($task,3),Block),
                          (nqp::atpos($task,3)(self,$int)),
                          nqp::atpos($task,3)
                        )
                      )
                    ),

                    nqp::if(
                      nqp::iseq_i($code,6),
                      nqp::if(                   # 6
                        nqp::iseq_n(my num $num = nqp::getattr_n(self,
                          nqp::atpos($task,1),
                          nqp::atpos($task,2)
                        ), 0e0),
                        nqp::bindattr_n(self,
                          nqp::atpos($task,1),
                          nqp::atpos($task,2),
                          nqp::if(
                            nqp::istype(nqp::atpos($task,3),Block),
                            (nqp::atpos($task,3)(self,$num)),
                            nqp::atpos($task,3)
                          )
                        )
                      ),

                      nqp::if(
                        nqp::iseq_i($code,7),
                        nqp::if(                 # 7
                          nqp::isnull_s(my str $str = nqp::getattr_s(self,
                            nqp::atpos($task,1),
                            nqp::atpos($task,2)
                          )),
                          nqp::bindattr_s(self,
                            nqp::atpos($task,1),
                            nqp::atpos($task,2),
                            nqp::if(
                              nqp::istype(nqp::atpos($task,3),Block),
                              (nqp::atpos($task,3)(self,$str)),
                              nqp::atpos($task,3)
                            )
                          )
                        ),

                      nqp::if(
                        nqp::iseq_i($code,8),
                        nqp::unless(             # 8
                          nqp::attrinited(self,
                            nqp::atpos($task,1),
                            nqp::atpos($task,2)
                          ),
                          X::Attribute::Required.new(
                            name => nqp::atpos($task,2),
                            why  => nqp::atpos($task,3)
                          ).throw
                        ),

                        nqp::if(
                          nqp::iseq_i($code,9),
                          nqp::bindattr(self,    # 9
                            nqp::atpos($task,1),
                            nqp::atpos($task,2),
                            (nqp::atpos($task,3)())
                          ),
                          nqp::if(
                            nqp::iseq_i($code,10),
                            # Force vivification, for the sake of meta-object
                            # mix-ins at compile time ending up with correctly
                            # shared containers.
                            nqp::stmts(          # 10
                              nqp::getattr(self,
                                nqp::atpos($task,1),
                                nqp::atpos($task,2)
                              ),
                              nqp::while(        # 10's flock together
                                nqp::islt_i(($i = nqp::add_i($i,1)),$count)
                                  && nqp::islist($task := nqp::atpos($bp,$i))
                                  && nqp::iseq_i(nqp::atpos($task,0),10),
                                nqp::getattr(self,
                                  nqp::atpos($task,1),
                                  nqp::atpos($task,2)
                                )
                              ),
                              ($i = nqp::sub_i($i,1))
                            ),
                            nqp::if(
                              nqp::iseq_i($code,11),
                              nqp::if(           # 11
                                nqp::existskey($init,nqp::atpos($task,3)),
                                (nqp::getattr(self,
                                  nqp::atpos($task,1),nqp::atpos($task,2))
                                  = %attrinit.AT-KEY(nqp::atpos($task,3))),
                                nqp::bindattr(self,
                                  nqp::atpos($task,1),nqp::atpos($task,2),
                                  nqp::list
                                )
                              ),
                              nqp::if(
                                nqp::iseq_i($code,12),
                                nqp::if(         # 12
                                  nqp::existskey($init,nqp::atpos($task,3)),
                                  (nqp::getattr(self,
                                    nqp::atpos($task,1),nqp::atpos($task,2))
                                    = %attrinit.AT-KEY(nqp::atpos($task,3))),
                                  nqp::bindattr(self,
                                    nqp::atpos($task,1),nqp::atpos($task,2),
                                    nqp::hash
                                  )
                                ),
                                die('Invalid ' ~ self.^name ~ ".BUILD_LEAST_DERIVED plan: $code"),
              )))))))))),

              nqp::if(                           # 0
                nqp::existskey($init,nqp::atpos($task,3)),
                (nqp::getattr(self,nqp::atpos($task,1),nqp::atpos($task,2))
                  = %attrinit.AT-KEY(nqp::atpos($task,3))),
              )
            )
          )
        );
        self
    }

    proto method Numeric(|) {*}
    multi method Numeric(Mu:U \v:) {
        warn "Use of uninitialized value of type {self.^name} in numeric context";
        0
    }
    proto method Real(|) {*}
    multi method Real(Mu:U \v:) {
        warn "Use of uninitialized value of type {self.^name} in numeric context";
        0
    }

    proto method Str(|) {*}
    multi method Str(Mu:U \v:) {
        my $name = (defined($*VAR_NAME) ?? $*VAR_NAME !! try v.VAR.name) // '';
        $name   ~= ' ' if $name ne '';
        warn "Use of uninitialized value {$name}of type {self.^name} in string"
                ~ " context.\nMethods .^name, .perl, .gist, or .say can be"
                ~ " used to stringify it to something meaningful.";
        ''
    }
    multi method Str(Mu:D:) {
        nqp::if(
          nqp::eqaddr(self,IterationEnd),
          "IterationEnd",
          self.^name ~ '<' ~ nqp::tostr_I(nqp::objectid(self)) ~ '>'
        )
    }

    proto method Stringy(|) {*}
    multi method Stringy(Mu:U \v:) {
        my $*VAR_NAME = try v.VAR.name;
        self.Str
    }
    multi method Stringy(Mu:D $:) { self.Str }

    method item(Mu \item:) is raw { item }

    proto method say(|) {*}
    multi method say() { say(self) }
    method print() { print(self) }
    method put() { put(self) }
    method note() { note(self) }

    method gistseen(Mu:D \SELF: $id, $gist, *%named) {
        if nqp::not_i(nqp::isnull(nqp::getlexdyn('$*gistseen'))) {
            my \sems := $*gistseen;
            my str $WHICH = nqp::unbox_s(self.WHICH);
            if nqp::existskey(sems,$WHICH) && nqp::atkey(sems,$WHICH) {
                nqp::bindkey(sems,$WHICH,2);
                "{$id}_{nqp::objectid(SELF)}";
            }
            else {
                nqp::bindkey(sems,$WHICH,1);
                my $result   := $gist(|%named);
                my int $value = nqp::atkey(sems,$WHICH);
                nqp::deletekey(sems,$WHICH);
                $value == 2
                  ?? "(\\{$id}_{nqp::objectid(SELF)} = $result)"
                  !! $result
            }
        }
        else {
            my $*gistseen := nqp::hash("TOP",1);
            SELF.gistseen($id,$gist,|%named)
        }
    }

    proto method gist(|) {*}
    multi method gist(Mu:U:) { '(' ~ self.^shortname ~ ')' }
    multi method gist(Mu:D:) { self.perl }

    method perlseen(Mu:D \SELF: $id, $perl, *%named) {
        my $sigil = nqp::iseq_s($id, 'Array') ?? '@'
            !! nqp::iseq_s($id, 'Hash') ?? '%' !! '\\';
        if nqp::not_i(nqp::isnull(nqp::getlexdyn('$*perlseen'))) {
            my \sems := $*perlseen;
            my str $WHICH = nqp::unbox_s(self.WHICH);
            if nqp::existskey(sems,$WHICH) && nqp::atkey(sems,$WHICH) {
                nqp::bindkey(sems,$WHICH,2);
                $sigil x nqp::isne_s($sigil, '\\') ~ "{$id}_{nqp::objectid(SELF)}";
            }
            else {
                nqp::bindkey(sems,$WHICH,1);
                my $result := $perl(|%named);
                my int $value = nqp::atkey(sems,$WHICH);
                nqp::deletekey(sems,$WHICH);
                $value == 2
                  ?? nqp::iseq_s($sigil, '\\')
                    ??  "(my {$sigil}{$id}_{nqp::objectid(SELF)} = $result)"
                    !! "((my {$sigil}{$id}_{nqp::objectid(SELF)}) = $result)"
                  !! $result
            }
        }
        else {
            my $*perlseen := nqp::hash("TOP",1);
            SELF.perlseen($id,$perl,|%named)
        }
    }

    proto method perl(|) {*}
    multi method perl(Mu:U:) { self.^name }
    multi method perl(Mu:D:) {
        nqp::if(
          nqp::eqaddr(self,IterationEnd),
          "IterationEnd",
          nqp::if(
            nqp::iscont(self), # a Proxy object would have a conted `self`
            nqp::decont(self).perl,
            self.perlseen: self.^name, {
                my @attrs;
                for self.^attributes().flat.grep: { .has_accessor } -> $attr {
                    my $name := substr($attr.Str,2);
                    @attrs.push: $name ~ ' => ' ~ $attr.get_value(self).perl
                }
                self.^name ~ '.new' ~ ('(' ~ @attrs.join(', ') ~ ')' if @attrs)
            }))
    }

    proto method DUMP(|) {*}
    multi method DUMP(Mu:U:) { self.perl }
    multi method DUMP(Mu:D: :$indent-step = 4, :%ctx?) {
        return DUMP(self, :$indent-step) unless %ctx;

        my Mu $attrs := nqp::list();
        for self.^attributes.flat -> $attr {
            my str $name       = $attr.name;
            my str $acc_name   = nqp::substr($name, 2, nqp::chars($name) - 2);
            my str $build_name = $attr.has_accessor ?? $acc_name !! $name;

            my Mu $value;
            if    $attr.has_accessor {
                $value := self."$acc_name"();
            }
            elsif nqp::can($attr, 'get_value') {
                $value := $attr.get_value(self);
            }
            elsif nqp::can($attr, 'package') {
                my Mu $decont  := nqp::decont(self);
                my Mu $package := $attr.package;

                $value := do given nqp::p6box_i(nqp::objprimspec($attr.type)) {
                    when 0 {              nqp::getattr(  $decont, $package, $name)  }
                    when 1 { nqp::p6box_i(nqp::getattr_i($decont, $package, $name)) }
                    when 2 { nqp::p6box_n(nqp::getattr_n($decont, $package, $name)) }
                    when 3 { nqp::p6box_s(nqp::getattr_s($decont, $package, $name)) }
                };
            }
            else {
                next;
            }

            nqp::push($attrs, $build_name);
            nqp::push($attrs, $value);
        }

        self.DUMP-OBJECT-ATTRS($attrs, :$indent-step, :%ctx);
    }
    method DUMP-PIECES(@pieces: $before, $after = ')', :$indent = @pieces > 1, :$indent-step) {
        $indent ?? $before ~ "\n" ~ @pieces.join(",\n").indent($indent-step) ~ "\n" ~ $after
                !! $before ~        @pieces.join(', ')                              ~ $after;
    }
    method DUMP-OBJECT-ATTRS(|args (*@args, :$indent-step, :%ctx, :$flags?)) {
        my Mu  $attrs := nqp::clone(nqp::captureposarg(nqp::usecapture(), 1));
        my str $where  = nqp::base_I(nqp::where(self), 16);
        my str $before = ($flags if defined $flags) ~ self.^name ~ '<' ~ %ctx{$where} ~ '>(';

        my @pieces;
        while $attrs {
            my str $name  = nqp::shift($attrs);
            my Mu $value := nqp::shift($attrs);
            @pieces.push: ':' ~ $name ~ '(' ~ DUMP($value, :$indent-step, :%ctx) ~ ')';
        }
        @pieces.DUMP-PIECES($before, :$indent-step);
    }

    proto method isa(|) {*}
    multi method isa(Mu \SELF: Mu $type --> Bool:D) {
        nqp::hllbool(SELF.^isa($type.WHAT))
    }
    multi method isa(Mu \SELF: Str:D $name --> Bool:D) {
        return True if .^name eq $name for SELF.^mro;
        False
    }

    method does(Mu \SELF: Mu $type) {
        nqp::hllbool(nqp::istype(SELF, $type.WHAT))
    }

    method can(Mu \SELF: $name) {
        SELF.^can($name)
    }

    proto method clone (|) {*}
    multi method clone(Mu:U: *%twiddles) {
        %twiddles and die 'Cannot set attribute values when cloning a type object';
        self
    }
    multi method clone(Mu:D: *%twiddles) {
        my $cloned := nqp::clone(self);
        if %twiddles.elems {
            for self.^attributes.flat -> $attr {
                my $name    := $attr.name;
                my $package := $attr.package;

                nqp::bindattr($cloned, $package, $name,
                  nqp::clone(nqp::getattr($cloned, $package, $name).VAR)
                ) if nqp::attrinited(self, $package, $name)
                    and nqp::not_i(nqp::objprimspec($attr.type));

                my $acc_name := substr($name,2);
                nqp::getattr($cloned, $package, $name) =
                  nqp::decont(%twiddles{$acc_name})
                  if $attr.has_accessor && %twiddles.EXISTS-KEY($acc_name);
            }
        }
        else {
            for self.^attributes.flat -> $attr {
                unless nqp::objprimspec($attr.type) {
                    my $name     := $attr.name;
                    my $package  := $attr.package;
                    if nqp::attrinited(self, $package, $name) {
                        my $attr_val := nqp::getattr($cloned, $package, $name);
                        nqp::bindattr($cloned,
                          $package, $name, nqp::clone($attr_val.VAR))
                            if nqp::iscont($attr_val);
                    }
                }
            }
        }
        $cloned
    }

    method Capture() {
        my $attrs := nqp::hash;
        for self.^attributes.flat -> $attr {
            if $attr.has_accessor {
                my str $name = substr($attr.name,2);
                nqp::bindkey($attrs,$name,self."$name"())
                  unless nqp::existskey($attrs,$name);
            }
        }
        my $capture := nqp::create(Capture);
        nqp::bindattr($capture,Capture,'%!hash',$attrs) if nqp::elems($attrs);
        $capture
    }

    # Various of the following dispatch methods are not called in situations
    # where the compiler can rewrite them into a cheaper form.

    # XXX TODO: Handle positional case.
    method dispatch:<var>(Mu \SELF: $var, |c) is raw {
        # We put a `return` here to make sure we do the right thing if $var
        # happens to be &fail.
        return $var(SELF, |c)
    }

    method dispatch:<::>(Mu \SELF: $name, Mu $type, |c) is raw {
        my $meth;
        my $ctx := nqp::ctxcaller(nqp::ctx());
        # Bypass wrapping thunk if redirected from spesh plugin
        $ctx := nqp::ctxcaller($ctx) if $*SPESH-THUNKED-DISPATCH;
        if nqp::istype(self, $type) {
            my $sym-found := 0;
            my $caller-type;
            repeat {
                my $pad := nqp::ctxlexpad($ctx);
                for <$?CONCRETIZATION $?CLASS> {
                    if nqp::existskey($pad, $_) {
                        $caller-type := nqp::atkey($pad, $_);
                        $sym-found := 1;
                        last;
                    }
                }
                $ctx := nqp::ctxouterskipthunks($ctx);
            } while $ctx && !$sym-found;
            $meth = $caller-type.^find_method_qualified($type, $name) if $sym-found;
            $meth = self.^find_method_qualified($type, $name) unless $meth;
        }

        unless nqp::defined($meth) {
            X::Method::InvalidQualifier.new(
                    method          => $name,
                    invocant        => SELF,
                    qualifier-type  => $type,
            ).throw;
        }

        return $meth(SELF, |c)
    }

    method dispatch:<!>(Mu \SELF: \name, Mu \type, |c) is raw {
        my $meth := type.^find_private_method(name);
        $meth ??
            $meth(SELF, |c) !!
            X::Method::NotFound.new(
              invocant => SELF,
              method   => name,
              typename => type.^name,
              :private,
            ).throw;
    }

    method dispatch:<.=>(\mutate: Str() $name, |c) is raw {
        $/ := nqp::getlexcaller('$/');
        mutate = mutate."$name"(|c)
    }

    method dispatch:<.?>(Mu \SELF: Str() $name, |c) is raw {
        nqp::can(SELF,$name) ??
            SELF."$name"(|c) !!
            Nil
    }

    method !batch-call(Mu \SELF: \name, Capture:D \c, :$throw = False, :$reverse = False, :$roles = False) {
        my @mro := SELF.^mro(:$roles);
        my $results := nqp::create(IterationBuffer);
        my int $mro_high = $reverse ?? 0 !! @mro.elems - 1;
        my int $i = @mro.elems;
        while nqp::isge_i(--$i, 0) {
            my int $idx = nqp::abs_i($mro_high - $i);
            my Mu \type-obj = @mro[$idx];
            my $meth = (type-obj.^method_table){name} unless type-obj.HOW.archetypes.composable;
            $meth = (type-obj.^submethod_table){name} if !$meth;
            nqp::push($results,$meth(SELF, |c))    if $meth;
        }
        if $throw && $results.elems == 0 {
            X::Method::NotFound.new(
              invocant => SELF,
              method   => name,
              typename => SELF.^name,
            ).throw;
        }
        $results.List
    }

    method dispatch:<.+>(Mu \SELF: \name, |c) {
        SELF!batch-call(name, c, :throw);
    }

    method dispatch:<.*>(Mu \SELF: \name, |c) {
        SELF!batch-call(name, c)
    }

    method dispatch:<hyper>(Mu \SELF: $nodality, Str $meth-name, |c) {
        nqp::if(
          nqp::if(
            nqp::istype($nodality,Str),
            nqp::if(
              $nodality,
                 nqp::can(List,$nodality)
              && nqp::can(List.can($nodality ).AT-POS(0),'nodal'),
                 nqp::can(List,$meth-name)
              && nqp::can(List.can($meth-name).AT-POS(0),'nodal')),
            nqp::can($nodality, 'nodal')),
          nqp::if(
            c,
            HYPER( sub (\obj) is nodal { obj."$meth-name"(|c) }, SELF ),
            HYPER( sub (\obj) is nodal { obj."$meth-name"()   }, SELF )),
          nqp::if(
            c,
            HYPER( -> \obj { obj."$meth-name"(|c) }, SELF ),
            HYPER( -> \obj { obj."$meth-name"(  ) }, SELF )))
    }

    proto method WALK(|) {*}
    multi method WALK(:$name!, :$canonical, :$ascendant, :$descendant, :$preorder, :$breadth,
                :$super, :$omit, :$include, :$roles, :$submethods = True, :$methods = True
                --> WalkList)
    {
        # First, build list of classes in the order we'll need them.

        my sub maybe-with-roles(Mu \typeobj) {
            flat typeobj.^parents(:local),
                 ($roles ?? typeobj.^roles(:local, :transitive, :mro) !! ())
        }

        my @classes;
        if $super {
            @classes = maybe-with-roles(self)
        }
        elsif $breadth {
            my @search_list = self.WHAT;
            while @search_list {
                append @classes, @search_list;
                my @new_search_list;
                for @search_list -> $current {
                    for maybe-with-roles($current) -> $next {
                        unless @new_search_list.grep({ $^c.WHAT =:= $next.WHAT }) {
                            push @new_search_list, $next;
                        }
                    }
                }
                @search_list = @new_search_list;
            }
        } elsif $ascendant | $preorder {
            sub build_ascendent(Mu $class) {
                unless @classes.grep({ $^c.WHAT =:= $class.WHAT }) {
                    push @classes, $class;
                    for maybe-with-roles($class) {
                        build_ascendent($^parent);
                    }
                }
            }
            build_ascendent(self.WHAT);
        } elsif $descendant {
            sub build_descendent(Mu $class) {
                unless @classes.grep({ $^c.WHAT =:= $class.WHAT }) {
                    for maybe-with-roles($class) {
                        build_descendent($^parent);
                    }
                    push @classes, $class;
                }
            }
            build_descendent(self.WHAT);
        } else {
            # Canonical, the default (just whatever the meta-class says) with us
            # on the start.
            @classes = self.^mro(:$roles);
        }

        # Now we have classes, build method list.
        my @methods;
        for @classes -> $class {
            if (!defined($include) || $include.ACCEPTS($class)) &&
              (!defined($omit) || !$omit.ACCEPTS($class)) {
                if $methods && !$class.HOW.archetypes.composable {
                    @methods.push: $_ with $class.^method_table{$name}
                }
                if $submethods {
                    @methods.push: $_ with $class.^submethod_table{$name}
                }
            }
        }

        WalkList.new(|@methods).set_invocant(self)
    }

    multi method WALK(Str:D $name, *%n --> WalkList ) {
        samewith(:$name, |%n)
    }
}


proto sub defined(Mu, *%) is pure {*}
multi sub defined(Mu \x) { x.defined }

proto sub infix:<~~>(Mu, Mu, *%) {*}
multi sub infix:<~~>(Mu \topic, Mu \matcher) {
    matcher.ACCEPTS(topic).Bool;
}

proto sub infix:<!~~>(Mu, Mu, *%) {*}
multi sub infix:<!~~>(Mu \topic, Mu \matcher) {
    matcher.ACCEPTS(topic).not;
}

proto sub infix:<=:=>(Mu $?, Mu $?, *%) is pure {*}
multi sub infix:<=:=>($?)      { Bool::True }
multi sub infix:<=:=>(Mu \a, Mu \b) {
    nqp::hllbool(nqp::eqaddr(a, b));
}

proto sub infix:<eqv>(Any $?, Any $?, *%) is pure {*}
multi sub infix:<eqv>($?)            { Bool::True }

# Last ditch snapshot semantics.  We shouldn't come here too often, so
# please do not change this to be faster but wronger.  (Instead, add
# specialized multis for datatypes that can be tested piecemeal.)
multi sub infix:<eqv>(Any:U \a, Any:U \b) {
    nqp::hllbool(nqp::eqaddr(nqp::decont(a),nqp::decont(b)))
}
multi sub infix:<eqv>(Any:D \a, Any:U \b --> False) { }
multi sub infix:<eqv>(Any:U \a, Any:D \b --> False) { }
multi sub infix:<eqv>(Any:D \a, Any:D \b) {
    nqp::hllbool(
      nqp::eqaddr(nqp::decont(a),nqp::decont(b))
        || (nqp::eqaddr(a.WHAT,b.WHAT) && nqp::iseq_s(a.perl,b.perl))
    )
}

multi sub infix:<eqv>(Iterable:D \a, Iterable:D \b) {
    nqp::hllbool(
      nqp::unless(
        nqp::eqaddr(nqp::decont(a),nqp::decont(b)),
        nqp::if(                                 # not same object
          nqp::eqaddr(a.WHAT,b.WHAT),
          nqp::if(                               # same type
            a.is-lazy,
            nqp::if(                             # a lazy
              b.is-lazy,
              die(X::Cannot::Lazy.new: :action<eqv>) # a && b lazy
            ),
            nqp::if(                             # a NOT lazy
              b.is-lazy,
              0,                                 # b lazy
              nqp::if(                           # a && b NOT lazy
                nqp::iseq_i((my int $elems = a.elems),b.elems),
                nqp::stmts(                      # same # elems
                  (my int $i = -1),
                  nqp::while(
                    nqp::islt_i(($i = nqp::add_i($i,1)),$elems) # not exhausted
                      && a.AT-POS($i) eqv b.AT-POS($i),         # still same
                    nqp::null
                  ),
                  nqp::iseq_i($i,$elems)         # exhausted = success!
                )
              )
            )
          )
        )
      )
    )
}

sub DUMP(|args (*@args, :$indent-step = 4, :%ctx?)) {
    my Mu $capture := nqp::usecapture();
    my Mu $topic   := nqp::captureposarg($capture, 0);

    return "\x25b6" ~ DUMP(nqp::decont($topic), :$indent-step, :%ctx)
        if nqp::iscont($topic);
    return '(null)' if nqp::isnull($topic);

    my str $type  = $topic.^name;
    my str $where = nqp::base_I(nqp::where($topic), 16);

    if %ctx{$where} -> $obj_num {
        nqp::istype($topic, Bool) ?? $topic.DUMP(:$indent-step, :%ctx)  !!
        nqp::isconcrete($topic)   ?? '=' ~ $type ~ '<' ~ $obj_num ~ '>' !!
        nqp::can($topic, 'DUMP')  ?? $topic.DUMP(:$indent-step, :%ctx)  !!
                                     $type;
    }
    else {
        my int $obj_num = %ctx.elems + 1;
        %ctx{$where} = $obj_num;

        if    nqp::islist($topic) {
            my str $id = $type ~ '<' ~ $obj_num ~ '>';

            my @pieces;
            $topic := nqp::clone($topic);
            while $topic {
                my Mu $x := nqp::shift($topic);
                @pieces.push: DUMP($x, :$indent-step, :%ctx);
            }

            @pieces.DUMP-PIECES($id ~ '(', :$indent-step);
        }
        elsif nqp::ishash($topic) {
            my str $id = $type ~ '<' ~ $obj_num ~ '>';

            my @pieces;
            {
                for $topic.pairs {
                    @pieces.push: $_.key ~ ' => ' ~ DUMP($_.value, :$indent-step, :%ctx);
                }
                CATCH { default { @pieces.push: '...' } }
            }

            @pieces.DUMP-PIECES($id ~ '(', :$indent-step);
        }
        elsif nqp::can($topic, 'DUMP') {
            $topic.DUMP(:$indent-step, :%ctx);
        }
        else {
            given nqp::p6box_i(nqp::captureposprimspec($capture, 0)) {
                when 0 { $type ~ '<' ~ $obj_num ~ '>(...)' }
                when 1 { nqp::captureposarg_i($capture, 0).DUMP(:$indent-step, :%ctx) }
                when 2 { nqp::captureposarg_n($capture, 0).DUMP(:$indent-step, :%ctx) }
                when 3 { nqp::captureposarg_s($capture, 0).DUMP(:$indent-step, :%ctx) }
            }
        }
    }
}

# These must collapse Junctions
proto sub so(Mu, *%) {*}
multi sub so(Mu $x)  { ?$x }
proto sub not(Mu, *%) {*}
multi sub not(Mu $x) { !$x }

Metamodel::ClassHOW.exclude_parent(Mu);

# vim: ft=perl6 expandtab sw=4