Update of /project/movitz/cvsroot/movitz In directory common-lisp.net:/tmp/cvs-serv22016
Modified Files: special-operators.lisp Log Message: Made define-primitive-function accept options for the pf somewhat like defstruct does. I.e.
(define-primitive-function (foo-pf :symtab-property t) () ...)
will make the symbol-value of foo-pf be a (primitive) code-vector as usual, but also the code-vector's symbol-table will be put into the symbol's :symtab property.
Date: Tue Aug 10 06:28:05 2004 Author: ffjeld
Index: movitz/special-operators.lisp diff -u movitz/special-operators.lisp:1.34 movitz/special-operators.lisp:1.35 --- movitz/special-operators.lisp:1.34 Fri Aug 6 07:45:30 2004 +++ movitz/special-operators.lisp Tue Aug 10 06:28:05 2004 @@ -8,7 +8,7 @@ ;;;; Author: Frode Vatvedt Fjeld frodef@acm.org ;;;; Created at: Fri Nov 24 16:22:59 2000 ;;;; -;;;; $Id: special-operators.lisp,v 1.34 2004/08/06 14:45:30 ffjeld Exp $ +;;;; $Id: special-operators.lisp,v 1.35 2004/08/10 13:28:05 ffjeld Exp $ ;;;; ;;;;------------------------------------------------------------------
@@ -272,12 +272,19 @@ (define-special-operator make-primitive-function (&form form &env env) (destructuring-bind (name docstring body) (cdr form) - (handler-bind (((or warning error) (lambda (c) - (declare (ignore c)) - (format *error-output* "~&;; In primitive function ~S:" name)))) - (let ((code-vector (make-compiled-primitive body env nil docstring))) - (setf (movitz-symbol-value (movitz-read name)) code-vector) - (compiler-values ()))))) + (destructuring-bind (name &key symtab-property) + (if (consp name) name (list name)) + (handler-bind (((or warning error) + (lambda (c) + (declare (ignore c)) + (format *error-output* "~&;; In primitive function ~S:" name)))) + (multiple-value-bind (code-vector symtab) + (make-compiled-primitive body env nil docstring) + (setf (movitz-symbol-value (movitz-read name)) code-vector) + (when symtab-property + (setf (movitz-env-get name :symtab) + (translate-program symtab :movitz :muerte))) + (compiler-values ()))))))
(define-special-operator define-prototyped-function (&form form) (destructuring-bind (function-name proto-name &rest parameters)