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