Merge branch 'master' into associate-heuristic-with-extension

Conflicts:
	lib/linguist/heuristics.rb

.gitmodules

@@ -133,9 +133,6 @@
 [submodule "vendor/grammars/fancy-tmbundle"]
 	path = vendor/grammars/fancy-tmbundle
 	url = https://github.com/fancy-lang/fancy-tmbundle
-[submodule "vendor/grammars/fsharpbinding"]
-	path = vendor/grammars/fsharpbinding
-	url = https://github.com/fsharp/fsharpbinding
 [submodule "vendor/grammars/monkey.tmbundle"]
 	path = vendor/grammars/monkey.tmbundle
 	url = https://github.com/gingerbeardman/monkey.tmbundle
@@ -644,3 +641,9 @@
 [submodule "vendor/grammars/smali-sublime"]
 	path = vendor/grammars/smali-sublime
 	url = https://github.com/ShaneWilton/sublime-smali
+[submodule "vendor/grammars/language-jsoniq"]
+	path = vendor/grammars/language-jsoniq
+	url = http://github.com/wcandillon/language-jsoniq
+[submodule "vendor/grammars/atom-fsharp"]
+	path = vendor/grammars/atom-fsharp
+	url = https://github.com/fsprojects/atom-fsharp

grammars.yml

@@ -169,6 +169,8 @@ vendor/grammars/asp.tmbundle:
 vendor/grammars/assembly.tmbundle:
 - objdump.x86asm
 - source.x86asm
+vendor/grammars/atom-fsharp/:
+- source.fsharp
 vendor/grammars/atom-salt:
 - source.python.salt
 - source.yaml.salt
@@ -215,6 +217,7 @@ vendor/grammars/d.tmbundle:
 vendor/grammars/dart-sublime-bundle:
 - source.dart
 - source.pubspec
+- text.dart-analysis-output
 - text.dart-doccomments
 vendor/grammars/desktop.tmbundle:
 - source.desktop
@@ -247,8 +250,6 @@ vendor/grammars/fish-tmbundle:
 vendor/grammars/fortran.tmbundle:
 - source.fortran
 - source.fortran.modern
-vendor/grammars/fsharpbinding:
-- source.fsharp
 vendor/grammars/gap-tmbundle/:
 - source.gap
 vendor/grammars/gettext.tmbundle:
@@ -320,6 +321,9 @@ vendor/grammars/language-hy:
 vendor/grammars/language-javascript:
 - source.js
 - source.js.regexp
+vendor/grammars/language-jsoniq/:
+- source.jq
+- source.xq
 vendor/grammars/language-python:
 - source.python
 - source.regexp.python

lib/linguist/heuristics.rb

@@ -302,12 +302,30 @@ module Linguist
     end
 
     disambiguate ".l" do |data|
