%File:  PLES2.TRA  (c)         09/24/80
         The Soft Warehouse %

MATHTRACE: FALSE $
MOVD (PRINT, #PRINT) $

FUNCTION PRINT (EX1),
  WHEN ATOM (EX1),  #PRINT (EX1)  EXIT,
  #PRINT (LPAR),  PRINT (FIRST(EX1)),  #PRINT (" . "),
  PRINT (REST(EX1)),  #PRINT (RPAR),  EX1,
ENDFUN $

MOVD (PRINTLINE, #PRINTLINE) $
FUNCTION PRINTLINE (EX1),
  PRINT (EX1),  NEWLINE (),  EX1,
ENDFUN $

NEWLINE: 1$  ECHO: TRUE $
%   This is the second of a sequence of
muSIMP programming lessons.

    EQ is a primitive muSIMP Comparator
operator  which returns TRUE if its two
operands  are the same object or  equal
integers, returning FALSE otherwise:  %

FIVE: 5 $  5 EQ FIVE ;
%   Names are stored uniquely,  so  two
occurences  of a name must involve  the
same address:  %

ACTOR: 'BOGART ;  ACTOR EQ 'BOGART ;
%   Here is an example of two different
references  to the same physical  node:
%

DATE: '(JULY . 4) &  FOO:  DATE $  FOO EQ DATE ;
%  However, watch this:  %

DATE EQ '(JULY . 4) ;
%   What happened?   The two aggregates
are  DUPLICATES,  but  since they  were
independently formed they do not  start
with the same node.   In fact, only the
name  JULY  is shared  among  them,  as
shown below:

                second
        DATE    argument
           /\   /\
          /  \ /  \
          !   \    \
          !  / \    \
         JULY   4    4

  Clearly  it  is desirable to  have  a
more  comprehensive equality comparator
which also returns TRUE for  aggregates
which  are  duplicates in the sense  of
printing similarly.  Let's write such a
function,  called DUP.   Following  the
general  advice given in  PLES1,  let's
first dispose of the trivial cases:

    If either argument is an atom, then
they are duplicates if and only if they
are EQ.

    Otherwise,  they  are  both  nodes,
which  is  the nontrivial  case.   Now,
let's  employ our  "divide-and-conquer"
strategem,  using FIRST and REST as the
partitioning.    Two  nodes  refer   to
duplicate aggregates if and only if the
FIRST parts are duplicates and the REST
parts are duplicates.   Moreover,  that
can   be   tested  with   our   beloved
recursion, using DUP itself!

    See    if    you   can   write    a
corresponding function named DUP:  %
RDS: FALSE $
%    There are many possible  variants,
but here is one of the most compact:  %

FUNCTION DUP (U, V),
  WHEN ATOM (U),  U EQ V  EXIT,
  WHEN ATOM (V),  FALSE  EXIT,
  WHEN DUP (FIRST(U), FIRST(V)),  DUP (REST(U), REST(V)) EXIT,
ENDFUN $
%    An interesting challenge for  your
spare time is to see how many different
but  reasonable ways this function  can
be written.

    Actually, there already is a built-
in infix operator named "=",  which  is
equivalent to DUP:  %

DATE: '(JULY . 4) $
DATE = '(JULY . 4) ;
%    Do you feel DUPed to learn that an
exercise    duplicated   an    existing
facility?

    It is crucial to understand exactly
what  the existing facilities  do,  and
the  best  way  to  learn  that  is  to
understand  how they work  by  creating
them independently.

    Here  is a good exercise:   See  if
you  can  write a  comparator  function
named SAMESHAPE,  which returns TRUE if
its  two  arguments are similar in  the
sense  of  having nodes  and  atoms  at
similar    places.      For    example,

SAMESHAPE  ('((KINGS  .   ROOK)  .  5),
     '((QUEENS . 3) . PAWN))

is TRUE:  %  RDS: FALSE $
%    This  is  one of  those  instances
where we will not give the answer.

    Now, using the infix operator named
"=",  see  if you can write a  function
named  CONTAINS which returns  TRUE  if
its  first  argument is a duplicate  of
its  second  argument  or  contains   a
duplicate of its second argument.   For
example,

    ((JULY . 4) . (1931 . FRIDAY))

contains   (1931 .  FRIDAY).   It is at
least as hard as DUP, so take your time
and  don't  give up  easily.   %   RDS:
FALSE $
%   Here is a harder exercise:  The two
aggregates

           /\           /\
          /  \         /  \
      CARBON /\    CARBON /\
            /  \         /  \
       SULFUR  IRON   IRON  SULFUR

are ISOMERS because they are either the
same atom or at every level either  the
left branches are isomers and the right
branches  are  isomers,   or  the  left
branch of one is an isomer of the right
branch  of  the other  and  vice-versa.
Write    a   corresponding   comparator
function named ISOMERS.   (It's similar
to DUP, with a twist.) %  RDS:  FALSE $
%   Our answer is:  %

FUNCTION ISOMERS (U, V),
  WHEN ATOM (U),  U EQ V  EXIT,
  WHEN ATOM (V),  FALSE  EXIT,
  ISOMERS (FIRST(U), FIRST(V))  AND  ISOMERS (REST(U), REST(V))
    OR  ISOMERS (FIRST(U), REST(V))  AND  ISOMERS (REST(U), FIRST(V))
ENDFUN $

%    Because  of all  the  combinations
which  might have to  be  checked,  the
execution  time  for this function  can
grow  quite quickly  with  depth.   Try
tracing  a  few  examples  of  moderate
depth:  %  RDS: FALSE $
%    So  far our functions have  merely
dismantled or analyzed aggregates given
to  them  as arguments.   None  of  our
examples    have    constructed     new
aggregates.   The dot of course results
in  aggregates,  but this occurs as the
dot  is  read.    Moreover,  since  the
single quote necessarily preceeding  an
outermost    dotted    pair    prevents
evaluation, bound variables in a dotted
pair   contribute  merely  their  names
rather than their values.  For example:
%

EG: 7 $  '(EG . 3) &
%    What we want is a  function  which
evaluates  its  two  arguments  in  the
usual  way,  then returns a node  whose
two  pointers  point to  those  values.
There is such a function, named ADJOIN:
%

ADJOIN (EG, 3) &
%    A  dotted pair within  a  function
definition  is a static entity,  frozen
at  the time the function  is  defined.
In  contrast,  a  reference  to  ADJOIN
within   a   function   definition   is
dynamic.   The  node  creation is  done
afresh,  with the current values of its
arguments  every time that part of  the
function is applied.   As an example of
the  use  of  ADJOIN,   let's  write  a
function    named    SKELETON,    which
constructs   a   new  tree   which   is
structurally  similar to  its  argument
but  has the name of length  zero,  "",
wherever  its  argument  has  an  atom.
Thus,  when printed,  the new aggregate
will  display the skeletal structure of
the    aggregate   without    visually-
discernable atoms.  For example,

 SKELETON
   ('((HALLOWEEN  . GHOSTS) . WITCHES))

will yield (( . ) . )

    OK,  let's recite the litany:  What
comes first?

    TRIVIAL CASES.

    So,  if the argument is an atom  we
return what?

    "".

    Otherwise we have a node,  which is
the most general case.   However, nodes
have  a  FIRST and a REST,  so  can  we
somehow  recurse,   using  SKELETON  on
these parts, then combine them?

    Yes, as follows:  %

FUNCTION SKELETON (U),
  WHEN ATOM (U),  ""  EXIT,
  ADJOIN (SKELETON (FIRST(U)), SKELETON (REST(U)))
ENDFUN $
SKELETON ('((MOO . GOO) . (GUY . PAN))) &
%  Easy.  Yes?

    Now  it  is  your  turn.   Write  a
function named TREEREV,  which produces
a  copy of its argument in which  every
left  and right branch are interchanged
at every level.  For example,

 TREEREV
('((MOO . GOO) . (GUY . (PAN . CAKE))))

should yield
 (((CAKE . PAN) . GUY) . (GOO . MOO))

%   RDS: FALSE $
%    If  you didn't get  the  following
solution,  you  may groan when you  see
how easy it is:  %

FUNCTION TREEREV (U),
  WHEN ATOM (U),  U  EXIT,
  ADJOIN (TREEREV (REST(U)),  TREEREV (FIRST(U)))
ENDFUN &
TREEREV ('(("Isn't" . that) . easy)) &
%   Here is a somewhat harder exercise:
Write  a function  named  SUBST,  which
returns  a  copy of its first  argument
wherein  every instance of  its  second
argument   is  replaced  by  its  third
argument.  For example, if

PHRASE:
  '(((THIS . (GOSH . DARN)) . CAR)
      . (IS . ((GOSH . DARN) . BAD))) $

then
  SUBST (PHRASE, '(GOSH . DARN),
        '(expletive . deleted))  yields

(((THIS . (expletive . deleted)) . CAR)
. (IS . ((expletive . deleted) . BAD)))
%  RDS: FALSE $
%  That's all folks.

    The   next  lesson  deals  with   a
special  form  of tree called  a  list.
Many  people find lists more  to  their
liking, and perhaps you will too.%

ECHO: FALSE$  NEWLINE: 0$
MOVD (#PRINT, PRINT)$
MOVD (#PRINTLINE, PRINTLINE)$
RDS ()$
