Page:AITR-474.djvu/277

 001 RABBIT 568 05/15/78 Page 71 002 (DEFINE CHECK-NUMBER-OF-ARGS 003 (LAMBDA (NAME NARGS DEFP) 004 (OR (GLTL NAME '(*LEXPR LSUBR)) 005 (LET ((N (GET NAME 'NUMBER-OF-ARGS))) 006                       (IF N 007                            (IF (NOT (= N NARGS)) 008                               (IF DEFP 009                                    (WARN |definition disagrees with earlier use on number of args| 010                                         NAME 011                                         NARGS 012                                         N)  013                                     (IF (GET NAME 'DEFINED) 014                                         (WARN |use disagrees with definition on number of args| 015                                                NAME 016                                                NARGS 017                                                N) 018                                          (WARN |two uses disagree before definition on number of args| 019                                                NAME  020                                                NARG5  021                                                N))))  022                              (PUTPROP NAME NARGS ‘NUMBER-OF-ARGS)) 023                         (IF DEFP (PUTPROP NAME 'T 'DEFINED)))))) 024 025 026 (DEFUN *EXPR FEXPR (X) 027         (MAPCAR '(LAMBDA (Y) (PUTPROP Y ‘T '*EXPR)) X)) 028 029 (DEFPROP *EXPR AFSUBR AMACRO) (DEFPROP *EXPR AMACRO AINT) 030 031 (DEFUN *LEXPR FEXPR (X) 032         (MAPCAR '(LAMBDA (Y) (PUTPROP Y 'T '*LEXPR)) X)) 033 034 (DEFPROP *LEXPR AFSUBR AMACRO) (DEFPROP *LEXPR AMACRO AINT) 035 036 037 (DEFINE DUMPIT 038          (LAMBDA 039                 (BLOCK (INIT-RABBIT) 040                  (SUSPEND '|:PDUMP DSK:SCHEME:TS RABBIT|) 041                  (TERPRI) 042                  (PRINC '|Fi1e name: |) 043                  (COMF1LE (READLINE)) 044                  (QUIT)))) 045 046 (DEFINE STATS 047          (LAMBDA 048                 (AMAPC (LAMBDA (VAR) 049                                (BLOCK (TERPRI) 050                                        (PRIN1 VAR) 051                                        (PRINC '| = |) 052                                        (PRINI (SYMEVAL VAR)))) 053                          *STAT-VARS*))) 054 055 (DEFINE RESET-STATS 056           (LAMBDA  (AMAPC (LAMBDA (VAR) (SET VAR 0)) *STAT-VARS*)))