mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 20:30:28 +02:00
Code Activity

record elisp function names

Browse source 
* language/elisp/compile-tree-il.scm (compile-lambda): Add a `meta'
  argument for the procedure's properties.

  (compile-function, compile-defmacro, compile-defun): Update
  accordingly, passing a `name' property to `compile-lambda' where
  possible.
This commit is contained in:
BT Templeton 2011-07-14 04:09:12 -04:00
parent 14b288ceb9
commit d9806be144
1 changed files with 8 additions and 4 deletions
Download patch file Download diff file Expand all files Collapse all files

12
module/language/elisp/compile-tree-il.scm
View file

@ -422,7 +422,7 @@
;;; binding for them (the lexical target variable is already there, ;;; binding for them (the lexical target variable is already there,
;;; namely the real lambda argument from TreeIL). ;;; namely the real lambda argument from TreeIL).
(define (compile-lambda loc args body) (define (compile-lambda loc meta args body)
(if (not (list? args)) (if (not (list? args))
(report-error loc "expected list for argument-list" args)) (report-error loc "expected list for argument-list" args))
(receive (required optional rest lexical dynamic) (receive (required optional rest lexical dynamic)
@ -476,7 +476,7 @@
(lambda () (lambda ()
(make-lambda (make-lambda
loc loc
'() meta
(make-lambda-case (make-lambda-case
#f #f
required required
@ -765,7 +765,7 @@
(defspecial function (loc args) (defspecial function (loc args)
(pmatch args (pmatch args
(((lambda ,args . ,body)) (((lambda ,args . ,body))
(compile-lambda loc args body)) (compile-lambda loc '() args body))
((,sym) (guard (symbol? sym)) ((,sym) (guard (symbol? sym))
(reference-variable loc sym function-slot)))) (reference-variable loc sym function-slot))))
@ -786,7 +786,10 @@
loc loc
(make-module-ref loc '(guile) 'cons #t) (make-module-ref loc '(guile) 'cons #t)
(list (make-const loc 'macro) (list (make-const loc 'macro)
(compile-lambda loc args body)))) (compile-lambda loc
`((name . ,name))
args
body))))
(make-const loc name))))) (make-const loc name)))))
(compile (ensuring-globals loc bindings-data tree-il) (compile (ensuring-globals loc bindings-data tree-il)
#:from 'tree-il #:from 'tree-il
@ -803,6 +806,7 @@
name name
function-slot function-slot
(compile-lambda loc (compile-lambda loc
`((name . ,name))
args args
body)) body))
(make-const loc name))))))) (make-const loc name)))))))