Revert commits to the wrong tree.

1 files changed, 683 insertions, 0 deletions

diff --git a/src/interp/pspad2.boot.pamphlet b/src/interp/pspad2.boot.pamphlet
new file mode 100644
index 00000000..54e9a584
--- /dev/null
+++ b/src/interp/pspad2.boot.pamphlet
@@ -0,0 +1,683 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp pspad2.boot}
+\author{The Axiom Team}
+\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>>
+
+)package "BOOT"
+
+--======================================================================
+--                Constructor Transformation Functions
+--======================================================================
+formatDeftranForm(form,tlist) ==
+  [ttype,:atypeList] := tlist
+  if form is [":",f,t] then 
+    form := f
+    ttype := t
+  if form is ['elt,a,b] then    ----> a.b ====> apply(b,a)
+    form := 
+      isTypeProbably? a =>
+        atypeList := REVERSE atypeList
+        ["$$", b, a]
+      ["apply",a, b]
+  op   := KAR form
+  argl := KDR form
+  if or/[t for t in atypeList] then
+    form := [op,:[(t => [":",a,t]; a) for a in argl for t in atypeList]]
+  if ttype then form := [":",form,ttype]
+  form
+ 
+formatDeftran(u,SEQflag) ==
+  u is ['Join,:x] => formatDeftranJoin(u,SEQflag)
+  u is ['CATEGORY,kind,:l,x] => formatDeftran(['with,['SEQ,:l,['exit,n,x]]],SEQflag)
+  u is ['CAPSULE,:l,x] => formatDeftranCapsule(l,x,SEQflag)
+  u is [op,:.] and MEMQ(op,'(rep per)) => formatDeftranRepper(u,SEQflag)
+  u is [op,:.] and MEMQ(op,'(_: _:_: _pretend _@)) => 
+    formatDeftranColon(u,SEQflag)
+  u is ['PROGN,:l,x] => formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag)
+  u is ['SEQ,:l,[.,n,x]] => 
+    v := [:l,x]
+    a := "APPEND"/[formatDeftranSEQ(x,true) for x in l]
+    b := formatDeftranSEQ(x,false)
+    if b is [:.,c] and c = '(void) then b := DROP(-1, b)
+    [:m,y] := [:a,:b]
+    ['SEQ,:m,['exit,n,y]]
+--  u is ['not,arg] and (op := LASSOC(KAR arg,'((_= . _^_=) (_< . _>_=)))) =>
+--    formatDeftran([op,:CDR arg],nil)
+  u is ["^",a] => formatDeftran(['not,a],SEQflag)
+  u is ["exquo",a,b] => formatDeftran(['xquo,a,b],SEQflag)
+  u is ['IF,a,b,c] => 
+    a := formatDeftran(a,nil)
+    b := formatDeftran(b,nil)
+    c := formatDeftran(c,nil)
+    null SEQflag and $insideDEF =>
+      [:y,last] := formatDeftranIf(a,b,c)
+      ['SEQ,:y,['exit,1,last]]
+    ['IF,a,b,c]
+  u is ['Union,:argl] => 
+    ['Union,:[x for a in argl 
+      | x := (STRINGP a => [":",INTERN a,'Branch]; formatDeftran(a,nil))]]
+  u is [op,:itl,body] and MEMQ(op,'(REPEAT COLLECT)) and
+    ([nitl,:nbody] := formatDeftranREPEAT(itl,body)) =>
+      formatDeftran([op,:nitl,nbody],SEQflag)
+  u is [":",a,b] => [":",formatDeftran(a,nil),formatDeftran(markMacroTran(b),nil)]
+  u is ["DEF",:.] => formatCapsuleFunction(u)
+  u is [op,:argl]=>[formatDeftran(op,nil),:[formatDeftran(x,nil) for x in argl]]
+  u = 'nil => 'empty
+  u
+
+formatCapsuleFunction ["DEF",form,tlist,b,body] ==
+  $insideDEF : local := true
+  ["DEF", formatDeftran(form,nil),tlist,b,formatDeftran(body,nil)]
+ 
+formatDeftranCapsule(l,x,SEQflag) ==
+  $insideCAPSULE: local := true
+  formatDeftran(['SEQ,:l,['exit,1,x]],SEQflag)
+
+formatDeftranRepper([op,a],SEQflag) ==
+    a is [op1,b] and MEMQ(op1,'(rep per)) =>
+        op = op1 => formatDeftran(a,SEQflag)
+        formatDeftran(b,SEQflag)
+    a is ["::",b,t] =>
+      b := formatDeftran(b,SEQflag)
+      t := formatDeftran(t,SEQflag)
+      a := ["::",b,t]
+      op = 'per and t = "$" or op = 'rep and t = 'Rep => a
+      [op,a]
+    a is ['SEQ,:r] => ['SEQ,:[formatSeqRepper(op,x) for x in r]]
+    a is ['IF,p,b,c] => 
+      formatDeftran(['IF,p,[op,b],[op, c]], SEQflag)
+    a is ['LET,a,b] => formatDeftran(['LET,a,[op,b]],SEQflag)
+    a is ['not,[op,a,b]] and (op1 := LASSOC(op,$pspadRelationAlist)) =>
+      formatDeftran [op1,a,b]
+    a is ['return,n,r] => 
+      MEMQ(opOf r,'(true false)) => a
+      ['return,n,[op,formatDeftran(r,SEQflag)]]
+    a is ['error,:.] => a
+    [op,formatDeftran(a,SEQflag)]
+
+formatDeftranColon([op,a,t],SEQflag) ==  --op is one of :  ::  pretend  @
+    a := formatDeftran(a,SEQflag)
+    t := formatDeftran(t,SEQflag)
+    a is ["UNCOERCE",b] => b
+    a is [op1,b,t1] and t1 = t and MEMQ(op,'(_: _:_: _pretend _@)) =>
+      op1 = "pretend" or op = "pretend" => ["pretend",b,t]
+      null SEQflag and op1 = ":" or op = ":" => ["pretend",b,t]
+      a
+    a is [=op,b,t1] =>
+      t1 = t => a
+      [op,b,t]
+    t = "$" =>
+      a is ['rep,b] => b
+      a is ['per,b] => a
+      [op,a,t]
+    t = "Rep" =>
+      a is ['per,b] => b
+      a is ['rep,b] => a
+      [op,a,t]
+    [op,a,t]
+
+formatSeqRepper(op,x) ==
+  x is ['exit,n,y] => ['exit,n,[op,formatDeftran(y,nil)]]
+  x is ["=>",a,b] => ["=>",formatDeftran(a,nil),[op,formatDeftran(b,nil)]]
+  atom x => x
+  [formatSeqRepper(op,y) for y in x]
+  
+formatDeftranJoin(u,SEQflag) ==
+  ['Join,:cats,lastcat] := u
+  lastcat is ['CATEGORY,kind,:l,x] =>
+    cat := 
+      CDR cats => ['Join,:cats]
+      first cats
+    formatDeftran(['with,cat,['SEQ,:l,['exit,1,x]]],SEQflag)
+  u
+ 
+formatENUM ['MyENUM, x] == format "'" and format x and format "'"
+
+formatDeftranREPEAT(itl,body) == 
+--do nothing unless "itl" contains UNTIL statements
+  u := [x for x in itl | x is ["UNTIL",p]] or return nil
+  nitl := SETDIFFERENCE(itl,u)
+  pred := MKPF([p for ['UNTIL,p] in u],'or)
+  cond := ['IF,pred,['leave,n,nil],'noBranch]
+  nbody :=
+    body is ['SEQ,:l,[.,n,x]] => ['SEQ,:l,x,['exit,n,cond]]
+    ['SEQ,body,['exit,n,cond]]
+  [nitl,:nbody]
+
+formatDeftranSEQ(x,flag) ==
+  u := formatDeftran(x,flag)
+  u is ['SEQ,:.] => rest u
+  [u]
+
+formatDeftranIf(a,b,c) ==
+  b = 'noBranch =>
+    a is [op,:r] and (al := '((_= . _~_=) (_< . _>_=) (_> . _<_=));
+                      iop := LASSOC(op, al) or rassoc(op, al)) =>
+      [["=>",[iop, :r],c]]
+    a is [op,r] and MEMQ(op,'(NOT not NULL null)) =>
+      [["=>", r, c]]
+    [["=>", ['not, a], c]]
+  post := 
+    c = 'noBranch => nil
+    c is ['SEQ,:.] => CDR c
+    [c]
+  [["=>",a,b],:post]
+
+formatWHERE ["where",a,b] ==
+  $insideTypeExpression: local := nil
+  $insideCAPSULE: local := false
+  tryBreak(formatLeft("format",a,"where","Led") and format " where ",b,"where","Led")
+ 
+--======================================================================
+--              Special Handlers:  Categories
+--======================================================================
+formatATTRIBUTE ['ATTRIBUTE,att] == format att
+ 
+formatDeftranCategory ['CATEGORY,kind,:items,item] == ["SEQ",:items,["exit",1,item]]
+
+formatCategory ['Category] == format " " and format "Category"
+  
+formatCATEGORY cat == 
+  con := opOf $form
+  $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION))
+  $insideEXPORTS : local := true
+  format ["with",formatDeftranCategory cat]
+ 
+formatSIGNATURE ['SIGNATURE,op,types,:r] ==
+  MEMQ('constant,r) => format op and format ": " and (u := format first types) and 
+    formatSC() and formatComments(u,op,types)
+  format op and format ": " and (u := format ['Mapping,:types]) and formatSC() and
+    formatComments(u,op,types) 
+  
+formatDefault ["default",a] ==
+  $insideCategoryIfTrue : local := false
+  $insideCAPSULE: local := true
+  $insideTypeExpression: local := false
+  tryBreak(format "default ",a,"with","Nud")
+--======================================================================
+--              Special Handlers:  Control Structures
+--======================================================================
+formatUNCOERCE ['UNCOERCE,x] == format x
+ 
+formatIF ['IF,a,b,c] == 
+  c = 'noBranch => formatIF2(a,b,"if ")
+  b = 'noBranch => formatIF ['IF,['not,a],c,'noBranch]
+  formatIF2(a,b,"if ") and newLine() and formatIF3 c
+
+formatIF2(a,b,prefix) ==  
+  tryBreakNB(format prefix and format a and format " then ",b,"then","Nud")
+
+formatIF3 x == 
+  x is ['IF,a,b,c] => 
+    c = 'noBranch => tryBreak(format "else if " 
+      and format a and format " then ",b,"then","Nud")
+    formatIF2(a,b,"else if ") and newLine() and formatIF3 c
+  tryBreak(format "else ",x,"else","Nud")
+    
+formatBlock(l,x) ==
+  null l => format x
+  $pilesAreOkHere: local
+  format "{ " and format first l and
+    (and/[formatSC() and format y for y in rest l]) 
+      and formatSC() and format x and format " }"
+ 
+formatExit ["exit",.,u] == format u
+
+formatvoid ["void"] == format "()"
+
+formatLeave ["leave",.,u] == format "break"
+ 
+formatCOLLECT u == formatSpill("formatCOLLECT1",u)
+ 
+formatCOLLECT1 ["COLLECT",:iteratorList,body] ==
+  $pilesAreOkHere: local
+  format "[" and format body and format " " and
+    formatSpill("formatIteratorTail",iteratorList)
+ 
+formatIteratorTail iteratorList ==
+  formatIterator first iteratorList and
+    (and/[format " " and formatIterator x for x in rest iteratorList]) and format "]"
+
+--======================================================================
+--                  Special Handlers:  Keywords
+--======================================================================
+ 
+formatColon [":",a,b] ==
+  b is ['with,c,:d] => formatColonWith(a,c,d)
+  if not $insideTypeExpression then 
+    insideCat() => nil
+    format
+      $insideDEF => "local "
+      "default "
+  op := 
+    $insideCAPSULE and not $insideDEF => ": "
+    insideCat() => ": "
+    ":"
+  b := (atom b => b; markMacroTran b)
+  a is ['LISTOF,:c] => formatComma c and format ": " and formatLocal1 b
+  formatInfix(op,[a, b],formatOpBindingPower(":","Led","left"),
+                              formatOpBindingPower(":","Led","right"))
+
+formatColonWith(form,a,b) ==
+  con := opOf $form
+  $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION))
+  $insideEXPORTS : local := true
+  $pilesAreOkHere: local := true
+  $insideTypeExpression : local := false
+  b => tryBreak(formatDefForm form and format ": " 
+        and format a and format " with ",first b,"with","Led")
+  tryBreak(formatDefForm form and format ": with ",a,"with","Nud")
+
+formatCOND ["COND",:l] ==
+  originalC:= $c
+  and/[x is [a,[.,.,b]] for x in l] =>
+    (originalC=$m or indent() and newLine()) and first l is [a,[.,.,b]] and
+      formatIfExit(a,b) and
+        (and/[newLine() and formatIfExit(a,b) for [a,[.,.,b]] in rest l]) and (originalC=$m or undent()) and originalC
+  formatIfThenElse l
+
+formatPROGN ["PROGN",:l] ==
+  l is [:u,x] => formatPiles(u,x)
+  error '"formatPROGN"
+  
+formatELT ["ELT",a,b] == formatApplication [a,b]
+ 
+formatCONS ["CONS",a,b] ==
+  $pilesAreOkHere: local
+  format "[" and formatConstructItem a and formatTail b
+ 
+formatTail x ==
+  null x => format "]"
+  format "," and formatTail1 x 
+ 
+formatTail1 x ==
+  x is ["CONS",a,b] => formatConstructItem a and formatTail b
+  x is ["APPEND",a,b] =>
+    null b => formatConstructItem a and format "]"
+    format ":" and formatConstructItem a and formatTail b
+  format ":" and formatConstructItem x and format "]"
+ 
+-- x = "." => format ""
+formatConstructItem x == format x
+ 
+formatLET ["LET",a,b] == 
+  $insideTypeExpression: local := true
+  a = "Rep" or atom a and constructor? opOf b =>
+    tryBreakNB(formatAtom a and format " == ",b,":=","Led")
+  tryBreakNB((IDENTP a => formatAtom a; format a) and format " := ",b,":=","Led")
+ 
+formatIfExit(a,b) ==
+                       --called from SCOND or COND only
+  $numberOfSpills: local:= 0
+  curMargin:= $m
+  curMarginStack:= $currentMarginStack
+  $doNotResetMarginIfTrue:= true
+  format a and format " => " and formatRight("formatCut",b,"=>","Led") =>
+    ($currentMarginStack:= curMarginStack; $m:= curMargin)
+ 
+formatIfThenElse x == formatSpill("formatIf1",x)
+ 
+formatIf1 x ==
+  x is [[a,:r],:c] and null c =>
+    b:=
+      r is [:l,s] and l => ['SEQ,:l,['exit,.,s]]
+      first r
+    isTrue a => format b
+    format "if " and format a and format " then " and format b
+  format "if " and format a and
+    (try
+      (format " then " and format b and format " else "
+        and formatIfThenElse c) or spillLine()
+          and format " then " and format b and
+--           ($c:= $m:= $m+6) and
+            ($numberOfSpills:= $numberOfSpills-1)
+              and spillLine() and format " else " and formatIfThenElse c)
+ 
+formatQUOTE ["QUOTE",x] == format "('" and format x and format ")"
+
+formatMI ["MI",a,b] == format a
+
+formatMapping ['Mapping,target,:sources] ==
+  $noColonDeclaration: local := true
+  formatTuple ['Tuple,:sources] and format " -> " and format target
+ 
+formatTuple ['Tuple,:types] ==
+  null types => format "()"
+  null rest types => format first types
+  formatFunctionCallTail types
+ 
+formatConstruct(['construct,:u]) == 
+  format "[" and (null u or format first u and
+    "and"/[format "," and formatCut x for x in rest u]) and format "]"
+ 
+formatNextConstructItem x ==
+  try format x or ($m := $m + 2) and newLine() and format x
+ 
+formatREPEAT ["REPEAT",:iteratorList,body] ==
+  tryBreakNB(null iteratorList or (formatIterator first iteratorList and
+    (and/[format " " and formatIterator x for x in rest iteratorList]) and format " ")
+      and format "repeat ",body,"repeat","Led")
+ 
+formatFATARROW ["=>",a,b] == tryBreak(format a and format " => ",b,"=>","Led")
+
+formatMap ["+->",a,b] == 
+  $noColonDeclaration: local := true
+  tryBreak(format a and format " +-> ", b, "+->","Led") 
+
+formatREDUCE ["REDUCE",op,.,u] == formatReduce1(op,u)
+
+formatreduce ["reduce",op,u] == formatReduce1(op,u)
+
+formatReduce1(op,u) ==
+  if STRINGP op then op := INTERN op
+  id := LASSOC(op,
+    '((_+ Zero)(_* One)(append . NIL)(gcd Zero) (lcm One) (strconc . "")(lcm One)))
+  formatFunctionCall
+    id => ['reduce,op,u,id]
+    ['reduce,op,u]
+
+formatIterator u ==
+  $noColonDeclaration : local := true
+  u is ["IN",x,y] =>
+    format "for " and formatLeft("format",x,"in","Led") and format " in " and
+      formatRight("format",y,"in","Led")
+  u is ["WHILE",x] => format "while " and formatRight("format",x,"while","Nud")
+  u is ["UNTIL",x] => format "until " and formatRight("format",x,"until","Nud")
+  u is ["|",x] => format "| " and formatRight("format",x,"|","Led")
+  u is ["STEP",i,init,step,:v] =>
+    final := IFCAR v
+    format "for " and formatLeft("format",i,"in","Led") and format " in " and
+      (seg := ['SEGMENT,init,final]) and (formatStepOne? step => format seg; formatBy ['by,seg,step])
+  error "formatIterator"
+
+formatStepOne? step ==
+  step = 1 or step = '(One) => true
+  step is [op,n,.] and MEMQ(op,'(_:_:  _@)) => n = 1 or n = '(One)
+  false
+ 
+formatBy ['by,seg,step] == format seg and format " by " and format step
+ 
+formatSCOND ["SCOND",:l] ==
+  $pilesAreOkHere =>
+                            --called from formatPileLine or formatBlock
+                     --if from formatPileLine
+    initialC:= $c
+    and/[x is [a,["exit",.,b]] for x in l] =>
+      first l is [a,["exit",.,b]] and formatIfExit(a,b) and
+        (and/[newLine() and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and initialC
+    formatIfThenElse l and initialC
+  and/[x is [a,["exit",.,b]] for x in l] =>
+    first l is [a,["exit",.,b]] and formatIfExit(a,b) and
+      (and/[format "; " and formatIfExit(a,b) for [a,["exit",.,b]] in rest l]) and $c
+   --warning: and/(...) returns T if there are no entries
+  formatIfThenElse l
+ 
+formatSEGMENT ["SEGMENT",a,b] ==
+  $pilesAreOkHere: local
+  (if pspadBindingPowerOf("right",a)<750 then formatPren a else format a) and
+    formatInfixOp ".." and
+      (null b and $c or
+        (if 750>pspadBindingPowerOf("left",b) then formatPren b else format b))
+ 
+formatSexpr x ==
+  atom x =>
+    null x or IDENTP x => consBuffer ident2PrintImage PNAME x
+    consBuffer x
+  spill("formatNonAtom",x)
+ 
+formatNonAtom x ==
+  format "_(" and formatSexpr first x and
+    (and/[format " " and formatSexpr y for y in rest x])
+      and (y:= LASTATOM x => format " . "
+        and formatSexpr y; true) and format "_)"
+ 
+formatCAPSULE ['CAPSULE,:l,x] == 
+  $insideCAPSULE: local := true
+  try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
+
+formatPAREN [.,:argl] == formatFunctionCallTail argl
+ 
+formatSEQ ["SEQ",:l,[.,.,x]] == 
+  try formatBlock(l,x) or formatPiles(l,x) or spillLine() and formatBlock(l,x)
+ 
+--======================================================================
+--              Comment Handlers
+--======================================================================
+formatCOMMENT ["COMMENT",x,marg,startXY,endXY,commentStack] ==
+  $commentsToPrint:= [[marg,startXY,endXY,commentStack],:$commentsToPrint]
+  format x
+ 
+formatComments(u,op,types) ==
+  $numberOfSpills :local := $commentIndentation/2 - 1
+  not $insideEXPORTS => u
+  alist := LASSOC(op,$comments) or
+    sayBrightly ['"No documentation for ",op]
+    return u
+  ftypes := SUBLISLIS($FormalMapVariableList,rest $form,types)
+  consComments(LASSOC(ftypes,alist),'"++ ")
+  u   
+ 
+consComments(s,plusPlus) ==
+  s is [word,:r] and null atom r => consComments(r, plusPlus)
+  s := first s
+  null s => nil
+  s := consCommentsTran s
+  indent() and newLine() or return nil
+  columnsLeft := $lineLength - $m - 2
+  while (m := MAXINDEX s) >= columnsLeft repeat
+    k := or/[i for i in (columnsLeft - 1)..1 by -1 | s.i = $charBlank] 
+    k := (k => k + 1; columnsLeft)
+    piece := SUBSTRING(s,0,k)
+    formatDoCommentLine [plusPlus,piece]
+    s := SUBSTRING(s,k,nil)
+  formatDoCommentLine [plusPlus,s]
+  undent()
+  $m
+
+consCommentsTran s ==
+  m := MAXINDEX s 
+  k := or/[i for i in 0..(m - 7) | substring?('"\spad{",s,i)] =>
+    r := charPosition(char '_},s,k + 6)
+    r = m + 1 => s
+    STRCONC(SUBSTRING(s,0,k),'"`",SUBSTRING(s,k+6,r-k-6),'"'",consCommentsTran SUBSTRING(s,r+1,nil))
+  s
+  
+formatDoCommentLine line ==
+  $lineBuffer := consLineBuffer [nBlanks $c,:line]
+  $c := $m+2*$numberOfSpills
+
+--======================================================================
+--                  Pile Handlers
+--======================================================================
+formatPreferPile y ==
+  y is ["SEQ",:l,[.,.,x]] => 
+    (u:= formatPiles(l,x)) => u 
+    formatSpill("format",y) 
+  formatSpill("format",y)
+ 
+formatPiles(l,x) ==
+  $insideTypeExpression : local := false
+  not $pilesAreOkHere => nil                  
+  originalC:= $c
+  lines:= [:l,x]
+                                                --piles must begin at margin
+  originalC=$m or indent() and newLine() or return nil
+  null (formatPileLine($m,first lines,false)) => nil
+  not (and/[formatPileLine($m,y,true) for y in rest lines]) => nil
+  (originalC=$m or undent()) and originalC          --==> brace
+ 
+formatPileLine($m,x,newLineIfTrue) ==
+  if newLineIfTrue then newLine() or return nil
+  $numberOfSpills: local:= 0
+  $newLineWritten := nil
+  format x and (x is ['SIGNATURE,:.] or $rightBraceFlag => $c; formatSC())
+    and (x is ['DEF,:.] and optNewLine() or $c)
+
+--======================================================================
+--                       Utility Functions
+--======================================================================
+nBlanks m == "STRCONC"/[char('_  ) for i in 1..m]
+ 
+isNewspadOperator op == GET(op,"Led") or GET(op,"Nud")
+ 
+isTrue x == x="true" or x is '(QUOTE T)
+ 
+nary2Binary(u,op) ==
+  u is [a,b,:t] => (t => nary2Binary([[op,a,b],:t],op); [op,a,b])
+  errhuh()
+ 
+string2PrintImage s ==
+  u:= GETSTR (2*SIZE s)
+  for i in 0..MAXINDEX s repeat
+    (if MEMQ(s.i,'(_( _{ _) _} _! _")) then
+      SUFFIX('__,u); u:= SUFFIX(s.i,u))
+  u
+ 
+ident2PrintImage s ==
+  m := MAXINDEX s
+  if m > 1 and s.(m - 1) = $underScore then s := STRCONC(SUBSTRING(s,0,m-1),s.m)
+  u:= GETSTR (2*SIZE s)
+  if not (ALPHA_-CHAR_-P s.(0) or s.(0)=char '"$") then SUFFIX('__,u)
+  u:= SUFFIX(s.(0),u)
+  for i in 1..MAXINDEX s repeat
+    if not (DIGITP s.i or ALPHA_-CHAR_-P s.i or ((c := s.i) = char '?) 
+      or (c = char '_!)) then SUFFIX('__,u)
+    u:= SUFFIX(s.i,u)
+  INTERN u
+ 
+isIdentifier x ==
+  IDENTP x =>
+    s:= PNAME x
+    #s = 0 => nil
+    ALPHA_-CHAR_-P s.(0) => and/[s.i^=char '" " for i in 1..MAXINDEX s]
+    #s>1 =>
+      or/[ALPHA_-CHAR_-P s.i for i in 1..(m:= MAXINDEX s)] =>
+        and/[s.i^=char '" " for i in 1..m] => true
+ 
+isGensym x == 
+  s := STRINGIMAGE x
+  n := MAXINDEX s
+  s.0 = char '_G and and/[DIGITP s.i for i in 1..n]
+ 
+--======================================================================
+--                       Macro Helpers
+--======================================================================
+tryToFit(s,x) ==
+--% try to format on current line; see macro try in file PSPADAUX LISP
+  --returns nil if unable to format stuff in x on a single line
+  x => ($back:= rest $back; $c)
+  restoreState()
+  nil
+ 
+restoreState(:options) ==
+  back := IFCAR options or $back
+  [
+    [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth,
+      $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :back]
+        := back
+  if null options then $back := back
+  [$newLineWritten, $autoLine, $rightBraceFlag,
+      $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere,
+       $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue,
+         $doNotResetMarginIfTrue,$noColonDeclaration]
+           := flags
+  nil
+ 
+saveState(:options) ==
+  flags := 
+    [$newLineWritten, $autoLine, $rightBraceFlag,
+      $semicolonFlag,$insideDEF,$insideTypeExpression,$pilesAreOkHere,
+       $insideEXPORTS, $insideCAPSULE, $insideCategoryIfTrue,
+         $doNotResetMarginIfTrue,$noColonDeclaration]
+  newState := 
+   [
+    [$lineBuffer, $lineFragmentBuffer,$comments,$marginStack,$braceStack,$DEFdepth,
+      $bc,$c,$m,$commentsToPrint,$numberOfSpills,flags], :$back]
+  if not KAR options then $back := newState
+  newState
+ 
+formatSC() ==
+  $pileStyle or $semicolonFlag => $c
+  format "; "
+
+wrapBraces(x,y,z) == y
+
+formatLB() ==
+  $pileStyle => $c
+  $numberOfSpills := 
+    $c > $lineLength / 2 => $braceIndentation/3 - 1 
+    $braceIndentation/2 - 1
+  format "{"
+
+restoreC() == --used by macro "embrace"
+  originalC := CAR $braceStack
+  $braceStack := CDR $braceStack
+  formatRB originalC
+ 
+saveC() ==  --used by macro "embrace"
+  $braceStack := [$c,:$braceStack]
+
+saveD() ==  --used by macro "embrace"
+  $braceStack := [$c,:$braceStack]
+
+restoreD() == --used by macro "indentNB"
+  originalC := CAR $braceStack
+  $braceStack := CDR $braceStack
+  originalC
+ 
+formatRB(originalC) == --called only by restoreC
+  while $marginStack and $m > originalC repeat undent()
+  if $m < originalC then $marginStack := [originalC,:$marginStack]
+  $m := originalC
+  $pileStyle => $m
+  newLine() and format "}" and $m    --==> brace
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}