-      if data.include?("(def(un|macro)\s")
+      if /\(def(un|macro)\s/.match(data)
         Language["Common Lisp"]
       elsif /^(%[%{}]xs|<.*>)/.match(data)
         Language["Lex"]
-      elsif /^\.[a-z][a-z](\s|$)/.match(data)
+      elsif /^\.[a-z][a-z](\s|$)/i.match(data)
         Language["Groff"]
+      elsif /^\((de|class|rel|code|data|must)\s/.match(data)
+        Language["PicoLisp"]
+      end
+    end
+
+    disambiguate "Groff", "Nemerle" do |data|
+      if /^[.']/.match(data)
+        Language["Groff"]
+      elsif /^(module|namespace|using)\s/.match(data)
+        Language["Nemerle"]
+      end
+    end
+
+    disambiguate "GAS", "Groff" do |data|
+      if /^[.'][a-z][a-z](\s|$)/i.match(data)
+        Language["Groff"]
+      elsif /((^|\s)move?[. ])|\.(include|globa?l)\s/.match(data)
+        Language["GAS"]
       end
     end
   end

lib/linguist/languages.yml

@@ -1041,6 +1041,7 @@ GAS:
   group: Assembly
   extensions:
   - .s
+  - .ms
   tm_scope: source.asm.x86
   ace_mode: assembly_x86
 
@@ -1209,13 +1210,26 @@ Groff:
   extensions:
   - .man
   - '.1'
+  - .1in
+  - .1m
+  - .1x
   - '.2'
   - '.3'
+  - .3in
+  - .3m
+  - .3qt
+  - .3x
   - '.4'
   - '.5'
   - '.6'
   - '.7'
+  - '.8'
+  - '.9'
   - .l
+  - .ms
+  - .n
+  - .rno
+  - .roff
   tm_scope: text.groff
   aliases:
   - nroff
@@ -1508,11 +1522,12 @@ JSONLD:
   tm_scope: source.js
 
 JSONiq:
+  color: "#40d47e"
   type: programming
   ace_mode: jsoniq
   extensions:
   - .jq
-  tm_scope: source.xquery
+  tm_scope: source.jq
 
 Jade:
   group: HTML
@@ -2475,6 +2490,16 @@ Perl6:
   tm_scope: source.perl.6
   ace_mode: perl
 
+PicoLisp:
+  type: programming
+  extensions:
+  - .l
+  interpreters:
+  - picolisp
+  - pil
+  tm_scope: source.lisp
+  ace_mode: lisp
+
 PigLatin:
   type: programming
   color: "#fcd7de"
@@ -3554,6 +3579,7 @@ XQuery:
   - .xqm
   - .xqy
   ace_mode: xquery
+  tm_scope: source.xq
 
 XS:
   type: programming

lib/linguist/version.rb

@@ -1,3 +1,3 @@
 module Linguist
-  VERSION = "4.5.5"
+  VERSION = "4.5.6"
 end

samples/Common Lisp/array.l

@@ -0,0 +1,164 @@
+;;; -*- Mode: Lisp; Package: LISP -*-
+;;;
+;;; This file is part of xyzzy.
+;;;
+
+(provide "array")
+
+(in-package "lisp")
+
+(export '(make-vector make-array vector array-dimensions array-in-bounds-p
+	  upgraded-array-element-type adjust-array))
+
+(defun upgraded-array-element-type (type)
+  (cond ((or (eq type 't)
+	     (null type))
+	 't)
+	((member type '(character base-character standard-char
+			extended-character) :test #'eq)
+	 'character)
+	(t
+	 (setq type (car (si:canonicalize-type type)))
+	 (cond ((or (eq type 't)
+		    (null type))
+		't)
+	       ((member type '(character base-character standard-char
+			       extended-character) :test #'eq)
+		'character)
+	       (t 't)))))
+
+(defun check-array-initialize-option (ies-p ics-p displaced-to)
+  (let ((x 0))
+    (and ies-p (incf x))
+    (and ics-p (incf x))
+    (and displaced-to (incf x))
+    (when (> x 1)
+      (error ":initial-element, :initial-contents, :displaced-to"))))
+
+(defun make-vector (length &key
+			   (element-type t)
+			   (initial-element nil ies-p)
+			   (initial-contents nil ics-p)
+			   fill-pointer
+			   adjustable
+			   displaced-to
+			   (displaced-index-offset 0))
+  (setq element-type (upgraded-array-element-type element-type))
+  (check-array-initialize-option ies-p ics-p displaced-to)
+  (let ((vector (si:*make-vector length element-type initial-element adjustable
+				 fill-pointer displaced-to displaced-index-offset)))
+    (when ics-p
+      (si:*copy-into-seq vector initial-contents))
+    vector))
+
+(defun make-array (dimensions &rest rest
+			      &key
+			      (element-type t)
+			      (initial-element nil ies-p)
+			      (initial-contents nil ics-p)
+			      fill-pointer
+			      adjustable
+			      displaced-to
+			      (displaced-index-offset 0))
+  (cond ((integerp dimensions)
+	 (apply #'make-vector dimensions rest))
+	((= (length dimensions) 1)
+	 (apply #'make-vector (car dimensions) rest))
+	(t
+	 (setq element-type (upgraded-array-element-type element-type))
+	 (check-array-initialize-option ies-p ics-p displaced-to)
+	 (when fill-pointer
+	   (error ":fill-pointer"))
+	 (let ((array (si:*make-array dimensions element-type
+				      initial-element adjustable
+				      displaced-to displaced-index-offset)))
+	   (when ics-p
+	     (let ((dims (make-list (array-rank array)
+				    :initial-element 0))
+		   (stack (list initial-contents))
+		   (rank (1- (array-rank array))))
+	       (dolist (x dims)
+		 (push (elt (car stack) 0) stack))
+	       (dotimes (i (array-total-size array))
+		 (setf (row-major-aref array i) (car stack))
+		 (do ((x dims (cdr x))
+		      (j rank (1- j)))
+		     ((null x))
+		   (pop stack)
+		   (incf (car x))
+		   (when (< (car x) (array-dimension array j))
+		     (do ((r (- rank j) (1- r)))
+			 ((< r 0))
+		       (push (elt (car stack) (nth r dims)) stack))
+		     (return))
+		   (setf (car x) 0)))))
+	   array))))
+
+(defun vector (&rest list)
+  (make-vector (length list) :element-type t :initial-contents list))
+
+(defun array-dimensions (array)
+  (do ((i (1- (array-rank array)) (1- i))
+       (dims '()))
+      ((minusp i) dims)
+    (push (array-dimension array i) dims)))
+
+(defun array-in-bounds-p (array &rest subscripts)
+  (let ((r (array-rank array)))
+    (when (/= r (length subscripts))
+      (error "subscripts: ~S" subscripts))
+    (do ((i 0 (1+ i))
+	 (s subscripts (cdr s)))
+	((= i r) t)
+      (unless (<= 0 (car s) (1- (array-dimension array i)))
+	(return nil)))))
+
+(defun adjust-array (old-array
+		     dimensions
+		     &rest rest
+		     &key
+		     (element-type nil ets-p)
+		     initial-element
+		     (initial-contents nil ics-p)
+		     (fill-pointer nil fps-p)
+		     displaced-to
+		     displaced-index-offset)
+  (when (/= (length dimensions) (array-rank old-array))
+    (error "?"))
+  (unless ets-p
+    (push (array-element-type old-array) rest)
+    (push :element-type rest))
+  (when (adjustable-array-p old-array)
+    (push t rest)
+    (push :adjustable rest))
+  (cond (fps-p
+	 (unless (array-has-fill-pointer-p old-array)
+	   (error "?")))
+	(t
+	 (when (array-has-fill-pointer-p old-array)
+	   (push (fill-pointer old-array) rest)
+	   (push :fill-pointer rest))))
+  (when (eq old-array displaced-to)
+    (error "?"))
+  (let ((new-array (apply #'make-array dimensions rest)))
+    (or ics-p displaced-to
+	(copy-array-partially old-array new-array))
+    (cond ((adjustable-array-p old-array)
+	   (si:*replace-array old-array new-array)
+	   old-array)
+	  (t
+	   new-array))))
+
+(defun copy-array-partially (src dst)
+  (let* ((dims (mapcar #'min (array-dimensions src) (array-dimensions dst)))
+	 (r (array-rank src))
+	 (s (make-list r :initial-element 0)))
+    (setq r (1- r))
+    (dotimes (x (apply #'* dims))
+      (setf (apply #'aref dst s) (apply #'aref src s))
+      (do ((i r (1- i)))
+	  ((minusp i))
+	(incf (nth i s))
+	(when (< (nth i s) (nth i dims))
+	  (return))
+	(setf (nth i s) 0)))))

samples/GAS/hello.ms

@@ -0,0 +1,91 @@
+# output(): Hello, world.\n
+# mach(): all
+
+# Emit hello world while switching back and forth between arm/thumb.
+# ??? Unfinished
+
+	.macro invalid
+# This is "undefined" but it's not properly decoded yet.
+	.word 0x07ffffff
+# This is stc which isn't recognized yet.
+	stc 0,cr0,[r0]
+	.endm
+
+	.global _start
+_start:
+# Run some simple insns to confirm the engine is at least working.
+	nop
+
+# Skip over output text.
+
+	bl skip_output
+
+hello_text:
+	.asciz "Hello, world.\n"
+
+	.p2align 2
+skip_output:
+
+# Prime loop.
+
+	mov r4, r14
+
+output_next:
+
+# Switch arm->thumb to output next chacter.
+# At this point r4 must point to the next character to output.
+
+	adr r0, into_thumb + 1
+	bx r0
+
+into_thumb:
+	.thumb
+
+# Output a character.
+
+	mov r0,#3 @ writec angel call
+	mov r1,r4
+	swi 0xab @ ??? Confirm number.
+
+# Switch thumb->arm.
+
+	adr r5, back_to_arm
+	bx r5
+
+	.p2align 2
+back_to_arm:
+	.arm
+
+# Load next character, see if done.
+
+	add r4,r4,#1
+	sub r3,r3,r3
+	ldrb r5,[r4,r3]
+	teq r5,#0
+	beq done
+
+# Output a character (in arm mode).
+
+	mov r0,#3
+	mov r1,r4
+	swi #0x123456
+
+# Load next character, see if done.
+
+	add r4,r4,#1
+	sub r3,r3,r3
+	ldrb r5,[r4,r3]
+	teq r5,#0
+	bne output_next
+
+done:
+	mov r0,#0x18
+	ldr r1,exit_code
+	swi #0x123456
+
+# If that fails, try to die with an invalid insn.
+
+	invalid
+
+exit_code:
+	.word 0x20026

samples/Groff/Tcl.n

@@ -0,0 +1,275 @@
+'\"
+'\" Copyright (c) 1993 The Regents of the University of California.
+'\" Copyright (c) 1994-1996 Sun Microsystems, Inc.
+'\"
+'\" See the file "license.terms" for information on usage and redistribution
+'\" of this file, and for a DISCLAIMER OF ALL WARRANTIES.
+'\"
+.TH Tcl n "8.6" Tcl "Tcl Built-In Commands"
+.so man.macros
+.BS
+.SH NAME
+Tcl \- Tool Command Language
+.SH SYNOPSIS
+Summary of Tcl language syntax.
+.BE
+.SH DESCRIPTION
+.PP
+The following rules define the syntax and semantics of the Tcl language:
+.IP "[1] \fBCommands.\fR"
+A Tcl script is a string containing one or more commands.
+Semi-colons and newlines are command separators unless quoted as
+described below.
+Close brackets are command terminators during command substitution
+(see below) unless quoted.
+.IP "[2] \fBEvaluation.\fR"
+A command is evaluated in two steps.
+First, the Tcl interpreter breaks the command into \fIwords\fR
+and performs substitutions as described below.
+These substitutions are performed in the same way for all
+commands.
+Secondly, the first word is used to locate a command procedure to
+carry out the command, then all of the words of the command are
+passed to the command procedure.
+The command procedure is free to interpret each of its words
+in any way it likes, such as an integer, variable name, list,
+or Tcl script.
+Different commands interpret their words differently.
+.IP "[3] \fBWords.\fR"
+Words of a command are separated by white space (except for
+newlines, which are command separators).
+.IP "[4] \fBDouble quotes.\fR"
+If the first character of a word is double-quote
+.PQ \N'34'
+then the word is terminated by the next double-quote character.
+If semi-colons, close brackets, or white space characters
+(including newlines) appear between the quotes then they are treated
+as ordinary characters and included in the word.
+Command substitution, variable substitution, and backslash substitution
+are performed on the characters between the quotes as described below.
+The double-quotes are not retained as part of the word.
+.IP "[5] \fBArgument expansion.\fR"
+If a word starts with the string
+.QW {*}
+followed by a non-whitespace character, then the leading
+.QW {*}
+is removed and the rest of the word is parsed and substituted as any other
+word. After substitution, the word is parsed as a list (without command or
+variable substitutions; backslash substitutions are performed as is normal for
+a list and individual internal words may be surrounded by either braces or
+double-quote characters), and its words are added to the command being
+substituted. For instance,
+.QW "cmd a {*}{b [c]} d {*}{$e f {g h}}"
+is equivalent to
+.QW "cmd a b {[c]} d {$e} f {g h}" .
+.IP "[6] \fBBraces.\fR"
+If the first character of a word is an open brace
+.PQ {
+and rule [5] does not apply, then
+the word is terminated by the matching close brace
+.PQ } "" .
+Braces nest within the word: for each additional open
+brace there must be an additional close brace (however,
+if an open brace or close brace within the word is
+quoted with a backslash then it is not counted in locating the
+matching close brace).
+No substitutions are performed on the characters between the
+braces except for backslash-newline substitutions described
+below, nor do semi-colons, newlines, close brackets,
+or white space receive any special interpretation.
+The word will consist of exactly the characters between the
+outer braces, not including the braces themselves.
+.IP "[7] \fBCommand substitution.\fR"
+If a word contains an open bracket
+.PQ [
+then Tcl performs \fIcommand substitution\fR.
+To do this it invokes the Tcl interpreter recursively to process
+the characters following the open bracket as a Tcl script.
+The script may contain any number of commands and must be terminated
+by a close bracket
+.PQ ] "" .
+The result of the script (i.e. the result of its last command) is
+substituted into the word in place of the brackets and all of the
+characters between them.
+There may be any number of command substitutions in a single word.
+Command substitution is not performed on words enclosed in braces.
+.IP "[8] \fBVariable substitution.\fR"
+If a word contains a dollar-sign
+.PQ $
+followed by one of the forms
+described below, then Tcl performs \fIvariable
+substitution\fR:  the dollar-sign and the following characters are
+replaced in the word by the value of a variable.
+Variable substitution may take any of the following forms:
+.RS
+.TP 15
+\fB$\fIname\fR
+.
+\fIName\fR is the name of a scalar variable;  the name is a sequence
+of one or more characters that are a letter, digit, underscore,
+or namespace separators (two or more colons).
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
+.TP 15
+\fB$\fIname\fB(\fIindex\fB)\fR
+.
+\fIName\fR gives the name of an array variable and \fIindex\fR gives
+the name of an element within that array.
+\fIName\fR must contain only letters, digits, underscores, and
+namespace separators, and may be an empty string.
+Letters and digits are \fIonly\fR the standard ASCII ones (\fB0\fR\(en\fB9\fR,
+\fBA\fR\(en\fBZ\fR and \fBa\fR\(en\fBz\fR).
+Command substitutions, variable substitutions, and backslash
+substitutions are performed on the characters of \fIindex\fR.
+.TP 15
+\fB${\fIname\fB}\fR
+.
+\fIName\fR is the name of a scalar variable or array element.  It may contain
+any characters whatsoever except for close braces.  It indicates an array
+element if \fIname\fR is in the form
+.QW \fIarrayName\fB(\fIindex\fB)\fR
+where \fIarrayName\fR does not contain any open parenthesis characters,
+.QW \fB(\fR ,
+or close brace characters,
+.QW \fB}\fR ,
+and \fIindex\fR can be any sequence of characters except for close brace
+characters.  No further
+substitutions are performed during the parsing of \fIname\fR.
+.PP
+There may be any number of variable substitutions in a single word.
+Variable substitution is not performed on words enclosed in braces.
+.PP
+Note that variables may contain character sequences other than those listed
+above, but in that case other mechanisms must be used to access them (e.g.,
+via the \fBset\fR command's single-argument form).
+.RE
+.IP "[9] \fBBackslash substitution.\fR"
+If a backslash
+.PQ \e
+appears within a word then \fIbackslash substitution\fR occurs.
+In all cases but those described below the backslash is dropped and
+the following character is treated as an ordinary
+character and included in the word.
+This allows characters such as double quotes, close brackets,
+and dollar signs to be included in words without triggering
+special processing.
+The following table lists the backslash sequences that are
+handled specially, along with the value that replaces each sequence.
+.RS
+.TP 7
+\e\fBa\fR
+Audible alert (bell) (Unicode U+000007).
+.TP 7
+\e\fBb\fR
+Backspace (Unicode U+000008).
+.TP 7
+\e\fBf\fR
+Form feed (Unicode U+00000C).
+.TP 7
+\e\fBn\fR
+Newline (Unicode U+00000A).
+.TP 7
+\e\fBr\fR
+Carriage-return (Unicode U+00000D).
+.TP 7
+\e\fBt\fR
+Tab (Unicode U+000009).
+.TP 7
+\e\fBv\fR
+Vertical tab (Unicode U+00000B).
+.TP 7
+\e\fB<newline>\fIwhiteSpace\fR
+.
+A single space character replaces the backslash, newline, and all spaces
+and tabs after the newline.  This backslash sequence is unique in that it
+is replaced in a separate pre-pass before the command is actually parsed.
+This means that it will be replaced even when it occurs between braces,
+and the resulting space will be treated as a word separator if it is not
+in braces or quotes.
+.TP 7
+\e\e
+Backslash
+.PQ \e "" .
+.TP 7
+\e\fIooo\fR 
+.
+The digits \fIooo\fR (one, two, or three of them) give a eight-bit octal 
+value for the Unicode character that will be inserted, in the range
+\fI000\fR\(en\fI377\fR (i.e., the range U+000000\(enU+0000FF).
+The parser will stop just before this range overflows, or when
+the maximum of three digits is reached.  The upper bits of the Unicode
+character will be 0.
+.TP 7
+\e\fBx\fIhh\fR 
+.
+The hexadecimal digits \fIhh\fR (one or two of them) give an eight-bit
+hexadecimal value for the Unicode character that will be inserted.  The upper
+bits of the Unicode character will be 0 (i.e., the character will be in the
+range U+000000\(enU+0000FF).
+.TP 7
+\e\fBu\fIhhhh\fR 
+.
+The hexadecimal digits \fIhhhh\fR (one, two, three, or four of them) give a
+sixteen-bit hexadecimal value for the Unicode character that will be
+inserted.  The upper bits of the Unicode character will be 0 (i.e., the
+character will be in the range U+000000\(enU+00FFFF).
+.TP 7
+\e\fBU\fIhhhhhhhh\fR 
+.
+The hexadecimal digits \fIhhhhhhhh\fR (one up to eight of them) give a
+twenty-one-bit hexadecimal value for the Unicode character that will be
+inserted, in the range U+000000\(enU+10FFFF.  The parser will stop just
+before this range overflows, or when the maximum of eight digits
+is reached.  The upper bits of the Unicode character will be 0.
+.RS
+.PP
+The range U+010000\(enU+10FFFD is reserved for the future.
+.RE
+.PP
+Backslash substitution is not performed on words enclosed in braces,
+except for backslash-newline as described above.
+.RE
+.IP "[10] \fBComments.\fR"
+If a hash character
+.PQ #
+appears at a point where Tcl is
+expecting the first character of the first word of a command,
+then the hash character and the characters that follow it, up
+through the next newline, are treated as a comment and ignored.
+The comment character only has significance when it appears
+at the beginning of a command.
+.IP "[11] \fBOrder of substitution.\fR"
+Each character is processed exactly once by the Tcl interpreter
+as part of creating the words of a command.
+For example, if variable substitution occurs then no further
+substitutions are performed on the value of the variable;  the
+value is inserted into the word verbatim.
+If command substitution occurs then the nested command is
+processed entirely by the recursive call to the Tcl interpreter;
+no substitutions are performed before making the recursive
+call and no additional substitutions are performed on the result
+of the nested script.
+.RS
+.PP
+Substitutions take place from left to right, and each substitution is
+evaluated completely before attempting to evaluate the next.  Thus, a
+sequence like
+.PP
+.CS
+set y [set x 0][incr x][incr x]
+.CE
+.PP
+will always set the variable \fIy\fR to the value, \fI012\fR.
+.RE
+.IP "[12] \fBSubstitution and word boundaries.\fR"
+Substitutions do not affect the word boundaries of a command,
+except for argument expansion as specified in rule [5].
+For example, during variable substitution the entire value of
+the variable becomes part of a single word, even if the variable's
+value contains spaces.
+.SH KEYWORDS
+backslash, command, comment, script, substitution, variable
+'\" Local Variables:
+'\" mode: nroff
+'\" fill-column: 78
+'\" End:

samples/PicoLisp/simul.l

@@ -0,0 +1,165 @@
+# 11dec13abu
+# (c) Software Lab. Alexander Burger
+
+(de permute (Lst)
+   (ifn (cdr Lst)
+      (cons Lst)
+      (mapcan
+         '((X)
+            (mapcar
+               '((Y) (cons X Y))
+               (permute (delete X Lst)) ) )
+         Lst ) ) )
+
+(de subsets (N Lst)
+   (cond
+      ((=0 N) '(NIL))
+      ((not Lst))
+      (T
+         (conc
+            (mapcar
+               '((X) (cons (car Lst) X))
+               (subsets (dec N) (cdr Lst)) )
+            (subsets N (cdr Lst)) ) ) ) )
+
+(de shuffle (Lst)
+   (by '(NIL (rand)) sort Lst) )
+
+(de samples (Cnt Lst)
+   (make
+      (until (=0 Cnt)
+         (when (>= Cnt (rand 1 (length Lst)))
+            (link (car Lst))
+            (dec 'Cnt) )
+         (pop 'Lst) ) ) )
+
+
+# Genetic Algorithm
+(de gen ("Pop" "Cond" "Re" "Mu" "Se")
+   (until ("Cond" "Pop")
+      (for ("P" "Pop" "P" (cdr "P"))
+         (set "P"
+            (maxi "Se"  # Selection
+               (make
+                  (for ("P" "Pop" "P")
+                     (rot "P" (rand 1 (length "P")))
+                     (link  # Recombination + Mutation
+                        ("Mu" ("Re" (pop '"P") (pop '"P"))) ) ) ) ) ) ) )
+   (maxi "Se" "Pop") )
+
+
+# Alpha-Beta tree search
+(de game ("Flg" "Cnt" "Moves" "Move" "Cost")
+   (let ("Alpha" '(1000000)  "Beta" -1000000)
+      (recur ("Flg" "Cnt" "Alpha" "Beta")
+         (let? "Lst" ("Moves" "Flg")
+            (if (=0 (dec '"Cnt"))
+               (loop
+                  ("Move" (caar "Lst"))
+                  (setq "*Val" (list ("Cost" "Flg") (car "Lst")))
+                  ("Move" (cdar "Lst"))
+                  (T (>= "Beta" (car "*Val"))
+                     (cons "Beta" (car "Lst") (cdr "Alpha")) )
+                  (when (> (car "Alpha") (car "*Val"))
+                     (setq "Alpha" "*Val") )
+                  (NIL (setq "Lst" (cdr "Lst")) "Alpha") )
+               (setq "Lst"
+                  (sort
+                     (mapcar
+                        '(("Mov")
+                           (prog2
+                              ("Move" (car "Mov"))
+                              (cons ("Cost" "Flg") "Mov")
+                              ("Move" (cdr "Mov")) ) )
+                        "Lst" ) ) )
+               (loop
+                  ("Move" (cadar "Lst"))
+                  (setq "*Val"
+                     (if (recurse (not "Flg") "Cnt" (cons (- "Beta")) (- (car "Alpha")))
+                        (cons (- (car @)) (cdar "Lst") (cdr @))
+                        (list (caar "Lst") (cdar "Lst")) ) )
+                  ("Move" (cddar "Lst"))
+                  (T (>= "Beta" (car "*Val"))
+                     (cons "Beta" (cdar "Lst") (cdr "Alpha")) )
+                  (when (> (car "Alpha") (car "*Val"))
+                     (setq "Alpha" "*Val") )
+                  (NIL (setq "Lst" (cdr "Lst")) "Alpha") ) ) ) ) ) )
+
+
+### Grids ###
+(de grid (DX DY FX FY)
+   (let Grid
+      (make
+         (for X DX
+            (link
+               (make
+                  (for Y DY
+                     (set
+                        (link
+                           (if (> DX 26)
+                              (box)
+                              (intern (pack (char (+ X 96)) Y)) ) )
+                        (cons (cons) (cons)) ) ) ) ) ) )
+      (let West (and FX (last Grid))
+         (for (Lst Grid  Lst)
+            (let
+               (Col (pop 'Lst)
+                  East (or (car Lst) (and FX (car Grid)))
+                  South (and FY (last Col)) )
+               (for (L Col  L)
+                  (with (pop 'L)
+                     (set (: 0 1) (pop 'West))  # west
+                     (con (: 0 1) (pop 'East))  # east
+                     (set (: 0 -1) South)       # south
+                     (con (: 0 -1)              # north
+                        (or (car L) (and FY (car Col))) )
+                     (setq South This) ) )
+               (setq West Col) ) ) )
+      Grid ) )
+
+(de west (This)
+   (: 0 1 1) )
+
+(de east (This)
+   (: 0 1 -1) )
+
+(de south (This)
+   (: 0 -1 1) )
+
+(de north (This)
+   (: 0 -1 -1) )
+
+(de disp ("Grid" "How" "Fun" "X" "Y" "DX" "DY")
+   (setq "Grid"
+      (if "X"
+         (mapcar
+            '((L) (flip (head "DY" (nth L "Y"))))
+            (head "DX" (nth "Grid" "X")) )
+         (mapcar reverse "Grid") ) )
+   (let (N (+ (length (cdar "Grid")) (or "Y" 1))  Sp (length N))
+      ("border" north)
+      (while (caar "Grid")
+         (prin " " (align Sp N) " "
+            (and "How" (if (and (nT "How") (west (caar "Grid"))) " " '|)) )
+         (for L "Grid"
+            (prin
+               ("Fun" (car L))
+               (and "How" (if (and (nT "How") (east (car L))) " " '|)) ) )
+         (prinl)
+         ("border" south)
+         (map pop "Grid")
+         (dec 'N) )
+      (unless (> (default "X" 1) 26)
+         (space (inc Sp))
+         (for @ "Grid"
+            (prin " " (and "How" "  ") (char (+ 96 "X")))
+            (T (> (inc '"X") 26)) )
+         (prinl) ) ) )
+
+(de "border" (Dir)
+   (when "How"
+      (space Sp)
+      (prin "  +")
+      (for L "Grid"
+         (prin (if (and (nT "How") (Dir (car L))) "   +" "---+")) )
+      (prinl) ) )