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:
fricas
(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(" -> ",