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