Allow adding additional sub/superscripts to symbols.
spad
)abbrev domain SYMBOL Symbol
++ Author: Stephen Watt
++ Date Created: 1986
++ Date Last Updated: 7 Mar 1991, 29 Apr. 1994 (FDLL)
++ Description:
++ Basic and scripted symbols.
++ Keywords: symbol.
Symbol() : Exports == Implementation where
L ==> List OutputForm
Scripts ==> Record(sub : L, sup : L, presup : L, presub : L, args : L)
Exports ==> Join(OrderedSet, ConvertibleTo InputForm, OpenMath,
ConvertibleTo Symbol,
ConvertibleTo Pattern Integer, ConvertibleTo Pattern Float,
PatternMatchable Integer, PatternMatchable Float) with
new : () -> %
++ new() returns a new symbol whose name starts with %.
new : % -> %
++ new(s) returns a new symbol whose name starts with %s.
resetNew : () -> Void
++ resetNew() resets the internals counters that new() and
++ new(s) use to return distinct symbols every time.
coerce : String -> %
++ coerce(s) converts the string s to a symbol.
name : % -> %
++ name(s) returns s without its scripts.
scripted? : % -> Boolean
++ scripted?(s) is true if s has been given any scripts.
scripts : % -> Scripts
++ scripts(s) returns all the scripts of s.
script : (%, List L) -> %
++ script(s, [a, b, c, d, e]) returns s with subscripts a,
++ superscripts b, pre-superscripts c, pre-subscripts d,
++ and argument-scripts e. Omitted components are taken to be empty.
++ For example, \spad{script(s, [a, b, c])} is equivalent to
++ \spad{script(s, [a, b, c, [], []])}.
script : (%, Scripts) -> %
++ script(s, [a, b, c, d, e]) returns s with subscripts a,
++ superscripts b, pre-superscripts c, pre-subscripts d,
++ and argument-scripts e.
subscript : (%, L) -> %
++ subscript(s, [a1, ..., an]) returns s
++ subscripted by \spad{[a1, ..., an]}.
superscript : (%, L) -> %
++ superscript(s, [a1, ..., an]) returns s
++ superscripted by \spad{[a1, ..., an]}.
argscript : (%, L) -> %
++ argscript(s, [a1, ..., an]) returns s
++ arg-scripted by \spad{[a1, ..., an]}.
elt : (%, L) -> %
++ elt(s, [a1, ..., an]) or s([a1, ..., an]) returns s subscripted by \spad{[a1, ..., an]}.
string : % -> String
++ string(s) converts the symbol s to a string.
++ Error: if the symbol is subscripted.
sample : constant -> %
++ sample() returns a sample of %
Implementation ==> add
import from Character
import from List(OutputForm)
import from List(%)
count : Reference(Integer) := ref 0
xcount : AssociationList(%, Integer) := empty()
istrings : PrimitiveArray(String) :=
construct ["0","1","2","3","4","5","6","7","8","9"]
-- the following 3 strings shall be of empty intersection
nums:String := "0123456789"
ALPHAS:String := "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
alphas:String := "abcdefghijklmnopqrstuvwxyz"
writeOMSym(dev : OpenMathDevice, x : %) : Void ==
scripted? x =>
error "Cannot convert a scripted symbol to OpenMath"
OMputVariable(dev, x pretend Symbol)
OMwrite(dev : OpenMathDevice, x : %, wholeObj : Boolean) : Void ==
if wholeObj then
OMputObject(dev)
writeOMSym(dev, x)
if wholeObj then
OMputEndObject(dev)
hd:String := "*"
lhd := #hd
ord0 := ord char("0")$Character
pcnt ==> 4
istring : Integer -> String
syprefix : Scripts -> String
syscripts : Scripts -> L
convert(s : %) : InputForm == convert(s pretend Symbol)$InputForm
convert(s : %) : Symbol == s pretend Symbol
coerce(s : String) : % == VALUES(INTERN(s)$Lisp)$Lisp
x = y == EQUAL(x, y)$Lisp
hashUpdate!(hs, s) == update!(hs, SXHASH(s)$Lisp)$HashState
x < y == GGREATERP(y, x)$Lisp
coerce(x : %) : OutputForm ==
not(scripted? x) => outputForm(x pretend Symbol)
ss : Scripts := scripts x
rsl : List(L) := [ss.presub, ss.presup, ss.sup, ss.sub]
sl : L := []
for si in rsl repeat
empty?(sl) and empty?(si) => "iterate"
se :=
#si = 1 => first(si)
commaSeparate(si)
sl := cons(se, sl)
x0 := scripts(outputForm(name(x) pretend Symbol), sl)
a := ss.args
empty?(a) => x0
prefix(x0, a)
subscript(sy, lx) == script(sy, [lx, nil, nil(), nil(), nil()])
elt(sy, lx) == subscript(sy, lx)
superscript(sy, lx) == script(sy, [nil(), lx, nil(), nil(), nil()])
argscript(sy, lx) == script(sy, [nil(), nil(), nil(), nil(), lx])
patternMatch(x : %, p : Pattern Integer, l : PatternMatchResult(Integer, %))==
(patternMatch(x pretend Symbol, p, l pretend
PatternMatchResult(Integer, Symbol))$PatternMatchSymbol(Integer))
pretend PatternMatchResult(Integer, %)
patternMatch(x : %, p : Pattern Float, l : PatternMatchResult(Float, %)) ==
(patternMatch(x pretend Symbol, p, l pretend
PatternMatchResult(Float, Symbol))$PatternMatchSymbol(Float))
pretend PatternMatchResult(Float, %)
convert(x : %) : Pattern(Float) ==
coerce(x pretend Symbol)$Pattern(Float)
convert(x : %) : Pattern(Integer) ==
coerce(x pretend Symbol)$Pattern(Integer)
syprefix sc ==
ns : List Integer := [#sc.presub, #sc.presup, #sc.sup, #sc.sub]
concat concat(concat(hd, istring(#sc.args)),
[istring n for n in reverse! ns])
syscripts sc ==
all := sc.presub
all := concat(sc.presup, all)
all := concat(sc.sup, all)
all := concat(sc.sub, all)
concat(all, sc.args)
script(sy : %, ls : List L) ==
sc : Scripts := [nil(), nil(), nil(), nil(), nil()]
if not null ls then (sc.sub := first ls; ls := rest ls)
if not null ls then (sc.sup := first ls; ls := rest ls)
if not null ls then (sc.presup := first ls; ls := rest ls)
if not null ls then (sc.presub := first ls; ls := rest ls)
if not null ls then (sc.args := first ls; ls := rest ls)
script(sy, sc)
script(sy : %, sc : Scripts) ==
--scripted? sy => error "Cannot add scripts to a scripted symbol"
oldsc:=scripts(sy)
output("symbol oldsc: ",oldsc::OutputForm)$OutputPackage
newsc:Scripts := [concat(sc.sub,oldsc.sub), _
concat(sc.sup,oldsc.sup), _
concat(sc.presup,oldsc.presup), _
concat(sc.presub,oldsc.presub), _
concat(sc.args,oldsc.args)]
output("symbol newsc: ",newsc::OutputForm)$OutputPackage
(concat(concat(syprefix newsc, string name sy)::%::OutputForm,
syscripts newsc)) pretend %
string e ==
not scripted? e => PNAME(e)$Lisp
error "Cannot form string from non-atomic symbols."
-- Scripts ==> Record(sub: L, sup: L, presup: L, presub: L, args: L)
latex e ==
s : String := (PNAME(name e)$Lisp) pretend String
if #s > 1 and s.1 ~= char "\" then
s := concat("\mbox{\it ", concat(s, "}")$String)$String
not scripted? e => s
ss : Scripts := scripts e
lo : List OutputForm := ss.sub
sc : String
if not empty? lo then
sc := "__{"
while not empty? lo repeat
sc := concat(sc, latex first lo)$String
lo := rest lo
if not empty? lo then sc := concat(sc, ", ")$String
sc := concat(sc, "}")$String
s := concat(s, sc)$String
lo := ss.sup
if not empty? lo then
sc := "^{"
while not empty? lo repeat
sc := concat(sc, latex first lo)$String
lo := rest lo
if not empty? lo then sc := concat(sc, ", ")$String
sc := concat(sc, "}")$String
s := concat(s, sc)$String
lo := ss.presup
if not empty? lo then
sc := "{}^{"
while not empty? lo repeat
sc := concat(sc, latex first lo)$String
lo := rest lo
if not empty? lo then sc := concat(sc, ", ")$String
sc := concat(sc, "}")$String
s := concat(sc, s)$String
lo := ss.presub
if not empty? lo then
sc := "{}__{"
while not empty? lo repeat
sc := concat(sc, latex first lo)$String
lo := rest lo
if not empty? lo then sc := concat(sc, ", ")$String
sc := concat(sc, "}")$String
s := concat(sc, s)$String
lo := ss.args
if not empty? lo then
sc := "\left( {"
while not empty? lo repeat
sc := concat(sc, latex first lo)$String
lo := rest lo
if not empty? lo then sc := concat(sc, ", ")$String
sc := concat(sc, "} \right)")$String
s := concat(s, sc)$String
s
anyRadix(n : Integer, s : String) : String ==
ns:String := ""
repeat
qr := divide(n, #s)
n := qr.quotient
ns := concat(s.(qr.remainder+minIndex s), ns)
if zero?(n) then return ns
new() ==
sym := anyRadix(count()::Integer, ALPHAS)
count() := count() + 1
concat("%",sym)::%
new x ==
n : Integer :=
(u := search(x, xcount)) case "failed" => 0
inc(u::Integer)
xcount(x) := n
xx :=
not scripted? x => string x
string name x
xx := concat("%",xx)
xx :=
(position(xx.maxIndex(xx), nums)>=minIndex(nums)) =>
concat(xx, anyRadix(n, alphas))
concat(xx, anyRadix(n, nums))
not scripted? x => xx::%
script(xx::%, scripts x)
resetNew() ==
count() := 0
for k in keys xcount repeat remove!(k, xcount)
void
scripted? sy ==
not ATOM(sy)$Lisp
of_list(x : %) : L == x pretend L
name sy ==
not scripted? sy => sy
str := string(first(of_list(sy)) pretend %)
si := lhd + pcnt + 2
str(si..#str)::%
scripts sy ==
not scripted? sy => [nil(), nil(), nil(), nil(), nil()]
nscripts : List NonNegativeInteger := [0, 0, 0, 0, 0]
lscripts : List L := [nil(), nil(), nil(), nil(), nil()]
str := string(first(of_list(sy)) pretend %)
nstr := #str
m := minIndex nscripts
for i in m.. for j in (lhd + 1)..(lhd + pcnt + 1) repeat
nscripts.i := (ord(str.j) - ord0)::NonNegativeInteger
-- Put the number of function scripts at the end.
nscripts := concat(rest nscripts, first nscripts)
allscripts := rest(of_list(sy))
m := minIndex lscripts
for i in m.. for n in nscripts repeat
#allscripts < n => error "Improper script count in symbol"
lscripts.i := first(allscripts, n)
allscripts := rest(allscripts, n)
[lscripts.m, lscripts.(m+1), lscripts.(m+2),
lscripts.(m+3), lscripts.(m+4)]
istring n ==
n > 9 => error "Can have at most 9 scripts of each kind"
istrings.(n + minIndex istrings)
sample() == "aSymbol"::%
--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.
spad
Compiling FriCAS source code from file
/var/lib/zope2.10/instance/axiom-wiki/var/LatexWiki/6497064979997941388-25px001.spad
using old system compiler.
SYMBOL abbreviates domain Symbol
------------------------------------------------------------------------
initializing NRLIB SYMBOL for Symbol
compiling into NRLIB SYMBOL
importing Character
importing List OutputForm
importing List $
compiling local writeOMSym : (OpenMathDevice,$) -> Void
;;; *** |SYMBOL;writeOMSym| REDEFINED
Time: 0.05 SEC.
compiling exported OMwrite : (OpenMathDevice,$,Boolean) -> Void
;;; *** |SYMBOL;OMwrite;Omd$BV;2| REDEFINED
Time: 0 SEC.
processing macro definition pcnt ==> 4
compiling exported convert : $ -> InputForm
;;; *** |SYMBOL;convert;$If;3| REDEFINED
Time: 0.01 SEC.
compiling exported convert : $ -> Symbol
SYMBOL;convert;2$;4 is replaced by s
;;; *** |SYMBOL;convert;2$;4| REDEFINED
Time: 0 SEC.
compiling exported coerce : String -> $
;;; *** |SYMBOL;coerce;S$;5| REDEFINED
Time: 0 SEC.
compiling exported = : ($,$) -> Boolean
SYMBOL;=;2$B;6 is replaced by EQUAL
;;; *** |SYMBOL;=;2$B;6| REDEFINED
Time: 0 SEC.
compiling exported hashUpdate! : (HashState,$) -> HashState
;;; *** |SYMBOL;hashUpdate!;Hs$Hs;7| REDEFINED
Time: 0 SEC.
compiling exported < : ($,$) -> Boolean
SYMBOL;<;2$B;8 is replaced by GGREATERPyx
;;; *** |SYMBOL;<;2$B;8| REDEFINED
Time: 0.01 SEC.
compiling exported coerce : $ -> OutputForm
;;; *** |SYMBOL;coerce;$Of;9| REDEFINED
Time: 0.01 SEC.
compiling exported subscript : ($,List OutputForm) -> $
;;; *** |SYMBOL;subscript;$L$;10| REDEFINED
Time: 0.02 SEC.
compiling exported elt : ($,List OutputForm) -> $
;;; *** |SYMBOL;elt;$L$;11| REDEFINED
Time: 0 SEC.
compiling exported superscript : ($,List OutputForm) -> $
;;; *** |SYMBOL;superscript;$L$;12| REDEFINED
Time: 0 SEC.
compiling exported argscript : ($,List OutputForm) -> $
;;; *** |SYMBOL;argscript;$L$;13| REDEFINED
Time: 0 SEC.
compiling exported patternMatch : ($,Pattern Integer,PatternMatchResult(Integer,$)) -> PatternMatchResult(Integer,$)
;;; *** |SYMBOL;patternMatch;$P2Pmr;14| REDEFINED
Time: 0 SEC.
compiling exported patternMatch : ($,Pattern Float,PatternMatchResult(Float,$)) -> PatternMatchResult(Float,$)
;;; *** |SYMBOL;patternMatch;$P2Pmr;15| REDEFINED
Time: 0.01 SEC.
compiling exported convert : $ -> Pattern Float
;;; *** |SYMBOL;convert;$P;16| REDEFINED
Time: 0 SEC.
compiling exported convert : $ -> Pattern Integer
;;; *** |SYMBOL;convert;$P;17| REDEFINED
Time: 0 SEC.
compiling local syprefix : Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) -> String
;;; *** |SYMBOL;syprefix| REDEFINED
Time: 0.01 SEC.
compiling local syscripts : Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm) -> List OutputForm
;;; *** |SYMBOL;syscripts| REDEFINED
Time: 0.01 SEC.
compiling exported script : ($,List List OutputForm) -> $
;;; *** |SYMBOL;script;$L$;20| REDEFINED
Time: 0.01 SEC.
compiling exported script : ($,Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm)) -> $
;;; *** |SYMBOL;script;$R$;21| REDEFINED
Time: 0.02 SEC.
compiling exported string : $ -> String
;;; *** |SYMBOL;string;$S;22| REDEFINED
Time: 0 SEC.
compiling exported latex : $ -> String
;;; *** |SYMBOL;latex;$S;23| REDEFINED
Time: 0.03 SEC.
compiling local anyRadix : (Integer,String) -> String
;;; *** |SYMBOL;anyRadix| REDEFINED
Time: 0.04 SEC.
compiling exported new : () -> $
;;; *** |SYMBOL;new;$;25| REDEFINED
Time: 0 SEC.
compiling exported new : $ -> $
;;; *** |SYMBOL;new;2$;26| REDEFINED
Time: 0.07 SEC.
compiling exported resetNew : () -> Void
;;; *** |SYMBOL;resetNew;V;27| REDEFINED
Time: 0 SEC.
compiling exported scripted? : $ -> Boolean
;;; *** |SYMBOL;scripted?;$B;28| REDEFINED
Time: 0 SEC.
compiling local of_list : $ -> List OutputForm
SYMBOL;of_list is replaced by x
;;; *** |SYMBOL;of_list| REDEFINED
Time: 0 SEC.
compiling exported name : $ -> $
;;; *** |SYMBOL;name;2$;30| REDEFINED
Time: 0 SEC.
compiling exported scripts : $ -> Record(sub: List OutputForm,sup: List OutputForm,presup: List OutputForm,presub: List OutputForm,args: List OutputForm)
;;; *** |SYMBOL;scripts;$R;31| REDEFINED
Time: 0.04 SEC.
compiling local istring : Integer -> String
;;; *** |SYMBOL;istring| REDEFINED
Time: 0 SEC.
compiling exported sample : () -> $
;;; *** |SYMBOL;sample;$;33| REDEFINED
Time: 0.01 SEC.
(time taken in buildFunctor: 0)
;;; *** |Symbol| REDEFINED
;;; *** |Symbol| REDEFINED
Time: 0 SEC.
Warnings:
[1] coerce: presup has no value
[2] coerce: sl has no value
[3] coerce: args has no value
[4] syprefix: presup has no value
[5] syprefix: args has no value
[6] syscripts: presup has no value
[7] syscripts: args has no value
[8] script: presup has no value
[9] script: args has no value
[10] latex: pretend(String) -- should replace by @
[11] latex: s has no value
[12] latex: sc has no value
[13] latex: presup has no value
[14] latex: args has no value
[15] anyRadix: quotient has no value
[16] anyRadix: remainder has no value
Cumulative Statistics for Constructor Symbol
Time: 0.35 seconds
finalizing NRLIB SYMBOL
Processing Symbol for Browser database:
--------constructor---------
--------(new (%))---------
--------(new (% %))---------
--------(resetNew ((Void)))---------
--------(coerce (% (String)))---------
--------(name (% %))---------
--------(scripted? ((Boolean) %))---------
--------(scripts ((Record (: sub (List (OutputForm))) (: sup (List (OutputForm))) (: presup (List (OutputForm))) (: presub (List (OutputForm))) (: args (List (OutputForm)))) %))---------
--------(script (% % (List (List (OutputForm)))))---------
--------(script (% % (Record (: sub (List (OutputForm))) (: sup (List (OutputForm))) (: presup (List (OutputForm))) (: presub (List (OutputForm))) (: args (List (OutputForm))))))---------
--------(subscript (% % (List (OutputForm))))---------
--------(superscript (% % (List (OutputForm))))---------
--------(argscript (% % (List (OutputForm))))---------
--------(elt (% % (List (OutputForm))))---------
--------(string ((String) %))---------
--------(sample (%) constant)---------
; compiling file "/var/aw/var/LatexWiki/SYMBOL.NRLIB/SYMBOL.lsp" (written 27 FEB 2015 09:12:52 PM):
; /var/aw/var/LatexWiki/SYMBOL.NRLIB/SYMBOL.fasl written
; compilation finished in 0:00:00.167
------------------------------------------------------------------------
Symbol is now explicitly exposed in frame initial
Symbol will be automatically loaded when needed from
/var/aw/var/LatexWiki/SYMBOL.NRLIB/SYMBOL
Examples
fricas
A:=superscript('a,['b])
symbol oldsc: [sub= [],sup= [],presup= [],presub= [],args= []]
symbol newsc: [sub= [],sup= [b],presup= [],presub= [],args= []]
Type: Symbol
fricas
B:=subscript(A,['c])
symbol oldsc: [sub= [],sup= [b],presup= [],presub= [],args= []]
symbol newsc: [sub= [c],sup= [b],presup= [],presub= [],args= []]
Type: Symbol
fricas
C:=argscript(B,['x])
symbol oldsc: [sub= [c],sup= [b],presup= [],presub= [],args= []]
symbol newsc: [sub= [c],sup= [b],presup= [],presub= [],args= [x]]
Type: Symbol
fricas
D:=subscript(C,['d])
symbol oldsc: [sub= [c],sup= [b],presup= [],presub= [],args= [x]]
symbol newsc: [sub= [d,c],sup= [b],presup= [],presub= [],args= [x]]
Type: Symbol