(DEFPROP FORLSPFNS (FORLSPFNS (SPECIAL *IF'SL)
DEFLIST RPLACNODE MAKEMAKECOPY REMOVEIS
RECORD RECDO REMOVEOF COMPOSE COMPOSE1
COMPOSE2 COMPOSE3 COMPOSE4 #CONS
#REPLACE VARNAME GONEXTN
PLUSSIGNTESTSET PLUSSIGNPV INITL
PLUSSIGNNEXT *FOR | CONDIT SETIT NEGATE
*IF THENCLAUSE QUOTEIT1 QUOTEIT2 FOR IF
REPLACE FULLEXPANSION DEFAULT GSET
ADVISE ADVISE1 SAVEFN1 ARGLIST NARGS
FIRSTN)
VALUE)
(SPECIAL *IF'SL)
(DEFPROP DEFLIST (LAMBDA (L PROP)
(PROG (VAL)
LP
(COND ((NULL L)
(RETURN VAL)))
(PUTPROP (CAAR L)
(CADAR L)
PROP)
(SETQ VAL (CONS (CAAR L)
VAL))
(SETQ L (CDR L))
(GO LP)))
EXPR)
(DEFPROP RPLACNODE (LAMBDA (OLD NEW)
(PROG2 (RPLACA OLD (CAR NEW))
(RPLACD OLD (CDR NEW))))
EXPR)
(DEFPROP MAKEMAKECOPY (LAMBDA (X)
(COND ((MEMQ (CAR X)
(QUOTE (LIST COPY)))
X)
((AND (EQ (CAR X)
(QUOTE APPEND))
(CDDR X))
X)
(T (LIST (QUOTE APPEND)
X NIL))))
EXPR)
(DEFPROP REMOVEIS (LAMBDA (FORM)
(COND ((NULL FORM)
NIL)
((EQ (CAR FORM)
(QUOTE IS))
(REMOVEIS (CDR FORM)))
((EQ (CAR FORM)
(QUOTE =))
(REMOVEIS (CDR FORM)))
(T (CONS (CAR FORM)
(REMOVEIS (CDR FORM))))))
EXPR)
(DEFPROP RECORD (LAMBDA
(NAME FIELD)
(PROG NIL (PUTPROP NAME FIELD (QUOTE RECORD))
(PUTPROP NAME (LIST (QUOTE LAMBDA)
(QUOTE (RECORDVAR))
(LIST (QUOTE COMPOSE)
(QUOTE (REMOVEIS RECORDVAR)
)
(LIST (QUOTE QUOTE)
FIELD)))
(QUOTE MACRO))
(RECDO FIELD (QUOTE X))))
EXPR)
(DEFPROP
RECDO
(LAMBDA
(FORMAT DEF)
(COND
((NULL FORMAT)
NIL)
((NOT (ATOM FORMAT))
(RECDO (CAR FORMAT)
(LIST (QUOTE CAR)
DEF))
(RECDO (CDR FORMAT)
(LIST (QUOTE CDR)
DEF)))
(T (PUTPROP
FORMAT
(LIST (QUOTE LAMBDA)
(QUOTE (RECORDFIELDVAR))
(LIST (QUOTE SUBST)
(QUOTE (COND ((NULL (CDDR (SETQ RECORDFIELDVAR
(REMOVEOF
RECORDFIELDVAR))))
(CADR RECORDFIELDVAR))
(T (CDR RECORDFIELDVAR))))
(QUOTE (QUOTE X))
(LIST (QUOTE QUOTE)
DEF)))
(QUOTE MACRO)))))
EXPR)
(DEFPROP REMOVEOF (LAMBDA (L)
(COND ((NULL L)
NIL)
((EQ (CAR L)
(QUOTE OF))
(REMOVEOF (CDR L)))
(T (CONS (CAR L)
(REMOVEOF (CDR L))))))
EXPR)
(DEFPROP COMPOSE (LAMBDA
(L FIELD)
(COND ((EQ (CADR L)
(QUOTE FROM))
(COND ((ATOM (CADDR L))
(COMPOSE1 L FIELD (CADDR L)))
(T (LIST (LIST (QUOTE LAMBDA)
(QUOTE (COMPOSEVAR))
(COMPOSE1 L FIELD
(QUOTE COMPOSEVAR)))
(CADDR L)))))
(T (COMPOSE1 L FIELD (QUOTE COMPOSEVAR)))))
EXPR)
(DEFPROP COMPOSE1 (LAMBDA (L FIELD DEF)
(PROG (K)
(RETURN (COND ((SETQ K
(COMPOSE2 L
FIELD DEF)
)
(CAR K))
(T (COMPOSE3 L FIELD
DEF))))))
EXPR)
(DEFPROP
COMPOSE2
(LAMBDA
(L FIELD DEF)
(COND
((NULL FIELD)
NIL)
((ATOM FIELD)
(COND ((GET L FIELD)
(LIST (SUBST DEF (QUOTE **)
(GET L FIELD))))
(T NIL)))
((EQ (CAR FIELD)
(QUOTE ID))
(LIST (LIST (QUOTE QUOTE)
(CDR FIELD))))
(T
(PROG
(KA KD)
(SETQ KD (COMPOSE2 L (CDR FIELD)
(LIST (QUOTE CDR)
DEF)))
(SETQ KA (COMPOSE2 L (CAR FIELD)
(LIST (QUOTE CAR)
DEF)))
(COND ((AND (NULL KA)
(NULL KD))
(RETURN NIL)))
(RETURN (LIST (#CONS (COND
(KA (CAR KA))
(T (COMPOSE1 L (CAR FIELD)
(LIST (QUOTE CAR)
DEF))))
(COND
(KD (CAR KD))
(T (COMPOSE1 L (CDR FIELD)
(LIST (QUOTE CDR)
DEF)))))))))))
EXPR)
(DEFPROP COMPOSE3 (LAMBDA (L FIELD DEF)
(COND ((EQ (QUOTE FROM)
(CADR L))
DEF)
(T (COMPOSE4 FIELD))))
EXPR)
(DEFPROP COMPOSE4 (LAMBDA (FIELD)
(COND ((NULL FIELD)
NIL)
((ATOM FIELD)
((LAMBDA
(X)
(COND (X (LIST (QUOTE QUOTE)
(COPY X)))
(T NIL)))
(GET FIELD (QUOTE RECDEFAULT))))
(T (#CONS (COMPOSE4 (CAR FIELD))
(COMPOSE4 (CDR FIELD))))))
EXPR)
(DEFPROP #CONS (LAMBDA (CARPART CDRPART)
(COND ((NOT CDRPART)
(LIST (QUOTE LIST)
CARPART))
((EQ (CAR CDRPART)
(QUOTE LIST))
(CONS (QUOTE LIST)
(CONS CARPART (CDR CDRPART))))
(T (LIST (QUOTE CONS)
CARPART CDRPART))))
EXPR)
(DEFPROP #REPLACE (LAMBDA (CARPART CDRPART)
(COND ((NULL CARPART)
CDRPART)
((NULL CDRPART)
CARPART)
((AND (EQ (CAR CARPART)
(QUOTE RPLACA))
(EQ (CAR CDRPART)
(QUOTE RPLACD))
(EQUAL (CADR CARPART)
(CADR CDRPART)))
(LIST (QUOTE RPLACD)
CARPART
(CADDR CDRPART)))
(T (LIST (QUOTE PROG2)
CARPART CDRPART))))
EXPR)
(DEFPROP VARNAME (LAMBDA (VARNL)
(LIST (QUOTE |)
(CADR VARNL)
(QUOTE VAR)))
MACRO)
(DEFPROP GONEXTN (LAMBDA (DUMMY)
(QUOTE (LIST (QUOTE GO)
(COND
((EQUAL N 1.0)
(QUOTE RETURN))
(T (| (QUOTE NEXT)
(SUB1 N)))))))
MACRO)
(DEFPROP PLUSSIGNTESTSET (LAMBDA (TSLS)
(LIST (QUOTE CAR)
(LIST (QUOTE SETQ)
(QUOTE TESTSET)
(LIST (QUOTE CONS)
(CADR TSLS)
(QUOTE TESTSET)))))
MACRO)
(DEFPROP PLUSSIGNPV (LAMBDA (PVL)
(LIST (QUOTE CAR)
(LIST (QUOTE SETQ)
(QUOTE PV)
(LIST (QUOTE CONS)
(CADR PVL)
(QUOTE PV)))))
MACRO)
(DEFPROP INITL (LAMBDA (INITLLS)
(LIST (QUOTE PROG1)
(LIST (QUOTE SETQ)
(QUOTE TEM)
(CADR INITLLS))
(LIST (QUOTE SETQ)
(QUOTE INIT)
(LIST (QUOTE CONS)
(LIST (QUOTE SETIT)
(QUOTE TEM)
(CADDR INITLLS))
(QUOTE INIT)))))
MACRO)
(DEFPROP PLUSSIGNNEXT (LAMBDA (ITEMLIST)
(LIST (QUOTE CAR)
(LIST (QUOTE SETQ)
(QUOTE NEXT)
(LIST (QUOTE CONS)
(CADR ITEMLIST)
(QUOTE NEXT)))))
MACRO)
(DEFPROP
*FOR
(LAMBDA
(L)
(PROG
(N FV PV EPILOGUE PROLOGUE DOFORM DOTYPE VAR RANGE LST VARNEXT
NEXT NEXTS N2 N3 INIT TESTSET DOVAL TEM)
(SETQ N 1.0)
FORLOOP
(COND ((EQ (CAR L)
(QUOTE NEW))
(PLUSSIGNPV (CAR (SETQ L (CDR L))))))
(SETQ VAR (CAR L))
(SETQ RANGE (CADDR L))
(PLUSSIGNNEXT (SETQ VARNEXT (VARNAME (QUOTE NEXT))))
(COND
((EQ (CADR L)
(QUOTE IN))
(PLUSSIGNTESTSET
(CONDIT (NEGATE (INITL (PLUSSIGNPV (SETQ
LST
(VARNAME
(QUOTE LIST))))
RANGE))
(GONEXTN)))
(PLUSSIGNTESTSET (SETIT VAR (LIST (QUOTE CAR)
LST)))
(PLUSSIGNNEXT (SETIT LST (LIST (QUOTE CDR)
LST))))
((EQ (CADR L)
(QUOTE ON))
(PLUSSIGNTESTSET (CONDIT (NEGATE VAR)
(GONEXTN)))
(PLUSSIGNNEXT (SETIT (INITL VAR RANGE)
(LIST (QUOTE CDR)
VAR))))
((MEMB (CADR L)
(QUOTE (:= ←)))
(SETQ N2 (COND ((ATOM (CADR RANGE))
(CADR RANGE))
(T (INITL (PLUSSIGNPV (VARNAME (QUOTE MAX)))
(CADR RANGE)))))
(SETQ N3 (COND ((CDDR RANGE)
(COND
((ATOM (CADDR RANGE))
(CADDR RANGE))
(T (INITL (PLUSSIGNPV (VARNAME
(QUOTE INC)))
(CADDR RANGE)))))
((AND (NUMBERP (CAR RANGE))
(NUMBERP (CADR RANGE))
(GREATERP (CAR RANGE)
(CADR RANGE)))
-1.0)
(T 1.0)))
(INITL VAR (CAR RANGE))
(AND
(NOT (MEMB N2 (QUOTE (∞ INFINITY))))
(PLUSSIGNTESTSET
(CONDIT (COND
((NOT (NUMBERP N3))
(LIST (QUOTE COND)
(LIST (LIST (QUOTE MINUSP)
N3)
(LIST (QUOTE LESSP)
VAR N2))
(LIST T (LIST (QUOTE OR)
(LIST (QUOTE ZEROP)
N3)
(LIST (QUOTE GREATERP)
VAR N2)))))
((MINUSP N3)
(LIST (QUOTE LESSP)
VAR N2))
(T (LIST (QUOTE GREATERP)
VAR N2)))
(GONEXTN))))
(PLUSSIGNNEXT (SETIT VAR (LIST (QUOTE PLUS)
VAR N3))))
((EQ (CADR L)
(QUOTE IS))
(PLUSSIGNTESTSET (SETIT VAR RANGE)))
(T (ERROR (QUOTE "INVALID FOR TYPE"))))
(SETQ L (CDDDR L))
ASLOOP
(COND ((EQ (CAR L)
(QUOTE AS))
(SETQ L (CDR L))
(SETQ NEXTS (APPEND NEXTS NEXT))
(SETQ NEXT NIL)
(GO FORLOOP))
((MEMQ (CAR L)
(QUOTE (IF WHEN)))
(PLUSSIGNTESTSET (CONDIT (NEGATE (CADR L))
(LIST (QUOTE GO)
VARNEXT)))
(SETQ L (CDDR L)))
((EQ (CAR L)
(QUOTE UNTIL))
(PLUSSIGNNEXT (CONDIT (CADR L)
(GONEXTN)))
(SETQ L (CDDR L)))
((EQ (CAR L)
(QUOTE WHILE))
(PLUSSIGNTESTSET (CONDIT (NEGATE (CADR L))
(GONEXTN)))
(SETQ L (CDDR L)))
(T (GO FORTEST)))
(GO ASLOOP)
FORTEST
(SETQ PROLOGUE (APPEND TESTSET (LIST (| (QUOTE LOOP)
N))
INIT PROLOGUE))
(SETQ EPILOGUE (CONS (| (QUOTE NEXT)
N)
(APPEND (REVERSE NEXT)
(REVERSE NEXTS)
(CONS (LIST (QUOTE GO)
(| (QUOTE LOOP)
N))
EPILOGUE))))
(SETQ TESTSET (SETQ INIT (SETQ NEXT (SETQ NEXTS NIL))))
(COND ((EQ (CAR L)
(QUOTE FOR))
(SETQ L (CDR L))
(SETQ N (ADD1 N))
(GO FORLOOP)))
(SETQ DOTYPE (CAR L))
(SETQ DOVAL (CAR (LAST L)))
(PLUSSIGNPV (QUOTE FOR-VALUE))
(SETQ FV (QUOTE FOR-VALUE))
(SETQ DOFORM (COND
((EQ DOTYPE (QUOTE OR))
(CONDIT (SETIT (QUOTE FOR-VALUE)
DOVAL)
(QUOTE (RETURN FOR-VALUE))))
((EQ DOTYPE (QUOTE AND))
(INITL (QUOTE FOR-VALUE)
T)
(CONDIT (NEGATE (SETIT (QUOTE FOR-VALUE)
DOVAL))
(QUOTE (RETURN NIL))))
((MEMQ DOTYPE (QUOTE (PROGN PROG2)))
(SETIT (QUOTE FOR-VALUE)
DOVAL))
((EQ DOTYPE (QUOTE DO))
DOVAL)
(T (SETIT (QUOTE FOR-VALUE)
(COND ((EQ DOTYPE (QUOTE LIST))
(LIST (QUOTE NCONC)
(QUOTE FOR-VALUE)
(LIST (QUOTE LIST)
DOVAL)))
((EQ DOTYPE (QUOTE NCONC))
(LIST (QUOTE NCONC)
(QUOTE FOR-VALUE)
DOVAL))
((EQ DOTYPE (QUOTE XLIST))
(LIST (QUOTE CONS)
DOVAL
(QUOTE FOR-VALUE)))
((EQ DOTYPE (QUOTE APPEND))
(LIST (QUOTE NCONC)
(QUOTE FOR-VALUE)
(MAKEMAKECOPY DOVAL)))
(T (LIST DOTYPE DOVAL (QUOTE FOR-VALUE))
))))))
(COND ((EQ (CAR (SETQ L (CDR L)))
(QUOTE FIRST))
(INITL (QUOTE FOR-VALUE)
(CADR L))
(SETQ L (CDDR L)))
((MEMQ DOTYPE (QUOTE (PLUS IPLUS TIMES ITIMES MAX MIN)))
(INITL (QUOTE FOR-VALUE)
(CDR (ASSOC DOTYPE (QUOTE ((PLUS . 0.0)
(MAX . -99999.0)
(MIN . 99999.0)
(IPLUS . 0.0)
(TIMES . 1.0)
(ITIMES . 1.0))))))))
(RETURN (CONS (QUOTE PROG)
(CONS PV (APPEND INIT (REVERSE PROLOGUE)
(REVERSE (CDR (REVERSE L)))
(LIST DOFORM)
EPILOGUE
(LIST (QUOTE RETURN)
(LIST (QUOTE RETURN)
FV))))))))
EXPR)
(DEFPROP | (LAMBDA (STR VAL)
(READLIST (NCONC (EXPLODE STR)
(CONS (QUOTE *)
(EXPLODE VAL)))))
EXPR)
(DEFPROP CONDIT (LAMBDA (PRD DO)
(LIST (QUOTE COND)
(LIST PRD DO)))
EXPR)
(DEFPROP SETIT (LAMBDA (VAR VAL)
(COND ((NOT (EQUAL VAR VAL))
(LIST (QUOTE SETQ)
VAR VAL))
(T NIL)))
EXPR)
(DEFPROP NEGATE (LAMBDA (EXP)
(COND ((MEMQ (CAR EXP)
(QUOTE (NOT NULL)))
(CADR EXP))
(T (LIST (QUOTE NOT)
EXP))))
EXPR)
(DEFPROP *IF (LAMBDA
(*IF'SL)
(COND (*IF'SL (CONS (CONS (CAR *IF'SL)
(COND
((NOT (EQ (CADR *IF'SL)
(QUOTE THEN)))
(ERROR *IF'SL (QUOTE
"NO CORRESPONDING THEN IN IF")))
(T (SETQ *IF'SL (CDDR *IF'SL))
(THENCLAUSE))))
(COND ((NULL *IF'SL)
NIL)
((EQ (CAR *IF'SL)
(QUOTE ELSEIF))
(*IF (CDR *IF'SL)))
((EQ (CAR (SETQ *IF'SL
(CDR *IF'SL)))
(QUOTE IF))
(*IF (CDR *IF'SL)))
(T (LIST (CONS T (THENCLAUSE)))))
))
(T NIL)))
EXPR)
(DEFPROP THENCLAUSE (LAMBDA NIL
(COND
((OR (NULL *IF'SL)
(MEMQ (CAR *IF'SL)
(QUOTE (ELSE ELSEIF))))
(LIST NIL))
((OR (NOT (CDR *IF'SL))
(MEMQ (CADR *IF'SL)
(QUOTE (ELSE ELSEIF))))
(PROG1 (LIST (CAR *IF'SL))
(SETQ *IF'SL (CDR *IF'SL))))
(T (CONS (CAR *IF'SL)
(PROG2 (SETQ *IF'SL
(CDR *IF'SL))
(THENCLAUSE))))))
EXPR)
(DEFPROP QUOTEIT1 (LAMBDA (X M)
(COND ((OR (NULL X)
(NUMBERP X)
(EQ X T))
X)
((SETQ M (QUOTEIT2 X M))
M)
(T (LIST (QUOTE QUOTE)
X))))
EXPR)
(DEFPROP
QUOTEIT2
(LAMBDA
(X N)
(COND
((ATOM X)
NIL)
((EQ (CAR X)
(QUOTE ¬))
(COND ((ATOM (CDR X))
(CDR X))
((NULL (CDDR X))
(LIST (QUOTE LIST)
(CADR X)))
(T ((LAMBDA (D E)
(COND ((EQ (CAR D)
(QUOTE LIST))
(CONS (QUOTE LIST)
(CONS E (CDR D))))
(T (LIST (QUOTE CONS)
E D))))
(QUOTEIT1 (CDDR X))
(CADR X)))))
((NULL (CDR X))
(COND ((SETQ N (QUOTEIT2 (CAR X)
N))
(LIST (QUOTE LIST)
N))
(T NIL)))
(T (PROG (M)
(SETQ M (QUOTEIT2 (CAR X)
N))
(SETQ N (QUOTEIT2 (CDR X)
N))
(COND ((AND (NULL M)
(NULL N))
(RETURN NIL)))
(COND ((AND (NULL M)
(SETQ M (CAR X))
(NOT (NUMBERP M))
(NOT (EQ M T)))
(SETQ M (LIST (QUOTE QUOTE)
M))))
(RETURN (COND
((EQ (CAR N)
(QUOTE LIST))
(CONS (CAR N)
(CONS M (CDR N))))
(T (LIST (QUOTE CONS)
M
(COND ((AND (NULL N)
(SETQ N (CDR X))
(NOT (NUMBERP N))
(NOT (EQ N T)))
(LIST (QUOTE QUOTE)
N))
(T N))))))))))
EXPR)
(DEFPROP FOR (LAMBDA (FOR-EXPRESSION)
(*FOR (CDR FOR-EXPRESSION)))
MACRO)
(DEFPROP IF (LAMBDA (IF-EXPRESSION)
(RPLACNODE IF-EXPRESSION
(CONS (QUOTE COND)
(*IF (CDR IF-EXPRESSION)))))
MACRO)
(DEFPROP REPLACE (LAMBDA (REPLACEXP)
(PROG (REPLACE1 REPLACE2)
(SETQ REPLACE1 (FULLEXPANSION
(CADR REPLACEXP)))
(SETQ REPLACE2 (CADDR REPLACEXP))
(RETURN (LIST (COND
((EQ (CAR REPLACE1)
(QUOTE CAR))
(QUOTE RPLACA))
((EQ (CAR REPLACE1)
(QUOTE CDR))
(QUOTE RPLACD))
(ERROR (QUOTE
"REPLACE CAN'T")
(LIST REPLACE1
REPLACE2)))
(CADR REPLACE1)
REPLACE2))))
MACRO)
(DEFPROP
FULLEXPANSION
(LAMBDA (X)
(COND
((MEMQ (CAR X)
(QUOTE (CAAR CADR CDAR CDDR CDDAR CDDDR CDDDAR
CDDDDR CADDAR CADDDR CADAR CADDR
CDADAR CDADDR CAADAR CAADDR CDAAR
CDADR CDDAAR CDDADR CADAAR CADADR
CAAAR CAADR CDAAAR CDAADR CAAAAR
CAAADR)))
(LIST (READLIST (LIST (QUOTE C)
(CADR (EXPLODE (CAR X)))
(QUOTE R)))
(LIST (READLIST (CONS (QUOTE C)
(CDDR (EXPLODE (CAR X)))))
(CADR X))))
((GET (CAR X)
(QUOTE MACRO))
(FULLEXPANSION (APPLY (GET (CAR X)
(QUOTE MACRO))
(LIST X))))
(T X)))
EXPR)
(DEFPROP DEFAULT (LAMBDA (FIELD VALUE)
(DEFLIST (LIST VALUE)
(QUOTE RECDEFAULT)))
EXPR)
(DEFPROP GSET (LAMBDA (VAR VAL)
(PROG2 (COND ((GET VAR (QUOTE SPECIAL)))
(T (PUTPROP VAR (QUOTE T)
(QUOTE SPECIAL))))
(SET VAR VAL)))
EXPR)
(DEFPROP
ADVISE
(LAMBDA
(FN WHEN WHAT)
(PUTPROP FN
(LIST (QUOTE LAMBDA)
(ARGLIST FN)
(LIST (QUOTE PROG)
(CONS (QUOTE !VALUE)
(COND ((EQ WHEN (QUOTE BIND))
WHAT)
(T NIL)))
(LIST (QUOTE SETQ)
(QUOTE !VALUE)
(LIST (QUOTE PROG)
NIL
(COND ((EQ WHEN (QUOTE BEFORE))
WHAT)
(T NIL))
(LIST (QUOTE RETURN)
(SAVEFN1 FN (ARGLIST
FN)))))
(COND ((EQ WHEN (QUOTE AFTER))
WHAT)
(T NIL))
(QUOTE (RETURN !VALUE))))
(QUOTE EXPR)))
EXPR)
(DEFPROP ADVISE1
(LAMBDA
(FN WHEN ARGLIST WHAT)
(PUTPROP
FN
(LIST (QUOTE LAMBDA)
ARGLIST
(LIST (QUOTE PROG)
(CONS (QUOTE !VALUE)
(COND ((EQ WHEN (QUOTE BIND))
WHAT)
(T NIL)))
(LIST (QUOTE SETQ)
(QUOTE !VALUE)
(LIST (QUOTE PROG)
NIL
(COND ((EQ WHEN (QUOTE BEFORE))
WHAT)
(T NIL))
(LIST (QUOTE RETURN)
(SAVEFN1 FN ARGLIST))))
(COND ((EQ WHEN (QUOTE AFTER))
WHAT)
(T NIL))
(QUOTE (RETURN !VALUE))))
(QUOTE EXPR)))
EXPR)
(DEFPROP SAVEFN1 (LAMBDA (FN ARGLIST)
(PROG (AT)
(SETQ AT (INTERN (GENSYM)))
(COND ((GET FN (QUOTE EXPR))
(PUTPROP AT
(GET FN (QUOTE EXPR))
(QUOTE EXPR)))
((GET FN (QUOTE SUBR))
(PUTPROP AT
(GET FN (QUOTE SUBR))
(QUOTE SUBR))))
(RETURN (CONS AT ARGLIST))))
EXPR)
(DEFPROP ARGLIST
(LAMBDA (FN)
(FIRSTN (QUOTE (ARG1 ARG2 ARG3 ARG4 ARG5 ARG6 ARG7
ARG8 ARG9 ARG10))
(NARGS FN)))
EXPR)
(DEFPROP NARGS (LAMBDA (FN)
(COND ((GET FN (QUOTE EXPR))
(LENGTH (CADR (GET FN (QUOTE EXPR)))))
(T 5.0)))
EXPR)
(DEFPROP FIRSTN (LAMBDA (L N)
(COND ((EQUAL N 0.0)
NIL)
(T (CONS (CAR L)
(FIRSTN (CDR L)
(SUB1 N))))))
EXPR)
STOP