mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-01-14 21:32:49 -08:00
Code Issues Projects Releases Packages Wiki Activity

Location annotations now use DSPECs

Browse source
This commit is contained in:
Juan Jose Garcia Ripoll 2010-02-24 10:55:04 +01:00
parent e0a268376f
commit 95e5dbf26d
3 changed files with 38 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

3
src/c/symbols_list.h
View file

@ -1874,6 +1874,9 @@ cl_symbols[] = {
{EXT_ "GET-ANNOTATION", EXT_ORDINARY, NULL, -1, Cnil},
{EXT_ "REMOVE-ANNOTATION", EXT_ORDINARY, NULL, -1, Cnil},
{EXT_ "FUNCTION-LAMBDA-LIST", EXT_ORDINARY, NULL, -1, Cnil},
{EXT_ "DEFAULT-ANNOTATION-LOGIC", EXT_ORDINARY, NULL, -1, Cnil},
{EXT_ "OPTIONAL-ANNOTATION", EXT_ORDINARY, NULL, -1, Cnil},
{EXT_ "LOCATION", EXT_ORDINARY, NULL, -1, Cnil},
/* Tag for end of list */
{NULL, CL_ORDINARY, NULL, -1, OBJNULL}};

3
src/c/symbols_list2.h
View file

@ -1874,6 +1874,9 @@ cl_symbols[] = {
{EXT_ "GET-ANNOTATION",NULL},
{EXT_ "REMOVE-ANNOTATION",NULL},
{EXT_ "FUNCTION-LAMBDA-LIST",NULL},
{EXT_ "DEFAULT-ANNOTATION-LOGIC",NULL},
{EXT_ "OPTIONAL-ANNOTATION",NULL},
{EXT_ "LOCATION",NULL},
/* Tag for end of list */
{NULL,NULL}};

44
src/lsp/helpfile.lsp
View file

@ -151,7 +151,7 @@ Sets up a new hash table for storing documentation strings."
(si::hash-set object dict record)
(remhash object dict))))))
(defun get-annotation (object key sub-key)
(defun get-annotation (object key &optional (sub-key :all))
(let ((output '()))
(dolist (dict *documentation-pool* output)
(let ((record (if (hash-table-p dict)
@ -224,18 +224,38 @@ strings."
(t
(error "~S is an unknown documentation type" type))))
(defun make-dspec (definition)
(when (consp definition)
(let* ((kind (first definition))
(name (second definition))
(extra '()))
(when (eq kind 'defmethod)
(let ((list (third definition)))
(setq extra (if (symbolp list)
(cons list (fourth definition))
list))))
(list* kind name extra))))
;; (EXT:OPTIONAL-ANNOTATION arguments for EXT:ANNOTATE)
(si::fset 'ext:optional-annotation
#'(ext:lambda-block ext:optional-annotation (whole env)
#+ecl-min
`(ext:annotate ,@(rest whole)))
t)
(defun default-annotation-logic (source-location definition output-form
&optional (dspec (make-dspec definition)))
(let* ((kind (first definition))
(name (second definition)))
`(progn
(ext:optional-annotation ',name 'location ',dspec ',source-location)
,(when (member kind '(defun defmacro defgeneric))
`(ext:optional-annotation ',name :lambda-list nil ',(third definition)))
,output-form)))
#+ecl-min
(when (null *documentation-pool*) (new-documentation-pool 1024))
#+ecl-min
(setq ext::*register-with-pde-hook*
#'(lambda (source-location definition output-form)
(let* ((kind (first definition))
(name (second definition)))
;(print (list name kind source-location))
(when (not (member kind '(defmethod)))
(annotate name 'location kind source-location))
(when (member kind '(defun defmacro defgeneric))
(annotate name :lambda-list nil (third definition))))
output-form))
(setq ext::*register-with-pde-hook* 'default-annotation-logic)