Initial population.

1 files changed, 802 insertions, 0 deletions

diff --git a/src/interp/format.boot.pamphlet b/src/interp/format.boot.pamphlet
new file mode 100644
index 00000000..e4c83a31
--- /dev/null
+++ b/src/interp/format.boot.pamphlet
@@ -0,0 +1,802 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/interp format.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>>
+
+--% Functions for display formatting system objects
+
+-- some of these are redundant and should be compacted
+$formatSigAsTeX := 1
+
+--% Formatting modemaps
+
+sayModemap m ==
+  -- sayMSG formatModemap displayTranModemap m
+  sayMSG formatModemap old2NewModemaps displayTranModemap m
+
+sayModemapWithNumber(m,n) ==
+  msg := reverse cleanUpSegmentedMsg reverse ["%i","%i",'" ",
+    STRCONC(lbrkSch(),object2String n,rbrkSch()),
+      :formatModemap displayTranModemap m,"%u","%u"]
+  sayMSG flowSegmentedMsg(reverse msg,$LINELENGTH,3)
+
+displayOpModemaps(op,modemaps) ==
+  TERPRI()
+  count:= #modemaps
+  phrase:= (count=1 => 'modemap;'modemaps)
+  sayMSG ['%b,count,'%d,phrase,'" for",'%b,op,'%d,'":"]
+  for modemap in modemaps repeat sayModemap modemap
+
+displayTranModemap (mm is [[x,:sig],[pred,:y],:z]) ==
+  -- The next 8 lines are a HACK to deal with the "partial" definition
+  -- JHD/RSS
+  if pred is ['partial,:pred'] then
+    [b,:c]:=sig
+    sig:=[['Union,b,'"failed"],:c]
+    mm:=[[x,:sig],[pred',:y],:z]
+  else if pred = 'partial then
+    [b,:c]:=sig
+    sig:=[['Union,b,'"failed"],:c]
+    mm:=[[x,:sig],y,:z]
+  mm' := EQSUBSTLIST('(m n p q r s t i j k l),
+    MSORT listOfPredOfTypePatternIds pred,mm)
+  EQSUBSTLIST('(D D1 D2 D3 D4 D5 D6 D7 D8 D9 D10 D11 D12 D13 D14),
+    MSORT listOfPatternIds [sig,[pred,:y]],mm')
+
+listOfPredOfTypePatternIds p ==
+  p is ['AND,:lp] or p is ['OR,:lp] =>
+    UNIONQ([:listOfPredOfTypePatternIds p1 for p1 in lp],NIL)
+  p is [op,a,.] and op = 'ofType =>
+    isPatternVar a => [a]
+    nil
+  nil
+
+removeIsDomains pred ==
+  pred is ['isDomain,a,b] => true
+  pred is ['AND,:predl] =>
+    MKPF([x for x in predl | x isnt ['isDomain,:.]],'AND)
+  pred
+
+canRemoveIsDomain? pred ==
+  -- returns nil OR an alist for substitutions of domains ordered so that
+  -- after substituting for each pair in turn, no left-hand names remain
+  alist :=
+    pred is ['isDomain,a,b] => [[a,:b],:alist]
+    pred is ['AND,:predl] =>
+      [[a,:b] for pred in predl | pred is ['isDomain,a,b]]
+  findSubstitutionOrder? alist
+
+findSubstitutionOrder? alist == fn(alist,nil) where
+  -- returns NIL or an appropriate substituion order
+  fn(alist,res) ==
+    null alist => NREVERSE res
+    choice := or/[x for (x:=[a,:b]) in alist | null containedRight(a,alist)] =>
+      fn(delete(choice,alist),[choice,:res])
+    nil
+
+containedRight(x,alist)== or/[CONTAINED(x,y) for [.,:y] in alist]
+
+removeIsDomainD pred ==
+  pred is ['isDomain,'D,D] =>
+    [D,nil]
+  pred is ['AND,:preds] =>
+    D := nil
+    for p in preds while not D repeat
+      p is ['isDomain,'D,D1] =>
+        D := D1
+        npreds := delete(['isDomain,'D,D1],preds)
+    D =>
+      1 = #npreds => [D,first npreds]
+      [D,['AND,:npreds]]
+    nil
+  nil
+
+formatModemap modemap ==
+  [[dc,target,:sl],pred,:.]:= modemap
+  if alist := canRemoveIsDomain? pred then
+    dc:= substInOrder(alist,dc)
+    pred:= substInOrder(alist,removeIsDomains pred)
+    target:= substInOrder(alist,target)
+    sl:= substInOrder(alist,sl)
+  else if removeIsDomainD pred is [D,npred] then
+    pred := SUBST(D,'D,npred)
+    target := SUBST(D,'D,target)
+    sl := SUBST(D,'D,sl)
+  predPart:= formatIf pred
+  targetPart:= prefix2String target
+  argTypeList:=
+    null sl => nil
+    concat(prefix2String first sl,fn(rest sl)) where
+      fn l ==
+        null l => nil
+        concat(",",prefix2String first l,fn rest l)
+  argPart:=
+    #sl<2 => argTypeList
+    ['"_(",:argTypeList,'"_)"]
+  fromPart:=
+    if dc = 'D and D
+      then concat('%b,'"from",'%d,prefix2String D)
+      else concat('%b,'"from",'%d,prefix2String dc)
+  firstPart:= concat('" ",argPart,'" -> ",targetPart)
+  sayWidth firstPart + sayWidth fromPart > 74 => --allow 5 spaces for " [n]"
+    fromPart:= concat('" ",fromPart)
+    secondPart :=
+      sayWidth fromPart + sayWidth predPart < 75 =>
+        concat(fromPart,predPart)
+      concat(fromPart,'%l,predPart)
+    concat(firstPart,'%l,secondPart)
+  firstPart:= concat(firstPart,fromPart)
+  sayWidth firstPart + sayWidth predPart < 80 =>
+    concat(firstPart,predPart)
+  concat(firstPart,'%l,predPart)
+
+substInOrder(alist,x) ==
+  alist is [[a,:b],:y] => substInOrder(y,SUBST(b,a,x))
+  x
+
+reportOpSymbol op1 ==
+  op := (STRINGP op1 => INTERN op1; op1)
+  modemaps := getAllModemapsFromDatabase(op,nil)
+  null modemaps =>
+    ok := true
+    sayKeyedMsg("S2IF0010",[op1])
+    if SIZE PNAME op1 < 3 then
+      x := UPCASE queryUserKeyedMsg("S2IZ0060",[op1])
+      null MEMQ(STRING2ID_-N(x,1),'(Y YES)) =>
+        ok := nil
+        sayKeyedMsg("S2IZ0061",[op1])
+    ok => apropos [op1]
+  sayNewLine()
+  -- filter modemaps on whether they are exposed
+  mmsE := mmsU := NIL
+  for mm in modemaps repeat
+    isFreeFunctionFromMm(mm) or isExposedConstructor getDomainFromMm(mm) => mmsE := [mm,:mmsE]
+    mmsU := [mm,:mmsU]
+  if mmsE then
+    sayMms(op,mmsE,'"exposed") where
+      sayMms(op,mms,label) ==
+        m := # mms
+        sayMSG
+          m = 1 =>
+            ['"There is one",:bright label,'"function called",
+              :bright op,'":"]
+          ['"There are ",m,:bright label,'"functions called",
+            :bright op,'":"]
+        for mm in mms for i in 1.. repeat
+          sayModemapWithNumber(mm,i)
+  if mmsU then
+    if mmsE then sayNewLine()
+    sayMms(op,mmsU,'"unexposed")
+  nil
+
+formatOpType (form:=[op,:argl]) ==
+  null argl => unabbrev op
+  form2String [unabbrev op, :argl]
+
+formatOperationAlistEntry (entry:= [op,:modemaps]) ==
+  -- alist has entries of the form: ((op sig) . pred)
+  -- opsig on this list => op is defined only when the predicate is true
+  ans:= nil
+  for [sig,.,:predtail] in modemaps repeat
+    pred := (predtail is [p,:.] => p; 'T)
+    -- operation is always defined
+    ans :=
+      [concat(formatOpSignature(op,sig),formatIf pred),:ans]
+  ans
+
+formatOperation([[op,sig],.,[fn,.,n]],domain) ==
+  opSigString := formatOpSignature(op,sig)
+  INTEGERP n and Undef = KAR domain.n =>
+    if INTEGERP $commentedOps then $commentedOps := $commentedOps + 1
+    concat(" --",opSigString)
+  opSigString
+
+formatOpSignature(op,sig) ==
+  concat('%b,formatOpSymbol(op,sig),'%d,": ",formatSignature sig)
+
+formatOpConstant op ==
+  concat('%b,formatOpSymbol(op,'($)),'%d,'": constant")
+
+formatOpSymbol(op,sig) ==
+  if op = 'Zero then op := "0"
+  else if op = 'One then op := "1"
+  null sig => op
+  quad := specialChar 'quad
+  n := #sig
+  (op = 'elt) and (n = 3) =>
+    (CADR(sig) = '_$) =>
+      STRINGP (sel := CADDR(sig)) =>
+        [quad,".",sel]
+      [quad,".",quad]
+    op
+  STRINGP op or GET(op,"Led") or GET(op,"Nud") =>
+    n = 3 =>
+      if op = 'SEGMENT then op := '".."
+      op = 'in => [quad,'" ",op,'" ",quad]
+-- stop exquo from being displayed as infix (since it is not accepted
+-- as such by the interpreter)
+      op = 'exquo => op
+      [quad,op,quad]
+    n = 2 =>
+      not GET(op,"Nud") => [quad,op]
+      [op,quad]
+    op
+  op
+
+formatAttribute x ==
+  atom x => ["  ",x]
+  x is [op,:argl] =>
+    for x in argl repeat
+      argPart:= NCONC(argPart,concat(",",formatAttributeArg x))
+    argPart => concat("  ",op,"_(",rest argPart,"_)")
+    ["  ",op]
+
+formatAttributeArg x ==
+  STRINGP x and x ='"*" => "_"*_""
+  atom x => formatOpSymbol (x,nil)
+  x is [":",op,["Mapping",:sig]] =>
+    concat('%b,formatOpSymbol(op,sig),": ",'%d,formatMapping sig)
+  prefix2String0 x
+
+formatMapping sig ==
+  "STRCONC"/concat("Mapping(",formatSignature sig,")")
+
+dollarPercentTran x ==
+    -- Translate $ to %. We actually return %% so that the message
+    -- printer will display a single %
+    x is [y,:z] =>
+        y1 := dollarPercentTran y
+        z1 := dollarPercentTran z
+        EQ(y, y1) and EQ(z, z1) => x
+        [y1, :z1]
+    x = "$" or x = '"$" => "%%"
+    x
+
+formatSignatureAsTeX sig == 
+  $formatSigAsTeX: local := 2
+  formatSignature0 sig
+
+formatSignature sig ==
+  $formatSigAsTeX: local := 1
+  formatSignature0 sig
+
+formatSignatureArgs sml ==
+  $formatSigAsTeX: local := 1
+  formatSignatureArgs0 sml
+  
+formatSignature0 sig ==
+  null sig => "() -> ()"
+  INTEGERP sig => '"hashcode"
+  [tm,:sml] := sig
+  sourcePart:= formatSignatureArgs0 sml
+  targetPart:= prefix2String0 tm
+  dollarPercentTran concat(sourcePart,concat(" -> ",targetPart))
+
+formatSignatureArgs0(sml) ==
+-- formats the arguments of a signature
+  null sml => ["_(_)"]
+  null rest sml => prefix2String0 first sml
+  argList:= prefix2String0 first sml
+  for m in rest sml repeat
+    argList:= concat(argList,concat(",",prefix2String0 m))
+  concat("_(",concat(argList,"_)"))
+
+--% Conversions to string form
+
+expr2String x ==
+  atom (u:= prefix2String0 x) => u
+  "STRCONC"/[atom2String y for y in u]
+
+-- exports (this is a badly named bit of sillyness)
+prefix2StringAsTeX form ==
+  form2StringAsTeX form
+
+prefix2String form ==
+  form2String form
+
+-- local version
+prefix2String0 form ==
+  form2StringLocal form
+
+--  SUBRP form => formWrapId BPINAME form
+--  atom form =>
+--    form=$EmptyMode or form=$quadSymbol => formWrapId specialChar 'quad
+--    STRINGP form => formWrapId form
+--    IDENTP form => 
+--      constructor? form => app2StringWrap(formWrapId form, [form])
+--      formWrapId form
+--    formWrapId STRINGIMAGE form
+
+form2StringWithWhere u ==
+  $permitWhere : local := true
+  $whereList: local := nil
+  s:= form2String u
+  $whereList => concat(s,'%b,'"where",'%d,"%i",$whereList,"%u")
+  s
+
+form2StringWithPrens form ==
+  null (argl := rest form) => [first form]
+  null rest argl => [first form,"(",first argl,")"]
+  form2String form
+
+formString u ==
+  x := form2String u
+  atom x => STRINGIMAGE x
+  "STRCONC"/[STRINGIMAGE y for y in x]
+
+form2String u == 
+  $formatSigAsTeX: local := 1
+  form2StringLocal u
+
+form2StringAsTeX u == 
+  $formatSigAsTeX: local := 2
+  form2StringLocal u
+
+form2StringLocal u ==
+--+
+  $NRTmonitorIfTrue : local := nil
+  $fortInts2Floats  : local := nil
+  form2String1 u
+
+constructorName con ==
+  $abbreviateTypes => abbreviate con
+  con
+
+form2String1 u ==
+  ATOM u => 
+    u=$EmptyMode or u=$quadSymbol => formWrapId specialChar 'quad
+    IDENTP u =>
+      constructor? u => app2StringWrap(formWrapId u, [u])
+      u
+    SUBRP u => formWrapId BPINAME u
+    STRINGP u => formWrapId u
+    WRITE_-TO_-STRING formWrapId u
+  u1 := u
+  op := CAR u
+  argl := CDR u
+  op='Join or op= 'mkCategory => formJoin1(op,argl)
+  $InteractiveMode and (u:= constructor? op) =>
+    null argl => app2StringWrap(formWrapId constructorName op, u1)
+    op = "NTuple"  => [ form2String1 first argl, "*"]
+    op = "Map"     => ["(",:formatSignature0 [argl.1,argl.0],")"]
+    op = 'Record => record2String(argl)
+    null (conSig := getConstructorSignature op) =>
+      application2String(constructorName op,[form2String1(a) for a in argl], u1)
+    ml := rest conSig
+    if not freeOfSharpVars ml then
+      ml:=SUBLIS([[pvar,:val] for pvar in $FormalMapVariableList
+        for val in argl], ml)
+    argl:= formArguments2String(argl,ml)
+      -- extra null check to handle mutable domain hack.
+    null argl => constructorName op
+    application2String(constructorName op,argl, u1)
+  op = "Mapping" => ["(",:formatSignature argl,")"]
+  op = "Record" => record2String(argl)
+  op = 'Union  =>
+    application2String(op,[form2String1 x for x in argl], u1)
+  op = ":" =>
+      null argl => [ '":" ]
+      null rest argl => [ '":", form2String1 first argl ]
+      formDecl2String(argl.0,argl.1)
+  op = "#" and PAIRP argl and LISTP CAR argl =>
+    STRINGIMAGE SIZE CAR argl
+  op = 'Join => formJoin2String argl
+  op = "ATTRIBUTE" => form2String1 first argl
+  op='Zero => 0
+  op='One => 1
+  op = 'AGGLST => tuple2String argl
+  op = 'BRACKET =>
+    argl' := form2String1 first argl
+    ["[",:(atom argl' => [argl']; argl'),"]"]
+  op = "SIGNATURE" =>
+     [operation,sig] := argl
+     concat(operation,": ",formatSignature sig)
+  op = 'COLLECT => formCollect2String argl
+  op = 'construct =>
+    concat(lbrkSch(),
+           tuple2String [form2String1 x for x in argl],rbrkSch())
+  op = "SEGMENT" =>
+    null argl => '".."
+    lo := form2String1 first argl
+    argl := rest argl
+    (null argl) or null (first argl) => [lo, '".."]
+    [lo, '"..", form2String1 first argl]
+  isBinaryInfix op => fortexp0 [op,:argl]
+  -- COMPILED_-FUNCTION_-P(op) => form2String1 coerceMap2E(u1,NIL)
+  application2String(op,[form2String1 x for x in argl], u1)
+
+formWrapId id == 
+  $formatSigAsTeX = 1 => id
+  $formatSigAsTeX = 2 => 
+    sep := '"`"
+    FORMAT(NIL,'"\verb~a~a~a",sep, id, sep)
+  error "Bad formatSigValue"
+
+formArguments2String(argl,ml) == [fn(x,m) for x in argl for m in ml] where
+  fn(x,m) ==
+    x=$EmptyMode or x=$quadSymbol => specialChar 'quad
+    STRINGP(x) or IDENTP(x) => x
+    x is [ ='_:,:.] => form2String1 x
+    isValidType(m) and PAIRP(m) and
+      (GETDATABASE(first(m),'CONSTRUCTORKIND) = 'domain) =>
+        (x' := coerceInteractive(objNewWrap(x,m),$OutputForm)) =>
+          form2String1 objValUnwrap x'
+        form2String1 x
+    form2String1 x
+
+formDecl2String(left,right) ==
+  $declVar: local := left
+  whereBefore := $whereList
+  ls:= form2StringLocal left
+  rs:= form2StringLocal right
+  NE($whereList,whereBefore) and $permitWhere => ls
+  concat(form2StringLocal ls,'": ",rs)
+
+formJoin1(op,u) ==
+  if op = 'Join then [:argl,last] := u else (argl := nil; last := [op,:u])
+  last is [id,.,:r] and id in '(mkCategory CATEGORY) =>
+    $abbreviateJoin = true => concat(formJoin2 argl,'%b,'"with",'%d,'"...")
+    $permitWhere = true =>
+      opList:= formatJoinKey(r,id)
+      $whereList:= concat($whereList,"%l",$declVar,": ",
+        formJoin2 argl,'%b,'"with",'%d,"%i",opList,"%u")
+      formJoin2 argl
+    opList:= formatJoinKey(r,id)
+    suffix := concat('%b,'"with",'%d,"%i",opList,"%u")
+    concat(formJoin2 argl,suffix)
+  formJoin2 u
+
+formatJoinKey(r,key) ==
+  key = 'mkCategory =>
+    r is [opPart,catPart,:.] =>
+      opString :=
+        opPart is [='LIST,:u] =>
+          "append"/[concat("%l",formatOpSignature(op,sig),formatIf pred)
+            for [='QUOTE,[[op,sig],pred]] in u]
+        nil
+      catString :=
+        catPart is [='LIST,:u] =>
+          "append"/[concat("%l",'" ",form2StringLocal con,formatIf pred)
+            for [='QUOTE,[con,pred]] in u]
+        nil
+      concat(opString,catString)
+    '"?? unknown mkCategory format ??"
+  -- otherwise we have the CATEGORY form
+  "append"/[fn for x in r] where fn ==
+    x is ['SIGNATURE,op,sig] => concat("%l",formatOpSignature(op,sig))
+    x is ['ATTRIBUTE,a] => concat("%l",formatAttribute a)
+    x
+
+formJoin2 argl ==
+-- argl is a list of categories NOT containing a "with"
+  null argl => '""
+  1=#argl => form2StringLocal argl.0
+  application2String('Join,[form2StringLocal x for x in argl], NIL)
+
+formJoin2String (u:=[:argl,last]) ==
+  last is ["CATEGORY",.,:atsigList] =>
+    postString:= concat("_(",formTuple2String atsigList,"_)")
+    #argl=1 => concat(first argl,'" with ",postString)
+    concat(application2String('Join,argl, NIL)," with ",postString)
+  application2String('Join,u, NIL)
+
+formCollect2String [:itl,body] ==
+  ["_(",body,:"append"/[formIterator2String x for x in itl],"_)"]
+
+formIterator2String x ==
+  x is ["STEP",y,s,.,:l] =>
+    tail:= (l is [f] => form2StringLocal f; nil)
+    concat("for ",y," in ",s,'"..",tail)
+  x is ["tails",y] => concat("tails ",formatIterator y)
+  x is ["reverse",y] => concat("reverse ",formatIterator y)
+  x is ["|",y,p] => concat(formatIterator y," | ",form2StringLocal p)
+  x is ["until",p] => concat("until ",form2StringLocal p)
+  x is ["while",p] => concat("while ",form2StringLocal p)
+  systemErrorHere "formatIterator"
+
+tuple2String argl ==
+  null argl => nil
+  string := first argl
+  if string in '("failed" "nil" "prime" "sqfr" "irred")
+    then string := STRCONC('"_"",string,'"_"")
+    else string :=
+      ATOM string => object2String string
+      [f x for x in string] where
+        f x ==
+          ATOM x => object2String x
+          -- [f CAR x,:f CDR x]
+          [f y for y in x]
+  for x in rest argl repeat
+    if x in '("failed" "nil" "prime" "sqfr" "irred") then
+      x := STRCONC('"_"",x,'"_"")
+    string:= concat(string,concat(",",f x))
+  string
+
+script2String s ==
+  null s => '""   -- just to be safe
+  if not PAIRP s then s := [s]
+  linearFormatForm(CAR s, CDR s)
+
+linearFormatName x ==
+  atom x => x
+  linearFormat x
+
+linearFormat x ==
+  atom x => x
+  x is [op,:argl] and atom op =>
+    argPart:=
+      argl is [a,:l] => [a,:"append"/[[",",x] for x in l]]
+      nil
+    [op,"(",:argPart,")"]
+  [linearFormat y for y in x]
+
+numOfSpadArguments id ==
+  char("*") = (s:= PNAME id).0 =>
+      +/[n for i in 1.. while INTEGERP (n:=PARSE_-INTEGER PNAME s.i)]
+  keyedSystemError("S2IF0012",[id])
+
+linearFormatForm(op,argl) ==
+  s:= PNAME op
+  indexList:= [PARSE_-INTEGER PNAME d for i in 1.. while
+    (DIGITP (d:= s.(maxIndex:= i)))]
+  cleanOp:= INTERN ("STRCONC"/[PNAME s.i for i in maxIndex..MAXINDEX s])
+  fnArgs:=
+    indexList.0 > 0 =>
+      concat('"(",formatArgList take(-indexList.0,argl),'")")
+    nil
+  if #indexList > 1 then
+    scriptArgs:= formatArgList take(indexList.1,argl)
+    argl := drop(indexList.1,argl)
+    for i in rest rest indexList repeat
+      subArglist:= take(i,argl)
+      argl:= drop(i,argl)
+      scriptArgs:= concat(scriptArgs,";",formatArgList subArglist)
+  scriptArgs:=
+    scriptArgs => concat(specialChar 'lbrk,scriptArgs, specialChar 'rbrk)
+    nil
+  l := [(STRINGP f => f; STRINGIMAGE f) for f in
+       concat(cleanOp,scriptArgs,fnArgs)]
+  "STRCONC"/l
+
+formatArgList l ==
+  null l => nil
+  acc:= linearFormat first l
+  for x in rest l repeat
+    acc:= concat(acc,",",linearFormat x)
+  acc
+
+formTuple2String argl ==
+  null argl => nil
+  string:= form2StringLocal first argl
+  for x in rest argl repeat
+    string:= concat(string,concat(",",form2StringLocal x))
+  string
+
+isInternalFunctionName(op) ==
+  (not IDENTP(op)) or (op = "*") or (op = "**") => NIL
+  (1 = SIZE(op':= PNAME op)) or (char("*") ^= op'.0) => NIL
+  -- if there is a semicolon in the name then it is the name of
+  -- a compiled spad function
+  null (e := STRPOS('"_;",op',1,NIL)) => NIL
+  (char(" ") = (y := op'.1)) or (char("*") = y) => NIL
+  table := MAKETRTTABLE('"0123456789",NIL)
+  s := STRPOSL(table,op',1,true)
+  null(s) or s > e => NIL
+  SUBSTRING(op',s,e-s)
+
+application2String(op,argl, linkInfo) ==
+  null argl =>
+    (op' := isInternalFunctionName(op)) => op'
+    app2StringWrap(formWrapId op, linkInfo)
+  1=#argl =>
+    first argl is ["<",:.] => concat(op,first argl)
+    concat(app2StringWrap(formWrapId op, linkInfo)," ",first argl)
+--op in '(UP SM) =>
+--  newop:= (op = "UP" => "P";"M")
+--  concat(newop,concat(lbrkSch(),argl.0,rbrkSch(),argl.1))
+--op='RM  =>concat("M",concat(lbrkSch(),
+--                     argl.0,",",argl.1,rbrkSch(),argl.2))
+--op='MP =>concat("P",concat(argl.0,argl.1))
+  op='SEGMENT =>
+    null argl => '".."
+    (null rest argl) or (null first rest argl) =>
+      concat(first argl, '"..")
+    concat(first argl, concat('"..", first rest argl))
+  concat(app2StringWrap(formWrapId op, linkInfo) ,
+			concat("_(",concat(tuple2String argl,"_)")))
+
+app2StringConcat0(x,y) ==
+  FORMAT(NIL, '"~a ~a", x, y)
+
+app2StringWrap(string, linkInfo) ==
+  not linkInfo => string
+  $formatSigAsTeX = 1 => string
+  $formatSigAsTeX = 2 =>
+    str2 :=  "app2StringConcat0"/form2Fence linkInfo
+    sep := '"`"
+    FORMAT(NIL, '"\lispLink{\verb!(|conPage| '~a)!}{~a}", 
+          str2, string)
+  error "Bad value for $formatSigAsTeX"
+
+record2String x ==
+  argPart := NIL
+  for [":",a,b] in x repeat argPart:=
+    concat(argPart,",",a,": ",form2StringLocal b)
+  null argPart => '"Record()"
+  concat("Record_(",rest argPart,"_)")
+
+plural(n,string) ==
+  suffix:=
+    n = 1 => '""
+    '"s"
+  [:bright n,string,suffix]
+
+formatIf pred ==
+  not pred => nil
+  pred in '(T (QUOTE T)) => nil
+  concat('%b,'"if",'%d,pred2English pred)
+
+formatPredParts s ==
+  s is ['QUOTE,s1] => formatPredParts s1
+  s is ['LIST,:s1] => [formatPredParts s2 for s2 in s1]
+  s is ['devaluate,s1] => formatPredParts s1
+  s is ['getDomainView,s1,.] => formatPredParts s1
+  s is ['SUBST,a,b,c] =>    -- this is a signature
+    s1 := formatPredParts SUBST(formatPredParts a,b,c)
+    s1 isnt [fun,sig] => s1
+    ['SIGNATURE,fun,[formatPredParts(r) for r in sig]]
+  s
+
+pred2English x ==
+  x is ['IF,cond,thenClause,elseClause] =>
+    c := concat('"if ",pred2English cond)
+    t := concat('" then ",pred2English thenClause)
+    e := concat('" else ",pred2English elseClause)
+    concat(c,t,e)
+  x is ['AND,:l] =>
+    tail:="append"/[concat(bright '"and",pred2English x) for x in rest l]
+    concat(pred2English first l,tail)
+  x is ['OR,:l] =>
+    tail:= "append"/[concat(bright '"or",pred2English x) for x in rest l]
+    concat(pred2English first l,tail)
+  x is ['NOT,l] =>
+    concat('"not ",pred2English l)
+  x is [op,a,b] and op in '(has ofCategory) =>
+    concat(pred2English a,'%b,'"has",'%d,form2String abbreviate b)
+  x is [op,a,b] and op in '(HasSignature HasAttribute HasCategory) =>
+    concat(prefix2String0 formatPredParts a,'%b,'"has",'%d,
+      prefix2String0 formatPredParts b)
+  x is [op,a,b] and op in '(ofType getDomainView) =>
+    if b is ['QUOTE,b'] then b := b'
+    concat(pred2English a,'": ",form2String abbreviate b)
+  x is [op,a,b] and op in '(isDomain domainEqual) =>
+    concat(pred2English a,'" = ",form2String abbreviate b)
+  x is [op,:.] and (translation := LASSOC(op,'(
+    (_< . " < ") (_<_= . " <= ")
+      (_> . " > ") (_>_= . " >= ") (_=  . " = ") (_^_= . " _^_= ")))) =>
+        concat(pred2English a,translation,pred2English b)
+  x is ['ATTRIBUTE,form] =>
+    concat("attribute: ",form2String form)
+  form2String x
+
+object2String x ==
+  STRINGP x => x
+  IDENTP x  => PNAME x
+  NULL x    => '""
+  PAIRP  x  => STRCONC(object2String first x, object2String rest x)
+  WRITE_-TO_-STRING x
+
+object2Identifier x ==
+  IDENTP x  => x
+  STRINGP x => INTERN x
+  INTERN WRITE_-TO_-STRING x
+
+blankList x == "append"/[[BLANK,y] for y in x]
+--------------------> NEW DEFINITION (see cformat.boot.pamphlet)
+pkey keyStuff ==
+    if not PAIRP keyStuff then keyStuff := [keyStuff]
+    allMsgs := ['" "]
+    while not null keyStuff repeat
+        dbN := NIL
+        argL := NIL
+        key := first keyStuff
+        keyStuff := IFCDR keyStuff
+        next := IFCAR keyStuff
+        while PAIRP next repeat
+            if CAR next = 'dbN then dbN := CADR next
+            else argL := next
+            keyStuff  := IFCDR keyStuff
+            next      := IFCAR keyStuff
+        oneMsg  := returnStLFromKey(key,argL,dbN)
+        allMsgs := ['" ", :NCONC (oneMsg,allMsgs)]
+    allMsgs
+
+string2Float s ==
+  -- takes a string, calls the parser on it and returns a float object
+  p := ncParseFromString s
+  p isnt [["$elt", FloatDomain, "float"], x, y, z] =>
+    systemError '"string2Float: did not get a float expression"
+  flt := getFunctionFromDomain("float", FloatDomain,
+    [$Integer, $Integer, $PositiveInteger])
+  SPADCALL(x, y, z, flt)
+
+
+
+form2Fence form == 
+  -- body of dbMkEvalable
+  [op, :.] := form
+  kind := GETDATABASE(op,'CONSTRUCTORKIND)
+  kind = 'category => form2Fence1 form
+  form2Fence1 mkEvalable form
+
+form2Fence1 x ==
+  x is [op,:argl] =>
+    op = 'QUOTE => ['"(QUOTE ",:form2FenceQuote first argl,'")"]
+    ['"(", FORMAT(NIL, '"|~a|", op),:"append"/[form2Fence1 y for y in argl],'")"]
+  IDENTP x => FORMAT(NIL, '"|~a|", x)
+--  [x]
+  ['"  ", x]
+
+form2FenceQuote x ==
+  NUMBERP x => [STRINGIMAGE x]
+  SYMBOLP x => [FORMAT(NIL, '"|~a|", x)]
+  atom    x => '"??"   
+  ['"(",:form2FenceQuote first x,:form2FenceQuoteTail rest x]
+
+form2FenceQuoteTail x ==
+  null x => ['")"]
+  atom x => ['" . ",:form2FenceQuote x,'")"]
+  ['" ",:form2FenceQuote first x,:form2FenceQuoteTail rest x]
+
+form2StringList u ==
+  atom (r := form2String u) => [r]
+  r
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}