Plaster

common-lisp
;;; /tmp/mc.lisp (defpackage :mc-test (:use :cl ) (:export )) (in-package :mc-test) (defun positive-integer-qualifier-p (method-qualifiers) (and (= (length method-qualifiers) 1) (typep (first method-qualifiers) '(integer 0 *)))) (define-method-combination example-method-combination () ((methods positive-integer-qualifier-p)) `(progn ,@(mapcar #'(lambda (method) `(call-method ,method)) (stable-sort methods #'< :key #'(lambda (method) (first (method-qualifiers method))))))) (defgeneric quux (a) (:method-combination example-method-combination)) (defmethod quux 0 (a) (format t "hi there")) (defmethod quux 1 (a) (format t "bye?")) (defun main () (quux 4)) ;; ? (load (compile-file "/tmp/mc.lisp")) ? (in-package :mc-test) ? (main) #| ==> > Error: The value 1 is not of the expected type (OR STRING SYMBOL CHARACTER). > While executing: STRING, in process listener(1). > Type :POP to abort, :R for a list of available restarts. > Type :? for other options. 1 > (:b) (1CC9778) : 0 (STRING 1) 373 (1CC9790) : 1 (STRING-START-END 1 NIL NIL) 45 (1CC97B8) : 2 (STRING-COMPARE 1 NIL NIL 0 NIL NIL) 165 (1CC9808) : 3 (STRING-LESSP 1 0 :START1 NIL :END1 NIL :START2 NIL :END2 NIL) 141 (1CC9870) : 4 (FUNCALL #'#<(:INTERNAL CCL::QUALIFIER-LIST< CCL::METHOD-QUALIFIERS<)> (1) (0)) 205 (1CC98A0) : 5 (MERGE-LISTS*-NO-KEY (#<STANDARD-METHOD QUUX 0 #>) (#<STANDARD-METHOD QUUX 1 #>) #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::SIMPLE-SORT-FN CCL::SORT-METHODS) #x1DEC31F>) 253 (1CC98E8) : 6 (SORT-LIST (#<STANDARD-METHOD QUUX 0 #>) #<CCL:COMPILED-LEXICAL-CLOSURE (:INTERNAL CCL::SIMPLE-SORT-FN CCL::SORT-METHODS) #x1DEC31F> NIL) 1261 (1CC9958) : 7 (SORT-METHODS (#<STANDARD-METHOD QUUX 0 #>) (#<BUILT-IN-CLASS FIXNUM> #<BUILT-IN-CLASS INTEGER> #<BUILT-IN-CLASS RATIONAL> #<BUILT-IN-CLASS REAL> #<BUILT-IN-CLASS NUMBER> ...) NIL) 389 (1CC9990) : 8 (COMPUTE-1ST-ARG-COMBINED-METHOD #<STANDARD-GENERIC-FUNCTION QUUX #x302000A9C59F> 4 #<CCL::CLASS-WRAPPER FIXNUM #x30200001FC0D>) 957 (1CC99F0) : 9 (1ST-ARG-COMBINED-METHOD-TRAP #<STANDARD-GENERIC-FUNCTION QUUX #x302000A9C59F> #<CCL::CLASS-WRAPPER FIXNUM #x30200001FC0D> 4) 85 (1CC9A20) : 10 (%%ONE-ARG-DCODE #((#<#> #<#>) NIL NIL 0 #<STANDARD-GENERIC-FUNCTION QUUX #x302000A9C59F> ...) 4) 405 (1CC9A80) : 11 (CALL-CHECK-REGS MAIN) 229 (1CC9AB8) : 12 (TOPLEVEL-EVAL (MAIN) NIL) 789 (1CC9B30) : 13 (READ-LOOP :INPUT-STREAM #<SYNONYM-STREAM to *TERMINAL-IO* #x30200046C34D> :OUTPUT-STREAM #<SYNONYM-STREAM to *TERMINAL-IO* #x30200046C1ED> :BREAK-LEVEL 0 :PROMPT-FUNCTION #<Compiled-function (:INTERNAL CCL::READ-LOOP) (Non-Global) #x3000005849BF>) 2421 (1CC9D78) : 14 (RUN-READ-LOOP :BREAK-LEVEL 0) 157 (1CC9DA0) : 15 (TOPLEVEL-LOOP) 93 (1CC9DB0) : 16 (FUNCALL #'#<(:INTERNAL (CCL:TOPLEVEL-FUNCTION (CCL::LISP-DEVELOPMENT-SYSTEM T)))>) 109 (1CC9DD0) : 17 (FUNCALL #'#<(:INTERNAL CCL::MAKE-MCL-LISTENER-PROCESS)>) 661 (1CC9E68) : 18 (RUN-PROCESS-INITIAL-FORM #<TTY-LISTENER listener(1) [Active] #x30200046B1AD> (#<CCL:COMPILED-LEXICAL-CLOSURE # #x30200046ACDF>)) 741 (1CC9EF0) : 19 (FUNCALL #'#<(:INTERNAL (CCL::%PROCESS-PRESET-INTERNAL (CCL:PROCESS)))> #<TTY-LISTENER listener(1) [Active] #x30200046B1AD> (#<CCL:COMPILED-LEXICAL-CLOSURE # #x30200046ACDF>)) 581 (1CC9F98) : 20 (FUNCALL #'#<(:INTERNAL CCL::THREAD-MAKE-STARTUP-FUNCTION)>) 277 |#