conservatory
/
femtolisp
4
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

fix bug in (case) 

reducing use of strlen
This commit is contained in:
JeffBezanson 2009-03-13 14:54:48 +00:00
parent 0643a4f3a2
commit dceced2bb0
3 changed files with 26 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
femtolisp/print.c
View File

@ -14,6 +14,11 @@ static void outs(char *s, ios_t *f)
ios_puts(s, f); ios_puts(s, f);
HPOS += u8_strwidth(s); HPOS += u8_strwidth(s);
} }
static void outsn(char *s, ios_t *f, size_t n)
{
ios_write(f, s, n);
HPOS += u8_strwidth(s);
}
static int outindent(int n, ios_t *f) static int outindent(int n, ios_t *f)
{ {
// move back to left margin if we get too indented // move back to left margin if we get too indented
@ -269,7 +274,7 @@ static void print_pair(ios_t *f, value_t v, int princ)
cd = cdr_(v); cd = cdr_(v);
if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) { if (!iscons(cd) || ptrhash_has(&printconses, (void*)cd)) {
if (cd != NIL) { if (cd != NIL) {
outs(" . ", f); outsn(" . ", f, 3);
fl_print_child(f, cd, princ); fl_print_child(f, cd, princ);
} }
outc(')', f); outc(')', f);
@ -340,7 +345,7 @@ void fl_print_child(ios_t *f, value_t v, int princ)
if (princ) if (princ)
outs(name, f); outs(name, f);
else if (ismanaged(v)) { else if (ismanaged(v)) {
outs("#:", f); outsn("#:", f, 2);
outs(name, f); outs(name, f);
} }
else else
@ -348,20 +353,20 @@ void fl_print_child(ios_t *f, value_t v, int princ)
break; break;
case TAG_BUILTIN: case TAG_BUILTIN:
if (v == FL_T) { if (v == FL_T) {
outs("#t", f); outsn("#t", f, 2);
break; break;
} }
if (v == FL_F) { if (v == FL_F) {
outs("#f", f); outsn("#f", f, 2);
break; break;
} }
if (v == NIL) { if (v == NIL) {
outs("()", f); outsn("()", f, 2);
break; break;
} }
if (isbuiltin(v)) { if (isbuiltin(v)) {
if (!princ) if (!princ)
outs("#.", f); outsn("#.", f, 2);
outs(builtin_names[uintval(v)], f); outs(builtin_names[uintval(v)], f);
break; break;
} }
@ -434,8 +439,8 @@ static void print_string(ios_t *f, char *str, size_t sz)
outc('"', f); outc('"', f);
while (i < sz) { while (i < sz) {
u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0); size_t n = u8_escape(buf, sizeof(buf), str, &i, sz, 1, 0);
outs(buf, f); outsn(buf, f, n-1);
} }
outc('"', f); outc('"', f);
} }
@ -467,7 +472,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1); size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
seq[nb] = '\0'; seq[nb] = '\0';
// TODO: better multibyte handling // TODO: better multibyte handling
if (!princ) outs("#\\", f); if (!princ) outsn("#\\", f, 2);
outs(seq, f); outs(seq, f);
} }
else if (weak) { else if (weak) {
@ -530,9 +535,9 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
} }
else if (d == 0) { else if (d == 0) {
if (1/d < 0) if (1/d < 0)
outs("-0.0", f); outsn("-0.0", f, 4);
else else
outs("0.0", f); outsn("0.0", f, 3);
if (type == floatsym && !princ && !weak) if (type == floatsym && !princ && !weak)
outc('f', f); outc('f', f);
} }
@ -540,7 +545,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10); snprint_real(buf, sizeof(buf), d, 0, ndec, 3, 10);
int hasdec = (strpbrk(buf, ".eE") != NULL); int hasdec = (strpbrk(buf, ".eE") != NULL);
outs(buf, f); outs(buf, f);
if (!hasdec) outs(".0", f); if (!hasdec) outsn(".0", f, 2);
if (type == floatsym && !princ && !weak) if (type == floatsym && !princ && !weak)
outc('f', f); outc('f', f);
} }
@ -589,7 +594,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
} }
size_t i; size_t i;
if (!weak) { if (!weak) {
outs("#array(", f); outsn("#array(", f, 7);
fl_print_child(f, eltype, princ); fl_print_child(f, eltype, princ);
if (cnt > 0) if (cnt > 0)
outc(' ', f); outc(' ', f);
@ -613,7 +618,7 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
value_t syms = car(cdr_(type)); value_t syms = car(cdr_(type));
assert(isvector(syms)); assert(isvector(syms));
if (!weak) { if (!weak) {
outs("#enum(", f); outsn("#enum(", f, 6);
fl_print_child(f, syms, princ); fl_print_child(f, syms, princ);
outc(' ', f); outc(' ', f);
} }

4
femtolisp/system.lsp
View File

@ -189,9 +189,7 @@
(define (expand x) (macroexpand x)) (define (expand x) (macroexpand x))
(define = eqv?) (define = eqv?)
(define eql eqv?)
(define (/= a b) (not (eqv? a b))) (define (/= a b) (not (eqv? a b)))
(define != /=)
(define (> a b) (< b a)) (define (> a b) (< b a))
(define (<= a b) (not (< b a))) (define (<= a b) (not (< b a)))
(define (>= a b) (not (< a b))) (define (>= a b) (not (< a b)))
@ -422,7 +420,7 @@
(define (vals->cond key v) (define (vals->cond key v)
(cond ((eq? v 'else) 'else) (cond ((eq? v 'else) 'else)
((null? v) #f) ((null? v) #f)
((atom? v) `(eqv? ,key ,v)) ((atom? v) `(eqv? ,key ,(quote-value v)))
((null? (cdr v)) `(eqv? ,key ,(quote-value (car v)))) ((null? (cdr v)) `(eqv? ,key ,(quote-value (car v))))
(else `(memv ,key ',v)))) (else `(memv ,key ',v))))
(let ((g (gensym))) (let ((g (gensym)))

15
llt/dump.c
View File

@ -12,30 +12,27 @@ static char hexdig[] = "0123456789abcdef";
void hexdump(ios_t *dest, char *buffer, size_t len, size_t startoffs) void hexdump(ios_t *dest, char *buffer, size_t len, size_t startoffs)
{ {
size_t offs=0; size_t offs=0;
size_t i, pos, nc; size_t i, pos;
char ch, linebuffer[16]; char ch, linebuffer[16];
char hexc[4]; char hexc[4];
static char *spc50 = " ";
hexc[2] = hexc[3] = ' '; hexc[2] = hexc[3] = ' ';
do { do {
ios_printf(dest, "%.8x ", offs+startoffs); ios_printf(dest, "%.8x ", offs+startoffs);
pos = 10; pos = 10;
for(i=0; i < 16 && (offs+i) < len; i++) { for(i=0; i < 16 && offs < len; i++, offs++) {
ch = buffer[offs + i]; ch = buffer[offs];
linebuffer[i] = (ch<32 || ch>=0x7f) ? '.' : ch; linebuffer[i] = (ch<32 || ch>=0x7f) ? '.' : ch;
hexc[0] = hexdig[((unsigned char)ch)>>4]; hexc[0] = hexdig[((unsigned char)ch)>>4];
hexc[1] = hexdig[ch&0x0f]; hexc[1] = hexdig[ch&0x0f];
nc = (i==7 || i==15) ? 4 : 3; pos += ios_write(dest, hexc, (i==7 || i==15) ? 4 : 3);
ios_write(dest, hexc, nc);
pos += nc;
} }
for(; i < 16; i++) for(; i < 16; i++)
linebuffer[i] = ' '; linebuffer[i] = ' ';
for(i=0; i < 60-pos; i++) ios_write(dest, spc50, 60-pos);
ios_putc(' ', dest);
ios_putc('|', dest); ios_putc('|', dest);
ios_write(dest, linebuffer, 16); ios_write(dest, linebuffer, 16);
ios_write(dest, "|\n", 2); ios_write(dest, "|\n", 2);
offs += 16;
} while (offs < len); } while (offs < len);
} }