define-compiler-macro(3cl) - define a compiler macro function

DEFINE-COMPILER-MACRO(3cl)

Common Lisp Reference

DEFINE-COMPILER-MACRO(3cl)

NAME

define-compiler-macro – define a compiler macro function (macro)

SYNOPSIS

define-compiler-macro name lambda-list
[[ { declaration }* | documentation ]] { form }*
→ name

ARGUMENTS and VALUES

name—a function name.

lambda-list—a macro lambda list.

documentation—a string, not evaluated.

form—a form.

DESCRIPTION

This is the normal mechanism for defining a compiler macro function. Its manner of definition is the same as for defmacro; the only differences are:

The name can be a function name naming any function or macro.
The expander function is installed as a compiler macro function for the name, rather than as a macro function.
The &whole argument is bound to the form argument that is passed to the compiler macro function. The remaining lambda-list parameters are specified as if this form contained the function name in the car and the actual arguments in the cdr , but if the car of the actual form is the symbol funcall, then the destructuring of the arguments is actually performed using its cddr instead.
documentation is attached as a documentation string to name (as kind compiler-macro) and to the compiler macro function.
Unlike an ordinary macro, a compiler macro can decline to provide an expansion merely by returning a form that is the same as the original (which can be obtained by using &whole).

AFFECTED BY

(none)

EXCEPTIONAL SITUATIONS

The consequences are undefined if environment is non-nil in a use of setf of compiler-macro-function.

NOTES

The consequences of writing a compiler macro definition for a function in the COMMON-LISP package are undefined; it is quite possible that in some implementations such an attempt would override an equivalent or equally important definition. In general, it is recommended that a programmer only write compiler macro definitions for functions he or she personally maintains–writing a compiler macro definition for a function maintained elsewhere is normally considered a violation of traditional rules of modularity and data abstraction.

EXAMPLES

( defun square ( x ) ( expt x 2 ))
→ SQUARE
( define-compiler-macro square ( &whole form arg )
    ( if ( atom arg )
        ` ( expt , arg 2 )
        ( case ( car arg )
            ( square ( if ( = ( length arg ) 2 )
                        ` ( expt ,( nth 1 arg ) 4 )
                        form ))
            ( expt    ( if ( = ( length arg ) 3 )
                        ( if ( numberp ( nth 2 arg ))
                            ` ( expt ,( nth 1 arg )
                                ,( * 2 ( nth 2 arg )))
                            ` ( expt ,( nth 1 arg )
                                ( * 2 ,( nth 2 arg ))))
                        form ))
            ( otherwise ` ( expt , arg 2 )))))
→ SQUARE
( square ( square 3 ))
→ 81
( macroexpand ’( square x ))
→ ( SQUARE X ), false
( funcall ( compiler-macro-function ’ square ) ’( square x ) nil )
→ ( EXPT X 2 )
( funcall ( compiler-macro-function ’ square )
    ’( square ( square x )) nil )
→ ( EXPT X 4 )
( funcall ( compiler-macro-function ’ square )
    ’( funcall #’ square x ) nil )
→ ( EXPT X 2 )
( defun distance-positional ( x1 y1 x2 y2 )
    ( sqrt ( + ( expt ( - x2 x1 ) 2 ) ( expt ( - y2 y1 ) 2 ))))
→ DISTANCE-POSITIONAL
( defun distance ( &key ( x1 0 ) ( y1 0 ) ( x2 x1 ) ( y2 y1 ))
    ( distance-positional x1 y1 x2 y2 ))
→ DISTANCE
( define-compiler-macro distance
                            ( &whole form
                            &rest key-value-pairs
                            &key     ( x1 0 x1-p )
                                    ( y1 0 y1-p )
                                    ( x2 x1 x2-p )
                                    ( y2 y1 y2-p )
                            &allow-other-keys
                            &environment env )
    ( flet (( key ( n ) ( nth ( * n 2 ) key-value-pairs ))
            ( arg ( n ) ( nth ( 1+ ( * n 2 )) key-value-pairs ))
            ( simplep ( x )
                ( let (( expanded-x ( macroexpand x env )))
                    ( or ( constantp expanded-x env )
                        ( symbolp expanded-x )))))
        ( let (( n ( / ( length key-value-pairs ) 2 )))
            ( multiple-value-bind ( x1s y1s x2s y2s others )
                    ( loop for ( key )
                        on key-value-pairs by #’ cddr
                        count ( eq key ’: x1 ) into x1s
                        count ( eq key ’: y1 ) into y1s
                        count ( eq key ’: x2 ) into x2s
                        count ( eq key ’: y1 ) into y2s
                        count ( not ( member key
                                    ’(: x1 : x2 : y1 : y2 )))
                            into others
                        finally ( return ( values
                                x1s y1s x2s y2s others )))
                ( cond
                    (( and    ( = n 4 )
                            ( eq ( key 0 ) : x1 )
                            ( eq ( key 1 ) : y1 )
                            ( eq ( key 2 ) : x2 )
                            ( eq ( key 3 ) : y2 ))
                        ` ( distance-positional , x1 , y1 , x2 , y2 ))
                    (( and    ( if x1-p
                                ( and ( = x1s 1 ) ( simplep x1 )) t )
                            ( if y1-p
                               (and ( = y1s 1 ) ( simplep y1 )) t )
                            ( if x2-p
                               (and ( = x2s 1 ) ( simplep x2 )) t )
                            ( if y2-p
                               (and ( = y2s 1 ) ( simplep y2 )) t )
                            ( zerop others ))
                        ` ( distance-positional , x1 , y1 , x2 , y2 ))
                    (( and    ( < x1s 2 )
                            ( < y1s 2 )
                            ( < x2s 2 )
                            ( < y2s 2 )
                            ( zerop others ))
                        ( let (( temps ( loop repeat n
                                        collect ( gensym ))))
                            ` ( let ,( loop for i below n
                                        collect ( list
                                            ( nth i temps )
                                            ( arg i )))
                                ( distance
                                    ,@( loop for i below n
                                    append ( list ( key i )
                                    ( nth i temps )))))))
                    ( t form ))))) )
