darcs - smoke

1 (in-package :cxx-support)

3 (eval-when (:compile-toplevel :load-toplevel :execute)

4 (use-package :smoke :cxx-support))

6 ;;; One could map enum-values to lisp symbols, store the type in the plist

7 ;;; an use those as enums, but C++ enums may have several symbols for

8 ;;; the same value and thus lisp symbols can not be used.

10 (defclass enum ()

11 ((value :reader value

12 :type integer

13 :initarg :value)

14 (type :reader enum-type

15 :initarg :type))

16 (:documentation "Holds the integer value and type of an C++ enum value."))

18 ;; Clozure CL needs this

19 ;; for the constants (e.g.: QT:+ALT+)

20 (defmethod make-load-form ((enum enum) &optional environment)

21 `(make-instance 'enum

22 :value ,(value enum)

23 :type ,(make-load-form (enum-type enum) environment)))

25 (defmethod print-object ((enum enum) stream)

26 (print-unreadable-object (enum stream :type t)

27 (format stream "~A ~A" (name (enum-type enum))

28 (value enum))))

31 (defun check-enum-type (enum enum-type)

32 (assert (smoke-type= (enum-type enum)

33 enum-type)

34 (enum enum-type)

35 "The enums ~A is not of type ~A." enum (name enum-type)))

37 (defun enum= (enum1 enum2)

38 "Returns true when ENUM1 and ENUM2 are equal and false otherwise."

39 (declare (enum enum1 enum2))

40 (assert (smoke-type= (enum-type enum1)

41 (enum-type enum2))

42 (enum1 enum2)

43 "The enums ~A and ~A have a different type." enum1 enum2)

44 (= (value enum1) (value enum2)))

46 (defmacro enum-xcase (case keyform &body cases)

47 (flet ((first-key (keys)

48 (if (listp keys)

49 (first keys)

50 keys)))

51 (let ((type (enum-type (eval (first-key (first (first cases)))))))

52 (loop for case in cases do

53 (check-enum-type (eval (first-key (first case)))

54 type)))

55 `(progn

56 ;; (check-enum-type (enum-type ,keyform)

57 ;; (enum-type ,(first (first cases))))

58 (,case (value ,keyform)

59 ,@(loop for case in cases

60 collect `(,(if (listp (first case))

61 (mapcar #'(lambda (c)

62 (print c)

63 (value (eval c)))

64 (first case))

65 (value (eval (first case))))

66 ,@(rest case)))))))

68 (defmacro enum-case (keyform &body cases)

69 `(enum-xcase case ,keyform ,@cases))

71 (defmacro enum-ecase (keyform &body cases)

72 `(enum-xcase ecase ,keyform ,@cases))

74 (defmacro enum-cases (keyform &body cases)

75 "Keyform returns a number; cases are enums."

76 `(case ,keyform

77 ,@(loop for case in cases

78 collect `(,(value (eval (first case)))

79 ,@(rest case)))))

81 (defun enum-logand (&rest enums)

82 (apply #'logand (mapcar #'value enums)))

84 (defun enum-logior (&rest enums)

85 (apply #'logior (mapcar #'value enums)))