Merge pull request #2441 from pchaigno/associate-heuristic-with-extension

Associate heuristic rules with file extensions

lib/linguist/heuristics.rb

@@ -13,11 +13,14 @@ module Linguist
     #   ])
     #
     # Returns an Array of languages, or empty if none matched or were inconclusive.
-    def self.call(blob, languages)
+    def self.call(blob, candidates)
       data = blob.data
 
       @heuristics.each do |heuristic|
-        return Array(heuristic.call(data)) if heuristic.matches?(languages)
+        if heuristic.matches?(blob.name)
+          languages = Array(heuristic.call(data))
+          return languages if languages.any? || languages.all? { |l| candidates.include?(l) }
+        end
       end
 
       [] # No heuristics matched
@@ -38,22 +41,22 @@ module Linguist
     #       end
     #     end
     #
-    def self.disambiguate(*languages, &heuristic)
+    def self.disambiguate(*extensions, &heuristic)
-      @heuristics << new(languages, &heuristic)
+      @heuristics << new(extensions, &heuristic)
     end
 
     # Internal: Array of defined heuristics
     @heuristics = []
 
     # Internal
-    def initialize(languages, &heuristic)
+    def initialize(extensions, &heuristic)
-      @languages = languages
+      @extensions = extensions
       @heuristic = heuristic
     end
 
     # Internal: Check if this heuristic matches the candidate languages.
-    def matches?(candidates)
+    def matches?(filename)
-      candidates.any? && candidates.all? { |l| @languages.include?(l.name) }
+      @extensions.any? { |ext| filename.end_with?(ext) }
     end
 
     # Internal: Perform the heuristic
@@ -64,7 +67,7 @@ module Linguist
     # Common heuristics
     ObjectiveCRegex = /^[ \t]*@(interface|class|protocol|property|end|synchronised|selector|implementation)\b/
 
