Steel Bank Common Lisp

Jeronimo Pellegrini wrote:

> I see that when dealing with fixnums only [...]

What exactly do you mean by that?

> (let ((middle (floor (+ start end) 2)) ...

Just from that code fragment, it cannot be inferred that (+ start end)
returns a fixnum, so you will have to declare it. Is there more context
from which the compiler could learn that?

Chris

On Wed, Aug 01, 2007 at 03:59:49PM +0200, Chris Laux wrote:
> Jeronimo Pellegrini wrote:
> 
> > I see that when dealing with fixnums only [...]
> 
> What exactly do you mean by that?

I wasn't clear -- sorry!

> > (let ((middle (floor (+ start end) 2)) ...
> 
> Just from that code fragment, it cannot be inferred that (+ start end)
> returns a fixnum, so you will have to declare it. Is there more context
> from which the compiler could learn that?

So -- I have written this simple binary search function that I tried to
make as generic as possible, but also as fast as possible. I thought
that since I did not declare "middle" to be fixnum, and #'+ could return
a bignum, the compiler would complain. But it didn't.

J.

Here's the function:


(defun binary-search (the-element vector &key
		      (test= #'eql)
		      (test< #'<)
		      (get-element #'svref)
		      (start 0)
		      (end (1- (length vector)))
		      (not-found nil))
  "Performs a binary search for an element el on a (sorted) array vec.
Return values:
   - The index where the element was found
   - Either t (if el was found) or nil (if el was not found) You can 
     ask the function to return something else on failure.
Named parameters:
   - get-element is the function used to retrieve an element of the
     vector. The default is svref (but for strings you'll need aref,
     for example). This should be a FUNCTION, and not a symbol!
   - start and end are the start and end indices within the array. If
     they are not supplied, 0 and the last index will be used.
   - test= and test-before are the tests to be used for equality and for
     determining precedence between elements. These should be FUNCTIONS,
     and not symbols!
   - not-found is the element to be returned when the element is not
     found.
     If not-found is set to 't', then, in case of failure, the function
     will return (i NIL), where i is the index where the element
     *should* be (or where it could be inserted).
     So, by default you can test the return inside an 
     (if (binary-search) ...), since it returns either NIL or the
     position."
  (declare (optimize (speed 3) (safety 0))
	   (fixnum start end)
	   (vector vector))
  ;; The internal function should be fast, so no key args	   
  (labels ((inside-binary-search (el vec start end)
	     (declare (fixnum start end)
		      (function test= test< get-element)
		      (vector vec))
	     (if (< end start)
		 (if (eq not-found 't)
		     (values start nil) ; where it *should* be
		     (values not-found nil))
		 (let* ((middle (floor (+ start end) 2))
			(middle-element
			  (funcall get-element vec middle)))
		   (declare (fixnum middle))
		   (cond ((funcall test= el middle-element)
			  (values middle t))
			 ((funcall test< el middle-element)
			  (inside-binary-search el
			                        vec
						start
						(1- middle)))
			 (t
			  (inside-binary-search el
			                        vec
						(1+ middle)
						end)))))))
    ;; If we don't test this and compile with (safety 0), the user can
    ;; pass symbols like '<, '= and 'aref instead of functions, like
    ;; #'<, #'= and #'aref -- and that would crash the program without
    ;; giving a reasonable explanation:
    (assert (and (functionp test=)
		 (functionp test<)
		 (functionp get-element)))
    (inside-binary-search the-element vector start end)))

Ah. I just realized that I did declare middle to be fixnum. Sorry,need
more sleep (or coffee). :-)

J.

On Wed, Aug 01, 2007 at 11:34:31AM -0300, Jeronimo Pellegrini wrote:
> On Wed, Aug 01, 2007 at 03:59:49PM +0200, Chris Laux wrote:
> > Jeronimo Pellegrini wrote:
> > 
> > > I see that when dealing with fixnums only [...]
> > 
> > What exactly do you mean by that?
> 
> I wasn't clear -- sorry!
> 
> > > (let ((middle (floor (+ start end) 2)) ...
> > 
> > Just from that code fragment, it cannot be inferred that (+ start end)
> > returns a fixnum, so you will have to declare it. Is there more context
> > from which the compiler could learn that?
> 
> So -- I have written this simple binary search function that I tried to
> make as generic as possible, but also as fast as possible. I thought
> that since I did not declare "middle" to be fixnum, and #'+ could return
> a bignum, the compiler would complain. But it didn't.
> 
> J.
> 
> Here's the function:
> 
> 
> (defun binary-search (the-element vector &key
> 		      (test= #'eql)
> 		      (test< #'<)
> 		      (get-element #'svref)
> 		      (start 0)
> 		      (end (1- (length vector)))
> 		      (not-found nil))
>   "Performs a binary search for an element el on a (sorted) array vec.
> Return values:
>    - The index where the element was found
>    - Either t (if el was found) or nil (if el was not found) You can 
>      ask the function to return something else on failure.
> Named parameters:
>    - get-element is the function used to retrieve an element of the
>      vector. The default is svref (but for strings you'll need aref,
>      for example). This should be a FUNCTION, and not a symbol!
>    - start and end are the start and end indices within the array. If
>      they are not supplied, 0 and the last index will be used.
>    - test= and test-before are the tests to be used for equality and for
>      determining precedence between elements. These should be FUNCTIONS,
>      and not symbols!
>    - not-found is the element to be returned when the element is not
>      found.
>      If not-found is set to 't', then, in case of failure, the function
>      will return (i NIL), where i is the index where the element
>      *should* be (or where it could be inserted).
>      So, by default you can test the return inside an 
>      (if (binary-search) ...), since it returns either NIL or the
>      position."
>   (declare (optimize (speed 3) (safety 0))
> 	   (fixnum start end)
> 	   (vector vector))
>   ;; The internal function should be fast, so no key args	   
>   (labels ((inside-binary-search (el vec start end)
> 	     (declare (fixnum start end)
> 		      (function test= test< get-element)
> 		      (vector vec))
> 	     (if (< end start)
> 		 (if (eq not-found 't)
> 		     (values start nil) ; where it *should* be
> 		     (values not-found nil))
> 		 (let* ((middle (floor (+ start end) 2))
> 			(middle-element
> 			  (funcall get-element vec middle)))
> 		   (declare (fixnum middle))
> 		   (cond ((funcall test= el middle-element)
> 			  (values middle t))
> 			 ((funcall test< el middle-element)
> 			  (inside-binary-search el
> 			                        vec
> 						start
> 						(1- middle)))
> 			 (t
> 			  (inside-binary-search el
> 			                        vec
> 						(1+ middle)
> 						end)))))))
>     ;; If we don't test this and compile with (safety 0), the user can
>     ;; pass symbols like '<, '= and 'aref instead of functions, like
>     ;; #'<, #'= and #'aref -- and that would crash the program without
>     ;; giving a reasonable explanation:
>     (assert (and (functionp test=)
> 		 (functionp test<)
> 		 (functionp get-element)))
>     (inside-binary-search the-element vector start end)))
>

On 8/1/07, Jeronimo Pellegrini <j_p@...> wrote:
> > Here's the function:
> >
> > (defun binary-search (the-element vector &key
> >                     (test= #'eql)
> >                     (test< #'<)
> >                     (get-element #'svref)
> >                     (start 0)
> >                     (end (1- (length vector)))
> >                     (not-found nil))
> >   (declare (optimize (speed 3) (safety 0))
> >          (fixnum start end)
> >          (vector vector))
> >   ;; The internal function should be fast, so no key args
> >   (labels ((inside-binary-search (el vec start end)
> >            (declare (fixnum start end)
> >                     (function test= test< get-element)
> >                     (vector vec))
> >            (if (< end start)
> >                (if (eq not-found 't)
> >                    (values start nil) ; where it *should* be
> >                    (values not-found nil))
> >                (let* ((middle (floor (+ start end) 2))
> >                       (middle-element
> >                         (funcall get-element vec middle)))
> >                  (declare (fixnum middle))
> >                  (cond ((funcall test= el middle-element)
> >                         (values middle t))
> >                        ((funcall test< el middle-element)
> >                         (inside-binary-search el
> >                                               vec
> >                                               start
> >                                               (1- middle)))
> >                        (t
> >                         (inside-binary-search el
> >                                               vec
> >                                               (1+ middle)
> >                                               end)))))))
> >     ;; If we don't test this and compile with (safety 0), the user can
> >     ;; pass symbols like '<, '= and 'aref instead of functions, like
> >     ;; #'<, #'= and #'aref -- and that would crash the program without
> >     ;; giving a reasonable explanation:
> >     (assert (and (functionp test=)
> >                (functionp test<)
> >                (functionp get-element)))
> >     (inside-binary-search the-element vector start end)))

You really do not want to compile stuff like this with safety = 0.
You're asking for the world of broken arithmetic, pointer errors, and
all kinds of other crap; set safety to 1, and learn how to work with
the compiler to produce the tight code you want, it's really not that
hard.

On Wed, Aug 01, 2007 at 08:53:34PM +0200, Thomas F. Burdick wrote:
> You really do not want to compile stuff like this with safety = 0.
> You're asking for the world of broken arithmetic, pointer errors, and
> all kinds of other crap;

Even after heavy testing? (I used safety 3 while testing)
I made sure it won't go past the array's limits, and checked that the
three functions are really functions.
I would like to know what other problems I could find here; I am
particularly interested in very, very fast code (that has been heavily
tested for correctness first).

> set safety to 1, and learn how to work with
> the compiler to produce the tight code you want, it's really not that
> hard.

I'll try to understand the optimization settings a bit more, then.

As to the compiler, the SBCL manual points me to the CMUCL manual for
optimization issues, and I have found that SBCL is already sort of far
from CMUCL on some aspects (not related to this particular function, but
I once tried block compilation directives, and SBCL complained that it
didn't know them).
Where else could I find information on how to get the compiler to
optimize more? That's sure one thing I've been looking for! :-)

Thanks a lot,
J.

Jeronimo Pellegrini <j_p@...> writes:

> On Wed, Aug 01, 2007 at 03:59:49PM +0200, Chris Laux wrote:
> > Jeronimo Pellegrini wrote:
> > 
> > > I see that when dealing with fixnums only [...]
> > 
> > What exactly do you mean by that?
> 
> I wasn't clear -- sorry!
> 
> > > (let ((middle (floor (+ start end) 2)) ...
> > 
> > Just from that code fragment, it cannot be inferred that (+ start end)
> > returns a fixnum, so you will have to declare it. Is there more context
> > from which the compiler could learn that?
> 
> So -- I have written this simple binary search function that I tried to
> make as generic as possible, but also as fast as possible. I thought
> that since I did not declare "middle" to be fixnum, and #'+ could return
> a bignum, the compiler would complain. But it didn't.

Ignoring the fact that you did in fact declare MIDDLE to be a fixnum,
no such declaration would've been needed anyway as long as START and
END were declared as fixnums. The type result of adding two numbers of
type (signed-byte 29) is known to be a (signed-byte 30). The result of
dividing a (signed-byte 30) with 2 is known to be a (signed-byte
29). So a fixnum declaration on middle tells the compiler nothing it
couldn't infer from the other types.

Now, declaring or inferring MIDDLE to be a fixnum doesn't imply that
the temporary return value of + is a fixnum. Obviously it can be a
(signed-byte 30) value, and not fit into a fixnum. So wondering about
why there's no efficiency note for that is a fair question. The answer
is that SBCL doesn't need to cons up a bignum for values larger than a
fixnum but which still fit into a machine register, as long as the
value doesn't escape. This is done by using a raw untagged
representation of the numeric values rather than the tagged one used
for fixnums.

So instead of the operation being just "add the two numbers, divide by
2, mask the tag bits", as it would be if the result of the addition
was known to be a fixnum, it's "shift both numbers right by 2 bits to
unfixnumize, add them, divide by two, shift left by two bits to
fixnumize". The performance difference here is small, and sbcl won't
issue a compiler note for it. But adding an explicit THE FIXNUM around
the + would indeed make a small difference.

-- 
Juho Snellman

On Thu, Aug 02, 2007 at 03:53:22AM +0300, Juho Snellman wrote:
> Jeronimo Pellegrini <j_p@...> writes:
> > So -- I have written this simple binary search function that I tried to
> > make as generic as possible, but also as fast as possible. I thought
> > that since I did not declare "middle" to be fixnum, and #'+ could return
> > a bignum, the compiler would complain. But it didn't.
> 
> Ignoring the fact that you did in fact declare MIDDLE to be a fixnum,
> no such declaration would've been needed anyway as long as START and
> END were declared as fixnums. The type result of adding two numbers of
> type (signed-byte 29) is known to be a (signed-byte 30). The result of
> dividing a (signed-byte 30) with 2 is known to be a (signed-byte
> 29). So a fixnum declaration on middle tells the compiler nothing it
> couldn't infer from the other types.

OK, I see.

> Now, declaring or inferring MIDDLE to be a fixnum doesn't imply that
> the temporary return value of + is a fixnum. Obviously it can be a
> (signed-byte 30) value, and not fit into a fixnum. So wondering about
> why there's no efficiency note for that is a fair question. The answer
> is that SBCL doesn't need to cons up a bignum for values larger than a
> fixnum but which still fit into a machine register, as long as the
> value doesn't escape. This is done by using a raw untagged
> representation of the numeric values rather than the tagged one used
> for fixnums.

Ah, so it does make a difference...

> So instead of the operation being just "add the two numbers, divide by
> 2, mask the tag bits", as it would be if the result of the addition
> was known to be a fixnum, it's "shift both numbers right by 2 bits to
> unfixnumize, add them, divide by two, shift left by two bits to
> fixnumize". The performance difference here is small, and sbcl won't
> issue a compiler note for it. But adding an explicit THE FIXNUM around
> the + would indeed make a small difference.

That's very interesting.
Thanks a lot for the help!

J.

Dear developers,

> But adding an explicit THE FIXNUM around
> the + would indeed make a small difference.

as far as I understand the documentation, in the (optimize (speed 3) (safety 0
or 1)) case another, more general possibility is to use the types

  (deftype mword () '(unsigned-byte 32))
  (deftype mwords () '(signed-byte 32))
  
(or the corresponding ones with 64 bits on a 64 machine) and modular arithmetic:
http://www.sbcl.org/manual/Modular-arithmetic.html

(pushnew :optimize *features*)  ;; for switching optimization on and off

(defmacro as-32 (a)             ;; a macro for doing modular 32-bit arithmetics
  `(logand ,a #xffffffff))

(declaim (ftype (function (mword mword) mword) f1))
(defun f1 (a b)
  (declare #+optimize (optimize (speed 3) (space 0) (safety 0) (debug 0)))
  (as-32 (+ a b 1)))

With this you get the efficiency and unsafety of C code, don't you?

Is there any difference between using the ftype declaration and the following?

(defun f1 (a b)
  (declare (type mword a b) (values mword)
           #+optimize (optimize (speed 3) (space 0) (safety 0) (debug 0)))
  (as-32 (+ a b 1)))

Best regards
  Bruno Daniel

Bruno Daniel <bruno.daniel@...> writes:
[...]
> (declaim (ftype (function (mword mword) mword) f1))
> (defun f1 (a b)
>   (declare #+optimize (optimize (speed 3) (space 0) (safety 0) (debug 0)))
>   (as-32 (+ a b 1)))
> 
> With this you get the efficiency and unsafety of C code, don't you?

No. A and B can be represented as either tagged fixnums or a boxed
small (header + one word) bignums, depending on their size. The code
will have to check which one of those types the values have, convert
them into a common form (raw untagged word in a register), do the
addition, and finally convert the result from an untagged word to
either fixnum or a small bignum, again depending on the size.

The parameters or the result can't be untagged values, since those
basically can't cross non-local function call borders.
 
> Is there any difference between using the ftype declaration and the following?
> 
> (defun f1 (a b)
>   (declare (type mword a b) (values mword)
>            #+optimize (optimize (speed 3) (space 0) (safety 0) (debug 0)))
>   (as-32 (+ a b 1)))

<http://groups.google.com/group/comp.lang.lisp/msg/2585807c582364de>

-- 
Juho Snellman

> No. A and B can be represented as either tagged fixnums or a boxed
> small (header + one word) bignums, depending on their size. The code
> will have to check which one of those types the values have, convert
> them into a common form (raw untagged word in a register), do the
> addition, and finally convert the result from an untagged word to
> either fixnum or a small bignum, again depending on the size.
> 
> The parameters or the result can't be untagged values, since those
> basically can't cross non-local function call borders.

I feared that. 
I understand that that's exactly why CMUCL introduced block-compilation which
makes all functions consider each other local within the block borders. Is
there a way to accomplish the same thing in SBCL? 

Best regards
  Bruno Daniel

On 8/2/07, Bruno Daniel <bruno.daniel@...> wrote:

> > The parameters or the result can't be untagged values, since those
> > basically can't cross non-local function call borders.
>
> I feared that.
> I understand that that's exactly why CMUCL introduced block-compilation which
> makes all functions consider each other local within the block borders. Is
> there a way to accomplish the same thing in SBCL?

Local functions, inlined functions, and saving the values into places which hold
raw untagged values (some defstruct slots, arrays with the approriate
upgraded element type) accomplish this.

Adding support for block compilation back to SBCL is in the plans, but
there is no
schedule.

Cheers,

 -- Nikodemus

> Local functions, inlined functions, and saving the values into places which hold
> raw untagged values (some defstruct slots, arrays with the approriate
> upgraded element type) accomplish this.
> 
> Adding support for block compilation back to SBCL is in the plans, but
> there is no
> schedule.

Thanks for your answer. The second possibility is not always an option, e.g.
for recursive functions. The first possibility amounts to manually duplicating
the code into labels definitions for each calling function, but this could be
automated by macros:

(defun-local f1 (a b)
  ...)

(defun f2 (c)
  (with-local-functions (f1)
    ...
    (f1 c1 c2)
    ...
    (f1 c3 c4)
    ...
    ))
    
(defun f3 (c)
  (with-local-functions (f1)
    ...
    (f1 c5 c6)
    ...
    ))

For non-recursive functions (and functions not mutually recursive with some
other inline function etc.) I consider it best to use both approaches and
generate f1 as an inline function and with-local-functions to generate just a
small delegating local functions calling f1:

(defun-local-inline f1 (a b)
  ...)

(defun f2 (c)
  (with-local-functions (f1)
    ...
    ))

What do you think of these workarounds?
    
Best regards
  Bruno Daniel

Here's the realization of the mentioned workaround. Over CMUCL's
block-compilation, it has the advantage that it may cross file boundaries.
See the code below.

> Thanks for your answer. The second possibility is not always an option, e.g.
> for recursive functions. The first possibility amounts to manually duplicating
> the code into labels definitions for each calling function, but this could be
> automated by macros:
> 
> (defun-local f1 (a b)
>   ...)
> 
> (defun f2 (c)
>   (with-local-functions (f1)
>     ...
>     (f1 c1 c2)
>     ...
>     (f1 c3 c4)
>     ...
>     ))
>     
> (defun f3 (c)
>   (with-local-functions (f1)
>     ...
>     (f1 c5 c6)
>     ...
>     ))
> 
> For non-recursive functions (and functions not mutually recursive with some
> other inline function etc.) I consider it best to use both approaches and
> generate f1 as an inline function and with-local-functions to generate just a
> small delegating local functions calling f1:
> 
> (defun-local-inline f1 (a b)
>   ...)
> 
> (defun f2 (c)
>   (with-local-functions (f1)
>     ...
>     ))
> 
> What do you think of these workarounds?

Here's the implementation:

(defun append-symbol (symbol suffix)
  "creates a new symbol out of a symbol name and a suffix"
  (intern (concatenate 'string (string symbol) suffix)))

(defun function->local-macro-name (func)
  "name of the auxiliary macro for inserting local functions"
  (append-symbol func "-local-macro-aux"))

(defun function->inline-function-name (func)
  "name of the auxiliary inline function created for local-inline functions"
  (append-symbol func "-inline-aux"))

(defmacro defun-local (func (&rest args) &body body)
  "Prepare this function to be automatically inserted as a local function by
with-local-functions. This will make its function calls faster since some
arguments won't have to boxed. Contrary to block-compilation in CMUCL, this
feature may also cross file boundaries. (Is an eval-when-statement needed?)
If the function is non-recursive, use defun-local-inline instead, because it
will avoid complete recompilation of the local function in each
with-local-functions statement.
The function may use optional and keyword parameters, but no &rest parameter."
  `(defmacro ,(function->local-macro-name func) ()
     '(,func (,@args)
       ,@body)))

(defun arg-list-for-call (args)
  "transforms a formal argument list of a function into an actual argument list
of a call in a delegating function. &rest arguments are not supported, keyword
and optional arguments are."
  (let ((keyword-package (symbol-package :dummy))
        (key-args-reached nil)
        (args-of-call nil))
    (flet ((symbol->keyword (symbol)
             (intern (string symbol) keyword-package)))
      (dolist (arg args)
        (cond ((eq '&key arg)
               (setq key-args-reached t))
              ((eq '&optional arg))
              (t
               (let ((arg-car (if (consp arg) (car arg) arg)))
                 (if key-args-reached
                     (progn
                       (push (symbol->keyword arg-car) args-of-call)
                       (push arg-car args-of-call))
                     (push arg-car args-of-call))))))
      (reverse args-of-call))))


(defmacro defun-local-inline (func (&rest args) &body body)
  "Declare a copy of this function inline and prepare a simple delegating
function to be automatically inserted as a local function by
with-local-functions. This is not applicable to recursive functions, since they
cannot be declared inline.
The function may use optional and keyword parameters, but no &rest parameter."
  (let* ((inline-function-name (function->inline-function-name func))
         (args-of-call (arg-list-for-call args)))
    `(progn
       (declaim (inline ,inline-function-name))
       (defun ,inline-function-name (,@args) ,@body)
       (defmacro ,(function->local-macro-name func) ()
         '(,func (,@args)
           (,inline-function-name ,@args-of-call))))))


(defmacro with-local-functions ((&rest funcs) &body body)
  "Insert prepared local functions in a labels statement."
  `(labels ,(loop :for func in funcs :collect
               (macroexpand-1 `(,(function->local-macro-name func))))
     ,@body))

(defun-local-inline f1 (a b &key (c 0))
  (+ a b c))

(defun f2 (c)
  (with-local-functions (f1)
    (* (f1 c (* 2 c))
       (f1 (* 3 c) (* 4 c)))))

(f2 3)

(defun-local f1a (a b &key (c 0))
  (+ a b c))

(defun f2a (c)
  (with-local-functions (f1a)
    (* (f1a c (* 2 c))
       (f1a (* 3 c) (* 4 c)))))

(f2a 3)


The disadvantage is that you need the with-local-functions statement. This
inconvenience might be lifted by a defun-variant that automatically recognizes
calls of functions that been registered in some hash as local functions. But
a similar variant of defmacro would then be needed as well, since
macroexpansions might introduce additional calls of local functions. On the
other hand it must be avoided that superfluous repetitions of the same local
function will be introduced by macro expansions.

Best regards
  Bruno Daniel