Skip to content

Instantly share code, notes, and snippets.

@scymtym
scymtym / map.cl
Created September 26, 2022 13:43
:map example
;; 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
scymtym / basic-idea.lisp
Last active February 12, 2022 19:52
Task handler abuse
(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)))))
(cl:in-package #:language-extension.protocol.dispatch)
;;;
(defgeneric test (x))
(p:defprotocol (role) specializer-test ()
(:initarg :foo role)
(:method test ((x role))))
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:
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
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
scymtym / contiguous-numeric-set-type.lisp
Last active May 2, 2020 21:19
contiguous-numeric-set-type
(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
scymtym / REPL
Last active January 25, 2020 15:55
CLIM Protocol
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
scymtym / backtrace
Last active September 18, 2019 14:49
Backtrace
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
@scymtym
scymtym / Backtrace
Last active September 9, 2019 11:46
failed AVER:
(= (HASH-TABLE-COUNT SB-IMPL::TABLE) SB-IMPL::HWM)
This is probably a bug in SBCL itself. (Alternatively, SBCL
might have been corrupted by bad user code, e.g. by an undefined
Lisp operation like (FMAKUNBOUND 'COMPILE), or by stray pointers
from alien code or from unsafe Lisp code; or there might be a
bug in the OS or hardware that SBCL is running on.) If it seems
to be a bug in SBCL itself, the maintainers would like to know
about it. Bug reports are welcome on the SBCL mailing lists,
which you can find at <http://sbcl.sourceforge.net/>.