X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fmacros.lisp;h=1efe6b2aea679a7c705df4c8d199002719168ef1;hb=0b5610d8a220a4b20cbeac958953ca4d67c00038;hp=e510d5bd768384df419e78ef00de505ba02d6258;hpb=64bf93a97814ea1caf62bbdcc7ef43e2fbfc8f73;p=sbcl.git diff --git a/src/compiler/macros.lisp b/src/compiler/macros.lisp index e510d5b..1efe6b2 100644 --- a/src/compiler/macros.lisp +++ b/src/compiler/macros.lisp @@ -24,47 +24,6 @@ ;;; Retain expansion, but only use it opportunistically. (deftype inlinep () '(member :inline :maybe-inline :notinline nil)) -;;;; the POLICY macro - -;;; a helper function for the POLICY macro: Return a list of -;;; POLICY-QUALITY-SLOT objects corresponding to the qualities which -;;; appear in EXPR. -(eval-when (:compile-toplevel :load-toplevel :execute) - (defun policy-quality-slots-used-by (expr) - (let ((result nil)) - (labels ((recurse (x) - (if (listp x) - (map nil #'recurse x) - (let ((pqs (named-policy-quality-slot x))) - (when pqs - (pushnew pqs result)))))) - (recurse expr) - result)))) - -;;; syntactic sugar for querying optimization policy qualities -;;; -;;; Evaluate EXPR in terms of the current optimization policy for -;;; NODE, or if NODE is NIL, in terms of the current policy as defined -;;; by *DEFAULT-POLICY* and *CURRENT-POLICY*. (Using NODE=NIL is only -;;; well-defined during IR1 conversion.) -;;; -;;; EXPR is a form which accesses the policy values by referring to -;;; them by name, e.g. SPEED. -(defmacro policy (node expr) - (let* ((n-policy (gensym)) - (binds (mapcar - (lambda (pqs) - `(,(policy-quality-slot-quality pqs) - (,(policy-quality-slot-accessor pqs) ,n-policy))) - (policy-quality-slots-used-by expr)))) - (/show "in POLICY" expr binds) - `(let* ((,n-policy (lexenv-policy - ,(if node - `(node-lexenv ,node) - '*lexenv*))) - ,@binds) - ,expr))) - ;;;; source-hacking defining forms ;;; to be passed to PARSE-DEFMACRO when we want compiler errors @@ -389,75 +348,71 @@ ;;;; DEFTRANSFORM -;;; Parse the lambda-list and generate code to test the policy and -;;; automatically create the result lambda. +;;; Define an IR1 transformation for NAME. An IR1 transformation +;;; computes a lambda that replaces the function variable reference +;;; for the call. A transform may pass (decide not to transform the +;;; call) by calling the GIVE-UP-IR1-TRANSFORM function. LAMBDA-LIST +;;; both determines how the current call is parsed and specifies the +;;; LAMBDA-LIST for the resulting lambda. +;;; +;;; We parse the call and bind each of the lambda-list variables to +;;; the continuation which represents the value of the argument. When +;;; parsing the call, we ignore the defaults, and always bind the +;;; variables for unsupplied arguments to NIL. If a required argument +;;; is missing, an unknown keyword is supplied, or an argument keyword +;;; is not a constant, then the transform automatically passes. The +;;; DECLARATIONS apply to the bindings made by DEFTRANSFORM at +;;; transformation time, rather than to the variables of the resulting +;;; lambda. Bound-but-not-referenced warnings are suppressed for the +;;; lambda-list variables. The DOC-STRING is used when printing +;;; efficiency notes about the defined transform. +;;; +;;; Normally, the body evaluates to a form which becomes the body of +;;; an automatically constructed lambda. We make LAMBDA-LIST the +;;; lambda-list for the lambda, and automatically insert declarations +;;; of the argument and result types. If the second value of the body +;;; is non-null, then it is a list of declarations which are to be +;;; inserted at the head of the lambda. Automatic lambda generation +;;; may be inhibited by explicitly returning a lambda from the body. +;;; +;;; The ARG-TYPES and RESULT-TYPE are used to create a function type +;;; which the call must satisfy before transformation is attempted. +;;; The function type specifier is constructed by wrapping (FUNCTION +;;; ...) around these values, so the lack of a restriction may be +;;; specified by omitting the argument or supplying *. The argument +;;; syntax specified in the ARG-TYPES need not be the same as that in +;;; the LAMBDA-LIST, but the transform will never happen if the +;;; syntaxes can't be satisfied simultaneously. If there is an +;;; existing transform for the same function that has the same type, +;;; then it is replaced with the new definition. +;;; +;;; These are the legal keyword options: +;;; :RESULT - A variable which is bound to the result continuation. +;;; :NODE - A variable which is bound to the combination node for the call. +;;; :POLICY - A form which is supplied to the POLICY macro to determine +;;; whether this transformation is appropriate. If the result +;;; is false, then the transform automatically gives up. +;;; :EVAL-NAME +;;; - The name and argument/result types are actually forms to be +;;; evaluated. Useful for getting closures that transform similar +;;; functions. +;;; :DEFUN-ONLY +;;; - Don't actually instantiate a transform, instead just DEFUN +;;; Name with the specified transform definition function. This +;;; may be later instantiated with %DEFTRANSFORM. +;;; :IMPORTANT +;;; - If supplied and non-NIL, note this transform as ``important,'' +;;; which means efficiency notes will be generated when this +;;; transform fails even if INHIBIT-WARNINGS=SPEED (but not if +;;; INHIBIT-WARNINGS>SPEED). +;;; :WHEN {:NATIVE | :BYTE | :BOTH} +;;; - Indicates whether this transform applies to native code, +;;; byte-code or both (default :native.) (defmacro deftransform (name (lambda-list &optional (arg-types '*) (result-type '*) &key result policy node defun-only eval-name important (when :native)) &body body-decls-doc) - #!+sb-doc - "Deftransform Name (Lambda-List [Arg-Types] [Result-Type] {Key Value}*) - Declaration* [Doc-String] Form* - Define an IR1 transformation for NAME. An IR1 transformation computes a - lambda that replaces the function variable reference for the call. A - transform may pass (decide not to transform the call) by calling the - GIVE-UP-IR1-TRANSFORM function. LAMBDA-LIST both determines how the - current call is parsed and specifies the LAMBDA-LIST for the resulting - lambda. - - We parse the call and bind each of the lambda-list variables to the - continuation which represents the value of the argument. When parsing - the call, we ignore the defaults, and always bind the variables for - unsupplied arguments to NIL. If a required argument is missing, an - unknown keyword is supplied, or an argument keyword is not a constant, - then the transform automatically passes. The DECLARATIONS apply to the - bindings made by DEFTRANSFORM at transformation time, rather than to - the variables of the resulting lambda. Bound-but-not-referenced - warnings are suppressed for the lambda-list variables. The DOC-STRING - is used when printing efficiency notes about the defined transform. - - Normally, the body evaluates to a form which becomes the body of an - automatically constructed lambda. We make LAMBDA-LIST the lambda-list - for the lambda, and automatically insert declarations of the argument - and result types. If the second value of the body is non-null, then it - is a list of declarations which are to be inserted at the head of the - lambda. Automatic lambda generation may be inhibited by explicitly - returning a lambda from the body. - - The ARG-TYPES and RESULT-TYPE are used to create a function type - which the call must satisfy before transformation is attempted. The - function type specifier is constructed by wrapping (FUNCTION ...) - around these values, so the lack of a restriction may be specified by - omitting the argument or supplying *. The argument syntax specified in - the ARG-TYPES need not be the same as that in the LAMBDA-LIST, but the - transform will never happen if the syntaxes can't be satisfied - simultaneously. If there is an existing transform for the same - function that has the same type, then it is replaced with the new - definition. - - These are the legal keyword options: - :Result - A variable which is bound to the result continuation. - :Node - A variable which is bound to the combination node for the call. - :Policy - A form which is supplied to the POLICY macro to determine whether - this transformation is appropriate. If the result is false, then - the transform automatically passes. - :Eval-Name - - The name and argument/result types are actually forms to be - evaluated. Useful for getting closures that transform similar - functions. - :Defun-Only - - Don't actually instantiate a transform, instead just DEFUN - Name with the specified transform definition function. This may - be later instantiated with %DEFTRANSFORM. - :Important - - If supplied and non-NIL, note this transform as ``important,'' - which means efficiency notes will be generated when this - transform fails even if brevity=speed (but not if brevity>speed) - :When {:Native | :Byte | :Both} - - Indicates whether this transform applies to native code, - byte-code or both (default :native.)" - (when (and eval-name defun-only) (error "can't specify both DEFUN-ONLY and EVAL-NAME")) (multiple-value-bind (body decls doc) (parse-body body-decls-doc) @@ -511,56 +466,58 @@ ;;; ;;; FIXME: DEFKNOWN is needed only at build-the-system time. Figure ;;; out some way to keep it from appearing in the target system. +;;; +;;; Declare the function NAME to be a known function. We construct a +;;; type specifier for the function by wrapping (FUNCTION ...) around +;;; the ARG-TYPES and RESULT-TYPE. ATTRIBUTES is an unevaluated list +;;; of boolean attributes of the function. These attributes are +;;; meaningful here: +;;; +;;; CALL +;;; May call functions that are passed as arguments. In order +;;; to determine what other effects are present, we must find +;;; the effects of all arguments that may be functions. +;;; +;;; UNSAFE +;;; May incorporate arguments in the result or somehow pass +;;; them upward. +;;; +;;; UNWIND +;;; May fail to return during correct execution. Errors +;;; are O.K. +;;; +;;; ANY +;;; The (default) worst case. Includes all the other bad +;;; things, plus any other possible bad thing. +;;; +;;; FOLDABLE +;;; May be constant-folded. The function has no side effects, +;;; but may be affected by side effects on the arguments. E.g. +;;; SVREF, MAPC. +;;; +;;; FLUSHABLE +;;; May be eliminated if value is unused. The function has +;;; no side effects except possibly CONS. If a function is +;;; defined to signal errors, then it is not flushable even +;;; if it is movable or foldable. +;;; +;;; MOVABLE +;;; May be moved with impunity. Has no side effects except +;;; possibly CONS, and is affected only by its arguments. +;;; +;;; PREDICATE +;;; A true predicate likely to be open-coded. This is a +;;; hint to IR1 conversion that it should ensure calls always +;;; appear as an IF test. Not usually specified to DEFKNOWN, +;;; since this is implementation dependent, and is usually +;;; automatically set by the DEFINE-VOP :CONDITIONAL option. +;;; +;;; NAME may also be a list of names, in which case the same +;;; information is given to all the names. The keywords specify the +;;; initial values for various optimizers that the function might +;;; have. (defmacro defknown (name arg-types result-type &optional (attributes '(any)) &rest keys) - #!+sb-doc - "Defknown Name Arg-Types Result-Type [Attributes] {Key Value}* - Declare the function Name to be a known function. We construct a type - specifier for the function by wrapping (FUNCTION ...) around the Arg-Types - and Result-Type. Attributes is an unevaluated list of boolean - attributes of the function. These attributes are meaningful here: - call - May call functions that are passed as arguments. In order - to determine what other effects are present, we must find - the effects of all arguments that may be functions. - - unsafe - May incorporate arguments in the result or somehow pass - them upward. - - unwind - May fail to return during correct execution. Errors - are O.K. - - any - The (default) worst case. Includes all the other bad - things, plus any other possible bad thing. - - foldable - May be constant-folded. The function has no side effects, - but may be affected by side effects on the arguments. E.g. - SVREF, MAPC. - - flushable - May be eliminated if value is unused. The function has - no side effects except possibly CONS. If a function is - defined to signal errors, then it is not flushable even - if it is movable or foldable. - - movable - May be moved with impunity. Has no side effects except - possibly CONS,and is affected only by its arguments. - - predicate - A true predicate likely to be open-coded. This is a - hint to IR1 conversion that it should ensure calls always - appear as an IF test. Not usually specified to Defknown, - since this is implementation dependent, and is usually - automatically set by the Define-VOP :Conditional option. - - Name may also be a list of names, in which case the same information - is given to all the names. The keywords specify the initial values - for various optimizers that the function might have." (when (and (intersection attributes '(any call unwind)) (intersection attributes '(movable))) (error "function cannot have both good and bad attributes: ~S" attributes)) @@ -575,31 +532,30 @@ attributes)) ,@keys)) -;;; Create a function which parses combination args according to -;;; LAMBDA-LIST, optionally storing it in a FUNCTION-INFO slot. +;;; Create a function which parses combination args according to WHAT +;;; and LAMBDA-LIST, where WHAT is either a function name or a list +;;; (FUNCTION-NAME KIND) and does some KIND of optimization. +;;; +;;; The FUNCTION-NAME must name a known function. LAMBDA-LIST is used +;;; to parse the arguments to the combination as in DEFTRANSFORM. If +;;; the argument syntax is invalid or there are non-constant keys, +;;; then we simply return NIL. +;;; +;;; The function is DEFUN'ed as FUNCTION-KIND-OPTIMIZER. Possible +;;; kinds are DERIVE-TYPE, OPTIMIZER, LTN-ANNOTATE and IR2-CONVERT. If +;;; a symbol is specified instead of a (FUNCTION KIND) list, then we +;;; just do a DEFUN with the symbol as its name, and don't do anything +;;; with the definition. This is useful for creating optimizers to be +;;; passed by name to DEFKNOWN. +;;; +;;; If supplied, NODE-VAR is bound to the combination node being +;;; optimized. If additional VARS are supplied, then they are used as +;;; the rest of the optimizer function's lambda-list. LTN-ANNOTATE +;;; methods are passed an additional POLICY argument, and IR2-CONVERT +;;; methods are passed an additional IR2-BLOCK argument. (defmacro defoptimizer (what (lambda-list &optional (n-node (gensym)) &rest vars) &body body) - #!+sb-doc - "Defoptimizer (Function Kind) (Lambda-List [Node-Var] Var*) - Declaration* Form* - Define some Kind of optimizer for the named Function. Function must be a - known function. Lambda-List is used to parse the arguments to the - combination as in Deftransform. If the argument syntax is invalid or there - are non-constant keys, then we simply return NIL. - - The function is DEFUN'ed as Function-Kind-OPTIMIZER. Possible kinds are - DERIVE-TYPE, OPTIMIZER, LTN-ANNOTATE and IR2-CONVERT. If a symbol is - specified instead of a (Function Kind) list, then we just do a DEFUN with the - symbol as its name, and don't do anything with the definition. This is - useful for creating optimizers to be passed by name to DEFKNOWN. - - If supplied, Node-Var is bound to the combination node being optimized. If - additional Vars are supplied, then they are used as the rest of the optimizer - function's lambda-list. LTN-ANNOTATE methods are passed an additional POLICY - argument, and IR2-CONVERT methods are passed an additional IR2-BLOCK - argument." - (let ((name (if (symbolp what) what (symbolicate (first what) "-" (second what) "-OPTIMIZER")))) @@ -616,18 +572,17 @@ ;;;; IR groveling macros +;;; Iterate over the blocks in a component, binding BLOCK-VAR to each +;;; block in turn. The value of ENDS determines whether to iterate +;;; over dummy head and tail blocks: +;;; NIL -- Skip Head and Tail (the default) +;;; :HEAD -- Do head but skip tail +;;; :TAIL -- Do tail but skip head +;;; :BOTH -- Do both head and tail +;;; +;;; If supplied, RESULT-FORM is the value to return. (defmacro do-blocks ((block-var component &optional ends result) &body body) #!+sb-doc - "Do-Blocks (Block-Var Component [Ends] [Result-Form]) {Declaration}* {Form}* - Iterate over the blocks in a component, binding Block-Var to each block in - turn. The value of Ends determines whether to iterate over dummy head and - tail blocks: - NIL -- Skip Head and Tail (the default) - :Head -- Do head but skip tail - :Tail -- Do tail but skip head - :Both -- Do both head and tail - - If supplied, Result-Form is the value to return." (unless (member ends '(nil :head :tail :both)) (error "losing ENDS value: ~S" ends)) (let ((n-component (gensym)) @@ -782,84 +737,7 @@ (values (cdr ,n-res) t) (values nil nil)))) -;;; These functions are called by the expansion of the DEFPRINTER -;;; macro to do the actual printing. -(declaim (ftype (function (symbol t stream &optional t) (values)) - defprinter-prin1 defprinter-princ)) -(defun defprinter-prin1 (name value stream &optional indent) - (declare (ignore indent)) - (defprinter-prinx #'prin1 name value stream)) -(defun defprinter-princ (name value stream &optional indent) - (declare (ignore indent)) - (defprinter-prinx #'princ name value stream)) -(defun defprinter-prinx (prinx name value stream) - (declare (type function prinx)) - (write-char #\space stream) - (when *print-pretty* - (pprint-newline :linear stream)) - (format stream ":~A " name) - (funcall prinx value stream) - (values)) - -;; Define some kind of reasonable PRINT-OBJECT method for a STRUCTURE-OBJECT. -;; -;; NAME is the name of the structure class, and CONC-NAME is the same as in -;; DEFSTRUCT. -;; -;; The SLOT-DESCS describe how each slot should be printed. Each SLOT-DESC can -;; be a slot name, indicating that the slot should simply be printed. A -;; SLOT-DESC may also be a list of a slot name and other stuff. The other stuff -;; is composed of keywords followed by expressions. The expressions are -;; evaluated with the variable which is the slot name bound to the value of the -;; slot. These keywords are defined: -;; -;; :PRIN1 Print the value of the expression instead of the slot value. -;; :PRINC Like :PRIN1, only princ the value -;; :TEST Only print something if the test is true. -;; -;; If no printing thing is specified then the slot value is printed as PRIN1. -;; -;; The structure being printed is bound to STRUCTURE and the stream is bound to -;; STREAM. -(defmacro defprinter ((name &key (conc-name (concatenate 'simple-string - (symbol-name name) - "-"))) - &rest slot-descs) - (flet ((sref (slot-name) - `(,(symbolicate conc-name slot-name) structure))) - (collect ((prints)) - (dolist (slot-desc slot-descs) - (if (atom slot-desc) - (prints `(defprinter-prin1 ',slot-desc ,(sref slot-desc) stream)) - (let ((sname (first slot-desc)) - (test t)) - (collect ((stuff)) - (do ((option (rest slot-desc) (cddr option))) - ((null option) - (prints - `(let ((,sname ,(sref sname))) - (when ,test - ,@(or (stuff) - `((defprinter-prin1 ',sname ,sname - stream))))))) - (case (first option) - (:prin1 - (stuff `(defprinter-prin1 ',sname ,(second option) - stream))) - (:princ - (stuff `(defprinter-princ ',sname ,(second option) - stream))) - (:test (setq test (second option))) - (t - (error "bad DEFPRINTER option: ~S" (first option))))))))) - - `(def!method print-object ((structure ,name) stream) - (print-unreadable-object (structure stream :type t) - (pprint-logical-block (stream nil) - ;;(pprint-indent :current 2 stream) - ,@(prints))))))) - -;;;; the Event statistics/trace utility +;;;; the EVENT statistics/trace utility ;;; FIXME: This seems to be useful for troubleshooting and ;;; experimentation, not for ordinary use, so it should probably @@ -867,7 +745,7 @@ (eval-when (:compile-toplevel :load-toplevel :execute) -(defstruct event-info +(defstruct (event-info (:copier nil)) ;; The name of this event. (name (required-argument) :type symbol) ;; The string rescribing this event. @@ -1114,4 +992,4 @@ (defmacro position-or-lose (&rest args) `(or (position ,@args) - (error "Shouldn't happen?"))) + (error "shouldn't happen?")))