Commit 3df5023f authored by Matthew Steele's avatar Matthew Steele

Lots of changes and improvements, including:

  - Added instrumentation for #. and #S
  - Potentially dangerous heuristics for defvar and defconstant
  - Improved handler for defstruct
  - New unit tests
  - Some cleanup of old code
parent e6bdb949
......@@ -29,12 +29,12 @@ to the base of the system."
;; Used only by with-dependency-tracking.
(defun call-with-dependency-tracking (comp thunk)
;; (if *using-constituents*
(if *current-constituent*
(operating-on-asdf-component-constituent (comp)
;((merge-pathnames (asdf:component-pathname comp)))
(with-groveling-readtable
(with-groveling-macroexpand-hook
(funcall thunk)))
(funcall thunk))))
(funcall thunk)))
;; (if *current-dependency-state*
;; (operating-on-component (comp)
......
This diff is collapsed.
This diff is collapsed.
......@@ -47,25 +47,75 @@
;;;;;;;;;;;;;;;;;;;;;;;;;; Variable-Related Handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (defvar *adg-specials* (make-hash-table :test 'eql))
;; (defun special-substitute-name (name)
;; (or (gethash name *adg-specials*)
;; (setf (gethash name *adg-specials*)
;; (gentemp (format nil "ASDF-DEPENDENCY-GROVEL-SPECIAL--~A" name)))))
;; ;; When we hit a declaim, we need to watch out for special variable
;; ;; declarations (all other declarations can be left as-is). Once a name is
;; ;; declared special, it can no longer be defined as a symbol macro; thus,
;; ;; without this handler, things will break if someone declares a name special
;; ;; before defvar-ing that name.
;; (define-macroexpand-handlers (form :function fun :environment env)
;; (declaim)
;; (destructuring-bind (dec &rest claims) form
;; (loop :for claim :in claims :with new-names := nil
;; :if (equal (string (car claim)) "SPECIAL")
;; :do (setf new-names (mapcar #'special-substitute-name (cdr claim)))
;; :and :collect (cons (car claim) new-names)
;; :into new-claims
;; :and :append (let ((*macroexpand-hook* *old-macroexpand-hook*))
;; (loop :for name :in (cdr claim)
;; :for new-name :in new-names
;; :collect (macroexpand-1
;; `(define-symbol-macro ,name
;; (signal-variable-use ',name 'defvar
;; ',new-name)))))
;; :into epilogue
;; :else
;; :collect claim :into new-claims
;; :finally (return (does-macroexpand-with-epilogue (fun env)
;; (cons dec new-claims)
;; (nconc epilogue (list '(values))))))))
(define-macroexpand-handlers (form)
(defvar defparameter)
(signal-provider (second form) 'defvar)
;; (unless *using-constituents*
;; (setf (gethash (second form) *suspected-variables*) t))
(does-not-macroexpand))
(destructuring-bind (def name &rest rest) form
(hashset-add name *suspected-variables*)
(signal-provider name 'defvar)
;; (let ((new-name (special-substitute-name name)))
;; ;; (new-name (gentemp (format nil "ASDF-DEPENDENCY-GROVEL-DEFVAR--~A"
;; ;; name))))
;; (does-macroexpand-with-prologue (fun env)
;; ;; Do a little dance to prevent ADG from thinking that this form is
;; ;; providing a symbol macro. Probably a better solution would be to
;; ;; change does-macroexpand-with-prologue (and
;; ;; does-macroexpand-with-epilogue, while we're at it) to not apply
;; ;; handlers to the prologue/epilogue.
;; (let ((*macroexpand-hook* *old-macroexpand-hook*))
;; (list (macroexpand-1
;; `(define-symbol-macro ,name
;; (signal-variable-use ',name 'defvar ',new-name)))))
;; ;; Do the original defvar/defparameter, but with the new name.
;; `(,def ,new-name ,@rest)))))
(does-not-macroexpand)))
(define-macroexpand-handlers (form :environment env)
(defconstant)
(let ((symbol (second form)))
(signal-provider (second form) (first form))
(if t ;; set to nil to disable defconstant instrumentation
(does-macroexpand-with-epilogue
((macro-function 'symbol-macroify) env)
`(symbol-macroify ,@form)
`((eval-when (:compile-toplevel :load-toplevel :execute)
(setf (symbol-value ',symbol) ,symbol))
',symbol))
(does-not-macroexpand))))
(signal-provider (second form) 'defconstant)
(hashset-add (second form) *suspected-constants*)
;; (does-macroexpand-with-epilogue
;; ((macro-function 'symbol-macroify) env)
;; `(symbol-macroify ,@form)
;; `((eval-when (:compile-toplevel :load-toplevel :execute)
;; (setf (symbol-value ',symbol) ,symbol))
;; ',symbol))
(does-not-macroexpand)))
;;;;;;;;;;;;;;;;;;;;;;;;;;; Macro-Related Handlers ;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -79,7 +129,7 @@
(define-macroexpand-handlers (form :function fun :environment env)
(define-symbol-macro)
(destructuring-bind (def name expansion) form
(signal-provider name def)
(signal-provider name 'define-symbol-macro)
(does-macroexpand (fun env)
`(,def ,name (signal-symbol-macroexpansion ',name ,expansion)))))
......@@ -190,7 +240,12 @@
(if (listp header) header (list header))
;; Provide the class and type for this struct.
(signal-provider name 'defclass)
(signal-provider (second form) 'deftype)
(signal-provider name 'defstruct)
(signal-provider name 'deftype)
;; Check for an :include struct option.
(let ((include-option (assoc :include struct-options)))
(when include-option
(signal-user (second include-option) 'defstruct)))
;; Deal with accessor functions. The defstruct macro automatically
;; defines a whole bunch of accessor functions, which we must
;; "retroactively" instrument. In particular, we must "manually"
......@@ -362,18 +417,55 @@
:do (cond
((consp setee)
(signal-user (first setee) 'setf))
((and (symbolp setee) (boundp setee))
#|((and (symbolp setee) (boundp setee))
(signal-user setee 'defvar)
(signal-provider setee 'defvar))))
(signal-provider setee 'defvar))|#)
(when (hashset-contains-p setee *suspected-variables*)
(push (list (first form)
setee
(constituent-summary *current-constituent*))
*global-mutations*)))
(does-not-macroexpand))
(define-macroexpand-handlers (form)
(define-macroexpand-handlers (form :function fun :environment env)
(pushnew push)
(let ((setee (third form)))
(when (and (symbolp setee) (boundp setee))
(signal-user setee 'defvar)
(signal-provider setee 'defvar))))
(when (hashset-contains-p setee *suspected-variables*)
(push (list (first form)
setee
(constituent-summary *current-constituent*))
*global-mutations*))
(does-not-macroexpand)))
;; (define-macroexpand-handlers (form :function fun :environment env)
;; (pushnew push)
;; (let ((setee (third form)))
;; (if (hashset-contains-p setee *suspected-variables*)
;; (with-gensyms (old-version new-version)
;; (assert (symbolp setee))
;; (does-macroexpand-with-prologue (fun env)
;; `((let* ((,old-version (gethash ,setee *variable-versions*))
;; (,new-version (1+ ,old-version)))
;; (signal-user (cons ,setee ,old-version) 'var-version)
;; (signal-provider (cons ,setee ,new-version) 'var-version)
;; (setf (gethash ,setee *variable-versions*) ,new-version)))
;; form))
;; (let* ((old-version (gethash setee *variable-versions*))
;; (new-version (1+ old-version)))
;; (signal-user (cons setee old-version) 'var-version)
;; (signal-provider (cons setee new-version) 'var-version)
;; (setf (gethash setee *variable-versions*) new-version)
;; )
;; (does-not-macroexpand))))
;; (define-macroexpand-handlers (form)
;; (pushnew push)
;; (let ((setee (third form)))
;; (when (and (symbolp setee) (boundp setee))
;; (signal-user setee 'defvar)
;; (signal-provider setee 'defvar))))
(define-macroexpand-handlers (form :function fun :environment env)
......
......@@ -19,9 +19,7 @@
#:instrumented-load
#:instrumented-compile-file
#:fine-grain-instrumented-load
#:print-big-ol-dependency-report
;; Feature set when groveling:
#:groveling))
#:print-big-ol-dependency-report))
(cl:defpackage #:asdf-dependency-grovel.packages
(:use))
......
(cl:in-package :asdf-dependency-grovel-test)
(defvar *p-defvar-variable* 42)
(defparameter *p-defvar-varlist* nil)
......@@ -9,6 +9,9 @@
(:file "p-define-method-combination")
(:file "p-feature")
;; defvar
(:file "p-defvar")
;; setf
(:file "p-define-setf-expander")
(:file "p-defsetf")
......@@ -39,6 +42,12 @@
(:file "u-define-method-combination")
(:file "u-feature")
;; defvar
(:file "u-defvar")
(:file "u-defvar.vector")
(:file "u-defvar.setf")
(:file "u-defvar.push")
;; setf
(:file "u-define-setf-expander")
(:file "u-defsetf")
......@@ -56,6 +65,7 @@
(:file "u-defstruct.defmethod")
(:file "u-defstruct.functions")
(:file "u-defstruct.functions.sharpquote")
(:file "u-defstruct.include")
;; package system
(:file "u-defpackage")
......
(cl:in-package :asdf-dependency-grovel-test)
(eval-when (:compile-toplevel)
(test-defstruct/function-a *function-defstruct*))
(defvar *function-defstruct-2* (make-test-defstruct/function :a 2 :b 3 :c 4))
(test-defstruct/function-a *function-defstruct-2*))
(cl:in-package :asdf-dependency-grovel-test)
(defstruct (test-defstruct/function-extended
(:include test-defstruct/function))
"This is a docstring."
d e)
(cl:in-package :asdf-dependency-grovel-test)
(defvar *function-defstruct* (make-test-defstruct/function :a 2 :b 3 :c 4))
(defvar *function-defstruct-1* (make-test-defstruct/function :a 2 :b 3 :c 4))
(test-defstruct/function-a *function-defstruct*)
(test-defstruct/function-a *function-defstruct-1*)
(cl:in-package :asdf-dependency-grovel-test)
(defparameter *u-defvar-variable* (+ 2 *p-defvar-variable*))
(cl:in-package :asdf-dependency-grovel-test)
(push 7 *p-defvar-varlist*)
(cl:in-package :asdf-dependency-grovel-test)
(setf *p-defvar-variable* 45)
(cl:in-package :asdf-dependency-grovel-test)
(defparameter *u-defvar-variable* #(1 2 *p-defvar-variable* 3))
#+xcvb (module (:depends-on ("package")))
(cl:in-package #:asdf-dependency-grovel)
(in-package #:asdf-dependency-grovel)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Debugging ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defparameter *debug-trace* nil
"When non-nil, enables all kinds of output for debugging ADG.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Macro Expansion ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
......@@ -10,15 +15,38 @@
"When the override macroexpand hook is active, this is bound to the old value
of *macroexpand-hook*.")
(defvar *preprocess-form-p* t
"Used to let the groveling-macroexpand-hook know when it needs to preprocess
a form before macroexpanding it. It starts out as t, but is bound to nil
within the instrumented-eval function.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Constituent Stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *current-constituent* nil
"The lowest-level constituent that we are currently inside.")
(defvar *constituent-table* nil
"Hash table mapping constituent designators to constituent objects
(initialized by with-constituent-groveling).")
;;;;;;;;;;;;;;;;;;;;;;;;;; Global Variable Tracking ;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar *suspected-variables* nil
"Hash table containing the symbols that should be treated as if they were
variables (as if by defvar/defparameter) when used in forms.")
(defvar *suspected-constants* nil
"Hash table containing the symbols that should be treated as if they were
constants (as if by defconstant) when used in forms.")
(defvar *global-mutations* nil
"Experimental -- likely to be removed in the future. (msteele)")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ASDF Stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (defvar *current-component* nil
;; "The currently loaded/compiled ASDF component")
;; (defvar *suspected-variables* nil
;; "Hash table containing the symbols that should be treated as if they were
;; variables when used in forms.")
;; (defvar *current-dependency-state* nil
;; "The state of dependency information for the current groveling run.")
......@@ -96,23 +124,4 @@
signal-internal-symbols becomes a no-op, and the defpackage and in-package
handlers do less work.")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Constituent Stuff ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Added by msteele:
;; (defvar *non-asdf-p* nil
;; "When nil, assumes we're groveling ASDF-based code.
;; When non-nil, assumes we're groveling non-ASDF-based code.")
;; (defvar *using-constituents* nil
;; "When nil, assumes we're using the old representations.
;; When non-nil, assumes we're using constituents.")
(defvar *current-constituent* nil
"The lowest-level constituent that we are currently inside.")
(defvar *constituent-table* nil
"Hash table mapping constituent designators to constituent objects
(initialized by with-constituent-groveling).")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment