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 (defvar *form-stack* nil)
  29
  30 (eval-when (:compile-toplevel :load-toplevel :execute)
  31  (defparameter *possible-states*
  32   '(:begin ; start of file
  33     :normal ; normal processing
  34    )))
  35
  36
  37 (defun set-state (state)
  38  (when (not (find state *possible-states*))
  39   (error "Can't set state to ~A" state))
  40  (setf *state* state)
  41  nil)
  42
  43 (defmacro defevaluator (state match func)
  44  (when (not (find state *possible-states*)) (error "~A is an invalid state" state))
  45  (let
  46   ((scanner (gensym)))
  47  `(let
  48    ((,scanner (when (stringp ,match) (cl-ppcre:create-scanner ,match))))
  49    (pushnew
  50     (list
  51      (lambda (state text)
  52       (and
  53        (eql ,state state)
  54        (or
  55         (and (symbolp text) (eql text ,match))
  56         (and ,scanner
  57              (stringp text)
  58              (multiple-value-bind (start end) (cl-ppcre:scan ,scanner text)
  59               (and start end (= 0 start) (/= 0 end)))))))
  60      (lambda (text) (second (multiple-value-list (cl-ppcre:scan ,scanner text))))
  61      ,func)
  62     *evaluators*))))
  63
  64 (defun evaluate (text)
  65  (if (string= "" text)
  66      (let*
  67       ((evaluator (find-if (lambda (f) (funcall f *state* :eof)) *evaluators* :from-end t :key #'car))
  68        (problem (when evaluator (funcall (third evaluator)))))
  69       (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*))))
  70      (let
  71       ((evaluator (find-if (lambda (f) (funcall f *state* text)) *evaluators* :from-end t :key #'car)))
  72       (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*)))
  73       (let
  74        ((problem (funcall (third evaluator))))
  75        (when problem (error (make-condition 'check-failure :msg problem :line-no *line-no* :col-no *col-no*)))
  76        (let
  77         ((length-of-match (funcall (cadr evaluator) text)))
  78         (incf *col-no* length-of-match)
  79         (when (< 120 *col-no*) (error (make-condition 'check-failure :msg "Line longer than 120 characters" :line-no *line-no* :col-no 0)))
  80         (evaluate (subseq text length-of-match)))))))
  81
  82 (defun slurp-file (filename &key (element-type 'character) (sequence-type 'string))
  83  (with-open-file (str filename :element-type element-type)
  84   (let ((seq (make-sequence sequence-type (file-length str)))) (read-sequence seq str) seq)))
  85
  86 (defun check-file (file)
  87  (set-state :begin)
  88  (setf *line-no* 0)
  89  (setf *col-no* 0)
  90  (format t "~%File: ~A~%" file)
  91  (handler-case
  92   (progn (evaluate (slurp-file file)) t)
  93   (check-failure (cf)
  94    (format t " - Had an error: ~S at ~A:~A~%" (check-failure-msg cf) (check-failure-line-no cf) (check-failure-col-no cf))
  95    nil)))
  96
  97 (defun check-directory (dir)
  98  (every #'identity (mapcar #'check-file (directory (format nil "~A/**/*.lisp" dir)))))
  99
 100 ; These are in reverse order
 101 (progn
 102  (setf *evaluators* nil)
 103  (defevaluator :begin "\\(in-package[^\\)]*\\)"
 104   (lambda ()
 105    (set-state :normal) nil))
 106  (defevaluator :begin ".*"
 107   (lambda ()
 108    "Must begin with in-package form"))
 109  (defevaluator :normal "\\n"
 110   (lambda ()
 111    (incf *line-no*)
 112    (setf *col-no* 0)
 113    nil))
 114  (defevaluator :normal "\\("
 115   (lambda ()
 116    (push
 117     (list *line-no* *col-no*)
 118     *form-stack*)
 119    nil))
 120  (defevaluator :normal "\\)"
 121   (lambda ()
 122    (let
 123     ((form (pop *form-stack*)))
 124     (when
 125      (< 50 (- *line-no* (car form)))
 126      "Forms can't be over 50 lines long"))))
 127
 128  (defevaluator :normal "." (constantly nil))
 129  )