login  home  contents  what's new  discussion  bug reports     help  links  subscribe  changes  refresh  edit

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:

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
 
   >> System error:
   invalid number of arguments: 1
; compiling file "/var/aw/var/LatexWiki/950355460378617197-25px001.clisp" (written 01 MAR 2010 10:25:37 PM):
; /var/aw/var/LatexWiki/950355460378617197-25px001.fasl written ; compilation finished in 0:00:00.263 Value = T

Tests

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

fricas
parse(s:String):InputForm == ncParseFromString(s)$Lisp::InputForm
>> System error: The function BOOT::BOOT-EQUAL is undefined.

Here are a few examples:

fricas
unparse(sin(x)::InputForm)
>> System error: The function BOOT::BOOT-EQUAL is undefined.

For some reason this result causes a tex error.

fricas
)set output tex off
 
fricas
)set output algebra on

fricas
%::InputForm
(1) %
>> System error: The function BOOT::BOOT-EQUAL is undefined.

fricas
)set output tex on
 
fricas
)set output algebra off

fricas
interpret(%)$InputForm

\label{eq1}\%(1)
fricas
>> System error:
   The function BOOT::BOOT-EQUAL is undefined.

Check for extra parenthesis

fricas
)set output tex off
 
fricas
)set output algebra on

fricas
unparse(parse("sin(x)^2"))
>> System error: The function BOOT::BOOT-EQUAL is undefined.

Precedence of / and *

fricas
parse("a/b*c*d")
>> System error: The function BOOT::BOOT-EQUAL is undefined.

Need to handle ::

fricas
integrate(1/sin(exp x)^2,x)
x ++ 1 (1) | - -------------- d%A ++ %A 2 cos(%e ) - 1
>> System error: The function BOOT::BOOT-EQUAL is undefined.

Know Problems

Not all values can be coerced to InputForm

fricas
(x^3+1)::Polynomial PF(5)
3 (1) x + 1
>> System error: The function BOOT::BOOT-EQUAL is undefined.

fricas
)set output tex on
 
fricas
)set output algebra off




  Subject:   Be Bold !!
  ( 13 subscribers )  
Please rate this page: