reduce-historical/psl-1983/util/mini.sl

NIL

(DE RUL NIL (AND (PROG (X) (SETQ X (STK!-LENGTH)) G0109 (COND ((OR (AND (
EQTOK!-NEXT (QUOTE DIP)) (FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !:)) (FAIL!-NOT (
AND (PROG (X) (SETQ X (STK!-LENGTH)) G0109 (COND ((AND (ANYTOK) (EQTOK!-NEXT (
QUOTE !,))) (GO G0109))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (
PROGN (DIPBLD (EXTRACT 1)) T) (FAIL!-NOT (EQTOK!-NEXT (QUOTE !;)))))))))) (
AND (ID) (FAIL!-NOT (AND (PROGN (SETQ !#LABLIST!# NIL) T) (FAIL!-NOT (AND (
OR (AND (EQTOK!-NEXT (QUOTE !:)) (FAIL!-NOT (AND (ALT) (FAIL!-NOT (AND (PUSH (
LIST (QUOTE DE) (EXTRACT 2) (QUOTE NIL) (EXTRACT 1))) (FAIL!-NOT (EQTOK (
QUOTE !;)))))))) (AND (EQTOK!-NEXT (QUOTE !=)) (FAIL!-NOT (AND (PROG (X) (
SETQ X (STK!-LENGTH)) G0109 (COND ((AND (PRUL) (EQTOK!-NEXT (QUOTE !,))) (GO 
G0109))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (EQTOK (QUOTE !;)) (
FAIL!-NOT (AND (PROGN (RULE!-DEFINE (LIST (QUOTE PUT) (LIST (QUOTE QUOTE) (
REF 2)) (LIST (QUOTE QUOTE) (QUOTE RB)) (LIST (QUOTE QUOTE) (EXTRACT 1)))) T) (
FAIL!-NOT (PUSH (LIST (QUOTE DE) (REF 1) (LIST (QUOTE A)) (LIST (QUOTE 
RBMATCH) (QUOTE A) (LIST (QUOTE GET) (LIST (QUOTE QUOTE) (EXTRACT 1)) (LIST (
QUOTE QUOTE) (QUOTE RB))) (QUOTE NIL))))))))))))) (FAIL!-NOT (AND (PROGN (
RULE!-DEFINE (EXTRACT 1)) T) (FAIL!-NOT (PROGN (NEXT!-TOK) T)))))))))) (GO 
G0109))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (EQTOK (QUOTE FIN)))))

(DE ALT NIL (AND (SEQ) (FAIL!-NOT (PROGN (AND (EQTOK!-NEXT (QUOTE !/)) (
FAIL!-NOT (AND (ALT) (FAIL!-NOT (PUSH (LIST (QUOTE OR) (EXTRACT 2) (EXTRACT 
1))))))) T))))

(DE SEQ NIL (AND (REP) (FAIL!-NOT (PROGN (AND (SEQ) (FAIL!-NOT (PUSH (LIST (
QUOTE AND) (EXTRACT 2) (LIST (QUOTE FAIL!-NOT) (EXTRACT 1)))))) T))))

(DE REP NIL (AND (ONE) (FAIL!-NOT (PROGN (OR (AND (EQTOK!-NEXT (QUOTE ![)) (
FAIL!-NOT (AND (OR (AND (ID) (FAIL!-NOT (PUSH (LIST (EXTRACT 1))))) (OR (AND (
EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (AND (ANYKEY) (FAIL!-NOT (PUSH (LIST (
QUOTE EQTOK!-NEXT) (LIST (QUOTE QUOTE) (EXTRACT 1)))))))) (AND (ANYKEY) (
FAIL!-NOT (PUSH (LIST (QUOTE EQTOK!-NEXT) (LIST (QUOTE QUOTE) (EXTRACT 
1)))))))) (FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !])) (FAIL!-NOT (AND (PUSH (
LIST (QUOTE AND) (EXTRACT 2) (EXTRACT 1))) (FAIL!-NOT (AND (EQTOK!-NEXT (
QUOTE !*)) (FAIL!-NOT (BLD!-EXPR))))))))))) (AND (EQTOK!-NEXT (QUOTE !*)) (
FAIL!-NOT (BLD!-EXPR)))) T))))

(DE BLD!-EXPR NIL (PUSH (LIST (QUOTE PROG) (LIST (QUOTE X)) (LIST (QUOTE 
SETQ) (QUOTE X) (LIST (QUOTE STK!-LENGTH))) (GENLAB 1) (LIST (QUOTE COND) (
LIST (EXTRACT 1) (LIST (QUOTE GO) (GENLAB 1)))) (LIST (QUOTE BUILD!-REPEAT) (
QUOTE X)) (LIST (QUOTE RETURN) (QUOTE T)))))

