graphics/gimp
graphics/gimp
1
0
Fork 0
mirror of https://gitlab.gnome.org/GNOME/gimp synced 2024-10-20 19:43:01 +00:00
Code Issues Packages Projects Releases Wiki Activity

R5RS compatability fix for string->number and number->string (SF bug #3399335)

Browse source 
Optional radix parameter from SVN version 92 of official version of TinyScheme.
This commit is contained in:
Kevin Cozens 2012-12-14 17:36:26 -05:00
parent 82f2c0b1ce
commit df30fd6e68
4 changed files with 103 additions and 35 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

7
plug-ins/script-fu/scripts/script-fu.init
View file

@ -142,7 +142,9 @@
(if (pred a) a
(error "string->xxx: not a xxx" a))))
(define (string->number str) (string->anyatom str number?))
(define (string->number str . base)
(let ((n (string->atom str (if (null? base) 10 (car base)))))
(if (number? n) n #f)))
(define (anyatom->string n pred)
(if (pred n)
@ -150,7 +152,8 @@
(error "xxx->string: not a xxx" n)))
(define (number->string n) (anyatom->string n number?))
(define (number->string n . base)
(atom->string n (if (null? base) 10 (car base))))
(define (char-cmp? cmp a b)
(cmp (char->integer a) (char->integer b)))

7
plug-ins/script-fu/tinyscheme/init.scm
View file

@ -142,15 +142,18 @@
(if (pred a) a
(error "string->xxx: not a xxx" a))))
(define (string->number str) (string->anyatom str number?))
(define (string->number str . base)
(let ((n (string->atom str (if (null? base) 10 (car base)))))
(if (number? n) n #f)))
(define (anyatom->string n pred)
(if (pred n)
(atom->string n)
(error "xxx->string: not a xxx" n)))
(define (number->string n . base)
(atom->string n (if (null? base) 10 (car base))))
(define (number->string n) (anyatom->string n number?))
(define (char-cmp? cmp a b)
(cmp (char->integer a) (char->integer b)))

4
plug-ins/script-fu/tinyscheme/opdefines.h
View file

@ -88,9 +88,9 @@
_OP_DEF(opexe_2, "char-upcase", 1, 1, TST_CHAR, OP_CHARUPCASE )
_OP_DEF(opexe_2, "char-downcase", 1, 1, TST_CHAR, OP_CHARDNCASE )
_OP_DEF(opexe_2, "symbol->string", 1, 1, TST_SYMBOL, OP_SYM2STR )
_OP_DEF(opexe_2, "atom->string", 1, 1, TST_ANY, OP_ATOM2STR )
_OP_DEF(opexe_2, "atom->string", 1, 2, TST_ANY TST_NATURAL, OP_ATOM2STR )
_OP_DEF(opexe_2, "string->symbol", 1, 1, TST_STRING, OP_STR2SYM )
_OP_DEF(opexe_2, "string->atom", 1, 1, TST_STRING, OP_STR2ATOM )
_OP_DEF(opexe_2, "string->atom", 1, 2, TST_STRING TST_NATURAL, OP_STR2ATOM )
_OP_DEF(opexe_2, "make-string", 1, 2, TST_NATURAL TST_CHAR, OP_MKSTRING )
_OP_DEF(opexe_2, "string-length", 1, 1, TST_STRING, OP_STRLEN )
_OP_DEF(opexe_2, "string-ref", 2, 2, TST_STRING TST_NATURAL, OP_STRREF )

120
plug-ins/script-fu/tinyscheme/scheme.c
View file

@ -1437,7 +1437,6 @@ static int file_push(scheme *sc, const char *fname) {
if(fname)
sc->load_stack[sc->file_i].rep.stdio.filename = store_string(sc, strlen(fname), fname, 0);
#endif
}
return fin!=0;
}
@ -2126,17 +2125,38 @@ static void atom2str(scheme *sc, pointer l, int f, char **pp, int *plen) {
snprintf(p, STRBUFFSIZE, "#<PORT>");
} else if (is_number(l)) {
p = sc->strbuff;
if(num_is_integer(l)) {
snprintf(p, STRBUFFSIZE, "%ld", ivalue_unchecked(l));
if (f <= 1 || f == 10) /* f is the base for numbers if > 1 */ {
if(num_is_integer(l)) {
snprintf(p, STRBUFFSIZE, "%ld", ivalue_unchecked(l));
} else {
snprintf(p, STRBUFFSIZE, "%.10g", rvalue_unchecked(l));
/* r5rs says there must be a '.' (unless 'e'?) */
f = strcspn(p, ".e");
if (p[f] == 0) {
p[f] = '.'; // not found, so add '.0' at the end
p[f+1] = '0';
p[f+2] = 0;
}
}
} else {
snprintf(p, STRBUFFSIZE, "%.10g", rvalue_unchecked(l));
/* R5RS says there must be a '.' (unless 'e'?) */
f = strcspn(p, ".e");
if (p[f] == 0) {
p[f] = '.'; // not found, so add '.0' at the end
p[f+1] = '0';
p[f+2] = 0;
}
long v = ivalue(l);
if (f == 16) {
if (v >= 0)
snprintf(p, STRBUFFSIZE, "%lx", v);
else
snprintf(p, STRBUFFSIZE, "-%lx", -v);
} else if (f == 8) {
if (v >= 0)
snprintf(p, STRBUFFSIZE, "%lo", v);
else
snprintf(p, STRBUFFSIZE, "-%lo", -v);
} else if (f == 2) {
unsigned long b = (v < 0) ? -v : v;
p = &p[STRBUFFSIZE-1];
*p = 0;
do { *--p = (b&1) ? '1' : '0'; b >>= 1; } while (b != 0);
if (v < 0) *--p = '-';
}
}
} else if (is_string(l)) {
if (!f) {
@ -2981,7 +3001,7 @@ static pointer opexe_0(scheme *sc, enum scheme_opcodes op) {
sc->code = car(sc->code);
else
sc->code = cadr(sc->code); /* (if #f 1) ==> () because
* car(sc->NIL) = sc->NIL */
* car(sc->NIL) = sc->NIL */
s_goto(sc,OP_EVAL);
case OP_LET0: /* let */
@ -3528,28 +3548,70 @@ static pointer opexe_2(scheme *sc, enum scheme_opcodes op) {
s_return(sc,mk_symbol(sc,strvalue(car(sc->args))));
case OP_STR2ATOM: /* string->atom */ {
char *s=strvalue(car(sc->args));
if(*s=='#') {
s_return(sc, mk_sharp_const(sc, s+1));
} else {
s_return(sc, mk_atom(sc, s));
}
}
char *s=strvalue(car(sc->args));
long pf = 0;
if(cdr(sc->args)!=sc->NIL) {
/* we know cadr(sc->args) is a natural number */
/* see if it is 2, 8, 10, or 16, or error */
pf = ivalue_unchecked(cadr(sc->args));
if(pf == 16 || pf == 10 || pf == 8 || pf == 2) {
/* base is OK */
}
else {
pf = -1;
}
}
if (pf < 0) {
Error_1(sc, "string->atom: bad base:", cadr(sc->args));
} else if(*s=='#') /* no use of base! */ {
s_return(sc, mk_sharp_const(sc, s+1));
} else {
if (pf == 0 || pf == 10) {
s_return(sc, mk_atom(sc, s));
}
else {
char *ep;
long iv = strtol(s,&ep,(int )pf);
if (*ep == 0) {
s_return(sc, mk_integer(sc, iv));
}
else {
s_return(sc, sc->F);
}
}
}
}
case OP_SYM2STR: /* symbol->string */
x=mk_string(sc,symname(car(sc->args)));
setimmutable(x);
s_return(sc,x);
case OP_ATOM2STR: /* atom->string */
x=car(sc->args);
if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) {
char *p;
int len;
atom2str(sc,x,0,&p,&len);
s_return(sc,mk_counted_string(sc,p,len));
} else {
Error_1(sc, "atom->string: not an atom:", x);
}
case OP_ATOM2STR: /* atom->string */ {
long pf = 0;
x=car(sc->args);
if(cdr(sc->args)!=sc->NIL) {
/* we know cadr(sc->args) is a natural number */
/* see if it is 2, 8, 10, or 16, or error */
pf = ivalue_unchecked(cadr(sc->args));
if(is_number(x) && (pf == 16 || pf == 10 || pf == 8 || pf == 2)) {
/* base is OK */
}
else {
pf = -1;
}
}
if (pf < 0) {
Error_1(sc, "atom->string: bad base:", cadr(sc->args));
} else if(is_number(x) || is_character(x) || is_string(x) || is_symbol(x)) {
char *p;
int len;
atom2str(sc,x,(int )pf,&p,&len);
s_return(sc,mk_counted_string(sc,p,len));
} else {
Error_1(sc, "atom->string: not an atom:", x);
}
}
case OP_MKSTRING: { /* make-string */
gunichar fill=' ';