adding read and print support for named characters, e.g. #\space
printing infs and nans in R6RS format making closure print syntax more compact; fn instead of function adding more c[ad]+r functions
This commit is contained in:
JeffBezanson
parent
1a6d9d391f
commit
302ddec770
|
|
@ -7,6 +7,11 @@
|
|||
(define vector-set! aset!)
|
||||
(define vector-length length)
|
||||
(define make-vector vector.alloc)
|
||||
(define (vector-fill! v f)
|
||||
(for 0 (- (length v) 1)
|
||||
(lambda (i) (aset! v i f)))
|
||||
#t)
|
||||
(define (vector-map f v) (vector.map f v))
|
||||
|
||||
(define array-ref! aref)
|
||||
(define (array-set! a obj i0 . idxs)
|
||||
|
|
@ -23,18 +28,25 @@
|
|||
(define (exact? x) (integer? x))
|
||||
(define (inexact? x) (not (exact? x)))
|
||||
(define quotient div0)
|
||||
(define (inexact x) x)
|
||||
(define (exact x)
|
||||
(if (exact? x) x
|
||||
(error "exact real numbers not supported")))
|
||||
(define (finite? x) (and (< x +inf.0) (> x -inf.0)))
|
||||
(define (infinite? x) (or (equal? x +inf.0) (equal? x -inf.0)))
|
||||
(define (nan? x) (or (equal? x +nan.0) (equal? x -nan.0)))
|
||||
|
||||
(define (char->integer c) (fixnum c))
|
||||
(define (integer->char i) (wchar i))
|
||||
(define char-upcase char.upcase)
|
||||
(define char-downcase char.downcase)
|
||||
(define char=? =)
|
||||
(define char=? eqv?)
|
||||
(define char<? <)
|
||||
(define char>? >)
|
||||
(define char<=? <=)
|
||||
(define char>=? >=)
|
||||
|
||||
(define string=? =)
|
||||
(define string=? eqv?)
|
||||
(define string<? <)
|
||||
(define string>? >)
|
||||
(define string<=? <=)
|
||||
|
|
@ -44,6 +56,14 @@
|
|||
(define string-length string.count)
|
||||
(define string->symbol symbol)
|
||||
(define (symbol->string s) (string s))
|
||||
(define symbol=? eq?)
|
||||
(define (make-string k (fill #\space))
|
||||
(string.rep fill k))
|
||||
|
||||
(define (string-ref s i)
|
||||
(string.char s (string.inc s 0 i)))
|
||||
|
||||
(define (input-port? x) (iostream? x))
|
||||
(define (output-port? x) (iostream? x))
|
||||
|
||||
(define (eval-core x) (eval x))
|
||||
|
|
|
|||
File diff suppressed because one or more lines are too long
|
|
@ -89,14 +89,21 @@ static uint32_t curr_frame = 0;
|
|||
static value_t *GCHandleStack[N_GC_HANDLES];
|
||||
static uint32_t N_GCHND = 0;
|
||||
|
||||
value_t NIL, FL_T, FL_F, LAMBDA, QUOTE, IF, TRYCATCH;
|
||||
value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
|
||||
value_t NIL, FL_T, FL_F;
|
||||
value_t IOError, ParseError, TypeError, ArgError, UnboundError, MemoryError;
|
||||
value_t DivideError, BoundsError, Error, KeyError, EnumerationError;
|
||||
value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
|
||||
value_t definesym, defmacrosym, forsym, labelsym, printprettysym, setqsym;
|
||||
value_t printwidthsym, printreadablysym;
|
||||
value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym;
|
||||
value_t printwidthsym, printreadablysym, printprettysym;
|
||||
|
||||
value_t QUOTE;
|
||||
static value_t LAMBDA, IF, TRYCATCH;
|
||||
static value_t BACKQUOTE, COMMA, COMMAAT, COMMADOT, FUNCTION;
|
||||
|
||||
static value_t pairsym, symbolsym, fixnumsym, vectorsym, builtinsym, vu8sym;
|
||||
static value_t definesym, defmacrosym, forsym, labelsym, setqsym;
|
||||
static value_t tsym, Tsym, fsym, Fsym, booleansym, nullsym, evalsym, fnsym;
|
||||
// for reading characters
|
||||
static value_t nulsym, alarmsym, backspacesym, tabsym, linefeedsym, newlinesym;
|
||||
static value_t vtabsym, pagesym, returnsym, escsym, spacesym, deletesym;
|
||||
|
||||
static value_t apply_cl(uint32_t nargs);
|
||||
static value_t *alloc_words(int n);
|
||||
|
|
@ -2089,39 +2096,31 @@ static void lisp_init(void)
|
|||
NIL = builtin(OP_THE_EMPTY_LIST);
|
||||
FL_T = builtin(OP_BOOL_CONST_T);
|
||||
FL_F = builtin(OP_BOOL_CONST_F);
|
||||
LAMBDA = symbol("lambda");
|
||||
FUNCTION = symbol("function");
|
||||
QUOTE = symbol("quote");
|
||||
TRYCATCH = symbol("trycatch");
|
||||
BACKQUOTE = symbol("backquote");
|
||||
COMMA = symbol("*comma*");
|
||||
COMMAAT = symbol("*comma-at*");
|
||||
COMMADOT = symbol("*comma-dot*");
|
||||
IOError = symbol("io-error");
|
||||
ParseError = symbol("parse-error");
|
||||
TypeError = symbol("type-error");
|
||||
ArgError = symbol("arg-error");
|
||||
LAMBDA = symbol("lambda"); FUNCTION = symbol("function");
|
||||
QUOTE = symbol("quote"); TRYCATCH = symbol("trycatch");
|
||||
BACKQUOTE = symbol("backquote"); COMMA = symbol("*comma*");
|
||||
COMMAAT = symbol("*comma-at*"); COMMADOT = symbol("*comma-dot*");
|
||||
IOError = symbol("io-error"); ParseError = symbol("parse-error");
|
||||
TypeError = symbol("type-error"); ArgError = symbol("arg-error");
|
||||
UnboundError = symbol("unbound-error");
|
||||
KeyError = symbol("key-error");
|
||||
MemoryError = symbol("memory-error");
|
||||
KeyError = symbol("key-error"); MemoryError = symbol("memory-error");
|
||||
BoundsError = symbol("bounds-error");
|
||||
DivideError = symbol("divide-error");
|
||||
EnumerationError = symbol("enumeration-error");
|
||||
Error = symbol("error");
|
||||
pairsym = symbol("pair");
|
||||
symbolsym = symbol("symbol");
|
||||
fixnumsym = symbol("fixnum");
|
||||
vectorsym = symbol("vector");
|
||||
builtinsym = symbol("builtin");
|
||||
booleansym = symbol("boolean");
|
||||
nullsym = symbol("null");
|
||||
definesym = symbol("define");
|
||||
defmacrosym = symbol("define-macro");
|
||||
forsym = symbol("for");
|
||||
labelsym = symbol("label");
|
||||
setqsym = symbol("set!");
|
||||
evalsym = symbol("eval");
|
||||
vu8sym = symbol("vu8");
|
||||
Error = symbol("error"); pairsym = symbol("pair");
|
||||
symbolsym = symbol("symbol"); fixnumsym = symbol("fixnum");
|
||||
vectorsym = symbol("vector"); builtinsym = symbol("builtin");
|
||||
booleansym = symbol("boolean"); nullsym = symbol("null");
|
||||
definesym = symbol("define"); defmacrosym = symbol("define-macro");
|
||||
forsym = symbol("for"); labelsym = symbol("label");
|
||||
setqsym = symbol("set!"); evalsym = symbol("eval");
|
||||
vu8sym = symbol("vu8"); fnsym = symbol("fn");
|
||||
nulsym = symbol("nul"); alarmsym = symbol("alarm");
|
||||
backspacesym = symbol("backspace"); tabsym = symbol("tab");
|
||||
linefeedsym = symbol("linefeed"); vtabsym = symbol("vtab");
|
||||
pagesym = symbol("page"); returnsym = symbol("return");
|
||||
escsym = symbol("esc"); spacesym = symbol("space");
|
||||
deletesym = symbol("delete"); newlinesym = symbol("newline");
|
||||
tsym = symbol("t"); Tsym = symbol("T");
|
||||
fsym = symbol("f"); Fsym = symbol("F");
|
||||
set(printprettysym=symbol("*print-pretty*"), FL_T);
|
||||
|
|
|
|||
|
|
@ -253,12 +253,13 @@ typedef float float_t;
|
|||
|
||||
typedef value_t (*builtin_t)(value_t*, uint32_t);
|
||||
|
||||
extern value_t QUOTE;
|
||||
extern value_t int8sym, uint8sym, int16sym, uint16sym, int32sym, uint32sym;
|
||||
extern value_t int64sym, uint64sym;
|
||||
extern value_t longsym, ulongsym, bytesym, wcharsym;
|
||||
extern value_t structsym, arraysym, enumsym, cfunctionsym, voidsym, pointersym;
|
||||
extern value_t stringtypesym, wcstringtypesym, emptystringsym;
|
||||
extern value_t unionsym, floatsym, doublesym, builtinsym;
|
||||
extern value_t unionsym, floatsym, doublesym;
|
||||
extern fltype_t *bytetype, *wchartype;
|
||||
extern fltype_t *stringtype, *wcstringtype;
|
||||
extern fltype_t *builtintype;
|
||||
|
|
|
|||
|
|
@ -399,7 +399,7 @@ void fl_print_child(ios_t *f, value_t v)
|
|||
if (!print_princ) {
|
||||
if (print_circle_prefix(f, v)) return;
|
||||
function_t *fn = (function_t*)ptr(v);
|
||||
outs("#function(", f);
|
||||
outs("#fn(", f);
|
||||
char *data = cvalue_data(fn->bcode);
|
||||
size_t i, sz = cvalue_len(fn->bcode);
|
||||
for(i=0; i < sz; i++) data[i] += 48;
|
||||
|
|
@ -515,15 +515,28 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
|
|||
else if (type == wcharsym) {
|
||||
uint32_t wc = *(uint32_t*)data;
|
||||
char seq[8];
|
||||
if (print_princ || iswprint(wc)) {
|
||||
size_t nb = u8_toutf8(seq, sizeof(seq), &wc, 1);
|
||||
seq[nb] = '\0';
|
||||
if (print_princ) {
|
||||
// TODO: better multibyte handling
|
||||
if (!print_princ) outsn("#\\", f, 2);
|
||||
outs(seq, f);
|
||||
}
|
||||
else {
|
||||
HPOS+=ios_printf(f, "#\\x%04x", (int)wc);
|
||||
outsn("#\\", f, 2);
|
||||
if (wc == 0x00) outsn("nul", f, 3);
|
||||
else if (wc == 0x07) outsn("alarm", f, 5);
|
||||
else if (wc == 0x08) outsn("backspace", f, 9);
|
||||
else if (wc == 0x09) outsn("tab", f, 3);
|
||||
else if (wc == 0x0A) outsn("linefeed", f, 8);
|
||||
//else if (wc == 0x0A) outsn("newline", f, 7);
|
||||
else if (wc == 0x0B) outsn("vtab", f, 4);
|
||||
else if (wc == 0x0C) outsn("page", f, 4);
|
||||
else if (wc == 0x0D) outsn("return", f, 6);
|
||||
else if (wc == 0x1B) outsn("esc", f, 3);
|
||||
else if (wc == 0x20) outsn("space", f, 5);
|
||||
else if (wc == 0x7F) outsn("delete", f, 6);
|
||||
else if (iswprint(wc)) outs(seq, f);
|
||||
else HPOS+=ios_printf(f, "x%04x", (int)wc);
|
||||
}
|
||||
}
|
||||
else if (type == int64sym
|
||||
|
|
@ -569,9 +582,9 @@ static void cvalue_printdata(ios_t *f, void *data, size_t len, value_t type,
|
|||
if (!DFINITE(d)) {
|
||||
char *rep;
|
||||
if (isnan(d))
|
||||
rep = sign_bit(d) ? "-NaN" : "+NaN";
|
||||
rep = sign_bit(d) ? "-nan.0" : "+nan.0";
|
||||
else
|
||||
rep = sign_bit(d) ? "-Inf" : "+Inf";
|
||||
rep = sign_bit(d) ? "-inf.0" : "+inf.0";
|
||||
if (type == floatsym && !print_princ && !weak)
|
||||
HPOS+=ios_printf(f, "#%s(%s)", symbol_name(type), rep);
|
||||
else
|
||||
|
|
|
|||
|
|
@ -216,6 +216,25 @@ static u_int32_t peek()
|
|||
cval = numval(tokval);
|
||||
}
|
||||
}
|
||||
else if (cval >= 'a' && cval <= 'z') {
|
||||
read_token((char)cval, 0);
|
||||
tokval = symbol(buf);
|
||||
if (buf[1] == '\0') /* one character */;
|
||||
else if (tokval == nulsym) cval = 0x00;
|
||||
else if (tokval == alarmsym) cval = 0x07;
|
||||
else if (tokval == backspacesym) cval = 0x08;
|
||||
else if (tokval == tabsym) cval = 0x09;
|
||||
else if (tokval == linefeedsym) cval = 0x0A;
|
||||
else if (tokval == newlinesym) cval = 0x0A;
|
||||
else if (tokval == vtabsym) cval = 0x0B;
|
||||
else if (tokval == pagesym) cval = 0x0C;
|
||||
else if (tokval == returnsym) cval = 0x0D;
|
||||
else if (tokval == escsym) cval = 0x1B;
|
||||
else if (tokval == spacesym) cval = 0x20;
|
||||
else if (tokval == deletesym) cval = 0x7F;
|
||||
else
|
||||
lerrorf(ParseError, "read: unknown character #\\%s", buf);
|
||||
}
|
||||
toktype = TOK_NUM;
|
||||
tokval = mk_wchar(cval);
|
||||
}
|
||||
|
|
@ -580,6 +599,9 @@ static value_t do_read_sexpr(value_t label)
|
|||
sym = arraysym;
|
||||
Stack[SP-1] = fl_cons(uint8sym, Stack[SP-1]);
|
||||
}
|
||||
else if (sym == fnsym) {
|
||||
sym = FUNCTION;
|
||||
}
|
||||
v = symbol_value(sym);
|
||||
if (v == UNBOUND)
|
||||
raise(list2(UnboundError, sym));
|
||||
|
|
|
|||
|
|
@ -147,7 +147,22 @@
|
|||
(define (cdadr x) (cdr (car (cdr x))))
|
||||
(define (cddar x) (cdr (cdr (car x))))
|
||||
(define (cdddr x) (cdr (cdr (cdr x))))
|
||||
(define (caaaar x) (car (car (car (car x)))))
|
||||
(define (caaadr x) (car (car (car (cdr x)))))
|
||||
(define (caadar x) (car (car (cdr (car x)))))
|
||||
(define (caaddr x) (car (car (cdr (cdr x)))))
|
||||
(define (cadaar x) (car (cdr (car (car x)))))
|
||||
(define (cadadr x) (car (cdr (car (cdr x)))))
|
||||
(define (caddar x) (car (cdr (cdr (car x)))))
|
||||
(define (cadddr x) (car (cdr (cdr (cdr x)))))
|
||||
(define (cdaaar x) (cdr (car (car (car x)))))
|
||||
(define (cdaadr x) (cdr (car (car (cdr x)))))
|
||||
(define (cdadar x) (cdr (car (cdr (car x)))))
|
||||
(define (cdaddr x) (cdr (car (cdr (cdr x)))))
|
||||
(define (cddaar x) (cdr (cdr (car (car x)))))
|
||||
(define (cddadr x) (cdr (cdr (car (cdr x)))))
|
||||
(define (cdddar x) (cdr (cdr (cdr (car x)))))
|
||||
(define (cddddr x) (cdr (cdr (cdr (cdr x)))))
|
||||
|
||||
(let ((*values* (list '*values*)))
|
||||
(set! values
|
||||
|
|
@ -511,10 +526,12 @@
|
|||
(for-each write args)))
|
||||
|
||||
(define (newline) (princ *linefeed*) #t)
|
||||
(define (display x) (princ x) #t)
|
||||
(define (display x (port *output-stream*))
|
||||
(with-output-to port (princ x))
|
||||
#t)
|
||||
(define (println . args) (prog1 (apply print args) (newline)))
|
||||
|
||||
(define (io.readline s) (io.readuntil s #\x0a))
|
||||
(define (io.readline s) (io.readuntil s #\linefeed))
|
||||
|
||||
; call f on a stream until the stream runs out of data
|
||||
(define (read-all-of f s)
|
||||
|
|
|
|||
|
|
@ -643,6 +643,7 @@ low-level functions:
|
|||
- (eltype type field [field ...])
|
||||
- (memcpy dest-cv src-cv)
|
||||
- (memcpy dest doffs src soffs nbytes)
|
||||
- (bswap cvalue)
|
||||
- (c2lisp cvalue) ; convert to sexpr form
|
||||
* (typeof cvalue)
|
||||
* (sizeof cvalue|type)
|
||||
|
|
@ -968,7 +969,7 @@ consolidated todo list as of 7/8:
|
|||
|
||||
- evaluator improvements, perf & debugging (below)
|
||||
* fix make-system-image to save aliases of builtins
|
||||
- reading named characters, e.g. #\newline etc.
|
||||
* reading named characters, e.g. #\newline etc.
|
||||
- #+, #- reader macros
|
||||
- printing improvements: *print-big*, keep track of horiz. position
|
||||
per-stream so indenting works across print calls
|
||||
|
|
@ -978,6 +979,7 @@ consolidated todo list as of 7/8:
|
|||
* optional arguments
|
||||
* keyword arguments
|
||||
- some kind of record, struct, or object system
|
||||
- improve test coverage
|
||||
|
||||
- special efficient reader for #array
|
||||
- reimplement vectors as (array lispvalue)
|
||||
|
|
|
|||
Loading…
Reference in New Issue