diff options
| author | Daniel Colascione | 2014-04-20 07:46:13 -0700 |
|---|---|---|
| committer | Daniel Colascione | 2014-04-20 07:46:13 -0700 |
| commit | e100022976f0e878ce88cf4a0230cbee86951ba1 (patch) | |
| tree | 475daf4475e8036f3bad77206095efaab3fef8c5 | |
| parent | ad80bf1720695dd104924238bcbb8e03c48af737 (diff) | |
| download | emacs-e100022976f0e878ce88cf4a0230cbee86951ba1.tar.gz emacs-e100022976f0e878ce88cf4a0230cbee86951ba1.zip | |
unbreak the build
| -rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 122 |
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. | ||
| 2629 | STRUCT 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. | ||
| 2637 | STRUCT and SLOT-NAME are symbols. INST is a structure instance. | ||
| 2638 | VALUE is the value to which to set the given slot. Return | ||
| 2639 | VALUE." | ||
| 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. | ||
| 2681 | The 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. | ||
| 2933 | The 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. | ||
| 2944 | STRUCT 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. | ||
| 2952 | STRUCT and SLOT-NAME are symbols. INST is a structure instance. | ||
| 2953 | VALUE is the value to which to set the given slot. Return | ||
| 2954 | VALUE." | ||
| 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 | ||