Revert commits to the wrong tree.

1 files changed, 0 insertions, 741 deletions

diff --git a/src/interp/pspad1.boot b/src/interp/pspad1.boot
deleted file mode 100644
index b936eb77..00000000
--- a/src/interp/pspad1.boot
+++ /dev/null
@@ -1,741 +0,0 @@
--- 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.
-
-
-)package "BOOT"
-
-$escapeWords := ["always", "assert", "but", "define", 
-  "delay", "do", "except", "export", "extend", "fix", "fluid",
-    "from", "generate", "goto", "import", "inline", "never", "select",
-       "try", "yield"]
-$pileStyle := false
-$commentIndentation := 8
-$braceIndentation := 8
-$doNotResetMarginIfTrue := true
-$marginStack := nil
-$numberOfSpills := 0
-$lineFragmentBuffer:= nil
-$pspadRelationAlist := '((_= . _~_=) (_< . _>_=) (_<_= . _>)(_~_= . _=)(_>_= . _<) (_> . _<_=))
-$lineBuffer := nil
-$formatForcePren := nil
-$underScore := char ('__)
-$rightBraceFlag := nil 
-$semicolonFlag := nil
-$newLineWritten := nil
-$comments := nil
-$noColonDeclaration := false
-$renameAlist := '(
-  (SmallInteger . SingleInteger)
-  (SmallFloat . DoubleFloat)
-  (Void . _(_))
-  (xquo . exquo)
-  (setelt . set_!)
-  (_$ . _%)
-  (_$_$ . _$)
-  (_*_* . _^)
-  (_^_= . _~_=)
-  (_^ . _~))
-
---$opRenameAlist := '(
---  (and . AND)
---  (or  . OR)
---  (not . NOT))
-
-
---======================================================================
---               Main Translator Function
---======================================================================
---% lisp-fragment to boot-fragment functions
-lisp2Boot x ==
-                  --entry function
-  $fieldNames := nil
-  $pilesAreOkHere: local:= true
-  $commentsToPrint: local:= nil
-  $lineBuffer: local
-  $braceStack: local := nil
-  $marginStack: local:= [0]
-  --$autoLine is true except when inside a try---if true, lines are allowed to break
-  $autoLine:= true
-  $lineFragmentBuffer:= nil
-  $bc:=0     --brace count
-  $m:= 0
-  $c:= $m
-  $numberOfSpills:= 0
-  $lineLength:= 80
-  format x
-  formatOutput REVERSE $lineFragmentBuffer
-  [fragmentsToLine y for y in REVERSE $lineBuffer]
- 
-fragmentsToLine fragments ==
-  string:= lispStringList2String fragments
-  line:= GETSTR 240
-  for i in 0..MAXINDEX string repeat line:= SUFFIX(string.i,line)
-  line
- 
-lispStringList2String x ==
-  null x => '""
-  atom x => STRINGIMAGE x
-  CDR x => APPLY(function STRCONC,MAPCAR(function lispStringList2String,x))
-  lispStringList2String CAR x
- 
---% routines for buffer and margin adjustment
- 
-formatOutput x ==
-  for [currentColumn,start,end,stack] in REVERSE $commentsToPrint repeat
-    startY:= rest start
-    for [loc,comment] in stack repeat
-      commentY:= rest loc
-      gap:= startY-commentY
-      gap>0 => before:= [[commentY,first loc,gap,comment],:before]
-      gap=0 => same:= [[startY,1,gap,comment],:same]
-      true => after:= [[startY,first loc,-gap,comment],:after]
-  if before then putOut before
-  if same then
-    [y,:extraLines]:= "append"/[mkCommentLines u for u in orderList same]
-    line:= fragmentsToLine x
-    x:=
-      #line+#y>$lineLength =>
-        (y:= STRCONC(nBlanks $m,y); extraLines:= [y,:extraLines]; x)
-      [line,y]
-  consLineBuffer x
-  for y in extraLines repeat consLineBuffer LIST y
-  if after then putOut after
-  $commentsToPrint:= nil
- 
-consLineBuffer x ==  $lineBuffer := [x,:$lineBuffer]
-
-putOut x ==
-  eject ("min"/[gap for [.,.,gap,:.] in x])
-  for u in orderList x repeat addComment u
- 
-eject n == for i in 2..n repeat consLineBuffer nil
- 
-addComment u ==
-  for x in mkCommentLines u repeat consLineBuffer LIST x
- 
-mkCommentLines [.,n,.,s] ==
-  lines:= breakComments s
-  lines1:= [fragmentsToLine [nBlanks n,"_{",first lines],:rest lines]
-  [:l,last]:= lines1
-  [:l,fragmentsToLine [last,"_}"]]
- 
-breakComments s ==
-  n:= containsString(s,PNAME "ENDOFLINECHR") =>
-    #s>n+12 => [SUBSTRING(s,0,n),:breakComments SUBSTRING(s,n+12,NIL)]
-    LIST SUBSTRING(s,0,n)
-  LIST s
- 
-containsString(x,y) ==
-                       --if string x contains string y, return start index
-  for i in 0..MAXINDEX x-MAXINDEX y repeat
-    and/[x.(i+j)=y.j for j in 0..MAXINDEX y] => return i
- 
---======================================================================
---               Character/String Buffer Functions
---======================================================================
-consBuffer item ==
-  if item = '"failed" then item := 'failed
-  n:=
-    STRINGP item => 2+#item
-    IDENTP item => #PNAME item
-    #STRINGIMAGE item
-  columnsLeft:= $lineLength-$c
-  if columnsLeft <= 0 and isCloseDelimiter item then $lineLength := $lineLength + 2
-  columnsLeft:= $lineLength-$c
-  --cheat for semicolons, strings, and delimiters: they are NEVER too long
-  not isSpecialBufferItem item and (n>columnsLeft or columnsLeft < 0) =>
-    $autoLine =>
-                   --is true except within try
-      formatOutput REVERSE $lineFragmentBuffer
-      $c:= REMAINDER($m+2*($numberOfSpills:= $numberOfSpills+1), $lineLength)
-      $lineFragmentBuffer:= LIST nBlanks $c
-      consBuffer item
-    nil
-  $lineFragmentBuffer:=
-    ^item or IDENTP item => [PNAME item,:$lineFragmentBuffer]
-    NUMBERP item or CHARP item => [STRINGIMAGE item,:$lineFragmentBuffer]
-    STRINGP item => ["_"",string2PrintImage item,"_"",:$lineFragmentBuffer]
-    sayBrightly ['"Unexpected line buffer item: ", STRINGIMAGE item]
-    $lineFragmentBuffer
-  $rightBraceFlag := item = "}"
-  $semicolonFlag  := item = "; "   --prevents consecutive semicolons
-  $c:= $c+n
- 
-isSpecialBufferItem item ==
-  item = "; " or STRINGP item => true
-  false
-
-isCloseDelimiter item ==   EQ(item,")") or EQ(item,"]") or EQ(item,"}") 
-
---======================================================================
---               Formatting/Line Control Functions
---======================================================================
-newLine() ==
-  null $autoLine => nil
-  $newLineWritten := true
-  formatOutput REVERSE $lineFragmentBuffer
-  $lineFragmentBuffer:= LIST nBlanks $m
-  $c:= $m
- 
-optNewLine() ==
-  $newLineWritten => newLine()
-  $c
-
-spillLine() ==
-  null $autoLine => nil
-  formatOutput REVERSE $lineFragmentBuffer
-  $c:= $m+2*($numberOfSpills:= $numberOfSpills+1)
-  $lineFragmentBuffer:= LIST nBlanks $c
-  $c
- 
-indent() ==
-  $m:= $m+2*($numberOfSpills+1)
-  $marginStack:= [$m,:$marginStack]
-  $numberOfSpills:= 0
-  $m
- 
-undent() ==
---  $doNotResetMarginIfTrue=true => 
---    pp '"hoho"
---    $c
-  $marginStack is [m,:r] =>
-    $marginStack := r
-    $m := m
-  0
-
-spill(fn,a) == 
-  u := try FUNCALL(fn,a) => u
-  (nearMargin() or spillLine()) and FUNCALL(fn,a)
- 
-formatSpill(fn,a) ==
-  u := try FUNCALL(fn,a) => u
-  v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,a) 
-  w := stay or undent()
-  v and w
- 
-formatSpill2(fn,f,a) ==
-  u := try FUNCALL(fn,f,a) => u
-  v := (stay:= nearMargin() or indent() and newLine()) and FUNCALL(fn,f,a) 
-  w := stay or undent()
-  v and w
- 
-nearMargin() ==
-  $c=$m or $c=$m+1 => $c
- 
---======================================================================
---               Main Formatting Functions
---======================================================================
-format(x,:options) ==
-  oldC:= $c
-  qualification := IFCAR options
-  newCOrNil:=
-    x is [op,:argl] =>
-      if op = 'return then argl := rest argl
-      n := #argl
-      op is ['elt,y,"construct"] => formatDollar(y,'construct,argl)
-      op is ['elt,name,p] and UPPER_-CASE_-P (STRINGIMAGE opOf name).0 => 
-        formatDollar(name,p,argl)
-      op = 'elt and UPPER_-CASE_-P (STRINGIMAGE opOf CAR argl).0 => 
-        formatDollar1(CAR argl,CADR argl)
-      fn:= GETL(op,"PSPAD") => formatFn(fn,x,$m,$c)
-      if MEMQ(op,'(AND OR NOT)) then op:= DOWNCASE op
-      n=1 and GETL(op,'Nud) and (lbp:= formatOpBindingPower(op,"Nud","left")) =>
-        formatPrefix(op,first argl,lbp,formatOpBindingPower(op,"Nud","right"),qualification)
-      n=2 and (op = '_$ or getOp(op,'Led)) and (lbp:= formatOpBindingPower(op,"Led","left")) =>
-        formatInfix(op,argl,lbp,formatOpBindingPower(op,"Led","right"),qualification)
-      formatForm x
-    formatAtom x
-  null newCOrNil => ($c:= oldC; nil)
-  null FIXP newCOrNil => error()
-  $c:= newCOrNil
- 
-
-getOp(op,kind) ==
-  kind = 'Led =>
-    MEMQ(op,'(_div _exquo)) => nil
-    GET(op,'Led)
-  GET(op,'Nud)
-
-formatDollar(name,p,argl) ==
-  name := markMacroTran name
-  n := #argl
-  kind := (n=1 => "Nud"; "Led")
-  IDENTP name and GETL(p,kind) => format([p,:argl],name)
-  formatForcePren [p,:argl] and 
-    (try (format "$$" and formatForcePren name) 
-      or (indent() and format "$__" and formatForcePren name and undent()))
- 
-formatMacroCheck name ==
-  ATOM name => name
-  u := or/[x for [x,:y] in $globalMacroStack | y = name] => u
-  u := or/[x for [x,:y] in $localMacroStack  | y = name] => u
-  [op,:argl] := name
-  MEMQ(op,'(Record Union)) => 
-    pp ['"Cannot find: ",name]
-    name
-  [op,:[formatMacroCheck x for x in argl]]
-  
-formatDOLLAR ['DOLLAR,x,y] == formatDollar1(y, x)
-
-formatDollar1(name,arg) ==
-  id :=
-    IDENTP name => name
-    name is [p] and GETL(p,'NILADIC) => p
-    name
-  format arg and format "$$" and formatForcePren id
- 
- 
-formatForcePren x ==
-  $formatForcePren: local := true
-  format x
- 
-formatAtom(x,:options) ==
-  if u := LASSOC(x,$renameAlist) then x := u
-  null x or isIdentifier x => 
-    if MEMQ(x,$escapeWords) then 
-      consBuffer $underScore
-    consBuffer ident2PrintImage PNAME x
-  consBuffer x
- 
-formatFn(fn,x,$m,$c) == FUNCALL(fn,x)
-
-formatFree(['free,:u]) ==
-  format 'free and format " " and formatComma u
-
-formatUnion(['Union,:r]) == 
-  $count : local := 0
-  formatFormNoColonDecl formatTestForPartial ['Union,:[fn x for x in r]] where fn x ==
-    x is [":",y,'Branch] => fn STRINGIMAGE y
-    STRINGP x => [":", INTERN x, ['Enumeration,x]]
-    x is [":",:.] => x
-    tag := INTERN STRCONC("value",STRINGIMAGE ($count := $count + 1))
-    [":", tag, x]      
-
-formatTestForPartial u ==
-  u is ['Union,a,b] and b is [":","failed",:.] and a is [":",.,S] =>
-    ['Partial, S]
-  u
-
-formatEnumeration(y is ['Enumeration,:r]) ==
-  r is [x] => format "'" and format INTERN STRINGIMAGE x and format "'"
-  formatForm y
-
-formatRecord(u) == formatFormNoColonDecl u
-
-formatFormNoColonDecl u ==
-  $noColonDeclaration: local := true
-  formatForm u  
-
-formatElt(u) ==  
-  u is ["elt",a,b] => formatApplication rest u
-  formatForm u
- 
-formatForm (u) ==
-  [op,:argl] := u
-  if MEMQ(op, '(Record Union)) then 
-    $fieldNames := union(getFieldNames argl,$fieldNames)
-  MEMQ(op,'((QUOTE T) true)) => format "true"
-  MEMQ(op,'(false nil)) => format op
-  u='(Zero) => format 0
-  u='(One) => format 1
-  1=#argl => formatApplication u
-  formatFunctionCall u
- 
-formatFunctionCall u ==
-  $pilesAreOkHere: local
-  spill("formatFunctionCall1",u)
- 
-formatFunctionCall1 [op,:argl] ==
---null argl and getConstructorProperty(op,'niladic) => formatOp op
-  null argl => 
-    GETL(op,'NILADIC) => formatOp op
-    formatOp op and format "()"
-  formatOp op and formatFunctionCallTail argl 
- 
-formatFunctionCallTail argl == format "_(" and formatComma argl and format "_)"
-
-formatComma argl == 
-  format first argl and (and/[format "," and formatCut x for x in rest argl]) and $c
- 
-formatOp op ==
-  atom op => formatAtom op
-  formatPren op
- 
-formatApplication u ==
-  [op,a] := u
-  MEMQ(a, $fieldNames) => formatSelection u
-  atom op => 
-    formatHasDotLeadOp a => formatOpPren(op,a)
-    formatApplication0 u
-  formatSelection u
-
-formatHasDotLeadOp u ==
-  u is [op,:.] and (op = "." or not atom op)
-
-formatApplication0 u ==
---format as f(x) as f x if possible
-  $pilesAreOkHere: local
-  formatSpill("formatApplication1",u)
- 
-formatApplication1 u ==
-  [op,x] := u
-  formatHasDollarOp x or $formatForcePren or 
-    pspadBindingPowerOf("left",x) < 1000  => formatOpPren(op,x)
-  try (formatOp op and format " ") and 
-    (try formatApplication2 x or
-      format "(" and formatApplication2 x and format ")")
-
-formatHasDollarOp x ==
-  x is ["elt",a,b] and isTypeProbably? a 
-
-isTypeProbably? x ==
-  IDENTP x and UPPER_-CASE_-P (PNAME x).0
-
-formatOpPren(op,x) == formatOp op and formatPren x
-
-formatApplication2 x ==
-  leadOp := 
-    x is [['elt,.,y],:.] => y
-    opOf x
-  MEMQ(leadOp,'(COLLECT LIST construct)) or
-    pspadBindingPowerOf("left",x)<1000 => formatPren x
-  format x
-
-formatDot ["dot",a,x] ==
-  try (formatOp a and format ".") and
-    ATOM x => format x
-    formatPren x
- 
-formatSelection u ==
-  $pilesAreOkHere: local
-  formatSpill("formatSelection1",u)
- 
-formatSelection1 [f,x] == formatSelectionOp f and format "." and 
-    ATOM x => format x
-    formatPren x
- 
-formatSelectionOp op ==
-  op is [f,.] and not GET(f,'Nud) or 
-    1000 < pspadBindingPowerOf("right",op) => formatSelectionOp1 op
-  formatPren1("formatSelectionOp1",op)
- 
-formatSelectionOp1 f ==
-  f is [op,:argl] => 
-    argl is [a] => 
-      not ATOM op and ATOM a => formatSelection1 [op,a]
-      formatPren f
-    format f
-  formatOp f
- 
-formatPren a ==
-  $pilesAreOkHere: local
-  formatSpill("formatPrenAux",a)
- 
-formatPrenAux a == format "_(" and format a and format "_)"
- 
-formatPren1(f,a) ==
-  $pilesAreOkHere: local
-  formatSpill2("formatPren1Aux",f,a)
- 
-formatPren1Aux(f,a) == format "_(" and FUNCALL(f,a) and format "_)"
- 
-formatLeft(fn,x,op,key) ==
-  lbp:= formatOpBindingPower(op,key,"left")
-  formatOpBindingPower(opOf x,key,"right")<lbp => formatPren1(fn,x)
-  FUNCALL(fn,x)
- 
-formatRight(fn,x,op,key) ==
-  --are there exceptional cases where piles are ok?
-  x is ['LET,:.] => FUNCALL(fn,x)
-  --decide on basis of binding power whether prens are needed
-  rbp := formatOpBindingPower(op,key,"right")
-  lbp := formatOpBindingPower(opOf x,key,"left")
-  lbp < rbp => formatPren1(fn,x)
-  FUNCALL(fn,x)
- 
-formatCut a == formatSpill("format",a)
- 
---======================================================================
---               Prefix/Infix Operators
---======================================================================
-formatPrefix(op,arg,lbp,rbp,:options) ==
-  qualification := IFCAR options
-  $pilesAreOkHere: local
-  formatPrefixOp(op,qualification) and
-    (rbp>formatGetBindingPowerOf("left",arg) => formatPren arg; format arg)
- 
-formatPrefixOp(op,:options) ==
-  qualification := IFCAR options
-  op=char '" " => format " ="
-  qualification or GET(op,"Nud") and ^MEMQ(op,$spadTightList) => 
-    formatQual(op,qualification) and format " "
-  format op
-
-formatQual(op,D) ==
-  null D => format op
-  format op and format "$$" and format D
-
-formatInfix(op,[a,b],lbp,rbp,:options) ==
-  qualification  := IFCAR options
-  $pilesAreOkHere: local
-  (if formatGetBindingPowerOf("right",a)<lbp then formatPren a else format a) and
-    formatInfixOp(op,qualification) and (if rbp>formatGetBindingPowerOf("left",b) 
-      then formatPren b else format b)
- 
-formatGetBindingPowerOf(leftOrRight,x) ==
---  this function is nearly identical with getBindingPowerOf
---    leftOrRight = "left" => 0
---    1
-  pspadBindingPowerOf(leftOrRight,x)
- 
-pspadBindingPowerOf(key,x) ==
-  --binding powers can be found in file NEWAUX LISP
-  x is ['REDUCE,:.] => (key='left => 130; key='right => 0)
-  x is ["REPEAT",:.] => (key="left" => 130; key="right" => 0)
-  x is ["COND",:.] => (key="left" => 130; key="right" => 0)
-  x is [op,:argl] =>
-    if op is [a,:.] then op:= a
-    op = 'SLASH => pspadBindingPowerOf(key,["/",:argl]) - 1
-    op = 'OVER  => pspadBindingPowerOf(key,["/",:argl])
-    (n:= #argl)=1 =>
-      key="left" and (m:= pspadOpBindingPower(op,"Nud","left")) => m
-      key="right" and (m:= pspadOpBindingPower(op,"Nud","right")) => m
-      1000
-    n>1 =>
-      key="left" and (m:= pspadOpBindingPower(op,"Led","left")) => m
-      key="right" and (m:= pspadOpBindingPower(op,"Led","right")) => m
-      op="ELT" => 1002
-      1000
-    1000
-  1002
-
-pspadOpBindingPower(op,LedOrNud,leftOrRight) ==
-  if op in '(SLASH OVER) then op := "/"
-  MEMQ(op,'(_:)) and LedOrNud = 'Led =>
-    leftOrRight = 'left => 195
-    196
-  exception:=
-    leftOrRight="left" => 0
-    105
-  bp:=
-    leftOrRight="left" => leftBindingPowerOf(op,LedOrNud)
-    rightBindingPowerOf(op,LedOrNud)
-  bp^=exception => bp
-  1000
-
-formatOpBindingPower(op,key,leftOrRight) ==
-  if op in '(SLASH OVER) then op := "/"
-  op = '_$ => 1002
-  MEMQ(op,'(_:)) and key = 'Led =>
-    leftOrRight = 'left => 195
-    196
-  MEMQ(op,'(_^_= _>_=)) => 400
-  op = "not" and key = "Nud" =>
-    leftOrRight = 'left => 1000
-    1001
-  GETL(op,key) is [.,.,:r] =>
-    leftOrRight = 'left => KAR r or 0
-    KAR KDR r or 1
-  1000
- 
-formatInfixOp(op,:options) ==
-  qualification := IFCAR options
-  qualification or 
-    (op ^= '_$) and ^MEMQ(op,$spadTightList) => format " " and formatQual(op,qualification) and format " "
-  format op
- 
---======================================================================
---            Special Handlers: DEF forms
---======================================================================
-
-formatDEF def == formatDEF0(def,$DEFdepth + 1)
-
-formatDEF0(["DEF",form,tlist,sclist,body],$DEFdepth) ==
-  if not MEMQ(KAR form,'(Exports Implementation)) then 
-    $form := 
-      form is [":",a,:.] => a
-      form
-  con := opOf $form
-  $comments: local := SUBST('_$,'_%,GETDATABASE(con,'DOCUMENTATION))
-  $abb :local := constructor? opOf $form
-  if $DEFdepth < 2 then
-    condoc := (u := LASSOC('constructor,$comments)) and KDR KAR u or ['""]
-    $numberOfSpills := -1
-    consComments(condoc,'"+++ ")
-  form := formatDeftranForm(form,tlist)
-  u := ["DEF",form,tlist,sclist,body]
-  v := formatDEF1 u => v
-  $insideDEF: local := $DEFdepth > 1
-  $DEFdepth = 1 =>
-    exname := 'Exports
-    impname := 'Implementation
-    form is [":",.,=exname] or body = impname => nil
-    exports :=
-      form is [":",a,b] => 
-        form := a
-        [["MDEF",exname,'(NIL),'(NIL),b]]
-      nil
-    [op,:argl] := form
---  decls := [x for x in argl | x is [":",:.]]
---  form := [op,:[(a is [":",b,t] => b; a) for a in argl]]
---  $DEFdepth := $DEFdepth - 1  
-    formatWHERE(["where",
-      ["DEF",[":",form,exname],[nil for x in form],sclist,impname],
-        ['PROGN,:exports,["MDEF",impname,'(NIL),'(NIL),body]]])
-  $insideTypeExpression: local := true
-  body := formatDeftran(body,false)
-  body is ["add",a,:b] => formatAddDef(form,a,b) 
---body is ["with",a,:b] => formatWithDef(form,a,b)
-  tryBreakNB(format form and format " == ",body,"==","Led") 
-
-formatDEF1 ["DEF",form,tlist,b,body] ==
-  $insideDEF: local := $DEFdepth > 1
-  $insideEXPORTS: local := form = 'Exports
-  $insideTypeExpression: local := true
-  form := formatDeftran(form,false)
-  body := formatDeftran(body,false)
-  ---------> terrible, hideous, but temporary, hack
-  if not $insideDEF and body is ['SEQ,:.] then body := ["add", body]
-  prefix := (opOf tlist = 'Category => "define "; nil)
-  body is ["add",a,b] => formatAddDef(form,a,b)
-  body is ["with",a,:b] => formatWithDef(form,a,b,"==",prefix)
-  prefix => 
-    tryBreak(format prefix and format form and format " == ",body,"==","Led") 
-  tryBreak(format form and format " == ",body,"==","Led") 
-
-formatDefForm(form,:options) ==
-  prefix := IFCAR options 
-  $insideTypeExpression : local := true
-  form is [":",form1,["with",a,:b]] => formatWithDef(form1,a,b,":",prefix)
-  prefix => format prefix and format form
-  format form
-
-formatAddDef(form,a,b) ==
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  formatDefForm form or return nil
-  $marginStack := [0]
-  $m := $c := 0
-  $insideTypeExpression : local := false
-  cap := (b => b; "")
-  tryBreakNB(newLine() and format "== " and formatLeft("format",a,"add","Led") 
-      and format " add ", cap,"add","Led")
-
-formatWithDef(form,a,b,separator,:options) ==
-  prefix := IFCAR options
-  $insideEXPORTS : local := true
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  $insideTypeExpression : local := false
-  a1 := formatWithKillSEQ a
-  b => tryBreakNB(formatDefForm(form,prefix) and format separator and format " with " and formatLeft("format",a,"with","Led") 
-      and format " with ",first b,"with","Led")
-  tryBreak(formatDefForm(form,prefix) and format separator and format " with ",a1,"with","Nud")
- 
-formatWithKillSEQ x ==
-  x is ['SEQ,['exit,.,y]] => ['BRACE, y]
-  x
-
-formatBrace ['BRACE, x]  == format "{" and format x and format "}"
-
-formatWith ["with",a,:b] ==
-  $pilesAreOkHere: local := true
-  b => 
-    tryBreakNB(formatLeft("format",a,"with","Led") and format " with ",first b,"with","Led")
-  tryBreak(format "with ",a,"with","Nud")
-
-formatWithDefault ["withDefault",a,b] ==
-  if a is ['with,:init,["SEQ",:items,["exit",.,x]]] then
-    part2 := ["SEQ",:items,x,["exit", nil,["defaultDefs", b]]]
-    if IFCAR init then
-      a:= IFCAR init
-      b:= [part2]
-    else
-      a := part2
-      b := nil
-  $pilesAreOkHere: local := true
-  b => 
-    tryBreakNB(formatLeft("format",a,"with","Led") and format " with ",first b,"with","Led")
-  tryBreak(format "with ",a,"with","Nud")
-
-formatDefaultDefs ["default",a, :b] ==
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  $insideTypeExpression : local := false
-  b => 
-    tryBreak(formatLeft("format",a,"default","Led") and 
-      format " default ", first b,"default","Led")
-  tryBreak(format "default ",a,"default","Nud")
---format "add " and formatRight("formatPreferPile",a,"add","Nud")   --==> brace
-
-formatAdd ["add",a,:b] ==
-  $insideCAPSULE : local := true
-  $insideDEF     : local := false
-  $insideTypeExpression : local := false
-  b => 
-    tryBreakNB(formatLeft("format",a,"and","Led") and 
-      format " and ", first b,"and","Led")
-  tryBreakNB(format "add ",a,"and","Nud")
---format "add " and formatRight("formatPreferPile",a,"add","Nud")   --==> brace
-
-formatMDEF ["MDEF",form,.,.,body] ==
-  form is '(Rep) => formatDEF ["DEF",form,.,.,body]
-  $insideEXPORTS: local := form = 'Exports
-  $insideTypeExpression: local := true
-  body := formatDeftran(body,false)
-  name := opOf form
-  tryBreakNB(format name and format " ==> ",body,"==","Led") 
-   and ($insideCAPSULE and $c or format(";"))
-
-insideCat() == $insideCategoryIfTrue and not $insideFunctorIfTrue 
-   or $noColonDeclaration
-
-formatImport ["import",a] == 
-  addFieldNames a
-  addFieldNames macroExpand(a,$e)
-  format "import from " and formatLocal1 a
-
-addFieldNames a ==
-  a is [op,:r] and MEMQ(op,'(Record Union)) =>
-        $fieldNames := union(getFieldNames r,$fieldNames)
-  a is ['List,:b] => addFieldNames b
-  nil
-
-getFieldNames r ==
-  r is [[":",a,b],:r] => [a,:getFieldNames r]
-  nil
-
-formatLocal ["local",a] == format "local " and formatLocal1 a
- 
-formatLocal1 a ==
-  $insideTypeExpression: local := true
-  format a
-