aboutsummaryrefslogtreecommitdiff
path: root/src/interp/format.boot.pamphlet
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2007-09-20 03:47:46 +0000
committerdos-reis <gdr@axiomatics.org>2007-09-20 03:47:46 +0000
commit9b71e0a1f285fc207709cf8e90721160af299127 (patch)
tree3e64539a50da8370ac70d3556a34b4ddb67627bc /src/interp/format.boot.pamphlet
parenta0ea803003aecec7b3dfa8a0c1126fc439519d8f (diff)
downloadopen-axiom-9b71e0a1f285fc207709cf8e90721160af299127.tar.gz
remove pamphlets - part 3
Diffstat (limited to 'src/interp/format.boot.pamphlet')
-rw-r--r--src/interp/format.boot.pamphlet802
1 files changed, 0 insertions, 802 deletions
diff --git a/src/interp/format.boot.pamphlet b/src/interp/format.boot.pamphlet
deleted file mode 100644
index e4c83a31..00000000
--- a/src/interp/format.boot.pamphlet
+++ /dev/null
@@ -1,802 +0,0 @@
-\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}