[climacs-cvs] CVS climacs
thenriksen
thenriksen at common-lisp.net
Mon Sep 11 08:55:21 UTC 2006
Update of /project/climacs/cvsroot/climacs
In directory clnet:/tmp/cvs-serv11152
Modified Files:
lisp-syntax.lisp lisp-syntax-swine.lisp
Log Message:
Fixed some bugs related to evil argument lists (SBCL `make-string')
and made applicable-form-finding even more intelligent (again).
--- /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/09/02 21:43:56 1.112
+++ /project/climacs/cvsroot/climacs/lisp-syntax.lisp 2006/09/11 08:55:21 1.113
@@ -33,6 +33,11 @@
(funcall fn obj)
obj))
+(defun fully-unlisted (obj &optional (fn #'first))
+ (if (listp obj)
+ (fully-unlisted (funcall fn obj))
+ obj))
+
(defun listed (obj)
(if (listp obj)
obj
--- /project/climacs/cvsroot/climacs/lisp-syntax-swine.lisp 2006/09/08 18:12:03 1.4
+++ /project/climacs/cvsroot/climacs/lisp-syntax-swine.lisp 2006/09/11 08:55:21 1.5
@@ -118,7 +118,7 @@
(unlisted (find (symbol-name keyword)
(get-args '&key)
:key #'(lambda (arg)
- (symbol-name (unlisted arg)))
+ (symbol-name (fully-unlisted arg)))
:test #'string=))))
;; We have to find the associated
;; symbol in the argument list... ugly.
@@ -166,7 +166,7 @@
(get-args '&key)
:test #'string=
:key #'(lambda (arg)
- (symbol-name (unlisted arg))))))
+ (symbol-name (fully-unlisted arg))))))
;; We are in the &body, &rest or &key arguments.
(values
;; Only emphasize the &key
@@ -369,7 +369,7 @@
(worker (parent operand-form)))))))))
(nreverse (worker operand-form t)))))
-(defun find-operand-info (mark-or-offset syntax operator-form)
+(defun find-operand-info (syntax mark-or-offset operator-form)
"Returns two values: The operand preceding `mark-or-offset' and
the path from `operator-form' to the operand."
(as-offsets ((offset mark-or-offset))
@@ -444,31 +444,62 @@
(indices-match-arglist arg (rest arg-indices)))
(t t))))
-(defun direct-arg-p (form syntax)
- "Check whether `form' is a direct argument to one of its
- parents."
- (labels ((recurse (parent)
- (let ((operator (form-operator
- parent
- syntax)))
- (or (and
- ;; An operator is not an argument to itself...
- (not (= (start-offset form)
- (start-offset (first-form (children parent)))))
- (valid-operator-p operator)
- (indices-match-arglist
- (arglist (image syntax)
- operator)
- (second
- (multiple-value-list
- (find-operand-info
- (start-offset form)
- syntax
- parent)))))
- (when (parent parent)
- (recurse (parent parent)))))))
- (when (parent form)
- (recurse (parent form)))))
+(defun direct-arg-p (syntax operator-form arg-form)
+ "Is `arg-form' a direct argument to `operator-form'? A \"direct
+argument\" is defined as an argument that would be directly bound
+to a symbol when evaluating the operators body, or as an argument
+that would be a direct component of a &body or &rest argument."
+ (let ((operator (token-to-object syntax operator-form)))
+ (and
+ ;; An operator is not an argument to itself.
+ (not (eq arg-form
+ (first-form (children (parent operator-form)))))
+ ;; An operator must be valid.
+ (valid-operator-p operator)
+ ;; The argument must match the operators argument list.
+ (indices-match-arglist
+ (arglist (image syntax)
+ operator)
+ (nth-value 1 (find-operand-info
+ syntax
+ (start-offset arg-form)
+ (parent operator-form)))))))
+
+(defun find-direct-operator (syntax arg-form)
+ "Check whether `arg-form' is a direct argument to one of its
+parents. If it is, return the form with the operator that
+`arg-form' is a direct argument to. If not, return NIL."
+ (labels ((recurse (form)
+ ;; Check whether `arg-form' is a direct argument to
+ ;; the operator of `form'.
+ (when (parent form)
+ (if (direct-arg-p syntax (first-form (children form)) arg-form)
+ form
+ (recurse (parent form))))))
+ (recurse (parent arg-form))))
+
+(defun find-applicable-form (syntax arg-form)
+ "Find the enclosing form that has `arg-form' as a valid
+argument. Return NIL if none can be found."
+ ;; The algorithm for finding the applicable form:
+ ;;
+ ;; From `arg-form', we wander up the tree looking enclosing forms,
+ ;; until we find a a form with an operator, the form-operator, that
+ ;; has `arg-form' as a direct argument (this is checked by comparing
+ ;; argument indices for `arg-form', relative to form-operator, with
+ ;; the arglist ofform-operator). However, if form-operator itself is
+ ;; a direct argument to one of its parents, we ignore it (unless
+ ;; form-operators form-operator is itself a direct argument,
+ ;; etc). This is so we can properly handle nested/destructuring
+ ;; argument lists such as those found in macros.
+ (labels ((recurse (candidate-form)
+ (when (parent candidate-form)
+ (if (and (direct-arg-p syntax (first-form (children candidate-form))
+ arg-form)
+ (not (find-applicable-form syntax (first-form (children candidate-form)))))
+ candidate-form
+ (recurse (parent candidate-form))))))
+ (recurse (parent arg-form))))
(defun relevant-keywords (arglist arg-indices)
"Return a list of the keyword arguments that it would make
@@ -526,7 +557,8 @@
:test #'(lambda (a b)
(string-equal a b
:start1 1))
- :key #'symbol-name))
+ :key #'(lambda (s)
+ (symbol-name (fully-unlisted s)))))
(mapcar #'string-downcase completions))))
relevant-completions))
completions))))
@@ -719,31 +751,12 @@
;; Find a form with a valid (fboundp) operator.
(let ((immediate-form
(preceding-form ,mark-value-sym ,syntax-value-sym)))
- ;; Recurse upwards until we find a form with a valid
- ;; operator. This could be improved a lot, as we could
- ;; inspect the lambda list of the found operator and
- ;; check if the position of mark makes sense with
- ;; regard to the structure of the lambda list. If we
- ;; cannot find a form with a valid operator, just
- ;; return the form `mark' is in.
(unless (null immediate-form)
- (labels ((recurse (form)
- (unless (null (parent form))
- (or (unless (eq (first-form (children (parent form)))
- form)
- (recurse (parent form)))
- (and (valid-operator-p (form-operator
- form
- ,syntax-value-sym))
- (indices-match-arglist
- (arglist-for-form
- ,syntax-value-sym
- (form-operator form ,syntax-value-sym)
- (form-operands form ,syntax-value-sym))
- (nth-value 1 (find-operand-info ,mark-value-sym ,syntax-value-sym form)))
- (not (direct-arg-p form ,syntax-value-sym))
- form)))))
- (or (recurse (parent immediate-form))
+ (or (find-applicable-form ,syntax-value-sym immediate-form)
+ ;; If nothing else can be found, and `arg-form'
+ ;; is the operator of its enclosing form, we use
+ ;; the enclosing form.
+ (when (eq (first-form (children (parent immediate-form))) immediate-form)
(parent immediate-form))))))
;; If we cannot find a form, there's no point in looking
;; up any of this stuff.
@@ -752,7 +765,7 @@
(declare (ignorable ,mark-value-sym ,syntax-value-sym ,form-sym
,operator-sym ,operands-sym))
(multiple-value-bind (,preceding-operand-sym ,operand-indices-sym)
- (when ,form-sym (find-operand-info ,mark-value-sym ,syntax-value-sym ,form-sym))
+ (when ,form-sym (find-operand-info ,syntax-value-sym ,mark-value-sym ,form-sym))
(declare (ignorable ,preceding-operand-sym ,operand-indices-sym))
, at body))))
More information about the Climacs-cvs
mailing list