NQPCORE.setting

# This file automatically generated by tools\build\gen-cat.pl

# From src\core\NativeTypes.pm

use nqp-mo;

# We'll re-export all of the HOWs that we import from the meta-objects
# library. (Questionable whether we should need to do this - maybe the
# set of mappings the setting has should just be taken as the default
# for any program using it. OTOH, there's not a good way to factor
# this just yet.)
my module EXPORTHOW {
    ($?PACKAGE.WHO)<module>       := NQPModuleHOW;
    ($?PACKAGE.WHO)<class>        := NQPClassHOW;
    ($?PACKAGE.WHO)<class-attr>   := NQPAttribute;
    ($?PACKAGE.WHO)<grammar>      := NQPClassHOW;
    ($?PACKAGE.WHO)<grammar-attr> := NQPAttribute;
    ($?PACKAGE.WHO)<role>         := NQPParametricRoleHOW;
    ($?PACKAGE.WHO)<role-attr>    := NQPAttribute;
    ($?PACKAGE.WHO)<native>       := NQPNativeHOW;
}

my native int is repr('P6int') { }

my native num is repr('P6num') { }

my native str is repr('P6str') { }

# From src\core\NQPRoutine.pm

my knowhow NQPRoutine {
    has $!do;
    has $!signature;
    has $!dispatchees;
    has $!dispatch_cache;
    has $!dispatch_order;
    
    # Adds a multi-dispatch candidate.
    method add_dispatchee($code) {
        #pir::nqp_disable_sc_write_barrier__v();
        $!dispatch_cache := nqp::null();
        $!dispatch_order := nqp::null();
        nqp::push($!dispatchees, $code);
        #pir::nqp_enable_sc_write_barrier__v();
    }
    
    # Checks if this code object is a dispatcher.
    method is_dispatcher() {
        nqp::defined($!dispatchees)
    }
    
    method derive_dispatcher() {
        # Clone the underlying VM code ref.
        my $do  := nqp::clone($!do);
        
        # Clone and attach the code object.
        my $der := nqp::clone(self);
        nqp::bindattr($der, NQPRoutine, '$!do', $do);
        nqp::bindattr($der, NQPRoutine, '$!dispatchees', nqp::clone($!dispatchees));
        nqp::setcodeobj($do, $der);
        
        # If needed, arrange for a fixup of the cloned code-ref.
#        my $clone_callback := pir::getprop__PPs($!do, 'CLONE_CALLBACK');
#        if nqp::defined($clone_callback) {
#            $clone_callback($!do, $do, $der);
#        }
        
        $der
    }
    
    # Checks if one type is narrower than the other.
    sub is_narrower_type($a, $b) {
        # If one of the types is null, then we know that's automatically
        # wider than anything.
        if nqp::isnull($b) && !nqp::isnull($a) { 1 }
        elsif nqp::isnull($a) || nqp::isnull($b) { 0 }
        else { nqp::istype($a, $b) }
    }
    
    # Sorts the dispatchees. Puts nulls between groups that are of equal weight.
    # The most specific group comes first.
    my $SLURPY_ARITY      := nqp::bitshiftl_i(1, 30);
    my $EDGE_REMOVAL_TODO := -1;
    my $EDGE_REMOVED      := -2;
    my $DEFINED_ONLY      := 1;
    my $UNDEFINED_ONLY    := 2;
    method sort_dispatchees() {        
        # Takes two candidates and determines if the first one is narrower than the
        # second. Returns a true value if they are.
        sub is_narrower(%a, %b) {
            # Work out how many parameters to compare, factoring in slurpiness
            # and optionals.
            my $types_to_check;
            if %a<num_types> == %b<num_types> {
                $types_to_check := %a<num_types>;
            }
            elsif %a<min_arity> == %b<min_arity> {
                $types_to_check := %a<num_types> > %b<num_types> ?? %b<num_types> !! %a<num_types>;
            }
            else {
                return 0;
            }

            # Analyse each parameter in the two candidates.
            my $i := 0;
            my $narrower := 0;
            my $tied := 0;
            while $i < $types_to_check {
                my $type_obj_a := %a<types>[$i];
                my $type_obj_b := %b<types>[$i];
                if nqp::eqaddr($type_obj_a, $type_obj_b) {
                    $tied++;
                }
                elsif is_narrower_type($type_obj_a, $type_obj_b) {
                    $narrower++;
                }
                elsif !is_narrower_type($type_obj_b, $type_obj_a) {
                    $tied++;
                }
                $i++;
            }

            # If one is narrower than the other from current analysis, we're done.
            if $narrower >= 1 && $narrower + $tied == $types_to_check {
                return 1;
            }

            # If they aren't tied, we're also done.
            elsif $tied != $types_to_check {
                return 0;
            }

            # Otherwise, we see if one has a slurpy and the other not. A lack of
            # slurpiness makes the candidate narrower. Otherwise, they're tied.
            return %a<max_arity> != $SLURPY_ARITY && %b<max_arity> == $SLURPY_ARITY;
        }

        # Create a node for each candidate in the graph.
        my @graph;
        my $num_candidates := nqp::elems($!dispatchees);
        my $i := 0;
        while $i < $num_candidates {
            # Get hold of signature, types and definednesses.
            my $candidate := $!dispatchees[$i];
            my $multi_sig := $candidate.signature;
            my @types_list := $multi_sig.types;
            my @definedness_list := $multi_sig.definednesses;
            my $sig_elems := nqp::elems(@types_list);

            # Type information.
            my %info := nqp::hash(
                'sub',           $candidate,
                'types',         [],
                'definednesses', [],
                'min_arity',     0,
                'max_arity',     0,
                'num_types',     0
            );
            my %significant_param := 0;
            my $j := 0;
            while $j < $sig_elems {
                # XXX TODO: Worry about optional and slurpy later.
                %info<max_arity>++;
                %info<min_arity>++;

                # Record type info for this parameter. */
                nqp::push(%info<types>, @types_list[$j]);
                nqp::push(%info<definednesses>, @definedness_list[$j]);
                %info<num_types>++;
                
                $j++;
            }

            # Add it to graph node, and initialize list of edges.
            nqp::push(@graph, nqp::hash(
                'info',      %info,
                'edges',     [],
                'edges_in',  0,
                'edges_out', 0
            ));

            $i++;
        }

        # Now analyze type narrowness of the candidates relative to each other
        # and create the edges.
        $i := 0;
        while $i < $num_candidates {
            my $j := 0;
            while $j < $num_candidates {
                if ($i != $j) {
                    if is_narrower(@graph[$i]<info>, @graph[$j]<info>) {
                        @graph[$i]<edges>[@graph[$i]<edges_out>] := @graph[$j];
                        @graph[$i]<edges_out>++;
                        @graph[$j]<edges_in>++;
                    }
                }
                $j++;
            }
            $i++;
        }

        # Perform the topological sort.
        my @result;
        my $candidates_to_sort := $num_candidates;
        while $candidates_to_sort > 0 {
            my $rem_results := nqp::elems(@result);

            # Find any nodes that have no incoming edges and add them to
            # results.
            my $i := 0;
            while $i < $num_candidates {
                if @graph[$i]<edges_in> == 0 {
                    # Add to results.
                    nqp::push(@result, @graph[$i]<info>);
                    $candidates_to_sort--;
                    @graph[$i]<edges_in> := $EDGE_REMOVAL_TODO;
                }
                $i++;
            }
            if $rem_results == nqp::elems(@result) {
                nqp::die("Circularity detected in multi sub types");
            }

            # Now we need to decrement edges in counts for things that had
            # edges from candidates we added here.
            $i := 0;
            while $i < $num_candidates {
                if @graph[$i]<edges_in> == $EDGE_REMOVAL_TODO {
                    my $j := 0;
                    while $j < @graph[$i]<edges_out> {
                        @graph[$i]<edges>[$j]<edges_in>--;
                        $j++;
                    }
                    @graph[$i]<edges_in> := $EDGE_REMOVED;
                }
                $i++;
            }
            
            # Add gap between groups.
            nqp::push(@result, nqp::null());
        }
        
        # Add final null sentinel.
        nqp::push(@result, nqp::null());

        return @result;
    }
    
    method dispatch($capture) {
        # Count arguments.
        my $num_args := nqp::captureposelems($capture);

        # Get list and number of candidates, triggering a sort if there are none.
        my @candidates := $!dispatch_order;
        if nqp::isnull(@candidates) {
            #pir::nqp_disable_sc_write_barrier__v();
            @candidates := $!dispatch_order := self.sort_dispatchees();
            #pir::nqp_enable_sc_write_barrier__v();
            1;
        }
        my $num_candidates := nqp::elems(@candidates);

        # Initialize dispatcher state.
        my @possibles;

        # Go thorugh candidates.
        my $type_mismatch;
        my $type_check_count;
        my $i;
        my $cur_idx := 0;
        my $cur_candidate;
        while 1 {
            $cur_candidate := @candidates[$cur_idx];
            
            if nqp::isnull($cur_candidate) {
                # If we have some possible candidate(s), we're done in this loop.
                if nqp::elems(@possibles) {
                    last;
                }

                # Otherwise, we keep looping and looking, unless we really hit the end.
                $cur_idx++;
                if nqp::isnull(@candidates[$cur_idx]) {
                    last;
                }
                else {
                    next;
                }
            }

            # Check if it's admissable by arity.
            if $num_args < $cur_candidate<min_arity> || $num_args > $cur_candidate<max_arity> {
                $cur_idx++;
                next;
            }

            # Check if it's admissable by type.
            $type_check_count := $cur_candidate<num_types> > $num_args
                             ?? $num_args
                             !! $cur_candidate<num_types>;
            $type_mismatch := 0;
            $i := 0;
            while $i < $type_check_count {
                my $param := nqp::captureposarg($capture, $i);
                my $param_type := $param.WHAT;
                my $type_obj := $cur_candidate<types>[$i];
                my $definedness := $cur_candidate<definednesses>[$i];
                unless nqp::eqaddr($param_type, $type_obj) || is_narrower_type($param_type, $type_obj) {
                    $type_mismatch := 1;
                    last;
                }
                if $definedness {
                    # Have a constraint on the definedness.
                    my $defined := nqp::isnull($param_type) ?? nqp::defined($param) !! nqp::isconcrete($param);
                    if (!$defined && $definedness == $DEFINED_ONLY) || ($defined && $definedness == $UNDEFINED_ONLY) {
                        $type_mismatch := 1;
                        last;
                    }
                }
                $i++;
            }

            if $type_mismatch {
                $cur_idx++;
                next;
            }

            # If we get here, it's an admissable candidate; add to list. */
            nqp::push(@possibles, $cur_candidate);
            $cur_idx++;
        }

        # Cache the result if there's a single chosen one and return it.
        if nqp::elems(@possibles) == 1 {
            my $result := @possibles[0]<sub>;
            #pir::nqp_disable_sc_write_barrier__v();
            $!dispatch_cache := nqp::multicacheadd($!dispatch_cache, $capture, $result);
            #pir::nqp_enable_sc_write_barrier__v();
            $result
        }
        elsif nqp::elems(@possibles) == 0 {
            # XXX Include possible candidate signatures.
            nqp::die("No applicable candidates found to dispatch to for '" ~ self.name ~ "'.")
        }
        else {
            # XXX Include ambiguous candidate signatures.
            nqp::die("Ambiguous dispatch to multi '" ~ self.name ~ "'.")
        }
    }
    
    method clone() {
        # Clone the underlying VM code ref.
        my $do  := nqp::clone($!do);
        
        # Clone and attach the code object.
        my $der := nqp::clone(self);
        nqp::bindattr($der, NQPRoutine, '$!do', $do);
        nqp::setcodeobj($do, $der);
        
        # If needed, arrange for a fixup of the cloned code-ref.
#        my $clone_callback := pir::getprop__PPs($!do, 'CLONE_CALLBACK');
#        if nqp::defined($clone_callback) {
#            $clone_callback($!do, $do, $der);
#        }
        
        $der
    }
    
    method !set_name($name) {
        nqp::setcodename($!do, $name);
    }
    
    method name() {
        nqp::getcodename($!do)
    }
    
    method signature() { $!signature }
}
nqp::setinvokespec(NQPRoutine, NQPRoutine, '$!do', nqp::null);
nqp::setboolspec(NQPRoutine, 5, nqp::null());
#pir::stable_publish_vtable_handler_mapping__vPP(NQPRoutine,
#    nqp::hash('get_string', nqp::list(NQPRoutine, '$!do')));

my knowhow NQPSignature {
    has $!types;
    has $!definednesses;
    method types() { $!types }
    method definednesses() { $!definednesses }
}

my knowhow NQPRegex {
    has $!do;
    has $!caps;
    has $!nfa;
    has %!alt_nfas;
    has $!generic_nfa;
    has @!nested_codes;
    method SET_CAPS($caps) {
        $!caps := $caps;
    }
    method SET_NFA($nfa) {
        $!nfa := $nfa;
    }
    method SET_ALT_NFA($name, $nfa) {
        nqp::ifnull(%!alt_nfas, %!alt_nfas := {});
        %!alt_nfas{$name} := $nfa;
    }
    method SET_GENERIC_NFA($nfa) {
        $!generic_nfa := $nfa.save();
    }
    method ADD_NESTED_CODE($code) {
        nqp::ifnull(@!nested_codes, @!nested_codes := nqp::list());
        nqp::push(@!nested_codes, $code);
    }
    method CAPS() {
        $!caps
    }
    method NFA() {
        $!nfa
    }
    method ALT_NFAS() {
        nqp::isnull(%!alt_nfas) ?? nqp::hash() !! %!alt_nfas
    }
    method ALT_NFA(str $name) {
        nqp::isnull(%!alt_nfas) ?? nqp::null() !! %!alt_nfas{$name}
    }
    method NESTED_CODES() {
        nqp::isnull(@!nested_codes) ?? nqp::list() !! @!nested_codes
    }
    method clone() {
        # Clone the underlying VM code ref.
        my $do  := nqp::clone($!do);
        
        # Clone and attach the code object.
        my $der := nqp::clone(self);
        nqp::bindattr($der, NQPRegex, '$!do', $do);
        nqp::setcodeobj($do, $der);
        
        # If needed, arrange for a fixup of the cloned code-ref.
#        my $clone_callback := pir::getprop__PPs($!do, 'CLONE_CALLBACK');
#        if nqp::defined($clone_callback) {
#            $clone_callback($!do, $do, $der);
#        }
        
        $der
    }
    my $nfa_type;
    method SET_NFA_TYPE($type) {
        $nfa_type := $type;
    }
    method instantiate_generic($env) {
        if nqp::isnull($!generic_nfa) {
            self
        }
        else {
            my $ins := self.clone();
            nqp::bindattr($ins, NQPRegex, '$!nfa',
                $nfa_type.from_saved($!generic_nfa).instantiate_generic($env).save());
            nqp::bindattr($ins, NQPRegex, '$!generic_nfa', nqp::null());
            $ins
        }
    }
    method name() {
        nqp::getcodename($!do)
    }
    method !set_name($name) {
        nqp::setcodename($!do, $name);
    }
}
nqp::setinvokespec(NQPRegex, NQPRegex, '$!do', nqp::null);
nqp::setboolspec(NQPRegex, 5, nqp::null());
#pir::stable_publish_vtable_handler_mapping__vPP(NQPRegex,
#    nqp::hash('get_string', nqp::list(NQPRegex, '$!do')));

