repos
/
smoke
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
headblob
|
headfilediff
|
filehistory
normal
|
plain
|
shade
|
zebra
Support the new smokegenerator (r1015073).
Annotate for file src/objects/enum.lisp
2009-04-05 tobias
1
(in-package :cxx-support)
15:36:29 '
2
'
3
(eval-when (:compile-toplevel :load-toplevel :execute)
'
4
(use-package :smoke :cxx-support))
'
5
'
6
;;; One could map enum-values to lisp symbols, store the type in the plist
2009-05-12 tobias
7
;;; an use those as enums, but C++ enums may have several symbols for
2009-04-05 tobias
8
;;; the same value and thus lisp symbols can not be used.
15:36:29 '
9
'
10
(defclass enum ()
'
11
((value :reader value
2009-05-28 tobias
12
:type integer
2009-04-05 tobias
13
:initarg :value)
15:36:29 '
14
(type :reader enum-type
'
15
:initarg :type))
'
16
(:documentation "Holds the integer value and type of an C++ enum value."))
'
17
2009-05-12 tobias
18
;; Clozure CL needs this
2009-06-30 tobias
19
;; for the constants (e.g.: QT:+ALT+)
2009-05-12 tobias
20
(defmethod make-load-form ((enum enum) &optional environment)
13:54:46 '
21
`(make-instance 'enum
'
22
:value ,(value enum)
2009-06-30 tobias
23
:type ,(make-load-form (enum-type enum) environment)))
2009-05-12 tobias
24
2009-04-05 tobias
25
(defmethod print-object ((enum enum) stream)
15:36:29 '
26
(print-unreadable-object (enum stream :type t)
'
27
(format stream "~A ~A" (name (enum-type enum))
'
28
(value enum))))
'
29
'
30
'
31
(defun check-enum-type (enum enum-type)
2009-05-11 tobias
32
(assert (smoke-type= (enum-type enum)
2009-08-02 tobias
33
enum-type)
2009-04-05 tobias
34
(enum enum-type)
15:36:29 '
35
"The enums ~A is not of type ~A." enum (name enum-type)))
'
36
'
37
(defun enum= (enum1 enum2)
'
38
"Returns true when ENUM1 and ENUM2 are equal and false otherwise."
'
39
(declare (enum enum1 enum2))
2009-05-11 tobias
40
(assert (smoke-type= (enum-type enum1)
2009-08-02 tobias
41
(enum-type enum2))
2009-04-05 tobias
42
(enum1 enum2)
15:36:29 '
43
"The enums ~A and ~A have a different type." enum1 enum2)
'
44
(= (value enum1) (value enum2)))
'
45
'
46
(defmacro enum-xcase (case keyform &body cases)
2009-08-27 tobias
47
(flet ((first-key (keys)
11:43:13 '
48
(if (listp keys)
'
49
(first keys)
'
50
keys)))
'
51
(let ((type (enum-type (eval (first-key (first (first cases)))))))
2009-04-05 tobias
52
(loop for case in cases do
2009-08-27 tobias
53
(check-enum-type (eval (first-key (first case)))
2009-04-05 tobias
54
type)))
15:36:29 '
55
`(progn
2009-08-27 tobias
56
;; (check-enum-type (enum-type ,keyform)
11:43:13 '
57
;; (enum-type ,(first (first cases))))
2009-04-05 tobias
58
(,case (value ,keyform)
15:36:29 '
59
,@(loop for case in cases
2009-08-27 tobias
60
collect `(,(if (listp (first case))
11:43:13 '
61
(mapcar #'(lambda (c)
'
62
(print c)
'
63
(value (eval c)))
'
64
(first case))
'
65
(value (eval (first case))))
'
66
,@(rest case)))))))
2009-04-05 tobias
67
15:36:29 '
68
(defmacro enum-case (keyform &body cases)
'
69
`(enum-xcase case ,keyform ,@cases))
'
70
'
71
(defmacro enum-ecase (keyform &body cases)
'
72
`(enum-xcase ecase ,keyform ,@cases))
'
73
'
74
(defmacro enum-cases (keyform &body cases)
'
75
"Keyform returns a number; cases are enums."
'
76
`(case ,keyform
'
77
,@(loop for case in cases
2009-08-02 tobias
78
collect `(,(value (eval (first case)))
10:12:41 '
79
,@(rest case)))))
2009-04-05 tobias
80
15:36:29 '
81
(defun enum-logand (&rest enums)
'
82
(apply #'logand (mapcar #'value enums)))
2009-06-08 tobias
83
(defun enum-logior (&rest enums)
09:20:54 '
84
(apply #'logior (mapcar #'value enums)))
'
85