aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDaniel Colascione2014-04-20 07:46:13 -0700
committerDaniel Colascione2014-04-20 07:46:13 -0700
commite100022976f0e878ce88cf4a0230cbee86951ba1 (patch)
tree475daf4475e8036f3bad77206095efaab3fef8c5
parentad80bf1720695dd104924238bcbb8e03c48af737 (diff)
downloademacs-e100022976f0e878ce88cf4a0230cbee86951ba1.tar.gz
emacs-e100022976f0e878ce88cf4a0230cbee86951ba1.zip
unbreak the build
-rw-r--r--lisp/emacs-lisp/cl-macs.el122
1 files changed, 62 insertions, 60 deletions
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index b0a5c442d46..5fc8c9f9a42 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2624,66 +2624,6 @@ does not contain SLOT-NAME."
2624 (error "struct %s has no slot %s" struct-type slot-name))) 2624 (error "struct %s has no slot %s" struct-type slot-name)))
2625(put 'cl-struct-slot-offset 'side-effect-free t) 2625(put 'cl-struct-slot-offset 'side-effect-free t)
2626 2626
2627(defun cl-struct-slot-value (struct-type slot-name inst)
2628 "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
2629STRUCT and SLOT-NAME are symbols. INST is a structure instance."
2630 (unless (cl-typep inst struct-type)
2631 (signal 'wrong-type-argument (list struct-type inst)))
2632 (elt inst (cl-struct-slot-offset struct-type slot-name)))
2633(put 'cl-struct-slot-value 'side-effect-free t)
2634
2635(defun cl-struct-set-slot-value (struct-type slot-name inst value)
2636 "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE.
2637STRUCT and SLOT-NAME are symbols. INST is a structure instance.
2638VALUE is the value to which to set the given slot. Return
2639VALUE."
2640 (unless (cl-typep inst struct-type)
2641 (signal 'wrong-type-argument (list struct-type inst)))
2642 (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value))
2643
2644(defsetf cl-struct-slot-value cl-struct-set-slot-value)
2645
2646(cl-define-compiler-macro cl-struct-slot-value
2647 (&whole orig struct-type slot-name inst)
2648 (or (let* ((macenv macroexpand-all-environment)
2649 (struct-type (cl--const-expr-val struct-type macenv))
2650 (slot-name (cl--const-expr-val slot-name macenv)))
2651 (and struct-type (symbolp struct-type)
2652 slot-name (symbolp slot-name)
2653 (assq slot-name (cl-struct-slot-info struct-type))
2654 (let ((idx (cl-struct-slot-offset struct-type slot-name)))
2655 (cl-ecase (cl-struct-sequence-type struct-type)
2656 (vector `(aref (cl-the ,struct-type ,inst) ,idx))
2657 (list `(nth ,idx (cl-the ,struct-type ,inst)))))))
2658 orig))
2659
2660(cl-define-compiler-macro cl-struct-set-slot-value
2661 (&whole orig struct-type slot-name inst value)
2662 (or (let* ((macenv macroexpand-all-environment)
2663 (struct-type (cl--const-expr-val struct-type macenv))
2664 (slot-name (cl--const-expr-val slot-name macenv)))
2665 (and struct-type (symbolp struct-type)
2666 slot-name (symbolp slot-name)
2667 (assq slot-name (cl-struct-slot-info struct-type))
2668 (let ((idx (cl-struct-slot-offset struct-type slot-name)))
2669 (cl-ecase (cl-struct-sequence-type struct-type)
2670 (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx)
2671 ,value))
2672 (list `(setf (nth ,idx (cl-the ,struct-type ,inst))
2673 ,value))))))
2674 orig))
2675
2676;;; Types and assertions.
2677
2678;;;###autoload
2679(defmacro cl-deftype (name arglist &rest body)
2680 "Define NAME as a new data type.
2681The type name can then be used in `cl-typecase', `cl-check-type', etc."
2682 (declare (debug cl-defmacro) (doc-string 3))
2683 `(cl-eval-when (compile load eval)
2684 (put ',name 'cl-deftype-handler
2685 (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
2686
2687(defvar byte-compile-function-environment) 2627(defvar byte-compile-function-environment)
2688(defvar byte-compile-macro-environment) 2628(defvar byte-compile-macro-environment)
2689 2629
@@ -2985,6 +2925,68 @@ The function's arguments should be treated as immutable.
2985 '(eql cl-list* cl-subst cl-acons cl-equalp 2925 '(eql cl-list* cl-subst cl-acons cl-equalp
2986 cl-random-state-p copy-tree cl-sublis)) 2926 cl-random-state-p copy-tree cl-sublis))
2987 2927
2928;;; Types and assertions.
2929
2930;;;###autoload
2931(defmacro cl-deftype (name arglist &rest body)
2932 "Define NAME as a new data type.
2933The type name can then be used in `cl-typecase', `cl-check-type', etc."
2934 (declare (debug cl-defmacro) (doc-string 3))
2935 `(cl-eval-when (compile load eval)
2936 (put ',name 'cl-deftype-handler
2937 (cl-function (lambda (&cl-defs '('*) ,@arglist) ,@body)))))
2938
2939;;; Additional functions that we can now define because we've defined
2940;;; `cl-define-compiler-macro' and `cl-typep'.
2941
2942(defun cl-struct-slot-value (struct-type slot-name inst)
2943 "Return the value of slot SLOT-NAME in INST of STRUCT-TYPE.
2944STRUCT and SLOT-NAME are symbols. INST is a structure instance."
2945 (unless (cl-typep inst struct-type)
2946 (signal 'wrong-type-argument (list struct-type inst)))
2947 (elt inst (cl-struct-slot-offset struct-type slot-name)))
2948(put 'cl-struct-slot-value 'side-effect-free t)
2949
2950(defun cl-struct-set-slot-value (struct-type slot-name inst value)
2951 "Set the value of slot SLOT-NAME in INST of STRUCT-TYPE.
2952STRUCT and SLOT-NAME are symbols. INST is a structure instance.
2953VALUE is the value to which to set the given slot. Return
2954VALUE."
2955 (unless (cl-typep inst struct-type)
2956 (signal 'wrong-type-argument (list struct-type inst)))
2957 (setf (elt inst (cl-struct-slot-offset struct-type slot-name)) value))
2958
2959(gv-define-simple-setter cl-struct-slot-value cl-struct-set-slot-value)
2960
2961(cl-define-compiler-macro cl-struct-slot-value
2962 (&whole orig struct-type slot-name inst)
2963 (or (let* ((macenv macroexpand-all-environment)
2964 (struct-type (cl--const-expr-val struct-type macenv))
2965 (slot-name (cl--const-expr-val slot-name macenv)))
2966 (and struct-type (symbolp struct-type)
2967 slot-name (symbolp slot-name)
2968 (assq slot-name (cl-struct-slot-info struct-type))
2969 (let ((idx (cl-struct-slot-offset struct-type slot-name)))
2970 (cl-ecase (cl-struct-sequence-type struct-type)
2971 (vector `(aref (cl-the ,struct-type ,inst) ,idx))
2972 (list `(nth ,idx (cl-the ,struct-type ,inst)))))))
2973 orig))
2974
2975(cl-define-compiler-macro cl-struct-set-slot-value
2976 (&whole orig struct-type slot-name inst value)
2977 (or (let* ((macenv macroexpand-all-environment)
2978 (struct-type (cl--const-expr-val struct-type macenv))
2979 (slot-name (cl--const-expr-val slot-name macenv)))
2980 (and struct-type (symbolp struct-type)
2981 slot-name (symbolp slot-name)
2982 (assq slot-name (cl-struct-slot-info struct-type))
2983 (let ((idx (cl-struct-slot-offset struct-type slot-name)))
2984 (cl-ecase (cl-struct-sequence-type struct-type)
2985 (vector `(setf (aref (cl-the ,struct-type ,inst) ,idx)
2986 ,value))
2987 (list `(setf (nth ,idx (cl-the ,struct-type ,inst))
2988 ,value))))))
2989 orig))
2988 2990
2989(run-hooks 'cl-macs-load-hook) 2991(run-hooks 'cl-macs-load-hook)
2990 2992