\documentclass{article}
\usepackage{axiom}

\title{\File{src/boot/pile.boot} Pamphlet}
\author{The Axiom Team}

\begin{document}
\maketitle

\begin{abstract}
\end{abstract}

\eject
\tableofcontents
\eject

\section{License}

<<license>>=
-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
--     - Redistributions of source code must retain the above copyright
--       notice, this list of conditions and the following disclaimer.
--
--     - Redistributions in binary form must reproduce the above copyright
--       notice, this list of conditions and the following disclaimer in
--       the documentation and/or other materials provided with the
--       distribution.
--
--     - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--       names of its contributors may be used to endorse or promote products
--       derived from this software without specific prior written permission.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
-- IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
-- TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
-- PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
-- OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
-- EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
-- PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
-- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
-- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
-- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
-- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@
<<*>>=
<<license>>

module '"boot-pile"
import '"includer"
import '"scanner"
 
)package "BOOTTRAN"
shoeFirstTokPosn t== shoeTokPosn CAAR t
shoeLastTokPosn  t== shoeTokPosn CADR t
shoePileColumn t==CDR shoeTokPosn CAAR t
 
-- s is a token-dq-stream
 
shoePileInsert (s)==
     if bStreamNull s
     then cons([],s)
     else
         toktype:=shoeTokType CAAAR s
         if toktype ="LISP"  or toktype = "LINE"
         then cons([car s],cdr s)
         else
            a:=shoePileTree(-1,s)
            cons([a.2],a.3)
 
shoePileTree(n,s)==
    if bStreamNull s
    then [false,n,[],s]
    else
        [h,t]:=[car s,cdr s]
        hh:=shoePileColumn h
        if hh > n
        then shoePileForests(h,hh,t)
        else [false,n,[],s]
 
eqshoePileTree(n,s)==
    if bStreamNull s
    then [false,n,[],s]
    else
        [h,t]:=[car s,cdr s]
        hh:=shoePileColumn h
        if hh = n
        then shoePileForests(h,hh,t)
        else [false,n,[],s]
 
shoePileForest(n,s)==
     [b,hh,h,t]:= shoePileTree(n,s)
     if b
     then
       [h1,t1]:=shoePileForest1(hh,t)
       [cons(h,h1),t1]
     else [[],s]
 
shoePileForest1(n,s)==
     [b,n1,h,t]:= eqshoePileTree(n,s)
     if b
     then
       [h1,t1]:=shoePileForest1(n,t)
       [cons(h,h1),t1]
     else [[],s]
 
shoePileForests(h,n,s)==
      [h1,t1]:=shoePileForest(n,s)
      if bStreamNull h1
      then [true,n,h,s]
      else shoePileForests(shoePileCtree(h,h1),n,t1)
 
shoePileCtree(x,y)==dqAppend(x,shoePileCforest y)
 
-- only enshoePiles forests with >=2 trees
 
shoePileCforest x==
   if null x
   then []
   else if null cdr x
        then car x
        else
           a:=car x
           b:=shoePileCoagulate(a,rest x)
           if null cdr b
           then car b
           else shoeEnPile shoeSeparatePiles b
 
shoePileCoagulate(a,b)==
    if null b
    then [a]
    else
      c:=car b
      if EQ(shoeTokPart CAAR c,"THEN") or EQ(shoeTokPart CAAR c,"ELSE")
      then shoePileCoagulate (dqAppend(a,c),cdr b)
      else
         d:=CADR a
         e:=shoeTokPart d
         if EQCAR(d,"KEY") and
               (GET(e,"SHOEINF") or EQ(e,"COMMA") or EQ(e,"SEMICOLON"))
         then shoePileCoagulate(dqAppend(a,c),cdr b)
         else cons(a,shoePileCoagulate(c,rest b))
 
shoeSeparatePiles x==
  if null x
  then []
  else if null cdr x
       then car x
       else
         a:=car x
         semicolon:=dqUnit
                shoeTokConstruct("KEY", "BACKSET",shoeLastTokPosn a)
         dqConcat [a,semicolon,shoeSeparatePiles cdr x]
 
shoeEnPile x==
   dqConcat [dqUnit shoeTokConstruct("KEY","SETTAB",shoeFirstTokPosn x),
             x, _
             dqUnit shoeTokConstruct("KEY","BACKTAB",shoeLastTokPosn  x)]
 
@

<<pile.clisp>>=
(EVAL-WHEN (:COMPILE-TOPLEVEL) (PROVIDE "boot-pile"))

(IMPORT-MODULE "includer")

(IMPORT-MODULE "scanner")

(IN-PACKAGE "BOOTTRAN")

(DEFUN |shoeFirstTokPosn| (|t|)
  (PROG () (RETURN (|shoeTokPosn| (CAAR |t|)))))

(DEFUN |shoeLastTokPosn| (|t|)
  (PROG () (RETURN (|shoeTokPosn| (CADR |t|)))))

(DEFUN |shoePileColumn| (|t|)
  (PROG () (RETURN (CDR (|shoeTokPosn| (CAAR |t|))))))

(DEFUN |shoePileInsert| (|s|)
  (PROG (|a| |toktype|)
    (RETURN
      (COND
        ((|bStreamNull| |s|) (CONS NIL |s|))
        (#0='T (SETQ |toktype| (|shoeTokType| (CAAAR |s|)))
         (COND
           ((OR (EQ |toktype| 'LISP) (EQ |toktype| 'LINE))
            (CONS (LIST (CAR |s|)) (CDR |s|)))
           (#0# (SETQ |a| (|shoePileTree| (- 1) |s|))
            (CONS (LIST (ELT |a| 2)) (ELT |a| 3)))))))))

(DEFUN |shoePileTree| (|n| |s|)
  (PROG (|hh| |t| |h| |LETTMP#1|)
    (RETURN
      (COND
        ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
        (#0='T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
         (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
         (SETQ |hh| (|shoePileColumn| |h|))
         (COND
           ((< |n| |hh|) (|shoePileForests| |h| |hh| |t|))
           (#0# (LIST NIL |n| NIL |s|))))))))

(DEFUN |eqshoePileTree| (|n| |s|)
  (PROG (|hh| |t| |h| |LETTMP#1|)
    (RETURN
      (COND
        ((|bStreamNull| |s|) (LIST NIL |n| NIL |s|))
        (#0='T (SETQ |LETTMP#1| (LIST (CAR |s|) (CDR |s|)))
         (SETQ |h| (CAR |LETTMP#1|)) (SETQ |t| (CADR |LETTMP#1|))
         (SETQ |hh| (|shoePileColumn| |h|))
         (COND
           ((EQUAL |hh| |n|) (|shoePileForests| |h| |hh| |t|))
           (#0# (LIST NIL |n| NIL |s|))))))))

(DEFUN |shoePileForest| (|n| |s|)
  (PROG (|t1| |h1| |t| |h| |hh| |b| |LETTMP#1|)
    (RETURN
      (PROGN
        (SETQ |LETTMP#1| (|shoePileTree| |n| |s|))
        (SETQ |b| (CAR |LETTMP#1|))
        (SETQ |hh| (CADR . #0=(|LETTMP#1|)))
        (SETQ |h| (CADDR . #0#))
        (SETQ |t| (CADDDR . #0#))
        (COND
          (|b| (SETQ |LETTMP#1| (|shoePileForest1| |hh| |t|))
               (SETQ |h1| (CAR |LETTMP#1|))
               (SETQ |t1| (CADR |LETTMP#1|))
               (LIST (CONS |h| |h1|) |t1|))
          ('T (LIST NIL |s|)))))))

(DEFUN |shoePileForest1| (|n| |s|)
  (PROG (|t1| |h1| |t| |h| |n1| |b| |LETTMP#1|)
    (RETURN
      (PROGN
        (SETQ |LETTMP#1| (|eqshoePileTree| |n| |s|))
        (SETQ |b| (CAR |LETTMP#1|))
        (SETQ |n1| (CADR . #0=(|LETTMP#1|)))
        (SETQ |h| (CADDR . #0#))
        (SETQ |t| (CADDDR . #0#))
        (COND
          (|b| (SETQ |LETTMP#1| (|shoePileForest1| |n| |t|))
               (SETQ |h1| (CAR |LETTMP#1|))
               (SETQ |t1| (CADR |LETTMP#1|))
               (LIST (CONS |h| |h1|) |t1|))
          ('T (LIST NIL |s|)))))))

(DEFUN |shoePileForests| (|h| |n| |s|)
  (PROG (|t1| |h1| |LETTMP#1|)
    (RETURN
      (PROGN
        (SETQ |LETTMP#1| (|shoePileForest| |n| |s|))
        (SETQ |h1| (CAR |LETTMP#1|))
        (SETQ |t1| (CADR |LETTMP#1|))
        (COND
          ((|bStreamNull| |h1|) (LIST T |n| |h| |s|))
          ('T (|shoePileForests| (|shoePileCtree| |h| |h1|) |n| |t1|)))))))

(DEFUN |shoePileCtree| (|x| |y|)
  (PROG () (RETURN (|dqAppend| |x| (|shoePileCforest| |y|)))))

(DEFUN |shoePileCforest| (|x|)
  (PROG (|b| |a|)
    (RETURN
      (COND
        ((NULL |x|) NIL)
        ((NULL (CDR |x|)) (CAR |x|))
        (#0='T (SETQ |a| (CAR |x|))
         (SETQ |b| (|shoePileCoagulate| |a| (CDR |x|)))
         (COND
           ((NULL (CDR |b|)) (CAR |b|))
           (#0# (|shoeEnPile| (|shoeSeparatePiles| |b|)))))))))

(DEFUN |shoePileCoagulate| (|a| |b|)
  (PROG (|e| |d| |c|)
    (RETURN
      (COND
        ((NULL |b|) (LIST |a|))
        (#0='T (SETQ |c| (CAR |b|))
         (COND
           ((OR (EQ (|shoeTokPart| (CAAR |c|)) 'THEN)
                (EQ (|shoeTokPart| (CAAR |c|)) 'ELSE))
            (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
           (#0# (SETQ |d| (CADR |a|)) (SETQ |e| (|shoeTokPart| |d|))
            (COND
              ((AND (EQCAR |d| 'KEY)
                    (OR (GET |e| 'SHOEINF) (EQ |e| 'COMMA)
                        (EQ |e| 'SEMICOLON)))
               (|shoePileCoagulate| (|dqAppend| |a| |c|) (CDR |b|)))
              (#0# (CONS |a| (|shoePileCoagulate| |c| (CDR |b|))))))))))))

(DEFUN |shoeSeparatePiles| (|x|)
  (PROG (|semicolon| |a|)
    (RETURN
      (COND
        ((NULL |x|) NIL)
        ((NULL (CDR |x|)) (CAR |x|))
        ('T (SETQ |a| (CAR |x|))
         (SETQ |semicolon|
               (|dqUnit|
                   (|shoeTokConstruct| 'KEY 'BACKSET
                       (|shoeLastTokPosn| |a|))))
         (|dqConcat|
             (LIST |a| |semicolon| (|shoeSeparatePiles| (CDR |x|)))))))))

(DEFUN |shoeEnPile| (|x|)
  (PROG ()
    (RETURN
      (|dqConcat| (LIST (|dqUnit|
                            (|shoeTokConstruct| 'KEY 'SETTAB
                                (|shoeFirstTokPosn| |x|)))
                        |x|
                        (|dqUnit|
                            (|shoeTokConstruct| 'KEY 'BACKTAB
                                (|shoeLastTokPosn| |x|))))))))

@

\end{document}