add racket support #269

LANGUAGES.md

@@ -181,6 +181,7 @@ Q# (qs)
 QCL (qcl)
 QML (qml)
 R (r)
+Racket (rkt)
 Rakefile (rake,rakefile)
 Razor (cshtml)
 ReasonML (re,rei)

SCC-OUTPUT-REPORT.html

@@ -17,7 +17,7 @@
 		<th>421</th>
 		<th>7033</th>
 		<th>1416</th>
-		<th>350282</th>
+		<th>351026</th>
 	</tr><tr>
 		<th>Java</th>
 		<th>24</th>
@@ -39,12 +39,12 @@
 	</tr><tr>
 		<th>Markdown</th>
 		<th>11</th>
-		<th>1339</th>
+		<th>1340</th>
 		<th>319</th>
 		<th>0</th>
-		<th>1020</th>
+		<th>1021</th>
 		<th>0</th>
-		<th>54211</th>
+		<th>54250</th>
 	</tr><tr>
 		<th>Python</th>
 		<th>10</th>
@@ -74,13 +74,13 @@
 		<th>3425</th>
 	</tr><tr>
 		<th>YAML</th>
-		<th>4</th>
-		<th>78</th>
-		<th>13</th>
+		<th>5</th>
+		<th>103</th>
+		<th>19</th>
 		<th>20</th>
-		<th>45</th>
+		<th>64</th>
 		<th>0</th>
-		<th>2153</th>
+		<th>2514</th>
 	</tr><tr>
 		<th>gitignore</th>
 		<th>4</th>
@@ -98,7 +98,7 @@
 		<th>85</th>
 		<th>855</th>
 		<th>95</th>
-		<th>39003</th>
+		<th>39013</th>
 	</tr><tr>
 		<th>C#</th>
 		<th>2</th>
@@ -372,21 +372,21 @@
 	</tr><tr>
 		<th>HTML</th>
 		<th>1</th>
-		<th>590</th>
+		<th>599</th>
 		<th>0</th>
 		<th>0</th>
-		<th>590</th>
+		<th>599</th>
 		<th>0</th>
-		<th>8626</th>
+		<th>8751</th>
 	</tr><tr>
 		<th>JSON</th>
 		<th>1</th>
-		<th>7404</th>
+		<th>7443</th>
 		<th>0</th>
 		<th>0</th>
-		<th>7404</th>
+		<th>7443</th>
 		<th>0</th>
-		<th>103115</th>
+		<th>103673</th>
 	</tr><tr>
 		<th>Korn Shell</th>
 		<th>1</th>
@@ -459,6 +459,15 @@
 		<th>23</th>
 		<th>5</th>
 		<th>750</th>
+	</tr><tr>
+		<th>Racket</th>
+		<th>1</th>
+		<th>107</th>
+		<th>14</th>
+		<th>2</th>
+		<th>91</th>
+		<th>33</th>
+		<th>3480</th>
 	</tr><tr>
 		<th>Rakefile</th>
 		<th>1</th>
@@ -588,12 +597,12 @@
 	</tr></tbody>
 	<tfoot><tr>
 		<th>Total</th>
-		<th>173</th>
-		<th>26450</th>
-		<th>3003</th>
-		<th>1750</th>
-		<th>21697</th>
-		<th>2365</th>
-    	<th>1800858</th>
+		<th>175</th>
+		<th>26631</th>
+		<th>3023</th>
+		<th>1752</th>
+		<th>21856</th>
+		<th>2398</th>
+    	<th>1806175</th>
 	</tr></tfoot>
 	</table></body></html>

examples/language/racket.rkt

@@ -0,0 +1,107 @@
+#lang racket/base
+
+(require racket/private/norm-arity)
+
+(provide normalize-arity normalized-arity? arity=? arity-includes?)
+
+(define (normalized-arity? a)
+  (or (null? a)
+      (arity? a)
+      (and (list? a)
+           ((length a) . >= . 2)
+           (andmap arity? a)
+           (if (ormap arity-at-least? a)
+               (non-empty-non-singleton-sorted-list-ending-with-arity? a)
+               (non-singleton-non-empty-sorted-list? a)))))
+
+(define (arity? a)
+  (or (exact-nonnegative-integer? a)
+      (and (arity-at-least? a)
+           (exact-nonnegative-integer? (arity-at-least-value a)))))
+
+;; non-empty-non-singleton-sorted-list-ending-with-arity? : xx -> boolean
+;; know that 'a' is a list of at least 2 elements
+(define (non-empty-non-singleton-sorted-list-ending-with-arity? a)
+  (let loop ([bound (car a)]
+             [lst (cdr a)])
+    (cond
+      [(null? (cdr lst))
+       (and (arity-at-least? (car lst))
+            (> (arity-at-least-value (car lst)) (+ 1 bound)))]
+      [else
+       (and (exact-nonnegative-integer? (car lst))
+            ((car lst) . > . bound)
+            (loop (car lst)
+                  (cdr lst)))])))
+
+(define (non-empty-sorted-list? a)
+  (and (pair? a)
+       (sorted-list? a)))
+
+(define (non-singleton-non-empty-sorted-list? a)
+  (and (pair? a)
+       (pair? (cdr a))
+       (sorted-list? a)))
+
+(define (sorted-list? a)
+  (or (null? a)
+      (sorted/bounded-list? (cdr a) (car a))))
+
+(define (sorted/bounded-list? a bound)
+  (or (null? a)
+      (and (number? (car a))
+           (< bound (car a))
+           (sorted/bounded-list? (cdr a) (car a)))))
+
+(define (arity-supports-number? arity n)
+  (cond
+    [(exact-nonnegative-integer? arity) (= arity n)]
+    [(arity-at-least? arity) (<= (arity-at-least-value arity) n)]
+    [(list? arity)
+     (for/or {[elem (in-list arity)]}
+       (arity-supports-number? elem n))]))
+
+(define (arity-supports-at-least? arity n)
+  (cond
+    [(exact-nonnegative-integer? arity) #f]
+    [(arity-at-least? arity) (<= (arity-at-least-value arity) n)]
+    [(list? arity)
+     (define min-at-least
+       (for/fold {[min-at-least #f]} {[elem (in-list arity)]}
+         (cond
+           [(exact-nonnegative-integer? elem) min-at-least]
+           [(arity-at-least? elem)
+            (cond
+              [(not min-at-least) (arity-at-least-value elem)]
+              [else (min min-at-least (arity-at-least-value elem))])])))
+     (cond
+       [(not min-at-least) #f]
+       [else
+        (for/and {[i (in-range n min-at-least)]}
+          (arity-supports-number? arity i))])]))
+
+(define (unchecked-arity-includes? one two)
+  (cond
+    [(exact-nonnegative-integer? two)
+     (arity-supports-number? one two)]
+    [(arity-at-least? two)
+     (arity-supports-at-least? one (arity-at-least-value two))]
+    [(list? two)
+     (for/and {[elem (in-list two)]}
+       (unchecked-arity-includes? one elem))]))
+
+(define (arity-includes? one two)
+  (unless (procedure-arity? one)
+    (raise-argument-error 'arity-includes? "procedure-arity?" 0 one two))
+  (unless (procedure-arity? two)
+    (raise-argument-error 'arity-includes? "procedure-arity?" 1 one two))
+  (unchecked-arity-includes? one two))
+
+(define (arity=? one two)
+  (unless (procedure-arity? one)
+    (raise-argument-error 'arity=? "procedure-arity?" 0 one two))
+  (unless (procedure-arity? two)
+    (raise-argument-error 'arity=? "procedure-arity?" 1 one two))
+  (and
+    (unchecked-arity-includes? one two)
+    (unchecked-arity-includes? two one)))

languages.json

@@ -5568,6 +5568,45 @@
     ],
     "nestedmultiline": true,
     "quotes": [],
+    "shebangs": []
+  },
+  "Racket": {
+    "complexitychecks": [
+      "(if",
+      "(cond",
+      "[else",
+      "(and",
+      "(or",
+      "(for",
+      "#:when",
+      "#:unless",
+      "#:break",
+      "#:final",
+      "(do",
+      "(when",
+      "(unless",
+      "(shared",
+      "(case"
+    ],
+    "extensions": [
+      "rkt"
+    ],
+    "line_comment": [
+      ";"
+    ],
+    "multi_line": [
+      [
+        "|#",
+        "#|"
+      ]
+    ],
+    "nestedmultiline": true,
+    "quotes": [
+      {
+        "end": "\"",
+        "start": "\""
+      }
+    ],
     "shebangs": [
       "racket"
     ]

processor/detector_test.go

@@ -171,7 +171,7 @@ func TestDetectSheBangLisp(t *testing.T) {
 	}
 }
 
-func TestDetectSheBangScheme(t *testing.T) {
+func TestDetectSheBangRacket(t *testing.T) {
 	ProcessConstants()
 
 	cases := []string{
@@ -182,8 +182,8 @@ func TestDetectSheBangScheme(t *testing.T) {
 	for _, c := range cases {
 		x, y := DetectSheBang(c)
 
-		if x != "Scheme" || y != nil {
-			t.Error("Expected Scheme match got", x)
+		if x != "Racket" || y != nil {
+			t.Error("Expected Racket match got", x)
 		}
 	}
 }

test-all.sh

@@ -836,7 +836,7 @@ else
 fi
 
 # Try out specific languages
-for i in 'Bosque ' 'Flow9 ' 'Bitbucket Pipeline ' 'Docker ignore ' 'Q# ' 'Futhark ' 'Alloy ' 'Wren ' 'Monkey C ' 'Alchemist ' 'Luna ' 'ignore ' 'XML Schema ' 'Web Services' 'Go ' 'Java ' 'Boo ' 'License ' 'BASH ' 'C Shell ' 'Korn Shell ' 'Makefile ' 'Shell ' 'Zsh ' 'Rakefile ' 'Gemfile ' 'Dockerfile ' 'Yarn ' 'Sieve ' 'F# ' 'Elm ' 'Terraform ' 'Clojure ' 'C# ' 'LLVM IR ' 'HAML ' 'FXML ' 'DM ' 'Nushell '
+for i in 'Bosque ' 'Flow9 ' 'Bitbucket Pipeline ' 'Docker ignore ' 'Q# ' 'Futhark ' 'Alloy ' 'Wren ' 'Monkey C ' 'Alchemist ' 'Luna ' 'ignore ' 'XML Schema ' 'Web Services' 'Go ' 'Java ' 'Boo ' 'License ' 'BASH ' 'C Shell ' 'Korn Shell ' 'Makefile ' 'Shell ' 'Zsh ' 'Rakefile ' 'Gemfile ' 'Dockerfile ' 'Yarn ' 'Sieve ' 'F# ' 'Elm ' 'Terraform ' 'Clojure ' 'C# ' 'LLVM IR ' 'HAML ' 'FXML ' 'DM ' 'Nushell ' 'Racket '
 do
     if ./scc "examples/language/" | grep -q "$i "; then
         echo -e "${GREEN}PASSED $i Language Check"