On Tue, Sep 16, 2008 at 11:11 PM Waldek Hebisch wrote:

The patch below is a first shot at better unparse. The last hunk add parentheses around single argument - this fixes the sin x+1 problem. The rest of the patch is rewritten binop2String. I hope that large class of expressions (including polynomials) will be printed without useless parentheses, however all cases where we are unsure if parenthesis are needed will now get them.

On Thu, Sep 18, 2008 at 10:07 AM Waldek Hebisch wrote:

Below is improved patch: I have cleaned code a bit and added support for '::', '@', $ (package calls) and pretend. I keep handling of / and unary minus like in original patch.

src/interp/format.boot:

(1) -> <boot>
-- 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.

--% 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 GETL(op,"Led") or GETL(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 GETL(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]
  -- op = "MATRIX" => op
  -- does no work
  -- fortranCleanUp exp2Fort1 [op,:argl]
  -- somewhat works, but causes regression
  -- fortranCleanUp exp2Fort1 exp2FortOptimize [op,:argl]
  u1 is ["$elt", t, f] =>
     concat(form2String1 f, '"$", form2String1 t)
  #argl = 2 and (isBinaryInfix op or op = "::" or op = '"::"_
     or op = "@" or op = '"@" or op = "pretend" or op = '"pretend") =>
          binop2String [op,:argl]
  application2String(op,[form2String1 x for x in argl], u1)

binop2String x ==
    --$curOp : local := CAR x
    $curExpr : local := x
    x is ["=", arg1, arg2] or x is ['"=", arg1, arg2] =>
        concat(sumOrParen(arg1), '"=", sumOrParen(arg2))
        sumOrParen(x)
    sumOrParen(x)

sumOrParen(x) ==
   x is [op, arg1, arg2] =>
       op = "+" or op = '"+" =>
           concat(sumOrParen(arg1), '"+", productOrParen(arg2))
       op = "-" or op = '"-" =>
           concat(sumOrParen(arg1), '"-", productOrParen(arg2))
       op = "/" or op = '"/" =>
           concat(appOrParen(arg1), '"/", appOrParen(arg2))
       productOrParen(x)
   productOrParen(x)

productOrParen(x) ==
   x is [op, arg1, arg2] =>
       op = "*" or op ='"*" =>
           concat(productOrParen(arg1), '"*",  powerOrParen(arg2))
       powerOrParen(x)
   powerOrParen(x)

powerOrParen(x) ==
   x is [op, arg1, arg2] =>
      op = "**" or op = '"**" or op = "^" or op = '"^"  =>
           concat(coerceOrParen(arg1), '"^", coerceOrParen(arg2))
      coerceOrParen(x)
   coerceOrParen(x)

coerceOrParen(x) ==
   x is [op, arg1, arg2] =>
      op = "::" or op = '"::" =>
           concat(coerceOrParen(arg1), '"::", appOrParen(arg2))
      op = "@" or op = '"@" =>
           concat(coerceOrParen(arg1), '"@", appOrParen(arg2))
      op = "pretend" or op = '"pretend" =>
           concat(coerceOrParen(arg1), '" ", '"pretend", '" ",_
                   appOrParen(arg2))
      appOrParen(x)
   appOrParen(x)

appOrParen(x) ==
   SYMBOLP(x) => formWrapId x
   INTEGERP(x) => WRITE_-TO_-STRING x
   ATOM(x) => concat('"(", form2String1(x), '")")
   [op, :argl] := x
   (op = "-" or op = '"-") and #argl = 1 =>
       concat('"(", '"-", appOrParen(first argl), '")")
   --op = $curOp => BREAK()
   EQ(x, $curExpr) => BREAK()
   op is ["$elt", f, t] =>
       form2String1 x
   -- Put parenthesis around anything special
   not(SYMBOLP op) or GET(op, "Led") or GET(op, "Nud")_
     or op= 'mkCategory or op = "SEGMENT" _
     or op = 'construct or op = 'COLLECT or op = "SIGNATURE"_
     or op = 'BRACKET or op = 'AGGLST or op = "ATTRIBUTE"_
     or op = "#" =>
        concat('"(", form2String1(x), '")")
   op = "Zero" => '"0"
   op = "One" => '"1"
   form2String1 x

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) ==
  op is ["$elt", t, f] =>
      concat(application2String(f, argl, linkInfo), '"$", _
             form2String1 t)
  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

mathObject2String x ==
  CHARACTERP x => COERCE([x],'STRING)
  object2String 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</boot>

   The file 
      /var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/950355460378617197-25px001.boot
      is needed but does not exist.

Tests

Waldek: I found the following (stolen form fortpak.spad) useful when experimenting with InputForm:

parse(s:String):InputForm == ncParseFromString(s)$Lisp::InputForm

   Function declaration parse : String -> InputForm has been added to 
      workspace.

Here are a few examples:

unparse(sin(x)::InputForm)

(1)

unparse(sin(x+1)::InputForm)

(2)

parse(%)

Compiling function parse with type String -> InputForm

(3)

interpret(%)$InputForm

(4)

integrate(sin(x)^2+cos(x+1)^2,x)

(5)

For some reason this result causes a tex error.

)set output tex off
 

)set output algebra on

%::InputForm

   (7)
   (+  (* (* (+ (* - 1 (^ (cos 1) 2)) 1) (cos (+ x 1))) (sin (+ x 1)))
    (+ (* (* (cos 1) (sin 1)) (^ (cos (+ x 1)) 2)) x))

unparse(%)

   (8)  "((-1)*cos(1)^2+1)*cos(x+1)*sin(x+1)+(cos(1)*sin(1)*cos(x+1)^2+x)"

parse(%)

   (9)
   (+  (* (* (+ (* (- 1) (^ (cos 1) 2)) 1) (cos (+ x 1))) (sin (+ x 1)))
    (+ (* (* (cos 1) (sin 1)) (^ (cos (+ x 1)) 2)) x))

)set output tex on
 

)set output algebra off

interpret(%)$InputForm

(6)

Check for extra parenthesis

)set output tex off
 

)set output algebra on

unparse(parse("sin(x)^2"))

   (11)  "sin(x)^2"

unparse(parse("1+Gamma(x,y)"))

   (12)  "1+Gamma(x,y)"

Precedence of / and *

parse("a/b*c*d")

   (13)  (* (* (/ a b) c) d)

unparse(%)

   (14)  "(a/b)*c*d"

parse("a*b/c*d")

   (15)  (* (/ (* a b) c) d)

unparse(%)

   (16)  "((a*b)/c)*d"

parse("a*b/c/d")

   (17)  (/ (/ (* a b) c) d)

unparse(%)

   (18)  "((a*b)/c)/d"

parse("a/b/c/d")

   (19)  (/ (/ (/ a b) c) d)

unparse(%)

   (20)  "((a/b)/c)/d"

parse("(a*b)/(c*d)")

   (21)  (/ (* a b) (* c d))

unparse(%)

   (22)  "(a*b)/(c*d)"

Need to handle ::

integrate(1/sin(exp x)^2,x)

            x
          ++           1
   (23)   |   - -------------- d%A
         ++           %A 2
                cos(%e  )  - 1

%::InputForm

   (24)  (integral (/ - 1 (+ (^ (cos (exp x)) 2) - 1)) (:: x Symbol))

unparse(%)

   (25)  "integral((-1)/(cos(exp(x))^2+(-1)),x::Symbol)"

parse(%)

   (26)  (integral (/ (- 1) (+ (^ (cos (exp x)) 2) (- 1))) (:: x Symbol))

Know Problems

Not all values can be coerced to InputForm

(x^3+1)::Polynomial PF(5)

          3
   (27)  x  + 1

%::InputForm

   (28)
   (+  (* (($elt (PrimeField 5) index) 1) (^ x 3))
    (($elt (PrimeField 5) index) 1))

)set output tex on
 

)set output algebra off