Add Tree-sitter Query language (#7243)

* added tree sitter query heuristics
vendored vscode-tree-sitter-query

* added samples

* added test_heuristics case for scm

* updated license

* partial cleanup of heuristic regex queries

* removed '\w heuristic match from scheme

* added vscode-tree-sitter-query license

* added r6rs grammar

* tightened heuristics

* rename scheme namespace -

* added basic definitions

* updated with r7rs repo implementation exmaples

* removed r6rs sample

* added aliases

* removed redundant alias

* Update test_language.rb

remove unneeded assertion

.gitmodules

@@ -1425,6 +1425,9 @@
 [submodule "vendor/grammars/vscode-slice"]
 	path = vendor/grammars/vscode-slice
 	url = https://github.com/zeroc-ice/vscode-slice
+[submodule "vendor/grammars/vscode-tree-sitter-query"]
+	path = vendor/grammars/vscode-tree-sitter-query
+	url = https://github.com/jrieken/vscode-tree-sitter-query.git
 [submodule "vendor/grammars/vscode-vba"]
 	path = vendor/grammars/vscode-vba
 	url = https://github.com/serkonda7/vscode-vba.git

grammars.yml

@@ -1275,6 +1275,8 @@ vendor/grammars/vscode-singularity:
 vendor/grammars/vscode-slice:
 - source.ice
 - source.slice
+vendor/grammars/vscode-tree-sitter-query:
+- source.scm
 vendor/grammars/vscode-vba:
 - source.vba
 - source.wwb

lib/linguist/heuristics.yml

@@ -728,6 +728,23 @@ disambiguations:
   - language: Markdown
     # Markdown syntax for scdoc
     pattern: '^#+\s+(NAME|SYNOPSIS|DESCRIPTION)'
+- extensions: ['.scm']
+  rules:
+  - language: Scheme
+    pattern:
+    - '(?:''[\(\*#]|\w->\w|\.\.\.[\s\)]|\([+\-:<>\/=~\)]|~>|[#`]\(|#:\w)'
+    - '^\s*\((?:define\*?|import|library|lambda)'
+    negative_pattern:
+    - '\(#[\w-]+[!\?]'
+    - '[\)\]"_]\s*(?:[\*\+\?]|@\w)'
+  - language: Tree-sitter Query
+    pattern:
+    - '\(#[\w-]+[!\?]'
+    - '[\)\]"_]\s*(?:[\*\+\?]|@\w)'
+    - '(?:^\s*\w+:\s*[\(\[\"])'
+    - '\(#(?:set!|(?:not-)?(?:any-of|match)\?)'
+    negative_pattern:
+    - '\([+\-:<>\/=~\)]'
 - extensions: ['.sol']
   rules:
   - language: Solidity

lib/linguist/languages.yml

@@ -7580,6 +7580,16 @@ Toit:
   tm_scope: source.toit
   ace_mode: text
   language_id: 356554395
+Tree-sitter Query:
+  type: programming
+  color: "#8ea64c"
+  aliases:
+  - tsq
+  extensions:
+  - ".scm"
+  tm_scope: source.scm
+  ace_mode: text
+  language_id: 436081647
 Turing:
   type: programming
   color: "#cf142b"

samples/Scheme/common.scm

@@ -0,0 +1,88 @@
+;; Calculation of Hofstadter's male and female sequences as a list of pairs
+
+(define (hofstadter-male-female n)
+  (letrec ((female (lambda (n)
+		     (if (= n 0)
+			 1
+			 (- n (male (female (- n 1)))))))
+	   (male (lambda (n)
+		   (if (= n 0)
+		       0
+		       (- n (female (male (- n 1))))))))
+    (let loop ((i 0))
+      (if (> i n)
+	  '()
+	  (cons (cons (female i)
+		      (male i))
+		(loop (+ i 1)))))))
+
+(hofstadter-male-female 8)
+
+;; Building a list of squares from 0 to 9:
+;; Note: loop is simply an arbitrary symbol used as a label. Any symbol will do.
+
+(define (list-of-squares n)
+  (let loop ((i n) (res '()))
+    (if (< i 0)
+        res
+        (loop (- i 1) (cons (* i i) res)))))
+
+(list-of-squares 9)
+
+(let loop ((n 1))
+  (if (> n 10)
+      '()
+      (cons n
+	    (loop (+ n 1)))))
+
+(define (find-first func lst)
+  (call-with-current-continuation
+   (lambda (return-immediately)
+     (for-each (lambda (x)
+		 (if (func x)
+		     (return-immediately x)))
+	  lst)
+     #f)))
+
+(find-first integer? '(1/2 3/4 5.6 7 8/9 10 11))
+
+
+(set! +
+      (let ((original+ +))
+        (lambda args
+          (apply (if (or (null? args) (string? (car args)))
+                     string-append
+                     original+)
+                 args))))
+(+ 1 2 3)
+
+; create a hash-table, with keys :a and :b
+(define my-hash (hash-table :a 1 :b 2)
+
+(map
+  (lambda (x y) (list x y))
+  (list :a :b :c)   ; first collection
+  (list 1 2 3))     ; second collection6
+
+;; example using break and continue with random,
+;; a construct we might use in a musical algorithm
+(let ((count 0))
+  ; execute a maxium of 8 times
+  (while (< count 8)
+    (post "count:" count)
+
+    ; a 1 in 4 chance we quit after each time
+    (if (= 0 (random 4))
+      (begin (post "aborting!") (break)))
+
+    ; a 1 in 4 chance we stay on the same number
+    (if (= 0 (random 3))
+      (begin (post "continuing!") (continue)))
+
+    (set! count (+ 1 count))))
+
+; for-each will execute the functions, return #<unspecified>
+(for-each
+  (lambda (x) (post "loop pass, x is:" x))
+  (range 0 4))
+

samples/Scheme/r7rs.scm

@@ -0,0 +1,36 @@
+;string ports
+
+(define *output-strings* '())
+
+(define open-output-string
+  (let ((n 0))
+    (lambda ()
+      (let ((f (string-append *jobname* "-Z-SC-"
+                 (number->string n) ".scm")))
+        (set! n (+ n 1))
+        (if (file-exists? f)
+            ;try again
+            (open-output-string)
+            (let ((o (open-output-file f)))
+              (set! *output-strings*
+                (cons (cons o f) *output-strings*))
+              o))))))
+
+(define get-output-string
+  (lambda (o)
+    (let ((o-f (assv o *output-strings*)))
+      (let ((o (car o-f))
+            (f (cdr o-f)))
+        (close-output-port o)
+        (let ((s (call-with-input-file f
+                   (lambda (o)
+                     (let loop ((r '()))
+                       (let ((c (read-char o)))
+                         (if (eof-object? c)
+                             (list->string (reverse! r))
+                             (loop (cons c r)))))))))
+          (delete-file f)
+          s)))))
+
+
+

samples/Tree-sitter Query/basic.scm

@@ -0,0 +1,57 @@
+(assignment_expression
+  left: (member_expression
+    object: (call_expression)))
+
+(class_declaration
+  name: (identifier) @class_name
+  !type_parameters)
+
+(binary_expression
+  operator: "!="
+  right: (null))
+
+(MISSING identifier) @missing-identifier
+(MISSING ";") @missing-semicolon
+
+(assignment_expression
+  left: (identifier) @the-function-name
+  right: (function))
+
+(comment)+
+
+[
+  "break"
+  "delete"
+  "else"
+  "for"
+  "function"
+  "if"
+  "return"
+  "try"
+  "while"
+] @keyword
+
+(body
+  [
+   (identifier)
+   (function)
+   ]*
+)
+
+(class_declaration
+  (decorator)* @the-decorator
+  name: (identifier) @the-name)
+
+(call_expression
+  function: (identifier) @the-function
+  arguments: (arguments (string)? @the-string-arg))
+
+(dotted_name
+  (identifier) @prev-id
+  .
+  (identifier) @next-id)
+
+(
+  (number)
+  ("," (number))*
+)

samples/Tree-sitter Query/highlights.scm

@@ -0,0 +1,88 @@
+(string) @string
+
+(escape_sequence) @string.escape
+
+(capture
+  (identifier) @type)
+
+(anonymous_node
+  (string) @string)
+
+(predicate
+  name: (identifier) @function.call)
+
+(named_node
+  name: (identifier) @variable)
+
+(field_definition
+  name: (identifier) @property)
+
+(negated_field
+  "!" @operator
+  (identifier) @property)
+
+(comment) @comment @spell
+
+(quantifier) @operator
+
+(predicate_type) @punctuation.special
+
+"." @operator
+
+[
+  "["
+  "]"
+  "("
+  ")"
+] @punctuation.bracket
+
+":" @punctuation.delimiter
+
+[
+  "@"
+  "#"
+] @punctuation.special
+
+"_" @constant
+
+((parameters
+  (identifier) @number)
+  (#match? @number "^[-+]?[0-9]+(.[0-9]+)?$"))
+
+((program
+  .
+  (comment)*
+  .
+  (comment) @keyword.import)
+  (#lua-match? @keyword.import "^;+ *inherits *:"))
+
+((program
+  .
+  (comment)*
+  .
+  (comment) @keyword.directive)
+  (#lua-match? @keyword.directive "^;+ *extends *$"))
+
+((comment) @keyword.directive
+  (#lua-match? @keyword.directive "^;+%s*format%-ignore%s*$"))
+
+((predicate
+  name: (identifier) @_name
+  parameters:
+    (parameters
+      (string
+        "\"" @string
+        "\"" @string) @string.regexp))
+  (#any-of? @_name "match" "not-match" "vim-match" "not-vim-match" "lua-match" "not-lua-match"))
+
+((predicate
+  name: (identifier) @_name
+  parameters:
+    (parameters
+      (string
+        "\"" @string
+        "\"" @string) @string.regexp
+      .
+      (string) .))
+  (#any-of? @_name "gsub" "not-gsub"))
+