Trailing-Edge
-
PDP-10 Archives
-
decus_20tap1_198111
-
decus/20-0004/mit.xfo
There are no other files named mit.xfo in the archive.
(FILECREATED " 9-Jul-76 00:14:31" <LEWIS>MIT.XFORMS;9 37950 )
(DEFINEQ
(CREATE-DO-VARS
[LAMBDA (INP) (* dcl: 9 Jul 76
00:12)
(COND
((NULL (CAR INP))
NIL)
(T (for|VAR in INP join (SELECTQ (LENGTH VAR)
(1|(LIST (QUOTE BIND)
(CAR VAR)))
(2|(LIST (QUOTE BIND)
(CAR VAR)
(QUOTE |)
(CADR VAR)))
(3|(LIST (QUOTE AS)
(CAR VAR)
(QUOTE |)
(CADR VAR)
(QUOTE BY)
(CADDR VAR)))
NIL])
)
(PRETTYCOMPRINT (CREATE-DO-VARS))
(PRETTYCOMPRINT XFORMSVARS)
(RPAQQ XFORMSVARS (XFORMSFNS (TRANSAVE)))
(RPAQQ XFORMSFNS (CREATE-DO-VARS))
(RPAQQ DUMPFILE MIT.XFORMS)
(RPAQQ USERNOTES [(*FUNCTION: (* *FUNCTION is not implemented in
INTERLISP. FUNARG is implemented,
tentatively and differently, as a
second argument to the function
FUNCTION. the user must recode this
expression, carefully.))
(ADD1: (* ADD1, ZEROP and and SUB1 in INTERLISP fix
their arguments before checking or
incrementing, i.e. are an integer
functions only.))
(APPLY/EVAL (* TRANSOR will translate the arguments
of the APPLY or EVAL expression, but
the user must make sure that the
run-time evaluation of the arguments
returns a INTERLISP-compatible
expression.))
(ARG1: (* This particular instance of the function
arg could not be successfully translated,
because TRANSOR could not find the
containing lambda-atom expression, thus
could not identify the lambda variable
which must be inserted as the first
argument to arg. See comment on
successful translations of arg.))
(ARG: (* In maclisp, lsubrs (i.e. expr*'s)
take a single lambda-variable, which is
bound to the number of arguments actually
supplied at run-time. So also in
INTERLISP; but whereas the reference in
maclisp is (ARG N)
, where the name of the lambda-variable is
implicit, in INTERLISP the reference is
(ARG FOO N)
where FOO is the (quoted)
name of the lambda variable. TRANSOR looks
up the appropriate variable name and
inserts it, but users should probably
check to make sure TRANSOR got the right
lambda-expression. If TRANSOR cannot find
a containing expr* lambda-expression, a
separate note is made.))
(ARRAY: (* The transformation for the MACLISP
function is somewhat tentative. In
particular, their documentation names
the third argument as t-or-nil, and
describes it by 'and t-or-nil is the
garbage collector switch' thus cleverly
avoiding giving any hint of whether T is
NIL or vice-versa. I have assumed that T
means the ARRAY is to be unboxed, i.e.
not garbage collected. Basically,
MACLISP (ARRAY FOO t/nil index1 index2
...)
converts to
(SETQ FOO
(ARRAY (ITIMES INDEX1 INDEX2 ...)))
and
(array FOO NIL i1 i2 ...)
to
(SETQ FOO (ARRAY (ITIMES I1 I2 ...)
(ITIMES I1 I2 ...)))
%. users should further note that in
maclisp the fifth element of the array
foo is accessed by (foo 5)
where in INTERLISP foo is a variable,
bound to a pointer to the array which
itself prints as #12345, i.e. the octal
address. See manual discussion on
arrays. The fifth element must be
retrieved by (ELT FOO 5)
%. There is no way to anticipate this in
TRANSOR.))
(ARRAYS (* Array function. No transformations for
these functions have been composed yet.))
(BASE: (* The MACLISP function BASE should convert
directly to INTERLISP's RADIX.))
(CHARACTERCODE (* The MIT function ASCII should be
directly replacable by the
INTERLISP function CHARACTER.
This transformation has been
performed, but the user should
watch out for such problems as
different use of control
characters, etc.))
(CHRCT: (* The MACLISP function CHRCT can usually
be replaced by the appropriate use of
position, which returns the number of
chars already typed on the line instead
of the number to go.))
(DEFPROP-MACRO (* Use of the MACLISP system
property MACRO. This can be
translated but i didn't bother
since i have not encountered any
uses of it as yet.))
[DELETE: (*
The user is probably best advised to
define DELETE for himself. DELETE is
like DREMOVE, except that: - It matches
on EQUAL, not EQ; - It takes an optional
third argument which is a maximum number
of deletions. - It returns CDR if the
CAR matches, rather than always making
the return be EQ to its second argument
if at all possible, so that in MACLISP
it was almost always necessary to write
(SETQ FOO (DELETE & FOO))
- Herewith my definition, untested : - -
(LAMBDA
(X L N)
(PROG
(Z)
[COND
((NLISTP (SETQ Z L))
(RETURN))
((EQUAL X (CAR L))
(RETURN (DELETE X (CDR L)
(AND N
(SUB1 N]
LP
[COND ((NLISTP (CDR Z))
(RETURN L))
[(EQUAL X (CAR Z))
(FRPLACA Z (CADR Z))
(FRPLACD Z (CDDR Z))
(AND N (ZEROP (SETQ
N
(SUB1 N))
(RETURN L]
(T (SETQ Z (CDR Z]
(GO LP]
[DELQ: (*
DELQ is like DREMOVE, except that it takes
an optional third argument which is a
maximum number of deletions. where the
extra argument is not given, DELQ has been
converted to DREMOVE, but at the places
noted above, DELQ was callled with the
third argument and probably must be
defined by the user. Herewith my
definition, untested : -
(LAMBDA
(X L N)
(PROG
(Z)
[COND
((NLISTP (SETQ Z L))
(RETURN))
((EQ X (CAR L))
(RETURN (DELQ X (CDR L)
(AND N (SUB1 N]
LP
[COND ((NLISTP (CDR Z))
(RETURN L))
[(EQ X (CAR Z))
(FRPLACA Z (CADR Z))
(FRPLACD Z (CDDR Z))
(AND N (ZEROP (SETQ
N
(SUB1 N))
(RETURN L]
(T (SETQ Z (CDR Z]
(GO LP]
(ERR: (* MACLISP ERR is said to return the value of
its argument to the last ERRORSET or to
the top level if none. It is not clear to
me what returning to the top level is;
does the value print anyway? Ignoring the
top level problem my translation,
(RETFROM 'ERRORSET X)
or
(RETEVAL 'ERRORSET 'X)
, should work ok. If the toplevel case
arises at runtime you will get error 19,
illegal stack arg. If the ERR is meant to
reset, i.e. is thought of as returning no
value, then (ERROR!)
will DO.))
(ERRSET: (* The expression (ERRSET X Y)
where X and Y are forms, translates to
(ERRORSET 'X Y)
except that it seems that in maclisp Y
is not evaluated until an error occurs.)
)
(EXPR* (* The MIT function type LSUBR should
translate without user assistance to
INTERLISP EXPR*'S. However, see notes on
the use of the function ARG.))
(FDEFPROP (* Funny DEFPROP: too few args.
Translation of it abandoned.))
(FLATC: (* The maclisp function FLATC has been
converted to NCHARS.))
(FUNCALL: (* If the first argument, ie the
function, is an FEXPR, then there is a
difference betweenMACLISP and
INTERLISP that the user will have to
fix. MACLISP demands that there be
only one argument given to an FEXPR.
INTERLISP will make a list of the
given arguments if the function is an
NLAMBDA no-spread. The user will have
to sort this out for himself.))
(GC: (* maclisp GC converts to INTERLISP RECLAIM))
(GCTIME (* I did not think that MIT'S function
GCTIME took any arguments. Nothing done
to this form.))
(GET1: (* Expression of form (GET & 'PNAME)
user must recode any such direct
manipulations of the pname.))
(GET: (* Expression of the form (GET & 'VALUE)
converted to (CAR &)
%. INTERLISP INTERLISP manual discussion
of atom value cells and global variables.))
(GETSYM: (* GETSYM and PUTSYM are undefined.
functions which uses them probably have
to be completely recoded at a higher
level. However, there are a large
number of DDT symbols already
represented, however, by property
entries on the property coreval, which
is widely used by the compiler and may
be added to as you wish. Don't clobber
existing ones, though. COREVALS is a
list of extant symbols; the rest have
to be brought over by hand from DDT and
may change with new assemblies.))
(GO (* On MIT LISP, if the argument to GO is not a
tag of a containing PROG, then it is
evaluated to obtain a tag. This glitch has
been used in the above places, and has been
translated by gathering up all tags from the
closest containing PROG, and constructing a
dispatch of the form
(SELECTQ original-form (TAG1 (GO TAG1))
(TAG2 (GO TAG2))
...
(HELP ' "ILLEGAL TAG"))
%. This is successful as far as known,
subject to two improbable exceptions:
TRANSOR would not notice an expression of
the form (GO VAR)
where var was bound to a label; and if the
value of original-form was a label from a
PROG which wasn't the closest containing
PROG, then the dispatch would call help
since it only looks at the nearest PROG.))
(GREATERP/LESSP (* MIT'S GREATERP and LESSP take an
indefinite number of args and
test to see that they are in
order. Accordingly, where these
functions were used with exactly
two args they were allowed to
stand, but in the cases noted
here they were actually called
with extra arguments and must be
replaced with something written
for the purpose.))
(GRINDEF: (* MACLISP GRINDEF converts to INTERLISP
PP but the change has not been made
since I am unsure if GRINDEF is an
fexpr or what.))
(IBASE: (* The input RADIX for lisp is always
decimal. To input octal numbers, they
must be typed or printed with a Q
following.))
(IMPLODE: (* IMPLODE smashes its list argument
together to make an atom. However, the
characters in the list may be either
actual characters, or ascii codes. In
the former case, the expression should
be transformed to PACK, it the later,
it should be PACKC. Note also that
characters and ascii codes may
actually be mixed, in which case there
is no direct INTERLISP translation.))
(INTEGERFN? (* At the places noted above, an MIT
arithmetic function has been
converted to a general arithmetic fn
in the INTERLISP system. This choice
is rather conservative, since most
of the time the conversion could
probably be made to the
corresponding INTERLISP integer
arithmetic function. For the
advantages of using integer fns
whenever possible, see chapter 13 of
the INTERLISP manual. Users may
accept the conservative choice; or
they may eyeball their listings and
substitute the integer functions
themselves by hand, or they may
choose to revise the transformations
to convert to the integer functions
and then search by hand for those
places where the general function
was really required. The latter
approach is best when one knows in
advance that the object program does
no floating point arithmetic.))
(INTERN/MAKNAM (* The expression
(INTERN (MAKNAM FOO))
converts to (PACK FOO)
, but there is no INTERLISP
equivalent to INTERN or MAKNAM
alone; user must decide what is
being attempted.))
(IOC: (* IOC in maclisp is used to simulate the
typing on the tty of an interrupt (control)
character.))
(IOFNS (* Random grubby IO functions, documented in
chapter 14 of SRI LISP SAILON 28.2, which
I am too lazy to fix up.))
(LABEL (* The LABEL device is not implemented in
INTERLISP.))
(LAP: (* The MIT function LAP corresponds to the
INTERLISP pseudo function ASSEMBLE, which
permits direct machine-level coding, but
the code itself is of course completely
machine-dependent and must be rewritten by
the user.))
(LAZY (* I did not really expect this fn to appear
and will (may)
write TRANSFORMATIONS for it if it does.))
(LOAD: (* SRI lisp's function LOAD is not defined
in interlisp. INTERLISP's LOAD is a
symbolic lisp-file reader and has nothing
to do with loading rel files.))
(MACHINE-CODE (* Expression dependent on
machine-code. User must recode.))
(MACRO: (* The MIT function MACRO has to do with
read-in macros. The user will have to
figure out how to avoid their use. In
particular, the single-quote macro can
probably be ignored since DWIM's
evaluation-time correction will
accomplish the desired result.))
(MAKNUM: (* MAKNUM converts to LOC. But users
should perhaps make sure that the
overall sense of functions which do
boxing and unboxing is still
reasonable.))
(MAKOBLIST: (* The function MAKOBLIST does not
exist. Use MAPATOMS instead))
(MAPFNS (* User must recode here. MIT mapping
functions all permit an indefinite
number of list arguments. Where only one
was used, they translate correctly to
INTERLISP, but in the places noted
above, extra list arguments were
utilized, and the output expression will
be of the form
(MAPFN L1 (FUNCTION BLAH)
L2 L3 --)))
[MAX/MIN (* The MACLISP expr*'s MAX and MIN must be
defined by the user. Herewith a
definition of MAX.
(LAMBDA NARGS
(PROG ((N 2)
V BST)
(SETQ BST (ARG NARGS 1))
LP
(COND
((GREATERP
(SETQ V
(ARG NARGS N))
BST)
(SETQ BST V)))
(COND
((IGREATERP
(SETQ N (ADD1 N))
NARGS)
(RETURN BST)))
(GO LP]
(NOUUO: (* NOUUO is not defined in INTERLISP. For
discussion of linkage between compiled
functions see compiler chapter of
INTERLISP manual.))
(NUMVAL: (* NUMVAL converts to VAG. But users
should perhaps make sure that the
overall sense of functions which do
boxing and unboxing is still
reasonable.))
(PRIN1: (* Maclisp PRIN1 is identical as far as
known with INTERLISP PRIN2, and has been
converted.))
(PRINT: (* Maclisp PRINT outputs a carriage-return
and linefeed before the argument is
printed, not after, and outputs a space
after. Nothing has been done to it on
the grounds that most I/O code tends to
get pretty thoroughly revised anyway.
Users may however convert all calls to
PRINT in their program to calls to
MACPRINT by performing
(MAPC FNS
(F/L (CHANGENAME X 'PRINT
'MACPRINT)))
and then define MACPRINT with
[LAMBDA (X)
(TERPRI)
(PRIN2 X)
(SPACES 1]
Also note that the args to PRINT may
sometimes differ from INTERLISP.))
(PUTPROP1: (* Expression of form
(PUTPROP & & 'PNAME)
user must recode any such direct
manipulations of pnames.))
(PUTPROP: (* Expression of form (PUTPROP & & 'VALUE)
converted to (RPLACA & &)
See INTERLISP manual discussion of
atom value cells and global variables.)
)
(READCH: (* READCH converts to READC))
(READLIST (* The function READLIST has been
replaced with PACK, although it
differs from PACK in two ways. First,
READLIST only takes the first
character of the elements of the list
it is given. If some of these have
more than one character, they will be
included entire by INTERLISP's PACK.
But rather than do (NTHCHAR * 1)
around every element of the argument
list, I have left it to the user to
detect when and if the MIT. program
utilized this feature. Secondly,
INTERLISP's PACK returns an atom come
what may; MIT'S READLIST operates by
'UNREADING' and may therefore return
lists. Again, the user must check for
this, since there is no reasonable way
to check for it from TRANSOR.))
(REMPROP (* On MIT Lisp REMPROP returns T if the
property was there, on INTERLISP
returns name of property always. User
must check if value being used.))
[RUNTIME: (* The maclisp function RUNTIME converted
to the INTERLISP expression
(ITIMES 1000 (CLOCK 2]
(SASSOC: (* A call to SASSOC failed to translate
correctly. The last (functional)
argument was not in the expected
format, (FUNCTION [LAMBDA NIL --])
%. User must repair the expression.))
(SASSQ: (* SASSQ failed to translate correctly. The
last (functional)
argument was not in the expected format,
(FUNCTION [LAMBDA NIL --])
%. User must repair the expression.))
(SET (* SET on MIT LISP cannot affect compiled
function variables which are not special.
This may be used by some functions, to
allow their local variables to become
invisible. There is nothing TRANSOR can do
about this however; users will just have to
find such usage themselves.))
[SIGN: (* The function SIGN does not exist. It may
be defined by (LAMBDA (N)
(COND
((ZEROP N)
0)
((MINUSP N)
-1)
(T 1]
[SLEEP: (* The maclisp expression (SLEEP x)
has been converted to the INTERLISP
expression (DISMISS (ITIMES 1000 x]
(SPEAK: (* MACLISP SPEAK converts to INTERLISP
CONSCOUNT. See manual for extra features
of CONSCOUNT.))
(SPECPDL (* Maclisp fexprs usually convert in a
straightforward way to INTERLISP
fexpr*'s. However if two lambda
variables are given, to quote from the
maclisp manual, 'then upon entry to the
function the second variable is bound
to a representation of the current
a-list, which may subsequently be given
as an argument to EVAL or APPLY.' This
usage appears in the places noted here;
user must recode using the INTERLISP
funarg or spaghetti capabilities.))
(STORE: (* The MACLISP function STORE is used by
(STORE (name i1 i2 ...)
value)
where i1, i2, etc. are indexes to a
multiply-indexed array. Where only one
index is given, this converts to
INTERLISP's (SETA NAME I1 VALUE)
%. Where more than one index occurred, a
separate remark, STOREMI, was made.))
(STOREMI (* Use of MACLISP STORE with multiple
indexes. User must do his own indexing
since INTERLISP arrays are all
one-dimensional.))
(TIME (* (TIME)
has been changed to (IQUOTIENT
(CLOCK 0)
1000)
%.))
[TYI: (* The maclisp function TYI inputs one char
as an asciz code and has been converted to
(CHCON1 (READC]
(TYO: (* (TYO X)
translates to (PRINT1 (FCHARACTER X))
%. However, this is rather slow, so the
user might want to recode.))
(UDF (* This function is not defined directly in
INTERLISP))
(UFILE: (* Not sure what UFILE does.))
(UREAD: (* (UREAD X)
converts to (INPUT (INFILE X))
more or less.))
(UWRITE: (* Not sure what UWRITE does.))
(VALUE (* At the places noted above, reference was
made to the property indicators PNAME or
VALUE. This usage probably should be
revised to be (CAR '&)
or perhaps the atom should be put on
GLOBALVARS. I don't know what usage of
pname might involve since pnames are not
kept on property lists in INTERLISP. To
get the pname of an atom perform
(CDR (VAG (IPLUS 2 (LOC ATOM])
(RPAQQ NLISTPCOMS NOBIND)
(RPAQQ LAMBDACOMS NOBIND)
(RPAQQ TRANSFORMATIONS (* *APPEND *DIF *FUNCTION *GREAT *LESS *PLUS
*QUO *TIMES + - / 1+ 1- ; < = > ADD1
ALPHALESSP APPLY ARG ARRAY ASCII ASSOC ASSQ
BASE BIGP BOOLE BOUNDP BREAK CATCH CHARPOS
CHRCT CLOCK COMMENT COND CSYM DDTIN DDTOUT
DE DEFINEDP DEFPROP DEFUN DELETE DELQ
DEPOSIT DF DIFFERENCE DIVIDE DM DO ENTIER
ERR ERROR ERRSET EVAL EXAMINE EXARRAY
EXCISE EXPLODE EXPLODEC FIX FLATC FLATSIZE
FORCE FUNCALL GC GCD GCTIME GET GETCHAR
GETL GETSYM GO GREATERP GRINDEF IBASE
IMPLODE INC INPUT INTERN IOC LABEL LAP LAST
LENGTH LESSP LISTIFY LOAD LSH MACRO MAKNAM
MAKNUM MAKOBLIST MAKUNBOUND MAP MAPC MAPCAN
MAPCAR MAPCONC MAPLIST MAX MEMQ MIN NCONS
NOUUO NREVERSE NSTORE NTH1 NUMVAL OBLIST
ORV OUTC OUTPUT PLIST PRIN1 PRINC PRINT
PROG PROG2 PUTPROP PUTSYM QUOTE QUOTIENT
RE*ARRAY READ READCH READLIST RECIP
REMAINDER REMPROP RUNTIME SAMEPNAMEP SASSOC
SASSQ SELECTQ SET SETQ SIGN SLEEP SPEAK
SSTATUS STATUS STORE SUB1 SUBST SXHASH
TCONC TERPRI THROW TIME TYI TYO TYPEP UFILE
UREAD UUO UWRITE XCONS ZEROP \))
(PUTPROPS * XFORM ((1 ITIMES)))
(PUTPROPS *APPEND XFORM ((1 APPEND)))
(PUTPROPS *DIF XFORM ((1 DIFFERENCE)
(REMARK INTEGERFN?)))
(PUTPROPS *FUNCTION XFORM ((1 FUNCTION)
(REMARK *FUNCTION:)
2
(NTH 3)
DOTHESE))
(PUTPROPS *GREAT XFORM ((1 GREATERP)
(REMARK INTEGERFN?)))
(PUTPROPS *LESS XFORM ((1 LESSP)
(REMARK INTEGERFN?)))
(PUTPROPS *PLUS XFORM ((1 PLUS)
(REMARK INTEGERFN?)))
(PUTPROPS *QUO XFORM ((1 QUOTIENT)
(REMARK INTEGERFN?)))
(PUTPROPS *TIMES XFORM ((1 TIMES)
(REMARK INTEGERFN?)))
(PUTPROPS + XFORM ((1 IPLUS)))
(PUTPROPS - XFORM [(IF (EQ 1 (LENGTH (##)))
((: 0))
((IF (EQ 2 (LENGTH (##)))
((1 IMINUS))
((IF (EQ 3 (LENGTH (##)))
((1 IDIFFERENCE))
((EMBED (2 THRU 3)
IN IDIFFERENCE)
DOTHIS])
(PUTPROPS / XFORM [(IF (EQ 1 (LENGTH (##)))
((: 1))
((IF (EQ 2 (LENGTH (##)))
((-2 1))
((IF (EQ 3 (LENGTH (##)))
((1 IQUOTIENT))
((EMBED (2 THRU 3)
IN IQUOTIENT)
DOTHIS])
(PUTPROPS 1+ XFORM ((1 ADD1)))
(PUTPROPS 1- XFORM ((1 SUB1)))
(PUTPROPS ; XFORM (NLAM))
(PUTPROPS < XFORM ((1 LESSP)
(REMARK INTEGERFN?)))
(PUTPROPS = XFORM ((1 EQP)
(REMARK INTEGERFN?)))
(PUTPROPS > XFORM ((1 GREATERP)
(REMARK INTEGERFN?)))
(PUTPROPS ADD1 XFORM ((REMARK ADD1:)))
(PUTPROPS ALPHALESSP XFORM [(1 (LAMBDA (X Y)
(ALPHORDER Y X])
(PUTPROPS APPLY XFORM ((REMARK APPLY/EVAL)))
(PUTPROPS ARG XFORM [(BIND MARK (LPQ 0 (_ LAMBDA)
(S #1 2)
(IF (LISTP #1)))
__
(IF (LITATOM #1)
((I -2 #1)
(REMARK ARG:))
((REMARK ARG1:])
(PUTPROPS ARRAY XFORM ((REMARK ARRAY:)
(1 SETQ)
(IF (## 5)
((EMBED (4 TO)
IN ITIMES))
NIL)
[IF (## 3)
NIL
((I N (COPY (## 4]
(3 ARRAY)
(BI 3 -1)
-1
(NTH 2)
DOTHESE))
(PUTPROPS ASCII XFORM ((1 CHARACTER)
(REMARK CHARACTERCODE)))
(PUTPROPS ASSOC XFORM ((1 SASSOC)))
(PUTPROPS ASSQ XFORM ((1 FASSOC)))
(PUTPROPS BASE XFORM ((1 RADIX)
(REMARK BASE:)))
(PUTPROPS BIGP XFORM ((1 UDF)))
(PUTPROPS BOOLE XFORM [(IF (EQ (## 2)
7)
((1 LOGOR))
((IF (EQ (## 2)
1)
((1 LOGAND))
((IF (EQ (## 2)
6)
((1 LOGXOR))
((REMARK UDF])
(PUTPROPS BOUNDP XFORM ((REMARK LAZY)))
(PUTPROPS BREAK XFORM ((IF (NEQ (LENGTH (##))
4)
((N NIL)))
(SW 2 4)))
(PUTPROPS CATCH XFORM ((REMARK UDF)))
(PUTPROPS CHARPOS XFORM ((1 POSITION)))
(PUTPROPS CHRCT XFORM ((REMARK LAZY)
(REMARK CHRCT:)))
(PUTPROPS CLOCK XFORM [(IF (EQ (## 2)
1)
((1 DATE)
(2))
((2 0])
(PUTPROPS COMMENT XFORM ((1 *)))
(PUTPROPS COND XFORM (1 (LPQ NX DOTHESE)))
(PUTPROPS CSYM XFORM ((REMARK LAZY)))
(PUTPROPS DDTIN XFORM (DELETE))
(PUTPROPS DDTOUT XFORM (DELETE))
(PUTPROPS DE XFORM ((REMARK LAZY)))
(PUTPROPS DEFINEDP XFORM ((REMARK LAZY)))
(PUTPROPS DEFPROP XFORM
((ORR ((IF (NLISTP (CDDDAR L)))
(REMARK FDEFPROP)
NLAM)
((IF (EQ (## -1)
'MACRO))
(REMARK DEFPROP-MACRO))
((IF (EQ (## -1)
'VALUE))
(1 RPAQQ)
(4)
NLAM)
([IF (NOT (FMEMB (## -1)
'
(EXPR FEXPR]
(1 PUTPROPS)
(SW 3 4)
NLAM)
((1 DEFINEQ)
(IF (EQ (## 4)
'FEXPR)
[(CHANGE 3 1 TO NLAMBDA)
(IF (## 3 2 2)
((REMARK SPECPDL))
((EXTRACT 1 FROM 3 2]
NIL)
(4)
(BI 2 3)
2 2 3 UP DOTHESE))))
(PUTPROPS DEFUN XFORM ((ORR ((IF (EQ (## 2)
'FEXPR))
(IF (## 4 2)
((REMARK SPECPDL))
((BO 4)))
(EMBED (4 TO)
IN NLAMBDA))
((IF (EQ (## 2)
'MACRO))
(REMARK DEFPROP-MACRO)
OK)
((IF (EQ (## 2)
'EXPR)
NIL
((-2 EXPR)))
(IF (AND (## 4)
(LITATOM (## 4)))
((REMARK EXPR*))
NIL)
(EMBED (4 TO)
IN LAMBDA)))
(1 DEFINEQ)
(BI -2 -1)
(2)
-1 -1 (NTH 3)
DOTHESE))
(PUTPROPS DELETE XFORM ((REMARK DELETE:)))
(PUTPROPS DELQ XFORM [(IF (## 4)
((REMARK DELQ:))
((1 DREMOVE])
(PUTPROPS DEPOSIT XFORM ((1 CLOSER)
(REMARK MACHINE-CODE)))
(PUTPROPS DF XFORM ((REMARK LAZY)))
(PUTPROPS DIFFERENCE XFORM ((IF (## 4)
((EMBED (3 TO)
IN PLUS))
NIL)
(REMARK INTEGERFN?)))
(PUTPROPS DIVIDE XFORM ((REMARK UDF)))
(PUTPROPS DM XFORM ((REMARK LAZY)))
(PUTPROPS DO XFORM
[(IF (NLISTP (CADR (##)))
((1 FOR)
(-3 _)
(-5 BY)
(-7 UNTIL)
(-9 DO))
((IF (NULL (## 3))
((1 PROG)
(3))
((-3 UNTIL)
(IF (IGREATERP (LENGTH (## 4))
1)
(4 (-3 FINALLY)
(EMBED -1 IN (RETURN *))
0)
(4 (-1 (SETQ $$VAL)
(BI 1 -1)
0)))
(ORR ((-5 DO))
((N DO NIL)))
(BO 4)
(I 1 (CREATE-DO-VARS (## 2)))
(2)
(BO 1])
(PUTPROPS ENTIER XFORM ((1 FIX)))
(PUTPROPS ERR XFORM [(IF (## 2)
((IF (## 3)
((1 RETEVAL)
(-2 'ERRORSET)
(EMBED 3 IN QUOTE))
((1 RETFROM)
(-2 'ERRORSET)))
(REMARK ERR:))
((: (ERROR!])
(PUTPROPS ERROR XFORM ((REMARK LAZY)))
(PUTPROPS ERRSET XFORM [(ORR ((IF (EDIT4E ' (ERRSET & NIL)
(##)))
(3)
(1 NLSETQ))
((IF (EDIT4E ' (ERRSET & T)
(##)))
(3)
(1 ERSETQ))
((IF (EDIT4E ' (ERRSET &)
(##)))
(1 ERSETQ))
((1 ERRORSET)
(EMBED 2 IN QUOTE)
(REMARK ERRSET:])
(PUTPROPS EVAL XFORM ((REMARK APPLY/EVAL)))
(PUTPROPS EXAMINE XFORM ((1 OPENR)
(REMARK MACHINE-CODE)))
(PUTPROPS EXARRAY XFORM ((REMARK ARRAYS)))
(PUTPROPS EXCISE XFORM ((REMARK UDF)))
(PUTPROPS EXPLODE XFORM ((1 UNPACK)
(N T)))
(PUTPROPS EXPLODEC XFORM ((1 UNPACK)))
(PUTPROPS FIX XFORM ((1 IPLUS)))
(PUTPROPS FLATC XFORM ((REMARK FLATC:)
(1 NCHARS)))
(PUTPROPS FLATSIZE XFORM ((1 NCHARS)
(N T)))
(PUTPROPS FORCE XFORM (DELETE))
(PUTPROPS FUNCALL XFORM ((1 APPLY*)
(REMARK FUNCALL:)))
(PUTPROPS GC XFORM ((1 RECLAIM)
(REMARK GC:)))
(PUTPROPS GCD XFORM ((REMARK UDF)))
(PUTPROPS GCTIME XFORM [(IF (## 2)
((REMARK GCTIME))
((1 CLOCK)
(N 3])
(PUTPROPS GET XFORM [(ORR ((IF (EDIT4E ' (GET & 'VALUE)
(##)))
(REMARK GET:)
(1 CAR)
(3))
((IF (EDIT4E ' (GET & 'PNAME)
(##)))
(REMARK GET1:))
((1 GETP])
(PUTPROPS GETCHAR XFORM ((1 NTHCHAR)))
(PUTPROPS GETL XFORM ((1 GETLIS)
(IF (AND (EQ (## -1)
'QUOTE)
(INTERSECTION ' (VALUE PNAME)
(## -1 -1)))
((REMARK VALUE))
NIL)))
(PUTPROPS GETSYM XFORM ((REMARK GETSYM:)))
(PUTPROPS GO XFORM
((IF
(NULL (LITATOM (## 2)))
((REMARK GO)
(BIND
MARK
(_ PROG)
(E [MAPC (CDDR (##))
(FUNCTION
(LAMBDA (Y)
(AND Y (LITATOM Y)
(SETQ
#1
(CONS (LIST Y (LIST 'GO Y))
#1]
T)
__
(1 SELECTQ)
(I N #1)
(BO -1)
(N (HELP ' "ILLEGAL GOTO"))
2 DOTHIS))
NIL)))
(PUTPROPS GREATERP XFORM ((IF (EQ 3 (LENGTH (CAR L)))
NIL
((REMARK GREATERP/LESSP)))
(REMARK INTEGERFN?)))
(PUTPROPS GRINDEF XFORM ((REMARK GRINDEF:)))
(PUTPROPS IBASE XFORM ((REMARK IBASE:)))
(PUTPROPS IMPLODE XFORM ((REMARK IMPLODE:)))
(PUTPROPS INC XFORM ((REMARK IOFNS)))
(PUTPROPS INPUT XFORM ((REMARK IOFNS)))
(PUTPROPS INTERN XFORM [(IF (EDIT4E ' (INTERN (MAKNAM &))
(##))
((1 PACK)
(EXTRACT -1 FROM -1))
((REMARK INTERN/MAKNAM])
(PUTPROPS IOC XFORM ((REMARK IOC:)))
(PUTPROPS LABEL XFORM ((REMARK LABEL)))
(PUTPROPS LAP XFORM ((REMARK LAP:)))
(PUTPROPS LAST XFORM ((1 FLAST)))
(PUTPROPS LENGTH XFORM ((1 FLENGTH)))
(PUTPROPS LESSP XFORM ((IF (EQ 3 (LENGTH (CAR L)))
NIL
((REMARK GREATERP/LESSP)))
(REMARK INTEGERFN?)))
(PUTPROPS LISTIFY XFORM ((1 UDF)))
(PUTPROPS LOAD XFORM ((REMARK LOAD:)))
(PUTPROPS LSH XFORM ((1 LLSH)))
(PUTPROPS MACRO XFORM ((REMARK MACRO:)))
(PUTPROPS MAKNAM XFORM ((REMARK INTERN/MAKNAM)))
(PUTPROPS MAKNUM XFORM ((1 LOC)
(REMARK MAKNUM:)))
(PUTPROPS MAKOBLIST XFORM ((REMARK MAKOBLIST:)))
(PUTPROPS MAKUNBOUND XFORM ((REMARK UDF)))
(PUTPROPS MAP XFORM ((SW 2 3)
(IF (## 4)
((REMARK MAPFNS))
NIL)))
(PUTPROPS MAPC XFORM [(ORR (5 0 (REMARK MAPFNS))
(4 0 (1 MAP2C)
(MOVE 2 TO N HERE))
((MOVE 2 TO N HERE])
(PUTPROPS MAPCAN XFORM ((1 MAPCONC)
(SW 2 3)
(IF (## 4)
((REMARK MAPFNS))
NIL)))
(PUTPROPS MAPCAR XFORM ((SW 2 3)
(IF (## 4)
((REMARK MAPFNS))
NIL)))
(PUTPROPS MAPCONC XFORM ((SW 2 3)
(IF (## 4)
((REMARK MAPFNS))
NIL)))
(PUTPROPS MAPLIST XFORM ((SW 2 3)
(IF (## 4)
((REMARK MAPFNS))
NIL)))
(PUTPROPS MAX XFORM ((REMARK MAX/MIN)))
(PUTPROPS MEMQ XFORM ((1 FMEMB)))
(PUTPROPS MIN XFORM ((REMARK MAX/MIN)))
(PUTPROPS NCONS XFORM ((1 CONS)))
(PUTPROPS NOUUO XFORM ((REMARK NOUUO:)))
(PUTPROPS NREVERSE XFORM ((1 DREVERSE)))
(PUTPROPS NSTORE XFORM ((REMARK ARRAYS)))
(PUTPROPS NTH1 XFORM ((1 CAR)
(EMBED (2 TO)
IN NTH)))
(PUTPROPS NUMVAL XFORM ((1 VAG)
(REMARK NUMVAL:)))
(PUTPROPS OBLIST XFORM ((REMARK MAKOBLIST:)))
(PUTPROPS ORV XFORM ((1 OR)))
(PUTPROPS OUTC XFORM ((REMARK IOFNS)))
(PUTPROPS OUTPUT XFORM ((REMARK IOFNS)))
(PUTPROPS PLIST XFORM ((1 GETPROPLIST)))
(PUTPROPS PRIN1 XFORM ((1 PRIN2)
(IF (AND (EQ (LENGTH (##))
3)
(NULL (## 3)))
((3 T))
NIL)))
(PUTPROPS PRINC XFORM ((1 PRIN1)
(IF (AND (EQ (LENGTH (##))
3)
(NULL (## 3)))
((3 T))
NIL)))
(PUTPROPS PRINT XFORM ((REMARK PRINT:)))
(PUTPROPS PROG XFORM ((NTH 3)
DOTHESE))
(PUTPROPS PROG2 XFORM [(ORR ((IF (MEMBER (## 2)
'
(0 T NIL)))
(1 PROG1)
(2))
([IF (EQ 3 (LENGTH (##]
(1 PROGN))
((1 (LAMBDA (X Y)
Y])
(PUTPROPS PUTPROP XFORM [(ORR ((IF (EDIT4E ' (PUTPROP & & 'VALUE)
(##)))
(REMARK PUTPROP:)
(1 RPLACA)
(4))
((IF (EDIT4E ' (PUTPROP & & 'PNAME)
(##)))
(REMARK PUTPROP1:))
((1 PUT)
(SW 3 4])
(PUTPROPS PUTSYM XFORM ((REMARK GETSYM:)))
(PUTPROPS QUOTE XFORM (NLAM))
(PUTPROPS QUOTIENT XFORM ((IF (## 4)
((EMBED (3 TO)
IN TIMES))
NIL)
(REMARK INTEGERFN?)))
(PUTPROPS RE*ARRAY XFORM ((REMARK UDF)))
(PUTPROPS READ XFORM ((REMARK IOFNS)))
(PUTPROPS READCH XFORM ((REMARK IOFNS)
(1 READC)))
(PUTPROPS READLIST XFORM ((REMARK READLIST)))
(PUTPROPS RECIP XFORM ((1 QUOTIENT)
(-2 1)
-1 DOTHIS (REMARK INTEGERFN?)))
(PUTPROPS REMAINDER XFORM ((1 IREMAINDER)))
(PUTPROPS REMPROP XFORM ((REMARK REMPROP)))
(PUTPROPS RUNTIME XFORM ((: (ITIMES 1000 (CLOCK 2)))
(REMARK RUNTIME:)))
(PUTPROPS SAMEPNAMEP XFORM ((1 STREQUAL)))
(PUTPROPS SASSOC XFORM
[(MBD OR)
(MOVE 2 4 TO N HERE)
-1
(ORR ((IF (EDIT4E ' (FUNCTION [LAMBDA NIL &])
(##)))
(XTR 2 3))
((IF (EDIT4E ' (FUNCTION [LAMBDA NIL & & --])
(##)))
(XTR 2)
(EMBED (3 TO)
IN PROGN)
(XTR 3))
((REMARK SASSOC:])
(PUTPROPS SASSQ XFORM
[(1 FASSOC)
(MBD OR)
(MOVE 2 4 TO N HERE)
-1
(ORR ((IF (EDIT4E ' (FUNCTION [LAMBDA NIL &])
(##)))
(XTR 2 3))
((IF (EDIT4E ' (FUNCTION [LAMBDA NIL & & --])
(##)))
(XTR 2)
(EMBED (3 TO)
IN PROGN)
(XTR 3))
((REMARK SASSQ:])
(PUTPROPS SELECTQ XFORM [2 DOTHIS (LPQ NX (IF (## NX UP)
((NTH 2)
DOTHESE 0)
(DOTHIS])
(PUTPROPS SET XFORM ((REMARK SET)))
(PUTPROPS SETQ XFORM [(IF (LESSP 3 (LENGTH (##)))
((1 PROGN)
(LPQ (NTH 2)
(EMBED (1 THRU 2)
IN SETQ)))
((IF (LISTP (## 3))
(3 DOTHIS)
NIL])
(PUTPROPS SIGN XFORM ((REMARK SIGN:)))
(PUTPROPS SLEEP XFORM ((XTR 2)
(MBD (DISMISS (ITIMES 1000 *)))
(REMARK SLEEP:)))
(PUTPROPS SPEAK XFORM ((1 CONSCOUNT)
(REMARK SPEAK:)))
(PUTPROPS SSTATUS XFORM ((REMARK LAZY)))
(PUTPROPS STATUS XFORM ((REMARK LAZY)))
(PUTPROPS STORE XFORM ((1 SETA)
(MOVE 3 1 TO BEFORE 3)
(IF (## 3 2)
((REMARK STOREMI))
((BO 3)))
(REMARK STORE:)))
(PUTPROPS SUB1 XFORM ((REMARK ADD1:)))
(PUTPROPS SUBST XFORM ((IF (EQ (## 2)
(## 3))
((1 COPY))
NIL)))
(PUTPROPS SXHASH XFORM ((1 UDF)))
(PUTPROPS TCONC XFORM ((SW 2 3)))
(PUTPROPS TERPRI XFORM ((IF (AND (EQ 3 (LENGTH (##)))
(NULL (## 3)))
((3 T))
NIL)))
(PUTPROPS THROW XFORM ((REMARK UDF)))
(PUTPROPS TIME XFORM ((: (IQUOTIENT (CLOCK 0)
1000))
(REMARK TIME)))
(PUTPROPS TYI XFORM ((REMARK IOFNS)
(1 READC)
(MBD CHCON1)))
(PUTPROPS TYO XFORM ((1 PRIN1)
(EMBED 2 IN FCHARACTER)
(IF (AND (EQ 3 (LENGTH (##)))
(NULL (##)))
((3 T))
NIL)
(REMARK TYO:)))
(PUTPROPS TYPEP XFORM ((1 UDF)))
(PUTPROPS UFILE XFORM ((REMARK UFILE:)))
(PUTPROPS UREAD XFORM ((1 INPUT)
(EMBED 2 IN INFILE)
(REMARK UREAD:)))
(PUTPROPS UUO XFORM ((REMARK MACHINE-CODE)))
(PUTPROPS UWRITE XFORM ((REMARK UWRITE:)))
(PUTPROPS XCONS XFORM [(1 (LAMBDA (X Y)
(CONS Y X])
(PUTPROPS ZEROP XFORM [(IF (EDIT4E ' (ZEROP (DIFFERENCE & &))
(##))
((1 EQP)
(BO 2)
(2))
((REMARK ADD1:])
(PUTPROPS \ XFORM ((1 IREMAINDER)))
[COND [(EQ (EVALV (QUOTE MERGE))
T)
[RPAQ TRANSFORMATIONS
(UNION TRANSFORMATIONS
(LISTP (GETP (QUOTE TRANSFORMATIONS)
(QUOTE VALUE]
(MAPC (GETP (QUOTE USERNOTES)
(QUOTE VALUE))
(FUNCTION (LAMBDA (NOTE)
(OR (ASSOC (CAR NOTE)
USERNOTES)
(SETQ USERNOTES
(CONS NOTE USERNOTES]
(T (MAPC (GETP (QUOTE TRANSFORMATIONS)
(QUOTE VALUE))
(FUNCTION (LAMBDA (X)
(AND (NOT (MEMB X TRANSFORMATONS))
(/REMPROP X (QUOTE XFORM]
(DECLARE: DONTCOPY
(FILEMAP (NIL (68 752 (CREATE-DO-VARS 80 . 749)))))
STOP