<commit_before>;; -*- lisp -*-

(in-package :it.bese.arnesi)

;;;; * A Code Walker

;;;; ** Public Entry Point

(defun walk-form (form &optional (parent nil) (env (make-walk-env)))
  "Walk FORM and return a FORM object."
  (funcall (find-walker-handler form) form parent env))

(defun make-walk-env (&optional lexical-env)
  (let ((walk-env '()))
    (when lexical-env
      (dolist (var (lexical-variables lexical-env))
        (extend walk-env :lexical-let var t))
      (dolist (fun (lexical-functions lexical-env))
	(extend walk-env :lexical-flet fun t)))
    walk-env))

;;;; This takes a Common Lisp form and transforms it into a tree of
;;;; FORM objects.

(defvar *walker-handlers* (make-hash-table :test 'eq))

(defvar +atom-marker+ '+atom-marker+)

(defun find-walker-handler (form)
  "Simple function which tells us what handler should deal
  with FORM. Signals an error if we don't have a handler for
  FORM."
  (if (atom form)
      (gethash '+atom-marker+ *walker-handlers*)
      (aif (gethash (car form) *walker-handlers*)
	   it
	   (case (car form)
	     ((block declare flet function go if labels let let*
		     macrolet progn quote return-from setq symbol-macrolet
		     tagbody unwind-protect catch multiple-value-call
		     multiple-value-prog1 throw load-time-value the
		     eval-when locally progv)
	      (error "Sorry, No walker for the special operater ~S defined." (car form)))
	     (t (gethash 'application *walker-handlers*))))))

(defmacro defwalker-handler (name (form parent lexical-env)
                             &body body)
  `(progn
     (setf (gethash ',name *walker-handlers*)
           (lambda (,form ,parent ,lexical-env)
             (declare (ignorable ,parent ,lexical-env))
             ,@body))
     ',name))

(defclass form ()
  ((parent :accessor parent :initarg :parent)
   (source :accessor source :initarg :source)))

(defmethod make-load-form ((object form) &optional env)
  (let ((slot-names '()))
    (labels ((push-direct-slots (class)
               (dolist (slot (mopp:class-slots class))
                 (push (mopp:slot-definition-name slot) slot-names)))
             (collect-slot-names (class)
               (push-direct-slots class)
               (unless (eql class (find-class 'form))
                 (dolist (klass (mopp:class-direct-superclasses class))
                   (collect-slot-names klass)))))
      (collect-slot-names (class-of object))
      (setf slot-names (remove-duplicates slot-names :test #'eql))
      (make-load-form-saving-slots object
                                   :slot-names slot-names
                                   :environment env))))

(defmethod print-object ((form form) stream)
  (print-unreadable-object (form stream :type t :identity t)
    (when (slot-boundp form 'source)
      (let ((*print-readably* nil)
            (*print-level* 0)
            (*print-length* 4))
        (format stream "~S" (source form))))))

(defmacro with-form-object ((variable type &rest initargs)
                            &body body)
  `(let ((,variable (make-instance ',type ,@initargs)))
     ,@body
     ,variable))

(defclass implicit-progn-mixin ()
  ((body :accessor body :initarg :body)))

(defclass implicit-progn-with-declare-mixin (implicit-progn-mixin)
  ((declares :accessor declares :initarg :declares)))<commit_msg>Use class-slots instead of our custom 'walk class hierarchy and collect slot defs' code.<commit_after>;; -*- lisp -*-

(in-package :it.bese.arnesi)

;;;; * A Code Walker

;;;; ** Public Entry Point

(defun walk-form (form &optional (parent nil) (env (make-walk-env)))
  "Walk FORM and return a FORM object."
  (funcall (find-walker-handler form) form parent env))

(defun make-walk-env (&optional lexical-env)
  (let ((walk-env '()))
    (when lexical-env
      (dolist (var (lexical-variables lexical-env))
        (extend walk-env :lexical-let var t))
      (dolist (fun (lexical-functions lexical-env))
	(extend walk-env :lexical-flet fun t)))
    walk-env))

;;;; This takes a Common Lisp form and transforms it into a tree of
;;;; FORM objects.

(defvar *walker-handlers* (make-hash-table :test 'eq))

(defvar +atom-marker+ '+atom-marker+)

(defun find-walker-handler (form)
  "Simple function which tells us what handler should deal
  with FORM. Signals an error if we don't have a handler for
  FORM."
  (if (atom form)
      (gethash '+atom-marker+ *walker-handlers*)
      (aif (gethash (car form) *walker-handlers*)
	   it
	   (case (car form)
	     ((block declare flet function go if labels let let*
		     macrolet progn quote return-from setq symbol-macrolet
		     tagbody unwind-protect catch multiple-value-call
		     multiple-value-prog1 throw load-time-value the
		     eval-when locally progv)
	      (error "Sorry, No walker for the special operater ~S defined." (car form)))
	     (t (gethash 'application *walker-handlers*))))))

(defmacro defwalker-handler (name (form parent lexical-env)
                             &body body)
  `(progn
     (setf (gethash ',name *walker-handlers*)
           (lambda (,form ,parent ,lexical-env)
             (declare (ignorable ,parent ,lexical-env))
             ,@body))
     ',name))

(defclass form ()
  ((parent :accessor parent :initarg :parent)
   (source :accessor source :initarg :source)))

(defmethod make-load-form ((object form) &optional env)
  (make-load-form-saving-slots object
                               :slot-names (mapcar #'mopp:slot-definition-name
                                                   (mopp:class-slots (class-of object)))
                               :environment nil))

(defmethod print-object ((form form) stream)
  (print-unreadable-object (form stream :type t :identity t)
    (when (slot-boundp form 'source)
      (let ((*print-readably* nil)
            (*print-level* 0)
            (*print-length* 4))
        (format stream "~S" (source form))))))

(defmacro with-form-object ((variable type &rest initargs)
                            &body body)
  `(let ((,variable (make-instance ',type ,@initargs)))
     ,@body
     ,variable))

(defclass implicit-progn-mixin ()
  ((body :accessor body :initarg :body)))

(defclass implicit-progn-with-declare-mixin (implicit-progn-mixin)
  ((declares :accessor declares :initarg :declares)))
{'fraction_non_alphanumeric': 0.1361031518624642, 'fraction_numerical': 0.0009551098376313276, 'mean_word_length': 2.6550319953461314, 'pattern_counts': {'":': 0, '<': 3, '<?xml version=': 0, '>': 3, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1247877', 'n_tokens_mistral': 2034, 'n_tokens_neox': 1933, 'n_words': 589}