Initial population.

1 files changed, 325 insertions, 0 deletions

diff --git a/src/boot/pile.boot.pamphlet b/src/boot/pile.boot.pamphlet
new file mode 100644
index 00000000..eaad129f
--- /dev/null
+++ b/src/boot/pile.boot.pamphlet
@@ -0,0 +1,325 @@
+\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}