(DEFPROP DSKIN
(LAMBDA (%L %C)
        (SETQ %C (INC (APPLY INPUT (CONS T %L))))
        (ERRSET (PROG NIL T (EVAL (READ)) (GO T)))
        (INC %C T))
FEXPR)

(SETQ DSKIN @DSKIN)

(DEFPROP %DEFINE
(LAMBDA (X P R)
        (SETQ
         R
         (COND
          ((GETL (SETQ R (CAR X)) @(EXPR FEXPR SUBR FSUBR MACRO))
           (LIST R @REDEFINED))
          (R)))
        (PUTPROP (CAR X) (CONS LAMBDA (CDR X)) P)
        (RETURN R))
EXPR)

(SETQ %DEFINE @%DEFINE)

(DEFPROP DE
(LAMBDA (L) (%DEFINE L EXPR))
FEXPR)

(SETQ DE @DE)

(DEFPROP DF
(LAMBDA (L) (%DEFINE L FEXPR))
FEXPR)

(SETQ DF @DF)

(DEFPROP DM
(LAMBDA (L) (%DEFINE L MACRO))
FEXPR)

(SETQ DM @DM)

(SETQ RETFROM @RETFROM)
(PUTPROP RETFROM 222 SUBR)

(PROG NIL
     (CLRBFI)
     (PRINC "LOAD EXTENDED LIBRARY")
     ((EQ (PROG2 (PROMPT 77) (TYI) (PROMPT 52)) 116)
      (ERR $EOF$)))

(DEFPROP DSKOUT
(LAMBDA (%%L %%C)
        (SETQ %%C (OUTC (APPLY OUTPUT (LIST T (CAR %%L)))))
   A    (COND
         ((SETQ %%L (CDR %%L)) (EVAL (LIST GRINL (CAR %%L))) (GO A)))
        (OUTC %%C T))
FEXPR)

(SETQ DSKOUT @DSKOUT)

(DEFPROP GRINL
(LAMBDA (%L %X %Y %Z)
   A    ((NULL %L) (RETURN))
        (SETQ %X (EVAL (CAR %L)))
        ((CONSP (CAR %L)) (GO C))
        (EVAL (CONS GRINDEF (CONS (CAR %L) %X)))
   B    ((NULL %X) (GO C))
        (SETQ %Y (CAR %X))
        (COND
         ((SETQ %Z (GET %Y READMACRO))
          (TERPRI)
          (SPRINT
           (LIST (COND ((ONEP (REMAINDER (CHRVAL %Y) 10)) DSM) (DRM))
                 %Y
                 %Z)
           1)
          (TERPRI)))
        (SETQ %X (CDR %X))
        (GO B)
   C    (SETQ %L (CDR %L))
        (GO A))
FEXPR)

(SETQ GRINL @GRINL)

(DEFPROP GRINDEF
(LAMBDA (%%L %%F %%G)
   A    (COND ((NULL %%L) (TERPRI) (RETURN)))
        (COND
         ((CONSP (SETQ %%F (CAR %%L)))
          (TERPRI)
          (TERPRI)
          (SPRINT %%F 1)
          (GO D)))
        (SETQ %%F GRINPROPS)
   B    (COND
         ((SETQ %%G (GET (CAR %%L) (CAR %%F)))
          (TERPRI)
          (TERPRI)
          (PRINC "(DEFPROP ")
          (PRIN1 (CAR %%L))
          (TERPRI)
          (SPRINT %%G 2)
          (TERPRI)
          (PRIN1 (CAR %%F))
          (PRINC ")")))
        (COND ((SETQ %%F (CDR %%F)) (GO B)))
   C    (COND
         ((SETQ %%G (ERRSET (EVAL (CAR %%L)) NIL))
          (TERPRI)
          (TERPRI)
          (PRINC "(SETQ ")
          (PRIN1 (CAR %%L))
          (SPRINT (CONS QUOTE %%G)
                  (ADD 2 (SUB (LINELENGTH) (CHRCT)))
                  1)
          (PRINC ")")))
   D    (SETQ %%L (CDR %%L))
        (GO A))
FEXPR)

(SETQ GRINDEF @GRINDEF)

(SETQ GRINPROPS @(NIL EXPR FEXPR MACRO SUBR FSUBR))

(DEFPROP QUOTIENT
(LAMBDA (L) (*EXPAND L DIV))
MACRO)

(SETQ QUOTIENT @QUOTIENT)

(DEFPROP LDIFF
(LAMBDA (X Y Z)
        ((NULL Y) (RETURN X))
        (SETQ Z (NCONS))
   X    ((EQ X Y) (RETURN (VCONC Z)))
        ((ATOM X) (GO Z))
        (TCONC Z (CAR X))
        (SETQ X (CDR X))
        (GO X)
   Z    (ERROR "NOT A TAIL - LDIFF"))
EXPR)

(SETQ LDIFF @LDIFF)

(DEFPROP EXPLODE
(LAMBDA (X) (MAPCAR IASCII (#EXPLODE X)))
EXPR)

(SETQ EXPLODE @EXPLODE)

(DEFPROP TIMES
(LAMBDA (L) (*EXPAND L MUL))
MACRO)

(SETQ TIMES @TIMES)

(DEFPROP EXPLODEC
(LAMBDA (X) (MAPCAR IASCII (#EXPLODEC X)))
EXPR)

(SETQ EXPLODEC @EXPLODEC)

(DEFPROP *EXPAND
(LAMBDA (L FN)
 (COND
  ((CDDR L)
   (CONS (CAR L) (CONS (LIST FN (CADR L) (CADDR L)) (CDDDR L))))
  ((CADR L))))
EXPR)

(SETQ *EXPAND @*EXPAND)

(DEFPROP PLUS
(LAMBDA (L) (*EXPAND L ADD))
MACRO)

(SETQ PLUS @PLUS)

(DEFPROP DSM
(LAMBDA (L)
        (PUTPROP (CAR L) (CADR L) READMACRO)
        (SETCHR (CHRVAL (CAR L)) 1)
        (RETURN (CAR L)))
FEXPR)

(SETQ DSM @DSM)

(DEFPROP REMOB
(LAMBDA (X)
 (MAPC
  @(LAMBDA (X)
    (MAP @(LAMBDA (Y) (RPLACA Y (DREMOVE X (CAR Y)))) OBLIST))
  X))
FEXPR)

(SETQ REMOB @REMOB)

(DEFPROP DRM
(LAMBDA (L)
        (PUTPROP (CAR L) (CADR L) READMACRO)
        (SETCHR (CHRVAL (CAR L)) 5)
        (RETURN (CAR L)))
FEXPR)

(SETQ DRM @DRM)

(SETQ BREAKFNS NIL)

(DF BREAK (L) (PROGN (MAPC @%BREAK L) @OK))

(DE %BREAK (FN)
(%UNBREAK FN)
(PUTPROP FN T ERRORX)
(SETQ BREAKFNS (CONS FN BREAKFNS)))

(DF UNBREAK (L) (PROGN (MAPC @%UNBREAK (OR L (COPY BREAKFNS))) @OK))

(DE %UNBREAK (FN) (REMPROP FN ERRORX) (SETQ BREAKFNS (DREMOVE FN BREAKFNS)))

You are viewing proxied material from gopher.floodgap.com. The copyright of proxied material belongs to its original authors. Any comments or complaints in relation to proxied material should be directed to the original authors of the content concerned. Please see the disclaimer for more details.