mirror of
https://github.com/false-schemers/skint.git
synced 2024-12-26 21:58:51 +01:00
small fixes, void_obj, better error reporting
This commit is contained in:
ESL
parent
709304b17d
commit
833a6261b9
6 changed files with 588 additions and 480 deletions
32
i.c
32
i.c
|
|
@ -171,6 +171,7 @@ static void _sck(obj *s) {
|
|||
/* small object representation extras */
|
||||
#define bool_obj(b) obj_from_bool(b)
|
||||
#define char_obj(b) obj_from_char(b)
|
||||
#define void_obj() obj_from_void(0)
|
||||
#define null_obj() mknull()
|
||||
#define eof_obj() mkeof()
|
||||
#define fixnum_obj(x) obj_from_fixnum(x)
|
||||
|
|
@ -414,6 +415,7 @@ jump:
|
|||
|
||||
define_instrhelper(cxi_fail) {
|
||||
fprintf(stderr, "run-time failure: %s\n", (char*)ac);
|
||||
ac = void_obj();
|
||||
unwindi(0);
|
||||
}
|
||||
|
||||
|
|
@ -424,6 +426,7 @@ define_instrhelper(cxi_failactype) {
|
|||
oportputcircular(ac, p, 0);
|
||||
fputc('\n', stderr);
|
||||
spop();
|
||||
ac = void_obj();
|
||||
unwindi(0);
|
||||
}
|
||||
|
||||
|
|
@ -467,6 +470,22 @@ define_instruction(halt) {
|
|||
unwindi(0);
|
||||
}
|
||||
|
||||
define_instruction(panic) {
|
||||
obj l, p; cks(ac); ckl(sref(0));
|
||||
p = oport_file_obj(stderr);
|
||||
fprintf(stderr, "error: %s", stringchars(ac));
|
||||
if (ispair(sref(0))) fputs(":\n", stderr);
|
||||
else fputs("\n", stderr);
|
||||
for (l = sref(0); ispair(l); l = cdr(l)) {
|
||||
oportputcircular(car(l), p, 0);
|
||||
fputc('\n', stderr);
|
||||
}
|
||||
sdrop(1);
|
||||
ac = void_obj();
|
||||
unwindi(0);
|
||||
}
|
||||
|
||||
|
||||
define_instruction(lit) {
|
||||
ac = *ip++;
|
||||
gonexti();
|
||||
|
|
@ -2739,6 +2758,12 @@ define_instruction(cop) {
|
|||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(fop) {
|
||||
ckw(ac);
|
||||
oportflush(ac);
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(gos) {
|
||||
cxtype_oport_t *vt; ckw(ac);
|
||||
vt = ckoportvt(ac);
|
||||
|
|
@ -2789,42 +2814,49 @@ define_instruction(eof) {
|
|||
define_instruction(wrc) {
|
||||
obj x = ac, y = spop(); ckc(x); ckw(y);
|
||||
oportputc(char_from_obj(x), y);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(wrs) {
|
||||
obj x = ac, y = spop(); cks(x); ckw(y);
|
||||
oportputs(stringchars(x), y);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(wrcd) {
|
||||
obj x = ac, y = spop(); ckw(y);
|
||||
oportputcircular(x, y, 1);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(wrcw) {
|
||||
obj x = ac, y = spop(); ckw(y);
|
||||
oportputcircular(x, y, 0);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(wrnl) {
|
||||
ckw(ac);
|
||||
oportputc('\n', ac);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(wrhw) {
|
||||
obj x = ac, y = spop(); ckw(y);
|
||||
oportputshared(x, y, 0);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
define_instruction(wriw) {
|
||||
obj x = ac, y = spop(); ckw(y);
|
||||
oportputsimple(x, y, 0);
|
||||
ac = void_obj();
|
||||
gonexti();
|
||||
}
|
||||
|
||||
|
|
|
|||
2
i.h
2
i.h
|
|
@ -455,6 +455,7 @@ declare_instruction(ois, "P50", 0, "open-input-string", '1',
|
|||
declare_instruction(oos, "P51", 0, "open-output-string", '0', AUTOGL)
|
||||
declare_instruction(cip, "P60", 0, "close-input-port", '1', AUTOGL)
|
||||
declare_instruction(cop, "P61", 0, "close-output-port", '1', AUTOGL)
|
||||
declare_instruction(fop, "P71", 0, "flush-output-port", '1', AUTOGL)
|
||||
declare_instruction(gos, "P9", 0, "get-output-string", '1', AUTOGL)
|
||||
declare_instruction(rdc, "R0\0P10", 0, "read-char", 'u', AUTOGL)
|
||||
declare_instruction(rdac, "R1\0P10", 0, "peek-char", 'u', AUTOGL)
|
||||
|
|
@ -468,6 +469,7 @@ declare_instruction(wrcw, "W5\0P11", 0, "write", 'b',
|
|||
declare_instruction(wrnl, "W6\0P11", 0, "newline", 'u', AUTOGL)
|
||||
declare_instruction(wrhw, "W7\0P11", 0, "write-shared", 'b', AUTOGL)
|
||||
declare_instruction(wriw, "W8\0P11", 0, "write-simple", 'b', AUTOGL)
|
||||
declare_instruction(panic, "Z7", 0, "%panic", '2', AUTOGL)
|
||||
|
||||
/* serialization and deserialization instructions */
|
||||
declare_instruction(igp, "U0", 0, "integrable?", '1', AUTOGL)
|
||||
|
|
|
|||
44
s.c
44
s.c
|
|
@ -172,6 +172,29 @@ char *s_code[] = {
|
|||
"P", "square",
|
||||
"%1.0,.1*]1",
|
||||
|
||||
"P", "exact-integer-sqrt",
|
||||
"%1.0It,.0,.1*,.2-,.1,@(y6:values)[22",
|
||||
|
||||
"P", "make-rectangular",
|
||||
"%2'0,.2=?{.0]2}.1,'(s49:make-rectangular: nonzero imag part not suppor"
|
||||
"ted),@(y5:error)[22",
|
||||
|
||||
"P", "make-polar",
|
||||
"%2'0,.2=?{.0]2}'(j3.14159265358979),.2=?{.0-!]2}.1,'(s31:make-polar: a"
|
||||
"ngle not supported),@(y5:error)[22",
|
||||
|
||||
"P", "real-part",
|
||||
"%1.0]1",
|
||||
|
||||
"P", "imag-part",
|
||||
"%1'0]1",
|
||||
|
||||
"P", "magnitude",
|
||||
"%1.0Na]1",
|
||||
|
||||
"P", "angle",
|
||||
"%1.0<0?{'(j3.14159265358979)]1}'0]1",
|
||||
|
||||
"P", "%append",
|
||||
"%!0.0,,#0.0,&1{%1.0u?{n]1}.0du?{.0a]1}${.2d,:0^[01},.1aL6]1}.!0.0^_1[1"
|
||||
"1",
|
||||
|
|
@ -427,6 +450,9 @@ char *s_code[] = {
|
|||
"I+,:3^[11}.!0.0^_1[41}${.2,.5c,@(y13:%25vector->list),@(y5:%25map1)[02"
|
||||
"},.2c,@(y9:%25for-each),@(y13:apply-to-list)[32",
|
||||
|
||||
"P", "error",
|
||||
"%!1.0,.2Z7]2",
|
||||
|
||||
"P", "port?",
|
||||
"%1.0P00,.0?{.0]2}.1P01]2",
|
||||
|
||||
|
|
@ -448,5 +474,23 @@ char *s_code[] = {
|
|||
"=}_1?{.0R8?{.1}{f}?{.0]2}:1P9,:1P61.0]3}'(c%0d),.1C=?{f,:0^[21}:1,.1W0"
|
||||
"f,:0^[21}.!0.0^_1[31",
|
||||
|
||||
"P", "read-substring!",
|
||||
"%4.1,,#0.5,.4,.4,.3,.8,&5{%1:0,.1I<!?{:3,.1I-]1}:4R0,.0R8?{:3,.2I=?{.0"
|
||||
"]2}:3,.2I-]2}.0,.2,:2S5'1,.2I+,:1^[21}.!0.0^_1[41",
|
||||
|
||||
"P", "read-substring",
|
||||
"%2'(c ),.1S2,${.4,.4,'0,.5,@(y15:read-substring!)[04},.0R8?{.0]4}.2,.1"
|
||||
"I=?{.1]4}.0,'0,.3S7]4",
|
||||
|
||||
"C", 0,
|
||||
"&0{%4.1,.4,.4,.3,@(y15:read-substring!)[44}%x,&0{%3.1,.1S3,.4,.3,@(y15"
|
||||
":read-substring!)[34}%x,&0{%2.1,.1S3,'0,.3,@(y15:read-substring!)[24}%"
|
||||
"x,&0{%1P10,.1S3,'0,.3,@(y15:read-substring!)[14}%x,&4{|10|21|32|43%%}@"
|
||||
"!(y12:read-string!)",
|
||||
|
||||
"C", 0,
|
||||
"&0{%2.1,.1,@(y14:read-substring)[22}%x,&0{%1P10,.1,@(y14:read-substrin"
|
||||
"g)[12}%x,&2{|10|21%%}@!(y11:read-string)",
|
||||
|
||||
0, 0, 0
|
||||
};
|
||||
|
|
|
|||
2
src/k.sf
2
src/k.sf
|
|
@ -1515,7 +1515,7 @@
|
|||
(display "DECODE+EXECUTE =>") (newline)
|
||||
(set! start (current-jiffy)))
|
||||
(let* ([thunk (decode cstr)] [res (execute thunk)])
|
||||
(write res) (newline))
|
||||
(unless (eq? res (void)) (write res) (newline)))
|
||||
(when *verbose*
|
||||
(display "Elapsed time: ") (write (* 1000 (/ (- (current-jiffy) start) (jiffies-per-second))))
|
||||
(display " ms.") (newline))))))
|
||||
|
|
|
|||
44
src/s.scm
44
src/s.scm
|
|
@ -419,18 +419,18 @@
|
|||
(define (make-rectangular r i)
|
||||
(if (= i 0) r (error "make-rectangular: nonzero imag part not supported" i)))
|
||||
|
||||
(inline (make-polar m a)
|
||||
(define (make-polar m a)
|
||||
(cond [(= a 0) m]
|
||||
[(= a 3.141592653589793238462643) (- m)]
|
||||
[else (error "make-polar: angle not supported" a)]))
|
||||
|
||||
(define-inline (real-part x) x)
|
||||
(define (real-part x) x)
|
||||
|
||||
(define-inline (imag-part x) 0)
|
||||
(define (imag-part x) 0)
|
||||
|
||||
(define-inline (magnitude x) (abs x))
|
||||
(define (magnitude x) (abs x))
|
||||
|
||||
(define-inline (angle x) (if (negative? x) 3.141592653589793238462643 0))
|
||||
(define (angle x) (if (negative? x) 3.141592653589793238462643 0))
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -956,13 +956,15 @@
|
|||
;with-exception-handler
|
||||
;raise
|
||||
;raise-continuable
|
||||
;error
|
||||
;error-object?
|
||||
;error-object-message
|
||||
;error-object-irritants
|
||||
;read-error?
|
||||
;file-error?
|
||||
|
||||
(define (error msg . args) (%panic msg args)) ; should work for now
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
; Environments and evaluation
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
@ -1049,7 +1051,32 @@
|
|||
[else (write-char c op) (loop #f)])))))
|
||||
|
||||
;read
|
||||
;read-string
|
||||
|
||||
(define (read-substring! str start end p)
|
||||
(let loop ([i start])
|
||||
(if (fx>=? i end) (fx- i start)
|
||||
(let ([c (read-char p)])
|
||||
(cond [(eof-object? c) (if (fx=? i start) c (fx- i start))]
|
||||
[else (string-set! str i c) (loop (fx+ i 1))])))))
|
||||
|
||||
(define (read-substring k p)
|
||||
(let ([str (make-string k)])
|
||||
(let ([r (read-substring! str 0 k p)])
|
||||
(if (eof-object? r) r
|
||||
(if (fx=? r k) str (substring str 0 r))))))
|
||||
|
||||
(define read-string!
|
||||
(case-lambda
|
||||
[(str) (read-substring! str 0 (string-length str) (current-input-port))]
|
||||
[(str p) (read-substring! str 0 (string-length str) p)]
|
||||
[(str p start) (read-substring! str start (string-length str) p)]
|
||||
[(str p start end) (read-substring! str start end p)]))
|
||||
|
||||
(define read-string
|
||||
(case-lambda
|
||||
[(k) (read-substring k (current-input-port))]
|
||||
[(k p) (read-substring k p)]))
|
||||
|
||||
;read-u8
|
||||
;peek-u8
|
||||
;u8-ready?
|
||||
|
|
@ -1070,8 +1097,7 @@
|
|||
; (newline (p (current-output-port)))
|
||||
; (write-shared x (p (current-output-port)))
|
||||
; (write-simple x (p (current-output-port)))
|
||||
|
||||
;flush-output-port
|
||||
; (flush-output-port p)
|
||||
|
||||
|
||||
;---------------------------------------------------------------------------------------------
|
||||
|
|
|
|||
Loading…
Reference in a new issue