Custom Query (1030 matches)

Something seems fishy when inlining TRUNCATE:

Welcome to Clozure Common Lisp Version 1.5-dev-r13524M-trunk  (LinuxX8632)!
? (defun foo (x y) (declare (type fixnum x y)) (truncate x y))
FOO
? (foo most-negative-fixnum -1)
-536870912
0
? (truncate most-negative-fixnum -1)
536870912
0
? 

SLSIA. Here's an example:

Welcome to Clozure Common Lisp Version 1.5-dev-r13442M-trunk  (DarwinX8664)!
? (#/title (car (gui::windows)))
#<NS-MUTABLE-STRING "Listener" (#x1D03B0)>
? (set-macro-character #\e (lambda (stream char) char) t)
;Compiler warnings :
;   In an anonymous lambda form at position 25: Unused lexical variable STREAM
T
? (#/title (car (gui::windows)))
> Error: Undefined function NEXTSTEP-FUNCTIONS:|titl| called with arguments (#\e #<HEMLOCK-LISTENER-FRAME <HemlockListenerFrame: 0x1cd640> (#x1CD640)>) .

Here's the fix:

(set-dispatch-macro-character #\# #\/
  (let ((rt (copy-readtable nil)))
    (lambda (stream subchar numarg)
      (declare (ignorable subchar numarg))
      (let* ((token (make-array 16 :element-type 'character :fill-pointer 0 :adjustable t))
             (attrtab (rdtab.ttab rt)))
        (when (peek-char t stream nil nil)
          (loop
            (multiple-value-bind (char attr)
                                 (%next-char-and-attr stream attrtab)
              (unless (eql attr $cht_cnst)
                (when char (unread-char char stream))
                (return))
              (vector-push-extend char token))))
        (unless *read-suppress*
          (unless (> (length token) 0)
            (signal-reader-error stream "Invalid token after #/."))
          (check-objc-message-name token)
          (intern token "NSFUN"))))))

NOTE: This issue is related to the issue of reader macros affecting the syntax of uninterned symbols, which generate some controversy on the mailing list. In this case, the syntax of objective-C function names is not governed by the ANSI standard, so the controversy is moot.

while testing clx, with ccl-1-4, i observed that it misinterprets type declarations. it appears that this is a change from ccl-1-1. the actual instance was in clx's buffer.lisp#write-sequence-card8.

? yoda:/Development/Source/production/Library/de/setf/graphics janson$ /Development/Applications/LISP/ccl-1-3/dppccl
;Loading #P"P-LIBRARY:net;common-lisp;asdf;asdf.lisp.newest"...
Welcome to Clozure Common Lisp Version 1.3-r11936  (DarwinPPC32)!
? (defun test-type (x)
        (declare (type (or null (function (t) t)) x))
        x)
TEST-TYPE
? (disassemble 'test-type)
  (TWNEI NARGS 4)
  (MFLR LOC-PC)
  (BLA .SPSAVECONTEXTVSP)
  (VPUSH ARG_Z)
  (LWZ ARG_Z 0 VSP)
  (BA .SPPOPJ)
? (test-type #'(lambda (x) x))
#<Anonymous Function #x87253D6>
? ^D
? ^D
? yoda:/Development/Source/production/Library/de/setf/graphics janson$ /Development/Applications/LISP/ccl-1-4/dppccl
;Loading #P"P-LIBRARY:net;common-lisp;asdf;asdf..newest"...
Welcome to Clozure Common Lisp Version 1.4-r13119  (DarwinPPC32)!
? (defun test-type (x)
        (declare (type (or null (function (t) t)) x))
        x)
TEST-TYPE
? (disassemble 'test-type)
  (TWNEI NARGS 4)
  (MFLR LOC-PC)
  (BLA .SPSAVECONTEXTVSP)
  (VPUSH ARG_Z)
  (LWZ ARG_Y 0 VSP)
  (LWZ ARG_Z '(OR NULL (FUNCTION (T) T)) FN)
  (LWZ TEMP3 'TYPEP FN)
  (SET-NARGS 2)
  (VPUSH ARG_Y)
  (LWZ TEMP2 6 TEMP3)
  (LWZ TEMP0 -2 TEMP2)
  (MTCTR TEMP0)
  (BCTRL)
  (CMPWI ARG_Z NIL)
  (LWZ ARG_Y 0 VSP)
  (LA VSP 4 VSP)
  (BNE L84)
  (LI ARG_X '157)
  (LWZ ARG_Z '(OR NULL (FUNCTION (T) T)) FN)
  (SET-NARGS 3)
  (BLA .SPKSIGNALERR)
L84 
  (LWZ ARG_Z 0 VSP)
  (BA .SPPOPJ)
? (test-type nil)
NIL
? (test-type #'(lambda (x) x))
> Error: Function types are not a legal argument to TYPEP:
>          (FUNCTION (T) T)
> While executing: CCL::%%TYPEP, in process listener(1).
> Type :POP to abort, :R for a list of available restarts.
> Type :? for other options.
1 > :a

it is possible to suppress the check

? (defun test-type (x)
        (declare (optimize (speed 3) (safety 0)))
        (declare (type (or null (function (t) t)) x))
        x)
TEST-TYPE
? (disassemble 'test-type)
  (MFLR LOC-PC)
  (LWZ IMM0 44 RCONTEXT)
  (STWU SP -16 SP)
  (STW FN 4 SP)
  (STW LOC-PC 8 SP)
  (STW VSP 12 SP)
  (MR FN TEMP2)
  (TWLLT SP IMM0)
  (VPUSH ARG_Z)
  (LWZ ARG_Z 0 VSP)
  (LWZ LOC-PC 8 SP)
  (LWZ VSP 12 SP)
  (LWZ FN 4 SP)
  (MTLR LOC-PC)
  (LA SP 16 SP)
  (BLR)
? (test-type #'(lambda (x) x))
#<Anonymous Function #x8890F76>
? 

with extreme measures. is there some intermediate way to control this?