scymtym

(cl:defpackage #:s-expression-syntax.examples.diagram
  (:use
   #:cl))

(cl:in-package #:s-expression-syntax.examples.diagram)

;;; We parse a given expression and format it as a tree. As you can
;;; see, we need three helper functions: 1) draw a given node 2)
;;; compute the children of a given node 3) draw a relation as an edge
;;; between a parent node and a child node.

scymtym

;; for (defclass … (:default-initargs :foo 5 :bar 6))

  CL-USER> (defvar *ast*
	           (bp:with-builder ('list) 
	             (bp:node* (:defclass) 
	               (1 (:default-initarg . (:map . :name)) (bp:node* (:initform :value 5)) :name :foo)
	               (1 (:default-initarg . (:map . :name)) (bp:node* (:initform :value 6)) :name :bar))))
*AST*

CL-USER> (architecture.builder-protocol.print-tree:print-tree 'list *ast* *standard-output*)

scymtym

(define-condition get-context (condition) 
  ())

(lparallel:task-handler-bind ((get-context (lambda (c) 
                                (declare (ignore c)) 
                                (invoke-restart 'receive :my-context))))
  (lparallel:pdotimes (i 5)
    (print (restart-case (signal 'get-context) (receive (value) value)))))

scymtym

(cl:in-package #:language-extension.protocol.dispatch)

;;;

(defgeneric test (x))

(p:defprotocol (role) specializer-test ()
  (:initarg :foo role)
  (:method test ((x role))))

scymtym

COMMON-LISP:WARNING:
   /home/jmoringe/code/cl/mcclim/Apps/Debugger/clim-debugger.lisp
  Symbol SWANK/BACKEND:CONDITION-EXTRAS written as SWANK::CONDITION-EXTRAS
COMMON-LISP:WARNING:
   /home/jmoringe/code/cl/mcclim/Apps/Listener/dev-commands.lisp
  Symbol COMMON-LISP:SYMBOL written as CLIM::SYMBOL
COMMON-LISP:WARNING:
   /home/jmoringe/code/cl/mcclim/Apps/Listener/dev-commands.lisp
  Symbol COMMON-LISP:SYMBOL written as CLIM::SYMBOL
COMMON-LISP:WARNING:

scymtym

Running test suite CLIM-PDF
 Running test SMOKE Help! 11 nested errors. SB-KERNEL:*MAXIMUM-ERROR-DEPTH* exceeded.
Backtrace for: #<SB-THREAD:THREAD "repl-thread" RUNNING {10058F9DC3}>
0: (SB-KERNEL::CTYPE-OF-ARRAY #<unknown pointer object, widetag=#x83 {7FCD156966EF}>)
1: (TYPE-OF #<unknown pointer object, widetag=#x83 {7FCD156966EF}>)
2: (SB-KERNEL:ALLOCATE-CONDITION TYPE-ERROR :DATUM #<unknown pointer object, widetag=#x83 {7FCD156966EF}> :EXPECTED-TYPE SEQUENCE :CONTEXT NIL)
3: (MAKE-CONDITION TYPE-ERROR :DATUM #<unknown pointer object, widetag=#x83 {7FCD156966EF}> :EXPECTED-TYPE SEQUENCE :CONTEXT NIL)
4: (MAKE-CONDITION TYPE-ERROR :DATUM #<unknown pointer object, widetag=#x83 {7FCD156966EF}> :EXPECTED-TYPE SEQUENCE :CONTEXT NIL) [more]
5: (SB-KERNEL:COERCE-TO-CONDITION TYPE-ERROR SIMPLE-ERROR ERROR :DATUM #<unknown pointer object, widetag=#x83 {7FCD156966EF}> :EXPECTED-TYPE SEQUENCE :CONTEXT NIL) [more]
6: (ERROR TYPE-ERROR :DATUM #<unknown pointer object, widetag=#x83 {7FCD156966EF}> :EXPECTED-TYPE SEQUEN

scymtym

Error: CLIM:WITH-ACCEPT-HELP                            not implemented as :MACRO.
Error: CLIM:UNHIGHLIGHT-HIGHLIGHTED-PRESENTATION        not implemented as :FUNCTION.
Error: T                                                not in spec.
Error: STREAMP                                          not implemented as :GENERIC-FUNCTION.
Error: CLIM:STREAM-SET-CURSOR-POSITION                  not in spec.
Error: CLIM:SET-HIGHLIGHTED-PRESENTATION                not implemented as :FUNCTION.
Error: CLIM:SCALING-TRANSFORMATION-P                    not in spec.
Error: CLIM:REMOVE-PRESENTATION-TRANSLATOR-FROM-COMMAND-TABLE not implemented as :FUNCTION.
Error: CLIM:RECOMPUTE-CONTENTS-OK                       not implemented as :GENERIC-FUNCTION.
Error: CLIM:READ-BITMAP-FILE                            not implemented as :GENERIC-FUNCTION.

scymtym

(defun contiguous-numeric-set-type (xset)
  (let ((members (xset-members xset)))
    (cond ((null members)
           nil)
          ((null (cdr members))
           (ctype-of (car members)))
          ;; Is MEMBERS a contiguous integer range?
          ((loop for x in members
                 always (integerp x)
                 minimizing x into min

scymtym

CLIMI> (defclass foo () ())
#<STANDARD-CLASS CLIM-INTERNALS::FOO>
CLIMI> (report '((foo . gadget)) 'labelled-gadget-protocol)
For (FOO . GADGET) the following LABELLED-GADGET-PROTOCOL methods are not implemented
  • TRAIT-METHOD (SETF GADGET-CLIENT) (CLIENT GADGET) [from GADGET-PROTOCOL trait]
  • TRAIT-METHOD (SETF GADGET-ID) (ID GADGET) [from GADGET-PROTOCOL trait]
  • TRAIT-METHOD (SETF GADGET-LABEL) (NEW-VALUE GADGET) [from LABELLED-GADGET-PROTOCOL trait]
  • TRAIT-METHOD (SETF GADGET-LABEL-ALIGN-X) (NEW-VALUE GADGET) [from LABELLED-GADGET-PROTOCOL trait]
  • TRAIT-METHOD (SETF GADGET-LABEL-ALIGN-Y) (NEW-VALUE GADGET) [from LABELLED-GADGET-PROTOCOL trait]
  • TRAIT-METHOD ACTIVATE-GADGET (GADGET) [from GADGET-PROTOCOL trait]

scymtym

after REMHASH: hwm=852 ct=812 free=39 (796 798 797 795 794 802
                                         803 805 804 801 800 807
                                         808 809 810 811 812 813
                                         806 799 793 792 521 522
                                         523 524 525 526 527 528
                                         529 530 531 532 533 534
                                         520 519 538)

This is probably a bug in SBCL itself. (Alternatively, SBCL
might have been corrupted by bad user code, e.g. by an undefined