(DE ANYKEY NIL (AND (ANYTOK) (FAIL!-NOT (PROGN (ADDKEY (REF 1)) T))))

(DE ONE NIL (OR (AND (EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (AND (ANYKEY) (
FAIL!-NOT (PUSH (LIST (QUOTE EQTOK!-NEXT) (LIST (QUOTE QUOTE) (EXTRACT 
1)))))))) (OR (AND (EQTOK!-NEXT (QUOTE !@)) (FAIL!-NOT (AND (ANYKEY) (
FAIL!-NOT (AND (PROGN (ADDRTERM (REF 1)) T) (FAIL!-NOT (PUSH (LIST (QUOTE 
EQTOK) (LIST (QUOTE QUOTE) (EXTRACT 1)))))))))) (OR (AND (EQTOK!-NEXT (QUOTE 
!@!@)) (FAIL!-NOT (AND (ANYKEY) (FAIL!-NOT (AND (PROGN (ADDGTERM (REF 1)) T) (
FAIL!-NOT (PUSH (LIST (QUOTE EQTOK) (LIST (QUOTE QUOTE) (EXTRACT 1)))))))))) (
OR (AND (EQTOK!-NEXT (QUOTE !+)) (FAIL!-NOT (AND (UNLBLD) (FAIL!-NOT (PUSH (
LIST (QUOTE PUSH) (EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (QUOTE !.)) (
FAIL!-NOT (AND (EVLBLD) (FAIL!-NOT (PUSH (LIST (QUOTE PROGN) (EXTRACT 1) (
QUOTE T))))))) (OR (AND (EQTOK!-NEXT (QUOTE !=)) (FAIL!-NOT (EVLBLD))) (OR (
AND (EQTOK!-NEXT (QUOTE !<)) (FAIL!-NOT (AND (ALT) (FAIL!-NOT (AND (
EQTOK!-NEXT (QUOTE !>)) (FAIL!-NOT (PUSH (LIST (QUOTE PROGN) (EXTRACT 1) (
QUOTE T))))))))) (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (AND (ALT) (
FAIL!-NOT (EQTOK!-NEXT (QUOTE !))))))) (OR (AND (EQTOK!-NEXT (QUOTE !+!.)) (
FAIL!-NOT (AND (EVLBLD) (FAIL!-NOT (PUSH (LIST (QUOTE PUSH) (EXTRACT 1))))))) (
AND (ID) (FAIL!-NOT (PUSH (LIST (EXTRACT 1)))))))))))))))

(DE UNLBLD NIL (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (AND (UNLBLD) (
FAIL!-NOT (OR (AND (EQTOK!-NEXT (QUOTE !.)) (FAIL!-NOT (AND (UNLBLD) (
FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (LIST (QUOTE CONS) (
EXTRACT 2) (EXTRACT 1))))))))) (OR (AND (PROG (X) (SETQ X (STK!-LENGTH)) 
G0110 (COND ((UNLBLD) (GO G0110))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (
AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (CONS (QUOTE LIST) (CONS (
EXTRACT 2) (EXTRACT 1)))))))) (AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (
CONS (QUOTE LIST) (EXTRACT 1))))))))))) (OR (LBLD) (AND (ID) (FAIL!-NOT (
PUSH (LIST (QUOTE QUOTE) (EXTRACT 1))))))))

(DE EVLBLD NIL (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (AND (EVLBLD) (
FAIL!-NOT (OR (AND (EQTOK!-NEXT (QUOTE !.)) (FAIL!-NOT (AND (EVLBLD) (
FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (LIST (QUOTE CONS) (
EXTRACT 2) (EXTRACT 1))))))))) (OR (AND (PROG (X) (SETQ X (STK!-LENGTH)) 
G0111 (COND ((EVLBLD) (GO G0111))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (
AND (EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (CONS (EXTRACT 2) (EXTRACT 
1))))))) (EQTOK!-NEXT (QUOTE !))))))))) (OR (LBLD) (ID))))

