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*)))