code.consxy.com Git - wolf/blob - src/main/checker.lisp

   1 (in-package #:style-checker)
   2
   3 ; Rules
   4 ; - Elements in each form must be indented the same amount
   5 ; - No form longer than 50 lines
   6 ; - Top level multiline forms must be separated by exactly one space
   7 ; * No line longer than 120 characters
   8 ; - No use of unexported symbols in other packages
   9 ; - No tabs
  10 ; - Only one space between elements in a form on a single line
  11 ; * in-package must be first line in file unless file is package.lisp
  12 ; - No whitespace only lines
  13 ; - No empty lines at end of file
  14 ;
  15 ; Some thoughts
  16 ; - form starting reader macros will have to be hand added to this code
  17 ; - exceptions will eventually arise, and the rule file will have to be changed
  18 ; - the proper formatting of "loop" is weird
  19
  20 (define-condition check-failure nil ((msg :initarg :msg :reader check-failure-msg)
  21                                      (line-no :initarg :line-no :reader check-failure-line-no)
  22                                      (col-no :initarg :col-no :reader check-failure-col-no)))
  23
  24 (defvar *state* nil)
  25 (defvar *line-no* nil)
  26 (defvar *col-no* nil)
  27 (defvar *evaluators* nil)
  28
  29 (defparameter *possible-states*
  30  '(:begin ; start of file
  31    :normal ; normal processing
  32   ))
  33
  34
  35 (defun set-state (state)
  36  (when (not (find state *possible-states*))
  37   (error "Can't set state to ~A" state))
  38  (setf *state* state)
  39  nil)
  40
  41 (defmacro defevaluator (state match func)
  42  (when (not (find state *possible-states*)) (error "~A is an invalid state" state))
  43  (let
  44   ((scanner (gensym)))
  45  `(let
  46    ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match))))
  47    (pushnew
  48     (list
  49      (lambda (state text)
  50       (and
  51        (eql ,state state)
  52        (or
  53         (and (symbolp text) (eql text ,match))
  54         (and ,scanner
  55              (stringp text)
  56              (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text)
  57               (and start end (= 0 start) (/= 0 end)))))))
  58      (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text))))
  59      ,func)
  60     *evaluators*))))
  61
  62 (defun evaluate (text)
  63  (if (string= "" text)
  64      (let*
  65       ((evaluator (find-if (lambda (f) (funcall f *state* :eof)) *evaluators* :from-end t :key #'car))
  66        (problem (when evaluator (funcall (third evaluator)))))
  67       (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*))))
  68      (let
  69       ((evaluator (find-if (lambda (f) (funcall f *state* text)) *evaluators* :from-end t :key #'car)))
  70       (when (not evaluator) (error (make-condition 'check-failure :msg (format nil "Can't check in state ~S: ~S..." *state* (subseq text 0 (min (length text) 10))) :line-no *line-no* :col-no *col-no*)))
  71       (let
  72        ((problem (funcall (third evaluator))))
  73        (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*)))
  74        (let
  75         ((length-of-match (funcall (cadr evaluator) text)))
  76         (incf *col-no* length-of-match)
  77         (when (< 120 *col-no*) (error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no 0)))
  78         (evaluate (subseq text length-of-match)))))))
  79
  80 (defun slurp-file (filename &key (element-type 'character) (sequence-type 'string))
  81  (with-open-file (str filename :element-type element-type)
  82   (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
  83
  84 (defun check-file (file)
  85  (set-state :begin)
  86  (setf *line-no* 0)
  87  (setf *col-no* 0)
  88  (format t "~%File: ~A~%" file)
  89  (handler-case
  90   (progn (evaluate (slurp-file file)) t)
  91   (check-failure (cf)
  92    (format t " - Had an error: ~S at ~A:~A~%" (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))
  93    nil)))
  94
  95 (defun check-directory (dir)
  96  (every #'identity (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir)))))
  97
  98 ; These are in reverse order
  99 (progn
 100  (setf *evaluators* nil)
 101  (defevaluator :begin "\\(in-package[^\\)]*\\)"
 102   (lambda ()
 103    (set-state :normal) nil))
 104  (defevaluator :begin ".*"
 105   (lambda ()
 106    "Must begin with in-package form"))
 107  (defevaluator :normal "\\n"
 108   (lambda ()
 109    (incf *line-no*)
 110    (setf *col-no* 0)
 111    nil))
 112  (defevaluator :normal "." (constantly nil))
 113  )