digikar99 / extensible-compound-types Goto Github PK

(defpackage parametric-types-demo
  (:use #:extensible-compound-types-cl
        #:polymorphic-functions))

(in-package :parametric-types-demo)

(defstruct pair a b)

(define-compound-type pair (o &optional (type-a 'cl:*) (type-b 'cl:*))
  "A user-defined compound-type that allows the specification of the
types of the values stored in slots A and B of the structure-class
PAIR."
  (and (cl:typep o 'pair)
       (with-slots (a b) o
         (and (if (eq 'cl:* type-a)
                  t
                  (cl:typep a type-a))
              (if (eq 'cl:* type-b)
                  t
                  (cl:typep b type-b))))))

* (push :extensible-compound-types cl:*features*)
(:EXTENSIBLE-COMPOUND-TYPES :QUICKLISP :ASDF3.3 :ASDF3.2 :ASDF3.1 :ASDF3 :ASDF2
 :ASDF :OS-UNIX :NON-BASE-CHARS-EXIST-P :ASDF-UNICODE :SINGLE-FLOAT-TRAN
 :X86-64 :GENCGC :64-BIT :ANSI-CL :BSD :COMMON-LISP :ELF :FREEBSD
 :IEEE-FLOATING-POINT :LITTLE-ENDIAN :PACKAGE-LOCAL-NICKNAMES
 :SB-CORE-COMPRESSION :SB-LDB :SB-PACKAGE-LOCKS :SB-THREAD :SB-UNICODE :SBCL
 :UNIX)
*
(ql:quickload :polymorphic-functions)
To load "polymorphic-functions":
  Load 1 ASDF system:
    polymorphic-functions
; Loading "polymorphic-functions"
..................................................
[package polymorphic-functions.defpackage]........
[package polymorphic-functions.extended-types]....
[package polymorphic-functions.nonuser]...........
[package polymorphic-functions]...................
.................................
(:POLYMORPHIC-FUNCTIONS)
* (ql:quickload :extensible-compound-types)
To load "extensible-compound-types":
  Load 1 ASDF system:
    extensible-compound-types
; Loading "extensible-compound-types"

(:EXTENSIBLE-COMPOUND-TYPES)
* (ql:quickload :extensible-compound-types-cl)
To load "extensible-compound-types-cl":
  Load 1 ASDF system:
    extensible-compound-types-cl
; Loading "extensible-compound-types-cl"

(:EXTENSIBLE-COMPOUND-TYPES-CL)
* (compile-file "~/testext.lisp")
; compiling file "~/testext.lisp" (written 08 SEP 2022 07:54:13 PM):
; processing (DEFPACKAGE PARAMETRIC-TYPES-DEMO ...)
; processing (IN-PACKAGE :PARAMETRIC-TYPES-DEMO)
; processing (DEFSTRUCT PAIR ...)
; processing (DEFINE-COMPOUND-TYPE PAIR ...)
; file: ~/testext.lisp
; in: DEFINE-COMPOUND-TYPE PAIR
;     (EXTENSIBLE-COMPOUND-TYPES:DEFINE-COMPOUND-TYPE PARAMETRIC-TYPES-DEMO::PAIR
;         (PARAMETRIC-TYPES-DEMO::O &OPTIONAL (PARAMETRIC-TYPES-DEMO::TYPE-A '*)
;          (PARAMETRIC-TYPES-DEMO::TYPE-B '*))
;       "A user-defined compound-type that allows the specification of the
;   types of the values stored in slots A and B of the structure-class
;   PAIR."
;       (AND (TYPEP PARAMETRIC-TYPES-DEMO::O 'PARAMETRIC-TYPES-DEMO::PAIR)
;            (EXTENSIBLE-COMPOUND-TYPES-CL:WITH-SLOTS (PARAMETRIC-TYPES-DEMO::A
;                                                      PARAMETRIC-TYPES-DEMO::B)
;                PARAMETRIC-TYPES-DEMO::O
;              (AND
;               (IF #
;                   T
;                   #)
;               (IF #
;                   T
;                   #)))))
; --> DEFTYPE PROGN EVAL-WHEN
; ==>
;   (SB-IMPL::%DEFTYPE 'PARAMETRIC-TYPES-DEMO::PAIR
;                      (SB-INT:NAMED-LAMBDA (SB-IMPL::TYPE-EXPANDER
;                                            PARAMETRIC-TYPES-DEMO::PAIR)
;                          (#:EXPR &AUX (#:FORM0 #:EXPR))
;                        (DECLARE (SB-C::LAMBDA-LIST (&OPTIONAL # #)))
;                        (SB-INT:NAMED-DS-BIND (:MACRO
;                                               PARAMETRIC-TYPES-DEMO::PAIR
;                                               . DEFTYPE)
;                            (&OPTIONAL (PARAMETRIC-TYPES-DEMO::TYPE-A '*)
;                             (PARAMETRIC-TYPES-DEMO::TYPE-B '*))
;                            (CDR #:EXPR)
;                          (DECLARE
;                           (SB-C::CONSTANT-VALUE PARAMETRIC-TYPES-DEMO::TYPE-A
;                                                 PARAMETRIC-TYPES-DEMO::TYPE-B))
;                          (DECLARE
;                           (IGNORE PARAMETRIC-TYPES-DEMO::TYPE-A
;                            PARAMETRIC-TYPES-DEMO::TYPE-B))
;                          (BLOCK PARAMETRIC-TYPES-DEMO::PAIR
;                            (EXTENSIBLE-COMPOUND-TYPES:UPGRADED-CL-TYPE
;                             #:FORM0))))
;                      NIL)
;
; caught WARNING:
;   The class PAIR is being redefined to be a DEFTYPE.