-    disambiguate "BitBake", "BlitzBasic" do |data|
+    disambiguate ".bb" do |data|
       if /^\s*; /.match(data) || data.include?("End Function")
         Language["BlitzBasic"]
       elsif /^\s*(# |include|require)\b/.match(data)
@@ -72,7 +75,7 @@ module Linguist
       end
     end
 
-    disambiguate "C#", "Smalltalk" do |data|
+    disambiguate ".cs" do |data|
       if /![\w\s]+methodsFor: /.match(data)
         Language["Smalltalk"]
       elsif /^\s*namespace\s*[\w\.]+\s*{/.match(data) || /^\s*\/\//.match(data)
@@ -80,7 +83,7 @@ module Linguist
       end
     end
 
-    disambiguate "Objective-C", "C++", "C" do |data|
+    disambiguate ".h" do |data|
       if ObjectiveCRegex.match(data)
         Language["Objective-C"]
       elsif (/^\s*#\s*include <(cstdint|string|vector|map|list|array|bitset|queue|stack|forward_list|unordered_map|unordered_set|(i|o|io)stream)>/.match(data) ||
@@ -89,17 +92,25 @@ module Linguist
       end
     end
 
-    disambiguate "Perl", "Perl6", "Prolog" do |data|
+    disambiguate ".pl" do |data|
-      if data.include?("use v6")
+      if /^(use v6|(my )?class|module)/.match(data)
         Language["Perl6"]
-      elsif data.match(/use strict|use\s+v?5\./)
+      elsif /use strict|use\s+v?5\./.match(data)
         Language["Perl"]
       elsif /^[^#]+:-/.match(data)
         Language["Prolog"]
       end
     end
 
-    disambiguate "ECL", "Prolog" do |data|
+    disambiguate ".pm" do |data|
+      if /^(use v6|(my )?class|module)/.match(data)
+        Language["Perl6"]
+      elsif /use strict|use\s+v?5\./.match(data)
+        Language["Perl"]
+      end
+    end
+
+    disambiguate ".ecl" do |data|
       if /^[^#]+:-/.match(data)
         Language["Prolog"]
       elsif data.include?(":=")
@@ -107,7 +118,7 @@ module Linguist
       end
     end
 
-    disambiguate "IDL", "Prolog", "INI", "QMake" do |data|
+    disambiguate ".pro" do |data|
       if /^[^#]+:-/.match(data)
         Language["Prolog"]
       elsif data.include?("last_client=")
@@ -119,7 +130,7 @@ module Linguist
       end
     end
 
-    disambiguate "GAP", "Scilab" do |data|
+    disambiguate ".tst" do |data|
       if (data.include?("gap> "))
         Language["GAP"]
       # Heads up - we don't usually write heuristics like this (with no regex match)
@@ -128,7 +139,7 @@ module Linguist
       end
     end
 
-    disambiguate "Common Lisp", "OpenCL", "Cool" do |data|
+    disambiguate ".cl" do |data|
       if /^\s*\((defun|in-package|defpackage) /i.match(data)
         Language["Common Lisp"]
       elsif /^class/x.match(data)
@@ -138,7 +149,7 @@ module Linguist
       end
     end
 
-    disambiguate "Hack", "PHP" do |data|
+    disambiguate ".php" do |data|
       if data.include?("<?hh")
         Language["Hack"]
       elsif /<?[^h]/.match(data)
@@ -146,7 +157,7 @@ module Linguist
       end
     end
 
-    disambiguate "Scala", "SuperCollider" do |data|
+    disambiguate ".sc" do |data|
       if /\^(this|super)\./.match(data) || /^\s*(\+|\*)\s*\w+\s*{/.match(data) || /^\s*~\w+\s*=\./.match(data)
         Language["SuperCollider"]
       elsif /^\s*import (scala|java)\./.match(data) || /^\s*val\s+\w+\s*=/.match(data) || /^\s*class\b/.match(data)
@@ -154,7 +165,7 @@ module Linguist
       end
     end
 
-    disambiguate "AsciiDoc", "AGS Script", "Public Key" do |data|
+    disambiguate ".asc" do |data|
       if /^(----[- ]BEGIN|ssh-(rsa|dss)) /.match(data)
         Language["Public Key"]
       elsif /^[=-]+(\s|\n)|{{[A-Za-z]/.match(data)
@@ -164,7 +175,7 @@ module Linguist
       end
     end
 
-    disambiguate "FORTRAN", "Forth", "Formatted" do |data|
+    disambiguate ".for", ".f" do |data|
       if /^: /.match(data)
         Language["Forth"]
       elsif /^([c*][^a-z]|      (subroutine|program)\s|\s*!)/i.match(data)
@@ -172,7 +183,7 @@ module Linguist
       end
     end
 
-    disambiguate "F#", "Forth", "GLSL", "Filterscript" do |data|
+    disambiguate ".fs" do |data|
       if /^(: |new-device)/.match(data)
         Language["Forth"]
       elsif /^\s*(#light|import|let|module|namespace|open|type)/.match(data)
@@ -184,7 +195,7 @@ module Linguist
       end
     end
 
-    disambiguate "Limbo", "M", "MUF", "Mathematica", "Matlab", "Mercury", "Objective-C" do |data|
+    disambiguate ".m" do |data|
       if ObjectiveCRegex.match(data)
         Language["Objective-C"]
       elsif data.include?(":- module")
@@ -202,11 +213,11 @@ module Linguist
       end
     end
 
-    disambiguate "Gosu", "JavaScript" do |data|
+    disambiguate ".gs" do |data|
       Language["Gosu"] if /^uses java\./.match(data)
     end
 
-    disambiguate "LoomScript", "LiveScript" do |data|
+    disambiguate ".ls" do |data|
       if /^\s*package\s*[\w\.\/\*\s]*\s*{/.match(data)
         Language["LoomScript"]
       else
@@ -214,7 +225,7 @@ module Linguist
       end
     end
 
-    disambiguate "Common Lisp", "NewLisp" do |data|
+    disambiguate ".lsp", ".lisp" do |data|
       if /^\s*\((defun|in-package|defpackage) /i.match(data)
         Language["Common Lisp"]
       elsif /^\s*\(define /.match(data)
@@ -222,7 +233,7 @@ module Linguist
       end
     end
 
-    disambiguate "TypeScript", "XML" do |data|
+    disambiguate ".ts" do |data|
       if data.include?("<TS ")
         Language["XML"]
       else
@@ -230,7 +241,7 @@ module Linguist
       end
     end
 
-    disambiguate "Frege", "Forth", "Text" do |data|
+    disambiguate ".fr" do |data|
       if /^(: |also |new-device|previous )/.match(data)
         Language["Forth"]
       elsif /^\s*(import|module|package|data|type) /.match(data)
@@ -240,7 +251,7 @@ module Linguist
       end
     end
 
-    disambiguate "PLSQL", "SQLPL", "PLpgSQL", "SQL" do |data|
+    disambiguate ".sql" do |data|
       if /^\\i\b|AS \$\$|LANGUAGE '+plpgsql'+/i.match(data) || /SECURITY (DEFINER|INVOKER)/i.match(data) || /BEGIN( WORK| TRANSACTION)?;/i.match(data)
         #Postgres
         Language["PLpgSQL"]
@@ -256,7 +267,7 @@ module Linguist
       end
     end
 
-    disambiguate "D", "DTrace", "Makefile" do |data|
+    disambiguate ".d" do |data|
       if /^module /.match(data)
         Language["D"]
       elsif /^((dtrace:::)?BEGIN|provider |#pragma (D (option|attributes)|ident)\s)/.match(data)
@@ -266,7 +277,7 @@ module Linguist
       end
     end
 
-    disambiguate "OCaml", "Standard ML" do |data|
+    disambiguate ".ml" do |data|
       if /(^\s*module)|let rec |match\s+(\S+\s)+with/.match(data)
         Language["OCaml"]
       elsif /=> |case\s+(\S+\s)+of/.match(data)
@@ -274,7 +285,7 @@ module Linguist
       end
     end
 
-    disambiguate "XML", "Modula-2", "Linux Kernel Module", "AMPL" do |data|
+    disambiguate ".mod" do |data|
       if data.include?('<!ENTITY ')
         Language["XML"]
       elsif /MODULE\s\w+\s*;/i.match(data) || /^\s*END \w+;$/i.match(data)
@@ -284,13 +295,13 @@ module Linguist
       end
     end
 
-    disambiguate "Text", "NCL" do |data|
+    disambiguate ".ncl" do |data|
       if data.include?("THE_TITLE")
         Language["Text"]
       end
     end
 
-    disambiguate "NL", "NewLisp" do |data|
+    disambiguate ".nl" do |data|
       if /^(b|g)[0-9]+ /.match(data)
         Language["NL"]
       else
@@ -298,7 +309,7 @@ module Linguist
       end
     end
 
-    disambiguate "Rust", "RenderScript" do |data|
+    disambiguate ".rs" do |data|
       if /^(use |fn |mod |pub |macro_rules|impl|#!?\[)/.match(data)
         Language["Rust"]
       elsif /#include|#pragma\s+(rs|version)|__attribute__/.match(data)
@@ -306,7 +317,7 @@ module Linguist
       end
     end
 
-    disambiguate "Common Lisp", "Lex", "Groff", "PicoLisp" do |data|
+    disambiguate ".l" do |data|
       if /\(def(un|macro)\s/.match(data)
         Language["Common Lisp"]
       elsif /^(%[%{}]xs|<.*>)/.match(data)

samples/Perl6/List.pm

@@ -0,0 +1,699 @@
+# for our tantrums
+my class X::TypeCheck { ... }
+my role Supply { ... }
+
+my sub combinations($n, $k) {
+    my @result;
+    my @stack;
+
+    return ([],) unless $k;
+
+    @stack.push(0);
+    gather while @stack {
+        my $index = @stack - 1;
+        my $value = @stack.pop;
+
+        while $value < $n {
+            @result[$index++] = $value++;
+            @stack.push($value);
+            if $index == $k {
+                take [@result];
+                $value = $n;  # fake a last
+            }
+        }
+    }
+}
+
+my sub permutations(Int $n) {
+    $n == 1 ?? ( [0,] ) !!
+    gather for ^$n -> $i {
+        my @i = grep none($i), ^$n;
+        take [$i, @i[@$_]] for permutations($n - 1);
+    }
+}
+
+my class List does Positional { # declared in BOOTSTRAP
+    # class List is Iterable is Cool
+    #   has Mu $!items;        # VM's array of our reified elements
+    #   has Mu $!flattens;     # true if this list flattens its parcels
+    #   has Mu $!nextiter;     # iterator for generating remaining elements
+
+    method new(|) {
+        my Mu $args := nqp::p6argvmarray();
+        nqp::shift($args);
+
+        nqp::p6list($args, self.WHAT, Mu);
+    }
+
+    multi method Bool(List:D:)    { self.gimme(1).Bool }
+    multi method Int(List:D:)     { self.elems }
+    multi method end(List:D:)     { self.elems - 1 }
+    multi method Numeric(List:D:) { self.elems }
+    multi method Str(List:D:)     { self.join(' ') }
+
+    # Pretend we're a Match assuming we're a list of Matches
+    method to()         { self.elems ?? self[self.end].to !! Nil }
+    method from()       { self.elems ?? self[0].from !! Nil }
+
+    method fmt($format = '%s', $separator = ' ') {
+        self.map({ .fmt($format) }).join($separator);
+    }
+
+    method flat() { self.flattens
+                    ?? self
+                    !! nqp::p6list(nqp::list(self), List, Bool::True)
+    }
+    method list() { self }
+    method lol() {
+        self.gimme(0);
+        my Mu $rpa := nqp::clone($!items);
+        nqp::push($rpa, $!nextiter) if $!nextiter.defined;
+        nqp::p6list($rpa, LoL, Mu);
+    }
+
+    method flattens() { $!flattens }
+
+    method Capture() {
+        self.gimme(*);
+        my $cap := nqp::create(Capture);
+        nqp::bindattr($cap, Capture, '$!list', $!items);
+        $cap
+    }
+
+    method Parcel() {
+        my Mu $rpa := nqp::clone(nqp::p6listitems(self));
+        nqp::push($rpa, $!nextiter) if $!nextiter.defined;
+        nqp::p6parcel($rpa, Any);
+    }
+
+    method Supply(List:D:) { Supply.from-list(self) }
+
+    multi method at_pos(List:D: int \pos) is rw {
+        fail X::OutOfRange.new(:what<Index>,:got(pos),:range<0..Inf>)
+          if nqp::islt_i(pos,0);
+        self.exists_pos(pos) ?? nqp::atpos($!items,pos) !! Nil;
+    }
+    multi method at_pos(List:D: Int:D \pos) is rw {
+        my int $pos = nqp::unbox_i(pos);
+        fail X::OutOfRange.new(:what<Index>,:got(pos),:range<0..Inf>)
+          if nqp::islt_i($pos,0);
+        self.exists_pos($pos) ?? nqp::atpos($!items,$pos) !! Nil;
+    }
+
+    method eager() { self.gimme(*); self }
+
+    method elems() {
+        return 0 unless self.DEFINITE;
+        return nqp::elems(nqp::p6listitems(self)) unless nqp::defined($!nextiter);
+        # Get as many elements as we can.  If gimme stops before
+        # reaching the end of the list, assume the list is infinite.
+        my $n := self.gimme(*);
+        nqp::defined($!nextiter) ?? Inf !! $n
+    }
+
+    multi method exists_pos(List:D: int $pos) {
+        return False if nqp::islt_i($pos,0);
+        self.gimme($pos + 1);
+        nqp::p6bool(
+          nqp::not_i(nqp::isnull(nqp::atpos($!items,$pos)))
+        );
+    }
+    multi method exists_pos(List:D: Int:D $pos) {
+        return False if $pos < 0;
+        self.gimme($pos + 1);
+        nqp::p6bool(
+          nqp::not_i(nqp::isnull(nqp::atpos($!items,nqp::unbox_i($pos))))
+        );
+    }
+
+    method gimme($n, :$sink) {
+        return unless self.DEFINITE;
+        # loop through iterators until we have at least $n elements
+        my int $count = nqp::elems(nqp::p6listitems(self));
+        if nqp::istype($n, Whatever) || nqp::istype($n, Num) && nqp::istrue($n == Inf) {
+            while $!nextiter.DEFINITE && !$!nextiter.infinite {
+                $!nextiter.reify(*, :$sink);
+                $count = nqp::elems($!items);
+            }
+        }
+        else {
+            my int $target = $n.Int;
+            while nqp::isconcrete($!nextiter) && $count < $target {
+                $!nextiter.reify($target - $count, :$sink);
+                $count = nqp::elems($!items);
+            }
+        }
+
+        # return the number of elements we have now
+        $count
+    }
+
+    multi method infinite(List:D:) { $!nextiter.infinite }
+
+    method iterator() {
+        # Return a reified ListIter containing our currently reified elements
+        # and any subsequent iterator.
+        my $iter := nqp::create(ListIter);
+        nqp::bindattr($iter, ListIter, '$!nextiter', $!nextiter);
+        nqp::bindattr($iter, ListIter, '$!reified', self.Parcel());
+        $iter;
+    }
+
+    method munch($n is copy) {
+        $n = 0 if $n < 0;
+        $n = self.gimme($n) if nqp::not_i(nqp::istype($n, Int))
+                               || nqp::not_i(nqp::islist($!items))
+                               || nqp::islt_i(nqp::elems($!items), nqp::unbox_i($n));
+        nqp::p6parcel(
+            nqp::p6shiftpush(nqp::list(), $!items, nqp::unbox_i($n)),
+            Any
+        )
+    }
+
+    proto method pick(|) { * }
+    multi method pick() {
+        fail "Cannot .pick from infinite list" if self.infinite;
+        my $elems = self.elems;
+        $elems ?? self.at_pos($elems.rand.floor) !! Nil;
+    }
+    multi method pick($n is copy) {
+        fail "Cannot .pick from infinite list" if self.infinite;
+        ## We use a version of Fisher-Yates shuffle here to
+        ## replace picked elements with elements from the end
+        ## of the list, resulting in an O(n) algorithm.
+        my $elems = self.elems;
+        return unless $elems;
+        $n = Inf if nqp::istype($n, Whatever);
+        $n = $elems if $n > $elems;
+        return self.at_pos($elems.rand.floor) if $n == 1;
+        my Mu $rpa := nqp::clone($!items);
+        my $i;
+        my Mu $v;
+        gather while $n > 0 {
+            $i = nqp::rand_I(nqp::decont($elems), Int);
+            $elems--; $n--;
+            $v := nqp::atpos($rpa, nqp::unbox_i($i));
+            # replace selected element with last unpicked one
+            nqp::bindpos($rpa, nqp::unbox_i($i),
+                         nqp::atpos($rpa, nqp::unbox_i($elems)));
+            take-rw $v;
+        }
+    }
+
+    method pop() is parcel {
+        my $elems = self.gimme(*);
+        fail 'Cannot .pop from an infinite list' if $!nextiter.defined;
+        $elems > 0
+          ?? nqp::pop($!items)
+          !! fail 'Element popped from empty list';
+    }
+
+    method shift() is parcel {
+        # make sure we have at least one item, then shift+return it
+        nqp::islist($!items) && nqp::existspos($!items, 0) || self.gimme(1)
+          ?? nqp::shift($!items)
+          !! fail 'Element shifted from empty list';
+    }
+
+    my &list_push = multi method push(List:D: *@values) {
+        fail 'Cannot .push an infinite list' if @values.infinite;
+        nqp::p6listitems(self);
+        my $elems = self.gimme(*);
+        fail 'Cannot .push to an infinite list' if $!nextiter.DEFINITE;
+
+        # push is always eager
+        @values.gimme(*);
+
+        # need type checks?
+        my $of := self.of;
+
+        unless $of =:= Mu {
+            X::TypeCheck.new(
+              operation => '.push',
+              expected  => $of,
+              got       => $_,
+            ).throw unless nqp::istype($_, $of) for @values;
+        }
+
+        nqp::splice($!items,
+                nqp::getattr(@values, List, '$!items'),
+                $elems, 0);
+
+        self;
+    }
+
+    multi method push(List:D: \value) {
+        if nqp::iscont(value) || nqp::not_i(nqp::istype(value, Iterable)) && nqp::not_i(nqp::istype(value, Parcel)) {
+            $!nextiter.DEFINITE && self.gimme(*);
+            fail 'Cannot .push to an infinite list' if $!nextiter.DEFINITE;
+            nqp::p6listitems(self);
+            nqp::istype(value, self.of)
+                ?? nqp::push($!items, nqp::assign(nqp::p6scalarfromdesc(nqp::null), value))
+                !! X::TypeCheck.new(
+                      operation => '.push',
+                      expected  => self.of,
+                      got       => value,
+                    ).throw;
+            self
+        }
+        else {
+            list_push(self, value)
+        }
+    }
+
+    multi method unshift(List:D: \value) {
+        if nqp::iscont(value) || !(nqp::istype(value, Iterable) || nqp::istype(value, Parcel)) {
+            nqp::p6listitems(self);
+            value.gimme(*) if nqp::istype(value, List); # fixes #121994
+            nqp::istype(value, self.of)
+                ?? nqp::unshift($!items, my $ = value)
+                !! X::TypeCheck.new(
+                      operation => '.push',
+                      expected  => self.of,
+                      got       => value,
+                    ).throw;
+            self
+        }
+        else {
+            callsame();
+        }
+    }
+
+    multi method unshift(List:D: *@values) {
+        fail 'Cannot .unshift an infinite list' if @values.infinite;
+        nqp::p6listitems(self);
+
+        # don't bother with type checks
+        my $of := self.of;
+        if ( $of =:= Mu ) {
+            nqp::unshift($!items, @values.pop) while @values;
+        }
+
+        # we must check types
+        else {
+            while @values {
+                my $value := @values.pop;
+                if nqp::istype($value, $of) {
+                    nqp::unshift($!items, $value);
+                }
+
+                # huh?
+                else {
+                    X::TypeCheck.new(
+                      operation => '.unshift',
+                      expected  => $of,
+                      got       => $value,
+                    ).throw;
+                }
+            }
+        }
+
+        self
+    }
+
+    method plan(List:D: |args) {
+        nqp::p6listitems(self);
+        my $elems = self.gimme(*);
+        fail 'Cannot add plan to an infinite list' if $!nextiter.defined;
+
+#        # need type checks?
+#        my $of := self.of;
+#
+#        unless $of =:= Mu {
+#            X::TypeCheck.new(
+#              operation => '.push',
+#              expected  => $of,
+#              got       => $_,
+#            ).throw unless nqp::istype($_, $of) for @values;
+#        }
+
+        nqp::bindattr(self, List, '$!nextiter', nqp::p6listiter(nqp::list(args.list), self));
+        Nil;
+    }
+
+    proto method roll(|) { * }
+    multi method roll() {
+        fail "Cannot .roll from infinite list" if self.infinite;
+        my $elems = self.elems;
+        $elems ?? self.at_pos($elems.rand.floor) !! Nil;
+    }
+    multi method roll($n is copy) {
+        fail "Cannot .roll from infinite list" if self.infinite;
+        my $elems = self.elems;
+        return unless $elems;
+        $n = Inf if nqp::istype($n, Whatever);
+        return self.at_pos($elems.rand.floor) if $n == 1;
+
+        gather while $n > 0 {
+            take nqp::atpos($!items, nqp::unbox_i($elems.rand.floor.Int));
+            $n--;
+        }
+    }
+
+    method reverse() {
+        self.gimme(*);
+        fail 'Cannot .reverse from an infinite list' if $!nextiter.defined;
+        my Mu $rev  := nqp::list();
+        my Mu $orig := nqp::clone($!items);
+        nqp::push($rev, nqp::pop($orig)) while $orig;
+        my $rlist := nqp::create(self.WHAT);
+        nqp::bindattr($rlist, List, '$!items', $rev);
+        $rlist;
+    }
+
+    method rotate(Int $n is copy = 1) {
+        self.gimme(*);
+        fail 'Cannot .rotate an infinite list' if $!nextiter.defined;
+        my $items = nqp::p6box_i(nqp::elems($!items));
+        return self if !$items;
+
+        $n %= $items;
+        return self if $n == 0;
+
+        my Mu $res := nqp::clone($!items);
+        if $n > 0 {
+            nqp::push($res, nqp::shift($res)) while $n--;
+        }
+        elsif $n < 0 {
+            nqp::unshift($res, nqp::pop($res)) while $n++;
+        }
+        my $rlist := nqp::create(self.WHAT);
+        nqp::bindattr($rlist, List, '$!items', $res);
+        $rlist;
+    }
+
+    method splice($offset = 0, $size?, *@values) {
+        self.gimme(*);
+        my $o = $offset;
+        my $s = $size;
+        my $elems = self.elems;
+        $o = $o($elems) if nqp::istype($o, Callable);
+        X::OutOfRange.new(
+            what => 'offset argument to List.splice',
+            got  => $offset,
+            range => (0..^self.elems),
+        ).fail if $o < 0;
+        $s //= self.elems - ($o min $elems);
+        $s = $s(self.elems - $o) if nqp::istype($s, Callable);
+        X::OutOfRange.new(
+            what => 'size argument to List.splice',
+            got  => $size,
+            range => (0..^(self.elems - $o)),
+        ).fail if $s < 0;
+
+        my @ret = self[$o..($o + $s - 1)];
+        nqp::splice($!items,
+                    nqp::getattr(@values.eager, List, '$!items'),
+                    $o.Int, $s.Int);
+        @ret;
+    }
+
+    method sort($by = &infix:<cmp>) {
+        fail 'Cannot .sort an infinite list' if self.infinite; #MMD?
+
+        # Instead of sorting elements directly, we sort a Parcel of
+        # indices from 0..^$list.elems, then use that Parcel as
+        # a slice into self. This is for historical reasons: on
+        # Parrot we delegate to RPA.sort. The JVM implementation
+        # uses a Java collection sort. MoarVM has its sort algorithm
+        # implemented in NQP.
+
+        # nothing to do here
+        my $elems := self.elems;
+        return self if $elems < 2;
+
+        # Range is currently optimized for fast Parcel construction.
+        my $index := Range.new(0, $elems, :excludes-max).reify(*);
+        my Mu $index_rpa := nqp::getattr($index, Parcel, '$!storage');
+
+        # if $by.arity < 2, then we apply the block to the elements
+        # for sorting.
+        if ($by.?count // 2) < 2 {
+            my $list = self.map($by).eager;
+            nqp::p6sort($index_rpa, -> $a, $b { $list.at_pos($a) cmp $list.at_pos($b) || $a <=> $b });
+        }
+        else {
+            my $list = self.eager;
+            nqp::p6sort($index_rpa, -> $a, $b { $by($list.at_pos($a), $list.at_pos($b)) || $a <=> $b });
+        }
+        self[$index];
+    }
+
+    multi method ACCEPTS(List:D: $topic) { self }
+
+    method uniq(|c) {
+        DEPRECATED('unique', |<2014.11 2015.11>);
+        self.unique(|c);
+    }
+
+    proto method unique(|) {*}
+    multi method unique() {
+        my $seen := nqp::hash();
+        my str $target;
+        gather for @.list {
+            $target = nqp::unbox_s($_.WHICH);
+            unless nqp::existskey($seen, $target) {
+                nqp::bindkey($seen, $target, 1);
+                take $_;
+            }
+        }
+    }
+    multi method unique( :&as!, :&with! ) {
+        my @seen = "should be Mu, but doesn't work in settings :-("
+        my Mu $target;
+        gather for @.list {
+            $target = &as($_);
+            if first( { with($target,$_) }, @seen ) =:= Nil {
+                @seen.push($target);
+                take $_;
+            }
+        };
+    }
+    multi method unique( :&as! ) {
+        my $seen := nqp::hash();
+        my str $target;
+        gather for @.list {
+            $target = &as($_).WHICH;
+            unless nqp::existskey($seen, $target) {
+                nqp::bindkey($seen, $target, 1);
+                take $_;
+            }
+        }
+    }
+    multi method unique( :&with! ) {
+        nextwith() if &with === &[===]; # use optimized version
+
+        my @seen;  # should be Mu, but doesn't work in settings :-(
+        my Mu $target;
+        gather for @.list {
+            $target := $_;
+            if first( { with($target,$_) }, @seen ) =:= Nil {
+                @seen.push($target);
+                take $_;
+            }
+        }
+    }
+
+    my @secret;
+    proto method squish(|) {*}
+    multi method squish( :&as!, :&with = &[===] ) {
+        my $last = @secret;
+        my str $which;
+        gather for @.list {
+            $which = &as($_).Str;
+            unless with($which,$last) {
+                $last = $which;
+                take $_;
+            }
+        }
+    }
+    multi method squish( :&with = &[===] ) {
+        my $last = @secret;
+        gather for @.list {
+            unless with($_,$last) {
+                $last = $_;
+                take $_;
+            }
+        }
+    }
+
+    proto method rotor(|) {*}
+    multi method rotor(1, 0) { self }
+    multi method rotor($elems = 2, $overlap = 1) {
+        X::OutOfRange.new(
+            what => 'Overlap argument to List.rotor',
+            got  => $overlap,
+            range => (0 .. $elems - 1),
+        ).fail unless 0 <= $overlap < $elems;
+        X::OutOfRange.new(
+            what => 'Elements argument to List.rotor',
+            got  => $elems,
+            range => (0 .. *),
+        ).fail unless 0 <= $elems;
+
+        my $finished = 0;
+        gather while $finished + $overlap < self.gimme($finished + $elems) {
+            take item self[$finished ..^ $finished + $elems];
+            $finished += $elems - $overlap
+        }
+    }
+
+    multi method gist(List:D:) {
+        @(self).map( -> $elem {
+            given ++$ {
+                when 101 { '...' }
+                when 102 { last }
+                default  { $elem.gist }
+            }
+        } ).join: ' ';
+    }
+    multi method perl(List:D \SELF:) {
+        self.gimme(*);
+        self.Parcel.perl ~ '.list'
+          ~ (nqp::iscont(SELF) ?? '.item' !! '')
+    }
+
+    method REIFY(Parcel \parcel, Mu \nextiter) {
+        nqp::splice($!items, nqp::getattr(parcel, Parcel, '$!storage'),
+                    nqp::elems($!items), 0);
+        nqp::bindattr(self, List, '$!nextiter', nextiter);
+        parcel
+    }
+
+    method FLATTENABLE_LIST() { self.gimme(*); $!items }
+    method FLATTENABLE_HASH() { nqp::hash() }
+
+    multi method DUMP(List:D: :$indent-step = 4, :%ctx?) {
+        return DUMP(self, :$indent-step) unless %ctx;
+
+        my $flags    := ("\x221e" if self.infinite);
+        my Mu $attrs := nqp::list();
+        nqp::push($attrs, '$!flattens');
+        nqp::push($attrs,  $!flattens );
+        nqp::push($attrs, '$!items'   );
+        nqp::push($attrs,  $!items    );
+        nqp::push($attrs, '$!nextiter');
+        nqp::push($attrs,  $!nextiter );
+        self.DUMP-OBJECT-ATTRS($attrs, :$indent-step, :%ctx, :$flags);
+    }
+
+    multi method keys(List:D:) {
+        self.values.map: { (state $)++ }
+    }
+    multi method kv(List:D:) {
+        gather for self.values {
+            take (state $)++;
+            take-rw $_;
+        }
+    }
+    multi method values(List:D:) {
+        my Mu $rpa := nqp::clone(nqp::p6listitems(self));
+        nqp::push($rpa, $!nextiter) if $!nextiter.defined;
+        nqp::p6list($rpa, List, self.flattens);
+    }
+    multi method pairs(List:D:) {
+        self.values.map: {; (state $)++ => $_ }
+    }
+
+    method reduce(List: &with) {
+        fail('can only reduce with arity 2')
+            unless &with.arity <= 2 <= &with.count;
+        return unless self.DEFINITE;
+        my \vals = self.values;
+        my Mu $val = vals.shift;
+        $val = with($val, $_) for vals;
+        $val;
+    }
+
+    method sink() {
+        self.gimme(*, :sink) if self.DEFINITE && $!nextiter.DEFINITE;
+        Nil;
+    }
+
+    # this is a remnant of a previous implementation of .push(), which
+    # apparently is used by LoL.  Please remove when no longer necessary.
+    method STORE_AT_POS(Int \pos, Mu \v) is rw {
+        nqp::bindpos($!items, nqp::unbox_i(pos), v)
+    }
+
+    proto method combinations($?) {*}
+    multi method combinations( Int $of ) {
+        ([self[@$_]] for combinations(self.elems, $of).eager)
+    }
+    multi method combinations( Range $of = 0 .. * ) {
+        gather for @$of {
+            last if $_ > self.elems;
+            take self.combinations($_);
+        }
+    }
+
+    method permutations() {
+        # need block on Moar because of RT#121830
+        gather { take [self[@$_]] for permutations(self.elems).eager }
+    }
+}
+
+sub eager(|) {
+    nqp::p6parcel(nqp::p6argvmarray(), Any).eager
+}
+
+sub flat(|) {
+    nqp::p6list(nqp::p6argvmarray(), List, Bool::True)
+}
+
+sub list(|) {
+    nqp::p6list(nqp::p6argvmarray(), List, Mu)
+}
+
+proto sub infix:<xx>(|)       { * }
+multi sub infix:<xx>()        { fail "No zero-arg meaning for infix:<xx>" }
+multi sub infix:<xx>(Mu \x)   {x }
+multi sub infix:<xx>(Mu \x, $n is copy, :$thunked!) {
+    $n = nqp::p6bool(nqp::istype($n, Whatever)) ?? Inf !! $n.Int;
+    GatherIter.new({ take x.() while --$n >= 0; }, :infinite($n == Inf)).list
+}
+multi sub infix:<xx>(Mu \x, Whatever, :$thunked!) {
+    GatherIter.new({ loop { take x.() } }, :infinite(True)).flat
+}
+multi sub infix:<xx>(Mu \x, Whatever) {
+    GatherIter.new({ loop { take x } }, :infinite(True)).flat
+}
+multi sub infix:<xx>(Mu \x, $n) {
+    my int $size = $n.Int;
+
+    my Mu $rpa := nqp::list();
+    if $size > 0 {
+        nqp::setelems($rpa, $size);
+        nqp::setelems($rpa, 0);
+
+        $size = $size + 1;
+        nqp::push($rpa,x) while $size = $size - 1;
+    }
+
+    nqp::p6parcel($rpa, Any);
+}
+
+proto sub pop(@) {*}
+multi sub pop(@a) { @a.pop }
+
+proto sub shift(@) {*}
+multi sub shift(@a) { @a.shift }
+
+proto sub unshift(|) {*}
+multi sub unshift(\a, \elem) { a.unshift: elem }
+multi sub unshift(\a, *@elems) { a.unshift: @elems }
+
+proto sub push(|) {*}
+multi sub push(\a, \elem) { a.push: elem }
+multi sub push(\a, *@elems) { a.push: @elems }
+
+sub reverse(*@a)            { @a.reverse }
+sub rotate(@a, Int $n = 1)  { @a.rotate($n) }
+sub reduce (&with, *@list)  { @list.reduce(&with) }
+sub splice(@arr, $offset = 0, $size?, *@values) {
+    @arr.splice($offset, $size, @values)
+}
+
+multi sub infix:<cmp>(@a, @b) { (@a Zcmp @b).first(&prefix:<?>) || @a <=> @b }
+
+# vim: ft=perl6 expandtab sw=4

test/test_heuristics.rb

@@ -38,37 +38,39 @@ class TestHeuristcs < Minitest::Test
     # Only calling out '.h' filenames as these are the ones causing issues
     assert_heuristics({
       "Objective-C" => all_fixtures("Objective-C", "*.h"),
-      "C++" => ["C++/render_adapter.cpp", "C++/ThreadedQueue.h"],
+      "C++" => ["C++/scanner.h", "C++/qscicommand.h", "C++/v8.h", "C++/gdsdbreader.h"],
       "C" => nil
     })
   end
 
-  def test_c_by_heuristics
-    languages = [Language["C++"], Language["Objective-C"], Language["C"]]
-    results = Heuristics.call(file_blob("C/ArrowLeft.h"), languages)
-    assert_equal [], results
-  end
-
   def test_detect_still_works_if_nothing_matches
     blob = Linguist::FileBlob.new(File.join(samples_path, "Objective-C/hello.m"))
     match = Language.detect(blob)
     assert_equal Language["Objective-C"], match
   end
 
-  # Candidate languages = ["Perl", "Prolog"]
+  # Candidate languages = ["Perl", "Perl6", "Prolog"]
   def test_pl_prolog_perl_by_heuristics
     assert_heuristics({
-      "Prolog" => all_fixtures("Prolog/*.pl"),
+      "Prolog" => all_fixtures("Prolog", "*.pl"),
-      "Perl" => all_fixtures("Perl/*.pl") + ["Perl/perl-test.t"],
+      "Perl" => ["Perl/oo1.pl", "Perl/oo2.pl", "Perl/oo3.pl", "Perl/fib.pl", "Perl/use5.pl"],
-      "Perl6" => all_fixtures("Perl6/*.pl")
+      "Perl6" => all_fixtures("Perl6", "*.pl")
+    })
+  end
+
+  # Candidate languages = ["Perl", "Perl6"]
+  def test_pm_perl_by_heuristics
+    assert_heuristics({
+      "Perl" => all_fixtures("Perl", "*.pm"),
+      "Perl6" => all_fixtures("Perl6", "*.pm")
     })
   end
 
   # Candidate languages = ["ECL", "Prolog"]
   def test_ecl_prolog_by_heuristics
     assert_heuristics({
-      "ECL" => "ECL/sample.ecl",
+      "ECL" => all_fixtures("ECL", "*.ecl"),
-      "Prolog" => "Prolog/or-constraint.ecl"
+      "Prolog" => all_fixtures("Prolog", "*.ecl")
     })
   end
 
@@ -85,69 +87,69 @@ class TestHeuristcs < Minitest::Test
   # Candidate languages = ["AGS Script", "AsciiDoc", "Public Key"]
   def test_asc_by_heuristics
     assert_heuristics({
-      "AsciiDoc" => "AsciiDoc/list.asc",
+      "AsciiDoc" => all_fixtures("AsciiDoc", "*.asc"),
-      "AGS Script" => "AGS Script/GlobalScript.asc",
+      "AGS Script" => all_fixtures("AGS Script", "*.asc"),
       "Public Key" => all_fixtures("Public Key", "*.asc")
     })
   end
 
   def test_cl_by_heuristics
     assert_heuristics({
-      "Common Lisp" => all_fixtures("Common Lisp"),
+      "Common Lisp" => all_fixtures("Common Lisp", "*.cl"),
-      "OpenCL" => all_fixtures("OpenCL")
+      "OpenCL" => all_fixtures("OpenCL", "*.cl")
     })
   end
 
   def test_f_by_heuristics
     assert_heuristics({
-      "FORTRAN" => all_fixtures("FORTRAN"),
+      "FORTRAN" => all_fixtures("FORTRAN", "*.f") + all_fixtures("FORTRAN", "*.for"),
-      "Forth" => all_fixtures("Forth")
+      "Forth" => all_fixtures("Forth", "*.f") + all_fixtures("Forth", "*.for")
     })
   end
 
   # Candidate languages = ["Hack", "PHP"]
   def test_hack_by_heuristics
     assert_heuristics({
-      "Hack" => "Hack/funs.php",
+      "Hack" => all_fixtures("Hack", "*.php"),
-      "PHP" => "PHP/Model.php"
+      "PHP" => all_fixtures("PHP", "*.php")
     })
   end
 
   # Candidate languages = ["Scala", "SuperCollider"]
   def test_sc_supercollider_scala_by_heuristics
     assert_heuristics({
-      "SuperCollider" => "SuperCollider/WarpPreset.sc",
+      "SuperCollider" => all_fixtures("SuperCollider", "*.sc"),
-      "Scala" => "Scala/node11.sc"
+      "Scala" => all_fixtures("Scala", "*.sc")
     })
   end
 
   def test_fs_by_heuristics
     assert_heuristics({
-      "F#" => all_fixtures("F#"),
+      "F#" => all_fixtures("F#", "*.fs"),
-      "Forth" => all_fixtures("Forth"),
+      "Forth" => all_fixtures("Forth", "*.fs"),
-      "GLSL" => all_fixtures("GLSL")
+      "GLSL" => all_fixtures("GLSL", "*.fs")
     })
   end
 
   def test_fr_by_heuristics
     assert_heuristics({
-      "Frege" => all_fixtures("Frege"),
+      "Frege" => all_fixtures("Frege", "*.fr"),
-      "Forth" => all_fixtures("Forth"),
+      "Forth" => all_fixtures("Forth", "*.fr"),
       "Text" => all_fixtures("Text", "*.fr")
     })
   end
 
   def test_bb_by_heuristics
     assert_heuristics({
-      "BitBake" => all_fixtures("BitBake"),
+      "BitBake" => all_fixtures("BitBake", "*.bb"),
-      "BlitzBasic" => all_fixtures("BlitzBasic")
+      "BlitzBasic" => all_fixtures("BlitzBasic", "*.bb")
     })
   end
 
   def test_lsp_by_heuristics
     assert_heuristics({
-      "Common Lisp" => all_fixtures("Common Lisp"),
+      "Common Lisp" => all_fixtures("Common Lisp", "*.lsp") + all_fixtures("Common Lisp", "*.lisp"),
-      "NewLisp" => all_fixtures("NewLisp")
+      "NewLisp" => all_fixtures("NewLisp", "*.lsp") + all_fixtures("NewLisp", "*.lisp")
     })
   end
 
@@ -160,8 +162,8 @@ class TestHeuristcs < Minitest::Test
 
   def test_ls_by_heuristics
     assert_heuristics({
-      "LiveScript" => "LiveScript/hello.ls",
+      "LiveScript" => all_fixtures("LiveScript", "*.ls"),
-      "LoomScript" => "LoomScript/HelloWorld.ls"
+      "LoomScript" => all_fixtures("LoomScript", "*.ls")
     })
   end