# From src\core\NQPMu.pm

my class NQPMu {
    method CREATE() {
        nqp::create(self)
    }

    method bless(NQPMu:U $self: *%attributes) {
        my $instance := self.CREATE();
        $instance.BUILDALL(|%attributes);
        $instance
    }
    
    method BUILDALL(NQPMu:D $self: *%attrinit) {
        # Get the build plan.
        my $build_plan := self.HOW.BUILDALLPLAN(self);
        my $count      := nqp::elems($build_plan);
        my $i          := 0;
        while $i < $count {
            my $task := nqp::atpos($build_plan, $i);
            my $code := nqp::atpos($task, 0);
            $i := $i + 1;
            if nqp::iseq_i($code, 0) {
                # Custom BUILD call.
                nqp::atpos($task, 1)(self, |%attrinit);
            }
            elsif nqp::iseq_i($code, 1) {
                # See if we have a value to initialize this attr with.
                my $key_name := nqp::atpos($task, 2);
                if nqp::existskey(%attrinit, $key_name) {
                    nqp::bindattr(self, nqp::atpos($task, 1), nqp::atpos($task, 3), %attrinit{$key_name});
                }
            }
            elsif nqp::iseq_i($code, 2) {
                # See if we have a value to initialize this attr with;
                # if not, set it to an empty array.
                my $key_name := nqp::atpos($task, 2);
                if nqp::existskey(%attrinit, $key_name) {
                    nqp::bindattr(self, nqp::atpos($task, 1), nqp::atpos($task, 3), %attrinit{$key_name});
                }
                else {
                    nqp::bindattr(self, nqp::atpos($task, 1), nqp::atpos($task, 3), nqp::list());
                }
            }
            elsif nqp::iseq_i($code, 3) {
                # See if we have a value to initialize this attr with;
                # if not, set it to an empty array.
                my $key_name := nqp::atpos($task, 2);
                if nqp::existskey(%attrinit, $key_name) {
                    nqp::bindattr(self, nqp::atpos($task, 1), nqp::atpos($task, 3), %attrinit{$key_name});
                }
                else {
                    nqp::bindattr(self, nqp::atpos($task, 1), nqp::atpos($task, 3), nqp::hash());
                }
            }
            elsif nqp::iseq_i($code, 4) {
                unless nqp::attrinited(self, nqp::atpos($task, 1), nqp::atpos($task, 2)) {
                    nqp::bindattr(self, nqp::atpos($task, 1), nqp::atpos($task, 2),
                        nqp::atpos($task, 3)(self,
                            nqp::getattr(self, nqp::atpos($task, 1), nqp::atpos($task, 2))));
                }
            }
            else {
                nqp::die("Invalid BUILDALLPLAN");
            }
        }
        self
    }

    method new(*%attributes) {
        self.bless(|%attributes);
    }
}

