* Makefile.pamphlet (scan.$(FASLEXT)): New rule.

	(pile.$(FASLEXT)): Likewise.
	(INOBJS): Don't include parini.$(FASLEXT).
	* pile.boot: New.  Import scan.
	* pile.boot.pamphlet: Move content to pile.boot.  Remove.
	* vmlisp.lisp.pamphlet (|startsId?|): Move to sys-macros.lisp.
	* parini.boot.pamphlet:  Move content to scan.boot.  Remove.
	* scan.boot: New. Import bits, dq, incl.  Add workaround for GCL
	bug. 
	($SPACE): Rename from SPACE to avoid conflict with CL name.
	* scan.boot.pamphlet: Move content to scan.boot.  Remove.

1 files changed, 155 insertions, 0 deletions

diff --git a/src/interp/pile.boot b/src/interp/pile.boot
new file mode 100644
index 00000000..9fc3f0c7
--- /dev/null
+++ b/src/interp/pile.boot
@@ -0,0 +1,155 @@
+-- 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.
+
+import '"scan"
+
+)package "BOOT"
+
+-- insertpiles converts a line-list to a line-forest where
+ 
+-- a line is a token-dequeue and has a column which is an integer.
+-- an A-forest is an A-tree-list
+-- an A-tree has a root which is an A, and subtrees which is an A-forest.
+ 
+-- A forest with more than one tree corresponds to a Scratchpad pile
+-- structure (t1;t2;t3;...;tn), and a tree corresponds to a pile item.
+-- The ( ; and ) tokens are inserted into a >1-forest, otherwise
+-- the root of the first tree is concatenated with its forest.
+-- column t is the number of spaces before the first non-space in line t
+ 
+pileColumn t==CDR tokPosn CAAR t
+pileComment t== EQ(tokType CAAR t,"negcomment")
+pilePlusComment t== EQ(tokType CAAR t,"comment")
+ 
+-- insertpile is used by next so s is non-null
+-- bite off a line-tree, return it and the remaining line-list.
+ 
+insertpile (s)==
+     if npNull s
+     then [false,0,[],s]
+     else
+       [h,t]:=[car s,cdr s]
+       if pilePlusComment h
+       then
+          [h1,t1]:=pilePlusComments s
+          a:=pileTree(-1,t1)
+          cons([pileCforest [:h1,a.2]],a.3)
+       else
+         stream:=CADAR s
+         a:=pileTree(-1,s)
+         cons([[a.2,stream]],a.3)
+ 
+pilePlusComments s==
+      if npNull s
+      then [[],s]
+      else
+       [h,t]:=[car s,cdr s]
+       if pilePlusComment h
+       then
+         [h1,t1]:=pilePlusComments t
+         [cons(h,h1),t1]
+       else [[],s]
+ 
+pileTree(n,s)==
+    if npNull s
+    then [false,n,[],s]
+    else
+        [h,t]:=[car s,cdr s]
+        hh:=pileColumn CAR h
+        if hh > n
+        then pileForests(CAR h,hh,t)
+        else [false,n,[],s]
+ 
+eqpileTree(n,s)==
+    if npNull s
+    then [false,n,[],s]
+    else
+        [h,t]:=[car s,cdr s]
+        hh:=pileColumn CAR h
+        if hh = n
+        then pileForests(CAR h,hh,t)
+        else [false,n,[],s]
+ 
+pileForest(n,s)==
+     [b,hh,h,t]:= pileTree(n,s)
+     if b
+     then
+       [h1,t1]:=pileForest1(hh,t)
+       [cons(h,h1),t1]
+     else [[],s]
+ 
+pileForest1(n,s)==
+     [b,n1,h,t]:= eqpileTree(n,s)
+     if b
+     then
+       [h1,t1]:=pileForest1(n,t)
+       [cons(h,h1),t1]
+     else [[],s]
+ 
+pileForests(h,n,s)==
+      [h1,t1]:=pileForest(n,s)
+      if npNull h1
+      then [true,n,h,s]
+      else pileForests(pileCtree(h,h1),n,t1)
+ 
+pileCtree(x,y)==dqAppend(x,pileCforest y)
+ 
+-- only enpiles forests with >=2 trees
+ 
+pileCforest x==
+   if null x
+   then []
+   else if null cdr x
+        then
+           f:= car x
+           if EQ(tokPart CAAR f,"IF")
+           then enPile f
+           else f
+        else enPile separatePiles x
+ 
+firstTokPosn t== tokPosn CAAR t
+lastTokPosn  t== tokPosn CADR t
+ 
+separatePiles x==
+  if null x
+  then []
+  else if null cdr x
+       then car x
+       else
+         a:=car x
+         semicolon:=dqUnit tokConstruct("key", "BACKSET",lastTokPosn a)
+         dqConcat [a,semicolon,separatePiles cdr x]
+ 
+enPile x==
+   dqConcat [dqUnit tokConstruct("key","SETTAB",firstTokPosn x),
+             x, _
+             dqUnit tokConstruct("key","BACKTAB",lastTokPosn  x)]
+