→ DISTANCE
( dolist ( form
        ’(( distance : x1 ( setq x 7 ) : x2 ( decf x )
                        : y1 ( decf x ) : y2 ( decf x ))
        ( distance : x1 ( setq x 7 ) : y1 ( decf x )
                        : x2 ( decf x ) : y2 ( decf x ))
        ( distance : x1 ( setq x 7 ) : y1 ( incf x ))
        ( distance : x1 ( setq x 7 ) : y1 ( incf x ) : x1 ( incf x ))
        ( distance : x1 a1 : y1 b1 : x2 a2 : y2 b2 )
        ( distance : x1 a1 : x2 a2 : y1 b1 : y2 b2 )
        ( distance : x1 a1 : y1 b1 : z1 c1 : x2 a2 : y2 b2 : z2 c2 )))
    ( print ( funcall ( compiler-macro-function ’ distance )
        form nil )))
▻ ( LET ((#: G6558 ( SETQ X 7 ))
▻         (#: G6559 ( DECF X ))
▻          (#: G6560 ( DECF X ))
▻          (#: G6561 ( DECF X )))
▻      ( DISTANCE : X1 #: G6558 : X2 #: G6559
▻                : Y1 #: G6560 : Y2 #: G6561 ))
▻ ( DISTANCE-POSITIONAL ( SETQ X 7 ) ( DECF X ) ( DECF X ) ( DECF X ))
▻ ( LET ((#: G6567 ( SETQ X 7 ))
▻          (#: G6568 ( INCF X )))
▻      ( DISTANCE : X1 #: G6567 : Y1 #: G6568 ))
▻ ( DISTANCE : X1 ( SETQ X 7 ) : Y1 ( INCF X ) : X1 ( INCF X ))
▻ ( DISTANCE-POSITIONAL A1 B1 A2 B2 )
▻ ( DISTANCE-POSITIONAL A1 B1 A2 B2 )
▻ ( DISTANCE : X1 A1 : Y1 B1 : Z1 C1 : X2 A2 : Y2 B2 : Z2 C2 )
→ NIL