(DE LBLD NIL (OR (AND (EQTOK!-NEXT (QUOTE !#)) (FAIL!-NOT (AND (NUM) (
FAIL!-NOT (PUSH (LIST (QUOTE EXTRACT) (EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (
QUOTE !#!#)) (FAIL!-NOT (AND (NUM) (FAIL!-NOT (PUSH (LIST (QUOTE REF) (
EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (QUOTE !$)) (FAIL!-NOT (AND (NUM) (
FAIL!-NOT (PUSH (LIST (QUOTE GENLAB) (EXTRACT 1))))))) (OR (AND (EQTOK!-NEXT (
QUOTE !&)) (FAIL!-NOT (AND (NUM) (FAIL!-NOT (PUSH (LIST (QUOTE CADR) (LIST (
QUOTE ASSOC) (EXTRACT 1) (LIST (QUOTE CAR) (QUOTE VARLIST))))))))) (OR (NUM) (
OR (STR) (AND (EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (OR (AND (EQTOK!-NEXT (
QUOTE !()) (FAIL!-NOT (AND (PROG (X) (SETQ X (STK!-LENGTH)) G0112 (COND ((
UNLBLD) (GO G0112))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (
EQTOK!-NEXT (QUOTE !))) (FAIL!-NOT (PUSH (CONS (QUOTE LIST) (EXTRACT 1)))))))))
(AND (ANYTOK) (FAIL!-NOT (PUSH (LIST (QUOTE QUOTE) (EXTRACT 1)))))))))))))))

(DE PRUL NIL (AND (PROGN (SETQ INDEXLIST!* NIL) T) (FAIL!-NOT (AND (PAT) (
FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !-!>)) (FAIL!-NOT (AND (PROG (X) (SETQ X (
STK!-LENGTH)) G0113 (COND ((EVLBLD) (GO G0113))) (BUILD!-REPEAT X) (RETURN T)) (
FAIL!-NOT (AND (PUSH (LIST (QUOTE LAMBDA) (LIST (QUOTE VARLIST) (QUOTE T1) (
QUOTE T2) (QUOTE T3)) (CONS (QUOTE AND) (EXTRACT 1)))) (FAIL!-NOT (AND (
PROGN (SETQ PNAM (GENSYM)) T) (FAIL!-NOT (AND (PROGN (RULE!-DEFINE (LIST (
QUOTE PUTD) (LIST (QUOTE QUOTE) PNAM) (LIST (QUOTE QUOTE) (QUOTE EXPR)) (
LIST (QUOTE QUOTE) (EXTRACT 1)))) T) (FAIL!-NOT (PUSH (CONS (EXTRACT 1) PNAM))))
)))))))))))))

(DE PAT NIL (OR (AND (EQTOK!-NEXT (QUOTE !&)) (FAIL!-NOT (OR (AND (
EQTOK!-NEXT (QUOTE !<)) (FAIL!-NOT (AND (PROG (X) (SETQ X (STK!-LENGTH)) 
G0114 (COND ((AND (PSIMP) (EQTOK!-NEXT (QUOTE !/))) (GO G0114))) (
BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (EQTOK!-NEXT (QUOTE !>)) (
FAIL!-NOT (AND (NUM) (FAIL!-NOT (PUSH (PROGN (SETQ INDEXLIST!* (CONS (REF 
1) INDEXLIST!*)) (LIST (QUOTE !&) (EXTRACT 2) (EXTRACT 1)))))))))))) (AND (
NUM) (FAIL!-NOT (PUSH (COND ((MEMQ (REF 1) INDEXLIST!*) (LIST (QUOTE !&) (
QUOTE !&) (EXTRACT 1))) (T (PROGN (SETQ INDEXLIST!* (CONS (REF 1) INDEXLIST!*))
(LIST (QUOTE !&) (EXTRACT 1))))))))))) (OR (ID) (OR (AND (EQTOK!-NEXT (QUOTE 
!()) (FAIL!-NOT (AND (PROG (X) (SETQ X (STK!-LENGTH)) G0114 (COND ((PAT) (GO 
G0114))) (BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (AND (PROGN (AND (
EQTOK!-NEXT (QUOTE !.)) (FAIL!-NOT (AND (PAT) (FAIL!-NOT (PUSH (APPEND (
EXTRACT 2) (EXTRACT 1))))))) T) (FAIL!-NOT (EQTOK!-NEXT (QUOTE !))))))))) (
OR (AND (EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (ANYTOK))) (OR (STR) (NUM)))))))

(DE PSIMP NIL (OR (ID) (OR (NUM) (OR (AND (EQTOK!-NEXT (QUOTE !()) (FAIL!-NOT (
AND (PROG (X) (SETQ X (STK!-LENGTH)) G0115 (COND ((PSIMP) (GO G0115))) (
BUILD!-REPEAT X) (RETURN T)) (FAIL!-NOT (EQTOK!-NEXT (QUOTE !))))))) (AND (
EQTOK!-NEXT (QUOTE !')) (FAIL!-NOT (ANYTOK)))))))

(PUT (QUOTE RUL) (QUOTE KEYS) (QUOTE (!-!> !& !$ !#!# !# !+!. !) !( !> !< !. 
!+ !@!@ !@ !* !] !' ![ !/ FIN != !; !, !: DIP)))

(PUT (QUOTE RUL) (QUOTE DIPS) (QUOTE (!@!@ !+!. !-!> !#!#)))

(PUT (QUOTE RUL) (QUOTE RTS) (QUOTE (!;)))

(PUT (QUOTE RUL) (QUOTE GTS) (QUOTE (FIN)))
NIL
NIL