forked from github-linguist/linguist
-
Notifications
You must be signed in to change notification settings - Fork 0
Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Merge branch 'master' into associate-heuristic-with-extension
Conflicts: lib/linguist/heuristics.rb
- Loading branch information
Showing
42 changed files
with
1,960 additions
and
39 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -1,3 +1,3 @@ | ||
module Linguist | ||
VERSION = "4.5.5" | ||
VERSION = "4.5.6" | ||
end |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -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))))) |
Oops, something went wrong.