sub print(*@args) {
    for @args {
        nqp::print($_);
    }
    1;
}

sub say(*@args) {
    print(|@args, "\n");
}

sub join($delim, @things) {
    my @strs;
    for @things { nqp::push(@strs, ~$_) }
    nqp::join($delim, @strs)
}

# vim: ft=perl6
# From src\core\Hash.pm

sub hash(*%new) {
    %new
}
# From src\core\testing.pm

my $test_counter       := 0;
my $todo_upto_test_num := 0;
my $todo_reason        := '';

sub plan($quantity) {
    say("1..$quantity");
}

sub ok($condition, $desc?) {
    $test_counter := $test_counter + 1;

    unless $condition {
        print("not ");
    }
    print("ok $test_counter");
    if $desc {
        print(" - $desc");
    }
    if $test_counter <= $todo_upto_test_num {
        print($todo_reason);
    }
    print("\n");
    
    $condition ?? 1 !! 0
}

sub todo($reason, $count) {
    $todo_upto_test_num := $test_counter + $count;
    $todo_reason        := "# TODO $reason";
}

sub skip($desc) {
    $test_counter := $test_counter + 1;
    say("ok $test_counter # SKIP $desc\n");
}

# vim: ft=perl6
# From src\core\YOUAREHERE.pm


1;
{YOU_ARE_HERE}

# vim: set ft=perl6 nomodifiable :