Hi Quian,
thanks for your reply, here is the output. Meanwhile I found the reason
for the error, which I could eliminate, as this feature is not required
for the computations right now. But may be crucial for other application.
I enhanced Character and String with greek letters and other useful
functions. Code string-enhanced.spad is included. Also symbol-jg.spad
with signatures like alpha: () -> Sybol
There I had to do a boot strapping process (forgot why) for signatur
greek?: () -> Boolean, which one had to compile first without code and
then with code. But exactly this process causes the error now.
Please compile symbol-jg and string-enhanced (2 times, first with code
of greek? commented out and then with its code). Then calling e.g.
alpha() reproduces the error.
I am curious to learn what is going wrong now. And, if this can be fixed
I would appreciate to include my enhancements to the distribution.
Thanks and regards
Johannes
(4) -> fnvwh : FileName :=
filename("/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS",
"VWH_2024_newspad", "csv")
>> System error:
invalid number of arguments: 2
(4) ->
(4) ->
(4) -> )set break break
(4) -> fnvwh : FileName :=
filename("/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS",
"VWH_2024_newspad", "csv")
debugger invoked on a SB-INT:SIMPLE-PROGRAM-ERROR in thread
#<THREAD "main thread" RUNNING {7006C65233}>:
invalid number of arguments: 2
Type HELP for debugger help, or (SB-EXT:EXIT) to exit from SBCL.
restarts (invokable by number or by possibly-abbreviated name):
0: [REPLACE-FUNCTION] Call a different function with the same arguments
1: [CALL-FORM ] Call a different form
2: [ABORT ] Exit from the current thread.
(|make_full_CVEC| 1 34) [external]
source: (DEFUN |make_full_CVEC| (SINT) (|make_full_CVEC2| SINT #\ ))
0]
:backtrace
Backtrace for: #<SB-THREAD:THREAD "main thread" RUNNING {7006C65233}>
0: (|make_full_CVEC| 1 34) [external]
1: (|LNAGG-;concat;ASA;3|
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv"
34 #1=#((|LinearAggregate&| #2=(|String|) (|Character|)) (#3=#<FUNCTION
|lookupComplete|> #1# #(|trim| 197 |sorted?| 203 |sort!| 208 |sort| 213
|rightTrim| 224 |reverse| 230 ...)) NIL 31 (#(T) #((|Join| (|mkCategory|
# # NIL NIL))) . #(1 6 8 0 9 1 6 8 0 10 2 6 ...)) NIL #4=#(#2#
(#<FUNCTION |lookupIncomplete|> #4# #(|uentries| 103 |ucodeToString| 108
|toInteger| 113 |toDecimalExpansion| 118 |string| 123 |qsetelt!| 128
...)) NIL 16382 (#(T |StringAggregate&| #(# # NIL 0 # NIL #4# #5=# # # #
# ...) T #1# |IndexedAggregate&| |Collection&| |OrderedSet&|
|HomogeneousAggregate&| T |SetCategory&| |Aggregate&| ...)
#((|StringCategory|) (|StringAggregate|) (|OneDimensionalArrayAggregate|
9) (|FiniteLinearAggregate| 9) (|LinearAggregate| 9) (|IndexedAggregate|
11 9) (|Collection| 9) (|OrderedSet|) (|HomogeneousAggregate| 9)
(|Comparable|) (|SetCategory|) (|Aggregate|) ...) . #(1 0 6 0 7 2 9 8 0
0 10 1 ...)) #6=#((|IndexedString| 1) (#3# #6# #(~= 97 |upperCase!| 103
|upperCase| 108 |trim| 113 |swap!| 125 |suffix?| 132 ...)) NIL 4194175
(#(|StringAggregate&| |OneDimensionalArrayAggregate&| T
|LinearAggregate&| |IndexedAggregate&| |Collection&| |OrderedSet&|
|HomogeneousAggregate&| T |Aggregate&| |EltableAggregate&| NIL ...) #(#
# # # # # # # # # # # ...) . #(2 19 0 18 18 20 1 19 0 18 22 1 ...)) NIL
1 (|NonNegativeInteger|) (|Character|) (#<FUNCTION
|ISTRING;new;NniC$;1|> . #6#) (#<FUNCTION |ISTRING;empty;$;2|> . #6#)
(|Boolean|) ...) (|List| 9) (#7=#<FUNCTION |newGoGet|> #4# 0 . |parts|)
(|Boolean|) #5# (#7# #4# 5 . ~=) (|Integer|) ...) #5# (|Integer|) (#7#
#1# 0 . |minIndex|) (#7# #1# 5 . |maxIndex|) (|List| 8) ...))
2: (|OUTFORM;outputForm;S$;13|
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv"
#1=#((|OutputForm|) (#<FUNCTION |lookupComplete|> #1# #(~= 153 |zag| 165
|vspace| 171 |vconcat| 176 |tensor| 187 |supersub| 193 ...)) NIL 0
(#(|SetCategory&| |BasicType&| T T) #((|SetCategory|) (|BasicType|)
(|ConvertibleTo| 43) (|CoercibleTo| 21)) . #(2 6 0 2 0 7 1 12 11 0 13 1
...)) NIL (|List| $$) (#<FUNCTION |newGoGet|> #1# 0 . |cons|)
#2=#((|SExpression|) (#<FUNCTION |lookupIncomplete|> #2# #()) NIL 0 (#(T
|SetCategory&| |BasicType&| T) #((|SExpressionCategory| 9 10 7 8)
(|SetCategory|) (|BasicType|) (|CoercibleTo| 14)) . #())
(|SExpressionOf| 9 10 7 8) (|List| 7) (|Integer|) (|DoubleFloat|)
(|String|) (|Symbol|) (|List| $) ...) (|Void|) (#<FUNCTION
|OUTFORM;print;$V;2|> . #1#) (|Boolean|) ...))
3: (|coerceByFunction| ((|FileName|) WRAPPED .
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv")
(|OutputForm|))
4: (|coerceIntTower| ((|FileName|) WRAPPED .
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv")
(|OutputForm|))
5: (|coerceInt1| ((|FileName|) WRAPPED .
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv")
(|OutputForm|))
6: (|coerceInt| ((|FileName|) WRAPPED .
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv")
(|OutputForm|))
7: (|coerceInt0| ((|FileName|) WRAPPED .
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv")
(|OutputForm|))
8: (|coerceInteractive| ((|FileName|) WRAPPED .
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv")
(|OutputForm|))
9: (|output|
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv"
(|FileName|))
10: (|recordAndPrint|
#P"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS/VWH_2024_newspad.csv"
(|FileName|))
11: (|processInteractive1| (LET (|:| |fnvwh| |FileName|) (|filename|
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS"
"VWH_2024_newspad" "csv")) (|Assign| (|listOf| (|Tagged| ((|id| #) .
|fnvwh|) ((|id| #) . |FileName|))) (|Application| ((|id| (|posn| # .
20)) . |filename|) (|Tuple| (|listOf| (# .
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS")
(# . "VWH_2024_newspad") (# . "csv"))))))
12: (|processInteractive| (LET (|:| |fnvwh| |FileName|) (|filename|
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS"
"VWH_2024_newspad" "csv")) (|Assign| (|listOf| (|Tagged| ((|id| #) .
|fnvwh|) ((|id| #) . |FileName|))) (|Application| ((|id| (|posn| # .
20)) . |filename|) (|Tuple| (|listOf| (# .
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS")
(# . "VWH_2024_newspad") (# . "csv"))))))
13: (|intInterpretPform| (|Assign| (|listOf| (|Tagged| ((|id| #) .
|fnvwh|) ((|id| #) . |FileName|))) (|Application| ((|id| (|posn| # .
20)) . |filename|) (|Tuple| (|listOf| (# .
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS")
(# . "VWH_2024_newspad") (# . "csv"))))))
14: (|phInterpret| ((|carrier| (|ok?| . T) (|ptreePremacro| .
#1=(|Assign| (|listOf| #) (|Application| # #))) (|ptree| . #1#) (|lines|
((# . 1) . "fnvwh : FileName :=
filename(\"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS\",
\"VWH_2024_newspad\", \"csv\")")) (|messages|) (|stepNumber| . 1))))
15: (|ncConversationPhase| #<FUNCTION |phInterpret|> (((|carrier| (|ok?|
. T) (|ptreePremacro| . #1=(|Assign| # #)) (|ptree| . #1#) (|lines| (# .
"fnvwh : FileName :=
filename(\"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS\",
\"VWH_2024_newspad\", \"csv\")")) (|messages|) (|stepNumber| . 1)))))
16: (|intloopSpadProcess,interp| ((|carrier| (|ok?| . T)
(|ptreePremacro| . #1=(|Assign| (|listOf| #) (|Application| # #)))
(|ptree| . #1#) (|lines| ((# . 1) . "fnvwh : FileName :=
filename(\"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS\",
\"VWH_2024_newspad\", \"csv\")")) (|messages|) (|stepNumber| . 1)))
(|Assign| (|listOf| (|Tagged| ((|id| #) . |fnvwh|) ((|id| #) .
|FileName|))) (|Application| ((|id| (|posn| # . 20)) . |filename|)
(|Tuple| (|listOf| (# .
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS")
(# . "VWH_2024_newspad") (# . "csv"))))) T)
17: (|intloopSpadProcess| 1 ((((0 #1="fnvwh : FileName :=
filename(\"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS\",
\"VWH_2024_newspad\", \"csv\")" 1 1 "strings") . 1) . #1#)) (|Assign|
(|listOf| (|Tagged| ((|id| #) . |fnvwh|) ((|id| #) . |FileName|)))
(|Application| ((|id| (|posn| # . 20)) . |filename|) (|Tuple| (|listOf|
(# .
"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS")
(# . "VWH_2024_newspad") (# . "csv"))))) T)
18: (|intloopProcess| 1 T (((((# . 1) . "fnvwh : FileName :=
filename(\"/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS\",
\"VWH_2024_newspad\", \"csv\")")) (|Assign| (|listOf| (|Tagged| # #))
(|Application| (# . |filename|) (|Tuple| #)))) |nonnullstream|
#1=#<FUNCTION |next1|> #<FUNCTION |ncloopParse|> (|nonnullstream| #1#
#<FUNCTION |fakepile|> (|nullstream|))))
19: (|intloopReadConsole| #<unavailable argument> #<unavailable argument>)
20: (|SpadInterpretStream| 1 NIL T)
21: (|int_loop|)
22: (|ncTopLevel|)
23: (|runspad|)
24: (|spad|)
25: (FRICAS-RESTART)
26: ((LAMBDA NIL :IN FRICAS-LISP::SAVE-CORE-RESTART))
27: ((FLET SB-UNIX::BODY :IN SB-IMPL::START-LISP))
28: ((FLET "WITHOUT-INTERRUPTS-BODY-1" :IN SB-IMPL::START-LISP))
29: (SB-IMPL::START-LISP)
0]
Am 25.11.23 um 01:45 schrieb Qian Yun:
Hi,
I can't reproduce this problem either.
Did you compile FriCAS or use a binary?
Can you show me the backtrace by:
)set break break
filename(...)
Then type ":backtrace" in the debugger.
- Qian
On 11/25/23 03:59, Prof. Dr. Johannes Grabmeier wrote:
Hi all,
get the following error:
(7) ->
filename("/Users/jgrabmeier/stadtrat-deggendorf/haushalt/hh-plan-2024/entwurfHaushaltFriCAS",
"xxx", "input")
>> System error:
invalid number of arguments: 2
filename calls fnameMake from LISP
filename(d, n, e) == fnameMake(d, n, e)$Lisp
what is wrong? I have FriCAS 1.3.8 on SBCL 2.1.2 on Apple M2 Pro
Would be thankful for urgent reply, as I have to use the results of
the computations in a short time frame.
--
Mit freundlichen Grüßen
Johannes Grabmeier
Prof. Dr. Johannes Grabmeier,
Köckstraße 1, D-94469 Deggendorf
Tel. +49-(0)-991-2979584, Tel. +49-(0)-151-681-70756
Fax: +49-(0)-991-2979592
--
Mit freundlichen Grüßen
Johannes Grabmeier
Prof. Dr. Johannes Grabmeier,
Köckstraße 1, D-94469 Deggendorf
Tel. +49-(0)-991-2979584, Tel. +49-(0)-151-681-70756
Fax: +49-(0)-991-2979592
--
You received this message because you are subscribed to the Google Groups "FriCAS -
computer algebra system" group.
To unsubscribe from this group and stop receiving emails from it, send an email
to [email protected].
To view this discussion on the web visit
https://groups.google.com/d/msgid/fricas-devel/c0ce47ea-33e5-418a-8714-2ae323c4cc66%40grabmeier.net.
)abbrev domain SYMBOL Symbol
++ Author: Stephen Watt
++ Date Created: 1986
++ Date Last Updated: 29.08.2019 J. Grabmeier partial
++ Date Last Updated: 17.09.2018 J. Grabmeier Greek
++ Description:
++ Basic and scripted symbols. Extended for easily created Greek letters as
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.
-- begin new code jg
newGreek : () -> %
++ newGreek() returns the next greek character.
resetNewGreek : () -> Void
++ resetNewGreek() resets the internals counters that newGreek()
++ use to return distinct symbols every time.
-- end new code jg
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 %
-- begin new code jg
partial: constant -> %
++ partial() returns ∂.
tabulator: constant -> %
++ tabulator() returns .
endOfLine: constant -> %
++ endOfLine() returns the end-of-line chacter.
alpha: constant -> %
++ alpha() returns α.
beta: constant -> %
++ beta() returns β.
gamma: constant -> %
++ gamm() returns γ.
delta: constant -> %
++ delta() returns δ.
epsilon: constant -> %
++ epsilon() returns ε.
zeta: constant -> %
++ zeta() returns ς.
eta: constant -> %
++ eta() returns η.
theta: constant -> %
++ theta() returns θ.
iota: constant -> %
++ iota() returns ι.
kappa: constant -> %
++ kappa() returns κ.
lambda: constant -> %
++ lambda() returns λ.
mu: constant -> %
++ mu() returns μ.
nu: constant -> %
++ nu() returns ν.
xi: constant -> %
++ xi() returns ξ.
omicron: constant -> %
++ omicron() returns ο.
pi: constant -> %
++ pi() returns π.
rho: constant -> %
++ rho() returns ρ.
sigma: constant -> %
++ sigma() returns σ.
tau: constant -> %
++ tau() returns τ.
upsilon: constant -> %
++ upsilon() returns υ.
phi: constant -> %
++ phi() returns φ.
chi: constant -> %
++ chi() returns χ.
psi: constant -> %
++ psi() returns ψ.
omega: constant -> %
++ omega() returns ω.
Alpha: constant -> %
++ Alpha() returns Α.
Beta: constant -> %
++ Beta() returns Β.
Gamma: constant -> %
++ Gamm() returns Γ.
Delta: constant -> %
++ Delta() returns Δ.
Epsilon: constant -> %
++ Epsilon() returns Ε.
Zeta: constant -> %
++ Zeta() returns Ζ.
Eta: constant -> %
++ Eta() returns Η.
Theta: constant -> %
++ Theta() returns Θ.
Iota: constant -> %
++ Iota() returns Ι.
Kappa: constant -> %
++ Kappa() returns Κ.
Lambda: constant -> %
++ Lambda() returns Λ.
Mu: constant -> %
++ Mu() returns Μ.
Nu: constant -> %
++ Nu() returns Ν.
Xi: constant -> %
++ Xi() returns Ξ.
Omicron: constant -> %
++ Omicron() returns Ο.
Pi: constant -> %
++ Pi() returns Π.
Rho: constant -> %
++ Rho() returns Ρ.
Sigma: constant -> %
++ Sigma() returns Σ.
Tau: constant -> %
++ Tau() returns Τ.
Upsilon: constant -> %
++ Upsilon() returns Υ.
Phi: constant -> %
++ Phi() returns Φ.
Chi: constant -> %
++ Chi() returns Χ.
Psi: constant -> %
++ Psi() returns Ψ.
Omega: constant -> %
++ omega() returns Ω.
-- ["Α", "Β", "Γ", "Δ", "Ε", "Ζ", "Η", "Θ", "Ι", "Κ", "Λ", "Μ", "Ν", "Ξ",
"Ο", "Π", "Ρ", "", "Σ", "Τ", "Υ", "Φ", "Χ", "Ψ", "Ω"
-- end new code jg
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"
-- begin new code jg
greekCount : Reference(Integer) := ref 0
greekLetters : String := concat [index(i :: PositiveInteger)$Character
:: String for i in 946..970]
-- end new code jg
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 ==
n: InputForm := (name s) pretend InputForm
not scripted? s => n
ls := scripts s
A: List InputForm := [convert(e)@InputForm for e in ls.sub]
B: List InputForm := [convert(e)@InputForm for e in ls.sup]
C: List InputForm := [convert(e)@InputForm for e in ls.presup]
D: List InputForm := [convert(e)@InputForm for e in ls.presub]
E: List InputForm := [convert(e)@InputForm for e in ls.args]
a: InputForm := convert('script)$InputForm
b: InputForm := convert('construct)$InputForm
FF: List List InputForm := [cons(b, e) for e in [A, B, C, D, E]]
G: List InputForm := [convert(F)$InputForm for F in FF]
d: InputForm := convert(cons(b, G))$InputForm
convert([a, n, d])$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, [], [], [], []])
elt(sy, lx) == subscript(sy, lx)
superscript(sy, lx) == script(sy, [[], lx, [], [], []])
argscript(sy, lx) == script(sy, [[], [], [], [], 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.sub, #sc.sup, #sc.presup, #sc.presub]
concat concat(concat(hd, istring(#sc.args)),
[istring n for n in 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 := [[], [], [], [], []]
if not(empty?(ls)) then (sc.sub := first(ls); ls := rest(ls))
if not(empty?(ls)) then (sc.sup := first(ls); ls := rest(ls))
if not(empty?(ls)) then (sc.presup := first(ls); ls := rest(ls))
if not(empty?(ls)) then (sc.presub := first(ls); ls := rest(ls))
if not(empty?(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"
(concat(concat(syprefix sc, string name sy)::%::OutputForm,
syscripts sc)) 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)::%
-- begin new code jg
newGreek() ==
sym := anyRadix(greekCount()::Integer, greekLetters)
greekCount() := greekCount() + 1
sym :: %
-- end new code jg
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
-- begin new code jg
resetNewGreek() ==
greekCount() := 0
void
-- end new code jg
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 => [[], [], [], [], []]
nscripts : List NonNegativeInteger := [0, 0, 0, 0, 0]
lscripts : List L := [[], [], [], [], []]
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"::%
-- begin new code jg
getUTF(i : PositiveInteger): % ==
index(i :: PositiveInteger)$Character :: String :: %
partial(): % == getUTF(8707)
tabulator(): % == getUTF(9225)
endOfLine(): % == getUTF(10)
-- α, β, γ, δ, ε, ζ, η, θ, ι, κ, λ, μ, ν, ξ, ο, π, ρ, ς, σ, τ, υ, φ, χ, ψ, ω,
alpha(): % == getUTF(946)
beta(): % == getUTF(947)
gamma(): % == getUTF(948)
delta(): % == getUTF(949)
epsilon(): % == getUTF(950)
zeta(): % == getUTF(951)
eta(): % == getUTF(952)
theta(): % == getUTF(953)
iota(): % == getUTF(954)
kappa(): % == getUTF(955)
lambda(): % == getUTF(956)
mu(): % == getUTF(957)
nu(): % == getUTF(958)
xi(): % == getUTF(959)
omicron(): % == getUTF(960)
pi(): % == getUTF(961)
rho(): % == getUTF(962)
--?? (): % == getUTF(963)
sigma(): % == getUTF(964)
tau(): % == getUTF(965)
upsilon(): % == getUTF(966)
phi(): % == getUTF(967)
chi(): % == getUTF(968)
psi(): % == getUTF(969)
omega(): % == getUTF(670)
Alpha(): % == getUTF(914)
Beta(): % == getUTF(915)
Gamma(): % == getUTF(916)
Delta(): % == getUTF(917)
Epsilon(): % == getUTF(918)
Zeta(): % == getUTF(919)
Eta(): % == getUTF(920)
Theta(): % == getUTF(921)
Iota(): % == getUTF(922)
Kappa(): % == getUTF(923)
Lambda(): % == getUTF(924)
Mu(): % == getUTF(925)
Nu(): % == getUTF(926)
Xi(): % == getUTF(927)
Omicron(): % == getUTF(928)
Pi(): % == getUTF(929)
Rho(): % == getUTF(930)
--?? (): % == getUTF(931)
Sigma(): % == getUTF(932)
Tau(): % == getUTF(933)
Upsilon(): % == getUTF(934)
Phi(): % == getUTF(935)
Chi(): % == getUTF(936)
Psi(): % == getUTF(937)
Omega(): % == getUTF(938)
-- end new code jg
--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.
)abbrev domain CHAR Character
++ Author: Stephen M. Watt
++ Date Created: July 1986
++ Basic Operations: char
++ Related Domains:
++ Also See:
++ AMS Classifications:
++ Keywords: character, string
++ Examples:
++ References:
++ Description:
++ This domain provides the basic character data type.
++ ATTENTION: greek? code, not its definition
++ must be commented out for first compilation run, boot strapping!
--Character : OrderedFinite() with
Character : Export == Implementation where
OF ==> OutputForm
Export ==> OrderedFinite() with
ord : % -> Integer
++ ord(c) provides an integral code corresponding to the
++ character c. It is always true that \spad{char ord c = c}.
char : Integer -> %
++ char(i) provides a character corresponding to the integer
++ code i. It is always true that \spad{ord char i = i}.
char : String -> %
++ char(s) provides a character from a string s of length one.
space : () -> %
++ space() provides the blank character.
-- begin new code jg
infinityCharacter : () -> %
++ infinityCharacter() provides ∞.
-- end new code jg
quote : () -> %
++ quote() provides the string quote character, \spad{"}.
escape : () -> %
++ escape() provides the escape character, \spad{_}, which
++ is used to allow quotes and other characters {\em within}
++ strings.
newline : () -> %
++ newline() provides the newline character.
upperCase : % -> %
++ upperCase(c) converts a lower case letter to the corresponding
++ upper case letter. If c is not a lower case letter, then
++ it is returned unchanged.
lowerCase : % -> %
++ lowerCase(c) converts an upper case letter to the corresponding
++ lower case letter. If c is not an upper case letter, then
++ it is returned unchanged.
digit? : % -> Boolean
++ digit?(c) tests if c is a digit character,
++ i.e. one of 0..9.
hexDigit? : % -> Boolean
++ hexDigit?(c) tests if c is a hexadecimal numeral,
++ i.e. one of 0..9, a..f or A..F.
alphabetic? : % -> Boolean
++ alphabetic?(c) tests if c is a letter,
++ i.e. one of a..z or A..Z.
upperCase? : % -> Boolean
++ upperCase?(c) tests if c is an upper case letter,
++ i.e. one of A..Z.
lowerCase? : % -> Boolean
++ lowerCase?(c) tests if c is an lower case letter,
++ i.e. one of a..z.
alphanumeric? : % -> Boolean
++ alphanumeric?(c) tests if c is either a letter or number,
++ i.e. one of 0..9, a..z or A..Z.
-- begin new code jg
greek? : % -> Boolean
++ greek?(c) tests if c is a greek letter.
toDigit: % -> Integer
++ toDigit(c) transforms c to a digit, error if not possible.
-- end new code jg
--== add
Implementation ==> add
CC ==> CharacterClass()
import from CC
import from OF
Rep := SingleInteger -- 0..(1114112 - 1)
--cl: Record(dig: CC, hex: CC, upp: CC, low: CC, alpha: CC, alnum: CC)
:=
-- [ digit(), hexDigit(),
-- upperCase(), lowerCase(), alphabetic(), alphanumeric() ]
a = b == a =$Rep b
a < b == a <$Rep b
-- size() == 256
size() == 1114112
index n == char((n - 1)::Integer)
lookup c == (1 + ord c)::PositiveInteger
char(n : Integer) == n::%
ord c == convert(c)$Rep
-- random() == char(random(size())$Integer)
-- FIXME: limit to ASCII for now
random() == char(random(128)$Integer)
space == char 32 -- STR_ELT(" ", 0$Lisp)$Lisp
quote == char 34 -- STR_ELT("\" ", 0$Lisp)$Lisp
escape == char 95 -- STR_ELT("\_ ", 0$Lisp)$Lisp
newline == char(10)
coerce(c : %) : OutputForm == NUM2USTR(ord c)$Lisp
digit? c == member?(c pretend Character, digit())
hexDigit? c == member?(c pretend Character, hexDigit())
upperCase? c == member?(c pretend Character, upperCase())
lowerCase? c == member?(c pretend Character, lowerCase())
alphabetic? c == member?(c pretend Character, alphabetic())
alphanumeric? c == member?(c pretend Character, alphanumeric())
-- begin new code jg
infinityCharacter(): % == char 8734
greek? c == member?(c pretend Character, greek())
toDigit(c: %): Integer ==
--print blankSeparate [msg "toDigit aufgerufen mit c = ", c :: OF]
c = char "0" => 0
c = char "1" => 1
c = char "2" => 2
c = char "3" => 3
c = char "4" => 4
c = char "5" => 5
c = char "6" => 6
c = char "7" => 7
c = char "8" => 8
c = char "9" => 9
error "toDigit: not a number"
-1
-- end new code jg
latex c ==
concat("\mbox{`", concat(new(1,c pretend Character)$String,
"'}")$String)$String
char(s : String) == STR_to_CHAR(s)$Lisp
-- (#s) = 1 => s(minIndex s) pretend %
-- error "String is not a single character"
upperCase c ==
STR_ELT(PNAME(UPCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,
0$Lisp)$Lisp
lowerCase c ==
STR_ELT(PNAME(DOWNCASE(NUM2CHAR(ord c)$Lisp)$Lisp)$Lisp,
0$Lisp)$Lisp
hashUpdate!(hs : HashState, c : %) : HashState ==
update!(hs, c pretend SingleInteger)$HashState
)abbrev domain CCLASS CharacterClass
++ Author: Stephen M. Watt
++ Date Created: July 1986
++ Date extended: J. Grabmeier, 30.03.2019
++ Basic Operations: charClass
++ Related Domains: Character, Bits
++ Also See:
++ AMS Classifications:
++ Keywords:
++ Examples:
++ References:
++ Description:
++ This domain allows classes of characters to be defined and manipulated
++ efficiently.
CharacterClass : Join(SetCategory, ConvertibleTo String,
FiniteSetAggregate Character, ConvertibleTo List Character) with
charClass : String -> %
++ charClass(s) creates a character class which contains
++ exactly the characters given in the string s.
charClass : List Character -> %
++ charClass(l) creates a character class which contains
++ exactly the characters given in the list l.
digit : constant -> %
++ digit() returns the class of all characters
++ for which \spadfunFrom{digit?}{Character} is true.
hexDigit : constant -> %
++ hexDigit() returns the class of all characters for which
++ \spadfunFrom{hexDigit?}{Character} is true.
upperCase : constant -> %
++ upperCase() returns the class of all characters for which
++ \spadfunFrom{upperCase?}{Character} is true.
lowerCase : constant -> %
++ lowerCase() returns the class of all characters for which
++ \spadfunFrom{lowerCase?}{Character} is true.
alphabetic : constant -> %
++ alphabetic() returns the class of all characters for which
++ \spadfunFrom{alphabetic?}{Character} is true.
alphanumeric : constant -> %
++ alphanumeric() returns the class of all characters for which
++ \spadfunFrom{alphanumeric?}{Character} is true.
-- begin new code jg
greek : constant -> %
++ greek() returns the class of all characters for which
++ \spadfunFrom{greek?}{Character} is true.
-- end new code jg
== add
Rep := IndexedBits(0)
-- N := size()$Character
import from Character
--N := 256
N := 1024
a, b : %
digit() == charClass "0123456789"
hexDigit() == charClass "0123456789abcdefABCDEF"
upperCase() == charClass "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
lowerCase() == charClass "abcdefghijklmnopqrstuvwxyz"
alphabetic() == union(upperCase(), lowerCase())
alphanumeric() == union(alphabetic(), digit())
-- begin new code jg
gL : String := construct [index(u :: PositiveInteger) for u in
946..962]
gL := concat(gL, construct [index(u :: PositiveInteger) for u in
964..970] )
gL := concat(gL, construct [index(u :: PositiveInteger) for u in
914..930] )
gL := concat(gL, construct [index(u :: PositiveInteger) for u in
932..938] )
greek() == charClass gL
-- end new code jg
a = b == a =$Rep b
member?(c, a) ==
(i := ord c) < N => a(i)
false
union(a, b) == Or(a, b)
intersect (a, b) == And(a, b)
difference(a, b) == And(a, Not b)
-- FIXME: this is bogus for codes >= N
complement a == Not a
convert(cl) : String ==
construct(convert(cl)@List(Character))
convert(cl : %) : List(Character) ==
[char(i) for i in 0..N-1 | cl.i]
charClass(s : String) ==
cl := new(N, false)
for i in minIndex(s)..maxIndex(s) repeat
(j := ord s.i) >= N => error "character code too large"
cl(j) := true
cl
charClass(l : List Character) ==
cl := new(N, false)
for c in l repeat
(j := ord c) >= N => error "character code too large"
cl(j) := true
cl
coerce(cl) : OutputForm == (convert(cl)@String)::OutputForm
-- Stuff to make a legal SetAggregate view
# a == (n := 0; for i in 0..N-1 | a.i repeat n := n+1; n)
empty() : % == charClass []
set() : % == empty()
insert!(c, a) ==
(i := ord c) < N => (a(i) := true; a)
error "character code too large"
remove!(c : Character, a) ==
if(i := ord c) < N then a(i) := false
a
inspect(a) ==
for i in 0..N-1 | a.i repeat
return char i
error "Cannot take a character from an empty class."
extract!(a) ==
for i in 0..N-1 | a.i repeat
a.i := false
return char i
error "Cannot take a character from an empty class."
map(f, a) ==
b := new(N, false)
for i in 0..N-1 | a.i repeat b(ord f char i) := true
b
temp : % := new(N, false)$Rep
map!(f, a) ==
fill!(temp, false)
for i in 0..N-1 | a.i repeat temp(ord f char i) := true
copyInto!(a, temp, 0)
parts a ==
[char i for i in 0..N-1 | a.i]
)abbrev domain ISTRING IndexedString
++ Authors: Stephen Watt, Michael Monagan, Manuel Bronstein 1986 .. 1991
++ Description:
++ This domain implements low-level strings
IndexedString(mn : Integer) : Export == Implementation where
B ==> Boolean
C ==> Character
I ==> Integer
N ==> NonNegativeInteger
U ==> UniversalSegment Integer
Export ==> StringAggregate()
Implementation ==> add
-- These assume Character's Rep is Small I
Qelt ==> STR_ELT$Lisp
Qequal ==> EQUAL$Lisp
Qsetelt ==> STR_SETELT$Lisp
Qsize ==> QCSIZE$Lisp
Cheq ==> eql_SI$Lisp
Chlt ==> less_SI$Lisp
Chgt ==> greater_SI$Lisp
c : Character
cc : CharacterClass
new(n, c) == make_full_CVEC(n, c)$Lisp
empty() == make_full_CVEC(0$Lisp)$Lisp
empty?(s) == Qsize(s) = 0
#s == Qsize(s)
s = t == Qequal(s, t)
s < t == CGREATERP(t, s)$Lisp
concat(s : %, t : %) == STRCONC(s, t)$Lisp
copy s == COPY_-SEQ(s)$Lisp
insert(s : %, t : %, i : I) == concat(concat(s(mn..i-1), t), s(i..))
coerce(s : %) : OutputForm == outputForm(s pretend String)
minIndex s == mn
upperCase! s == map!(upperCase, s)
lowerCase! s == map!(lowerCase, s)
latex s == concat("\mbox{``", concat(s pretend String,
"''}"))
replace(s, sg, t) ==
l := low(sg) - mn
m := #s
n := #t
h : I := if hasHi sg then high(sg) - mn else maxIndex s - mn
l < 0 or h >= m or h < l-1 => error "index out of range"
r := new((m-(h-l+1)+n)::N, space$C)
for k in 0.. for i in 0..l-1 repeat Qsetelt(r, k, Qelt(s, i))
for k in k.. for i in 0..n-1 repeat Qsetelt(r, k, Qelt(t, i))
for k in k.. for i in h+1..m-1 repeat Qsetelt(r, k, Qelt(s, i))
r
qsetelt!(s : %, i : I, c : C) == Qsetelt(s, i - mn, c)
setelt!(s : %, i : I, c : C) ==
i < mn or i > maxIndex(s) => error "index out of range"
Qsetelt(s, i - mn, c)
substring?(part, whole, startpos) ==
np : I := Qsize part
nw : I := Qsize whole
(startpos := startpos - mn) < 0 => error "index out of bounds"
np > nw - startpos => false
for ip in 0..np-1 for iw in startpos.. repeat
not Cheq(Qelt(part, ip), Qelt(whole, iw)) => return false
true
position(s : %, t : %, startpos : I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
startpos >= Qsize t => mn - 1
r : I := STRPOS(s, t, startpos, NIL$Lisp)$Lisp
EQ(r, NIL$Lisp)$Lisp => mn - 1
r + mn
position(c : Character, t : %, startpos : I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
startpos >= Qsize t => mn - 1
for r in startpos..Qsize t - 1 repeat
if Cheq(Qelt(t, r), c) then return r + mn
mn - 1
position(cc : CharacterClass, t : %, startpos : I) ==
(startpos := startpos - mn) < 0 => error "index out of bounds"
startpos >= Qsize t => mn - 1
for r in startpos..Qsize t - 1 repeat
if member?(Qelt(t, r), cc) then return r + mn
mn - 1
suffix?(s, t) ==
(m := maxIndex s) > (n := maxIndex t) => false
substring?(s, t, mn + n - m)
split(s, c) ==
n := maxIndex s
for i in mn..n while s.i = c repeat 0
l := empty()$List(%)
j : Integer -- j is conditionally intialized
while i <= n and (j := position(c, s, i)) >= mn repeat
l := concat(s(i..j-1), l)
for i in j..n while s.i = c repeat 0
if i <= n then l := concat(s(i..n), l)
reverse! l
split(s, cc) ==
n := maxIndex s
for i in mn..n while member?(s.i, cc) repeat 0
l := empty()$List(%)
j : Integer -- j is conditionally intialized
while i <= n and (j := position(cc, s, i)) >= mn repeat
l := concat(s(i..j-1), l)
for i in j..n while member?(s.i, cc) repeat 0
if i <= n then l := concat(s(i..n), l)
reverse! l
leftTrim(s, cc) ==
n := maxIndex s
for i in mn .. n while member?(s.i, cc) repeat 0
s(i..n)
rightTrim(s, cc) ==
for j in maxIndex s .. mn by -1 while member?(s.j, cc) repeat 0
s(minIndex(s)..j)
concat l ==
t := new(+/[#s for s in l], space$C)
i := mn
for s in l repeat
copyInto!(t, s, i)
i := i + #s
t
copyInto!(y, x, s) ==
m := #x
n := #y
s := s - mn
s < 0 or s+m > n => error "index out of range"
RPLACSTR(y, s, m, x, 0, m)$Lisp
y
qelt(s : %, i : I) == Qelt(s, i - mn)
elt(s : %, i : I) ==
i < mn or i > maxIndex(s) => error "index out of range"
Qelt(s, i - mn)
elt(s : %, sg : U) ==
l := low(sg) - mn
h := if hasHi sg then high(sg) - mn else maxIndex s - mn
l < 0 or h >= #s => error "index out of bounds"
SUBSTRING(s, l, max(0, h-l+1))$Lisp
hashUpdate!(hs, s) == update!(hs, SXHASH(s)$Lisp)$HashState
match?(pattern, target, dontcare) ==
n := maxIndex pattern
p := position(dontcare, pattern, m := minIndex pattern)::N
p = m-1 => pattern = target
(p ~= m) and not prefix?(pattern(m..p-1), target) => false
i := p -- index into target
q := position(dontcare, pattern, p + 1)::N
while q ~= m-1 repeat
s := pattern(p+1..q-1)
i := position(s, target, i)::N
i = m-1 => return false
i := i + #s
p := q
q := position(dontcare, pattern, q + 1)::N
(p ~= n) and not suffix?(pattern(p+1..n), target) => false
true
)abbrev domain STRING String
++ Description:
++ This is the domain of character strings.
MINSTRINGINDEX ==> 1 -- as of 3/14/90.
--String() : StringCategory with
String() : Export == Implementation where
OF ==> OutputForm
Export ==> StringCategory with
ucodeToString : Integer -> %
++ ucodeToString(n) converts Unicode code point to one-character
++ string. If UTF-8 is in use the string may contain multiple
++ octets.
uentries : % -> List(SingleInteger)
++ uentries(s) converts s to a list of Unicode code points
++ encoding characters in s. It work even if lower layer
++ does not support Unicode, in such case string is treated
++ as sequence of octets using UTF-8 encoding. Consegently
++ length of returened list may be smaller than length
++ of the string in octets.
-- begin new code jg
toInteger: % -> Integer
++ toInteger(s) changes s into an integer, if it is a list of digits
++ possible after a minus sign.
toDecimalExpansion: % -> DecimalExpansion
++ toDecimalExpansion(s) changes s into a decimal expansion, if
++ it is a list of digit, possible after a minus sign,
++ containing at most one comma, but is allowed to contain
++ arbitrary many blanks and periods.
-- end new code jg
-- == IndexedString(MINSTRINGINDEX) add
Implementation ==> IndexedString(MINSTRINGINDEX) add
import OutputForm
-- begin new code jg
toInteger(s: %): Integer ==
lc : List Character := parts s
empty? lc => 0
negative? : Boolean := first(lc) = char "-"
if negative? then lc := rest lc
res : Integer := 0
for c in lc repeat
if c ~= char "." then
res := 10 * res + toDigit(c)$Character
if negative? then -res else res
toDecimalExpansion(s: %): DecimalExpansion ==
lc : List Character := parts s
empty? lc => 0
negative? : Boolean := first(lc) = char "-"
if negative? then lc := rest lc
lc' : List Character := copy lc
res : DecimalExpansion := 0
ten : DecimalExpansion := 10 :: DecimalExpansion
oneTenth : DecimalExpansion := 1/ten
for c in lc repeat
if c = char "," then
lc' := rest lc'
break
if c ~= char "." then
res := ten * res + toDigit(c) :: DecimalExpansion
lc' := rest lc'
lc' := reverse lc'
res' : DecimalExpansion := 0
for c in lc' repeat
if c ~= char "." then
res' := oneTenth * (res' + toDigit(c) :: DecimalExpansion)
res := res+res'
if negative? then -res else res
-- end new code jg
ucodeToString(n : Integer) : % == NUM2USTR(n)$Lisp
uentries(s : %) : List(SingleInteger) == UENTRIES(s)$Lisp
string n == STRINGIMAGE(n)$Lisp
OMwrite(dev : OpenMathDevice, x : %, wholeObj : Boolean) : Void ==
if wholeObj then
OMputObject(dev)
OMputString(dev, x pretend String)
if wholeObj then
OMputEndObject(dev)
convert(x : %) : InputForm == x pretend InputForm
qelt(s : %, i : Integer) == STR_ELT1(s, i)$Lisp
qsetelt!(s : %, i : Integer, c : Character) == STR_SETELT1(s, i, c)$Lisp
)abbrev category STRICAT StringCategory
-- Note that StringCategory is built into the old compiler
-- redundant SetCategory added to help A# compiler
++ Description:
++ A category for string-like objects
StringCategory() : Category == Join(StringAggregate(), SetCategory, OpenMath)
with
string : Integer -> %
++ string(i) returns the decimal representation of i as a string.
--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.
