-- Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
-- All rights reserved.
-- Copyright (C) 2007, Gabriel Dos Reis.
-- 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
namespace 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)]