Replace xwrite/xdisplay/xnewline with non-x names
This commit is contained in:
parent
924a45b7bd
commit
33488d73cf
File diff suppressed because it is too large
Load Diff
|
|
@ -178,18 +178,13 @@
|
|||
(define (file-exists? f) (path.exists? f))
|
||||
(define (delete-file name) (void)) ; TODO
|
||||
|
||||
(define (display x (port *output-stream*))
|
||||
(xdisplay x port))
|
||||
|
||||
(define assertion-violation
|
||||
(lambda args
|
||||
(xdisplay 'assertion-violation)
|
||||
(xnewline)
|
||||
(xdisplay args)
|
||||
(xnewline)
|
||||
(displayln 'assertion-violation)
|
||||
(displayln args)
|
||||
(car #f)))
|
||||
|
||||
(define pretty-print xwrite)
|
||||
(define pretty-print write)
|
||||
|
||||
(define (memp proc ls)
|
||||
(cond ((null? ls) #f)
|
||||
|
|
|
|||
|
|
@ -433,7 +433,7 @@
|
|||
(if (symbol? (cadr x))
|
||||
`(,(void))
|
||||
(error "compile error: invalid syntax "
|
||||
(print-to-string x))))))
|
||||
(write-to-string x))))))
|
||||
(if (symbol? form)
|
||||
`(set! ,form ,(car body))
|
||||
`(set! ,(car form)
|
||||
|
|
@ -656,20 +656,20 @@
|
|||
(define (disassemble f . lev?)
|
||||
(if (null? lev?)
|
||||
(begin (disassemble f 0)
|
||||
(xnewline)
|
||||
(newline)
|
||||
(return #t)))
|
||||
(let ((lev (car lev?))
|
||||
(code (function:code f))
|
||||
(vals (function:vals f)))
|
||||
(define (print-val v)
|
||||
(define (write-val v)
|
||||
(if (and (function? v) (not (builtin? v)))
|
||||
(begin (xdisplay "\n")
|
||||
(begin (display "\n")
|
||||
(disassemble v (+ lev 1)))
|
||||
(xwrite v)))
|
||||
(dotimes (xx lev) (xdisplay " "))
|
||||
(xdisplay "maxstack ")
|
||||
(xdisplay (ref-int32-LE code 0))
|
||||
(xnewline)
|
||||
(write v)))
|
||||
(dotimes (xx lev) (display " "))
|
||||
(display "maxstack ")
|
||||
(display (ref-int32-LE code 0))
|
||||
(newline)
|
||||
(let ((i 4)
|
||||
(N (length code)))
|
||||
(while (< i N)
|
||||
|
|
@ -678,64 +678,64 @@
|
|||
(or z (and (eq? v (aref code i))
|
||||
k)))
|
||||
#f Instructions)))
|
||||
(if (> i 4) (xnewline))
|
||||
(dotimes (xx lev) (xdisplay " "))
|
||||
(xdisplay (hex5 (- i 4)))
|
||||
(xdisplay ": ")
|
||||
(xdisplay (string inst))
|
||||
(xdisplay " ")
|
||||
(if (> i 4) (newline))
|
||||
(dotimes (xx lev) (display " "))
|
||||
(display (hex5 (- i 4)))
|
||||
(display ": ")
|
||||
(display (string inst))
|
||||
(display " ")
|
||||
(set! i (+ i 1))
|
||||
(case inst
|
||||
((loadv.l loadg.l setg.l)
|
||||
(print-val (aref vals (ref-int32-LE code i)))
|
||||
(write-val (aref vals (ref-int32-LE code i)))
|
||||
(set! i (+ i 4)))
|
||||
|
||||
((loadv loadg setg)
|
||||
(print-val (aref vals (aref code i)))
|
||||
(write-val (aref vals (aref code i)))
|
||||
(set! i (+ i 1)))
|
||||
|
||||
((loada seta call tcall list + - * / vector
|
||||
argc vargc loadi8 apply tapply)
|
||||
(xdisplay (number->string (aref code i)))
|
||||
(display (number->string (aref code i)))
|
||||
(set! i (+ i 1)))
|
||||
|
||||
((loada.l seta.l largc lvargc call.l tcall.l)
|
||||
(xdisplay (number->string (ref-int32-LE code i)))
|
||||
(display (number->string (ref-int32-LE code i)))
|
||||
(set! i (+ i 4)))
|
||||
|
||||
((loadc setc)
|
||||
(xdisplay (number->string (aref code i)))
|
||||
(xdisplay " ")
|
||||
(display (number->string (aref code i)))
|
||||
(display " ")
|
||||
(set! i (+ i 1))
|
||||
(xdisplay (number->string (aref code i)))
|
||||
(display (number->string (aref code i)))
|
||||
(set! i (+ i 1)))
|
||||
|
||||
((loadc.l setc.l optargs keyargs)
|
||||
(xdisplay (number->string (ref-int32-LE code i)))
|
||||
(xdisplay " ")
|
||||
(display (number->string (ref-int32-LE code i)))
|
||||
(display " ")
|
||||
(set! i (+ i 4))
|
||||
(xdisplay (number->string (ref-int32-LE code i)))
|
||||
(display (number->string (ref-int32-LE code i)))
|
||||
(set! i (+ i 4))
|
||||
(if (eq? inst 'keyargs)
|
||||
(begin
|
||||
(xdisplay " ")
|
||||
(xdisplay (number->string (ref-int32-LE code i)))
|
||||
(xdisplay " ")
|
||||
(display " ")
|
||||
(display (number->string (ref-int32-LE code i)))
|
||||
(display " ")
|
||||
(set! i (+ i 4)))))
|
||||
|
||||
((brbound)
|
||||
(xdisplay (number->string (ref-int32-LE code i)))
|
||||
(xdisplay " ")
|
||||
(display (number->string (ref-int32-LE code i)))
|
||||
(display " ")
|
||||
(set! i (+ i 4)))
|
||||
|
||||
((jmp brf brt brne brnn brn)
|
||||
(xdisplay "@")
|
||||
(xdisplay (hex5 (+ i -4 (ref-int16-LE code i))))
|
||||
(display "@")
|
||||
(display (hex5 (+ i -4 (ref-int16-LE code i))))
|
||||
(set! i (+ i 2)))
|
||||
|
||||
((jmp.l brf.l brt.l brne.l brnn.l brn.l)
|
||||
(xdisplay "@")
|
||||
(xdisplay (hex5 (+ i -4 (ref-int32-LE code i))))
|
||||
(display "@")
|
||||
(display (hex5 (+ i -4 (ref-int32-LE code i))))
|
||||
(set! i (+ i 4)))
|
||||
|
||||
(else #f)))))))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
(define (dump-buffers-as-c-literal . bufs)
|
||||
(xdisplay "char boot_image[] = \"")
|
||||
(display "char boot_image[] = \"")
|
||||
(let loop-bufs ((bufs bufs))
|
||||
(if (not (null? bufs))
|
||||
(begin (let ((buf (car bufs)))
|
||||
|
|
@ -7,10 +7,10 @@
|
|||
(let ((char (read-u8 buf)))
|
||||
(if (not (io.eof? buf))
|
||||
(let ((code (+ char 0)))
|
||||
(if (= 0 (mod i 16)) (xdisplay "\"\n\""))
|
||||
(xdisplay "\\x")
|
||||
(if (< code #x10) (xdisplay "0"))
|
||||
(xdisplay (number->string code 16))
|
||||
(if (= 0 (mod i 16)) (display "\"\n\""))
|
||||
(display "\\x")
|
||||
(if (< code #x10) (display "0"))
|
||||
(display (number->string code 16))
|
||||
(loop-buf-bytes (+ i 1)))))))
|
||||
(loop-bufs (cdr bufs)))))
|
||||
(xdisplay "\";\n"))
|
||||
(display "\";\n"))
|
||||
|
|
|
|||
|
|
@ -12,8 +12,7 @@
|
|||
(out (buffer)))
|
||||
(let next ((E (read in)))
|
||||
(if (not (io.eof? in))
|
||||
(begin (write (compile-thunk (expand E)) out)
|
||||
(xnewline out)
|
||||
(begin (writeln (compile-thunk (expand E)) out)
|
||||
(next (read in)))))
|
||||
(io.close in)
|
||||
(io.seek out 0)
|
||||
|
|
|
|||
|
|
@ -584,8 +584,7 @@
|
|||
(define-macro (assert expr) `(if ,expr #t (raise '(assert-failed ,expr))))
|
||||
|
||||
(define traced?
|
||||
(letrec ((sample-traced-lambda (lambda args (begin (xwrite (cons 'x args))
|
||||
(xnewline)
|
||||
(letrec ((sample-traced-lambda (lambda args (begin (writeln (cons 'x args))
|
||||
(apply #.apply args)))))
|
||||
(lambda (f)
|
||||
(and (closure? f)
|
||||
|
|
@ -599,8 +598,7 @@
|
|||
(set-top-level-value! sym
|
||||
(eval
|
||||
`(lambda ,args
|
||||
(begin (xwrite (cons ',sym ,args))
|
||||
(xnewline)
|
||||
(begin (writeln (cons ',sym ,args))
|
||||
(apply ',func ,args)))))))
|
||||
'ok)
|
||||
|
||||
|
|
@ -615,22 +613,13 @@
|
|||
`(let ((,t0 (time.now)))
|
||||
(prog1
|
||||
,expr
|
||||
(xdisplay "Elapsed time: ")
|
||||
(xdisplay (- (time.now) ,t0))
|
||||
(xdisplay " seconds")
|
||||
(xnewline)))))
|
||||
(display "Elapsed time: ")
|
||||
(display (- (time.now) ,t0))
|
||||
(display " seconds")
|
||||
(newline)))))
|
||||
|
||||
; text I/O -------------------------------------------------------------------
|
||||
|
||||
(define (print . args)
|
||||
(for-each xwrite args))
|
||||
|
||||
(define (princ . args)
|
||||
(for-each xdisplay args))
|
||||
|
||||
(define (newline (port *output-stream*))
|
||||
(xnewline port))
|
||||
|
||||
(define (io.readline s) (io.readuntil s #\linefeed))
|
||||
|
||||
; call f on a stream until the stream runs out of data
|
||||
|
|
@ -748,11 +737,13 @@
|
|||
(define (string.lpad s n c) (string (string.rep c (- n (string.count s))) s))
|
||||
(define (string.rpad s n c) (string s (string.rep c (- n (string.count s)))))
|
||||
|
||||
(define (print-to-string v)
|
||||
(define (write-to-string v)
|
||||
(let ((b (buffer)))
|
||||
(xwrite v b)
|
||||
(write v b)
|
||||
(io.tostring! b)))
|
||||
|
||||
(define print-to-string write-to-string) ;; TODO: remove
|
||||
|
||||
(define (string.join strlist sep)
|
||||
(if (null? strlist) ""
|
||||
(let ((b (buffer)))
|
||||
|
|
@ -927,25 +918,25 @@ Up Scheme
|
|||
|
||||
(define (repl)
|
||||
(define (prompt)
|
||||
(xdisplay "up> ")
|
||||
(display "up> ")
|
||||
(io.flush *output-stream*)
|
||||
(let ((v (trycatch (read)
|
||||
(lambda (e) (begin (io.discardbuffer *input-stream*)
|
||||
(raise e))))))
|
||||
(and (not (io.eof? *input-stream*))
|
||||
(let ((V (load-process v)))
|
||||
(xwrite V)
|
||||
(write V)
|
||||
(set! that V)
|
||||
#t))))
|
||||
(define (reploop)
|
||||
(when (trycatch (and (prompt) (xnewline))
|
||||
(when (trycatch (and (prompt) (newline))
|
||||
(lambda (e)
|
||||
(top-level-exception-handler e)
|
||||
#t))
|
||||
(begin (xnewline)
|
||||
(begin (newline)
|
||||
(reploop))))
|
||||
(reploop)
|
||||
(xnewline))
|
||||
(newline))
|
||||
|
||||
(define (top-level-exception-handler e)
|
||||
(with-output-to *stderr*
|
||||
|
|
@ -978,12 +969,11 @@ Up Scheme
|
|||
(n 0))
|
||||
(for-each
|
||||
(lambda (f)
|
||||
(xdisplay "#")
|
||||
(xdisplay n)
|
||||
(xdisplay " ")
|
||||
(xwrite (cons (fn-name (aref f 0) e)
|
||||
(display "#")
|
||||
(display n)
|
||||
(display " ")
|
||||
(writeln (cons (fn-name (aref f 0) e)
|
||||
(cdr (vector->list f))))
|
||||
(xnewline)
|
||||
(set! n (+ n 1)))
|
||||
st)))
|
||||
|
||||
|
|
@ -991,52 +981,53 @@ Up Scheme
|
|||
(cond ((and (pair? e)
|
||||
(eq? (car e) 'type-error)
|
||||
(length= e 4))
|
||||
(xdisplay "type error: ")
|
||||
(xdisplay (cadr e))
|
||||
(xdisplay ": expected ")
|
||||
(xdisplay (caddr e))
|
||||
(xdisplay ", got ")
|
||||
(xwrite (cadddr e)))
|
||||
(display "type error: ")
|
||||
(display (cadr e))
|
||||
(display ": expected ")
|
||||
(display (caddr e))
|
||||
(display ", got ")
|
||||
(write (cadddr e)))
|
||||
|
||||
((and (pair? e)
|
||||
(eq? (car e) 'bounds-error)
|
||||
(length= e 4))
|
||||
(xdisplay (cadr e))
|
||||
(xdisplay ": index ")
|
||||
(xdisplay (cadddr e))
|
||||
(xdisplay " out of bounds for ")
|
||||
(xwrite (caddr e)))
|
||||
(display (cadr e))
|
||||
(display ": index ")
|
||||
(display (cadddr e))
|
||||
(display " out of bounds for ")
|
||||
(write (caddr e)))
|
||||
|
||||
((and (pair? e)
|
||||
(eq? (car e) 'unbound-error)
|
||||
(pair? (cdr e)))
|
||||
(xdisplay "eval: variable ")
|
||||
(xdisplay (cadr e))
|
||||
(xdisplay " has no value"))
|
||||
(display "eval: variable ")
|
||||
(display (cadr e))
|
||||
(display " has no value"))
|
||||
|
||||
((and (pair? e)
|
||||
(eq? (car e) 'error))
|
||||
(xdisplay "error: ")
|
||||
(for-each xdisplay (cdr e)))
|
||||
(display "error: ")
|
||||
(for-each display (cdr e)))
|
||||
|
||||
((and (pair? e)
|
||||
(eq? (car e) 'load-error))
|
||||
(print-exception (caddr e))
|
||||
(xdisplay "in file " (cadr e)))
|
||||
(display "in file ")
|
||||
(display (cadr e)))
|
||||
|
||||
((and (list? e)
|
||||
(length= e 2))
|
||||
(xwrite (car e))
|
||||
(xdisplay ": ")
|
||||
(write (car e))
|
||||
(display ": ")
|
||||
(let ((msg (cadr e)))
|
||||
((if (or (string? msg) (symbol? msg))
|
||||
xdisplay xwrite)
|
||||
display write)
|
||||
msg)))
|
||||
|
||||
(else (xdisplay "*** Unhandled exception: ")
|
||||
(xwrite e)))
|
||||
(else (display "*** Unhandled exception: ")
|
||||
(write e)))
|
||||
|
||||
(xdisplay *linefeed*))
|
||||
(newline))
|
||||
|
||||
(define (simple-sort l)
|
||||
(if (or (null? l) (null? (cdr l))) l
|
||||
|
|
@ -1093,6 +1084,6 @@ Up Scheme
|
|||
(__script (cadr argv)))
|
||||
(begin (set! *argv* argv)
|
||||
(set! *interactive* #t)
|
||||
(xdisplay *banner*)
|
||||
(display *banner*)
|
||||
(repl)))
|
||||
(exit 0))
|
||||
|
|
|
|||
|
|
@ -295,14 +295,14 @@ todo:
|
|||
|
||||
(let ((x 0))
|
||||
(while (< x 10)
|
||||
(begin (print x) (set! x (+ 1 x)))))
|
||||
(begin (write x) (set! x (+ 1 x)))))
|
||||
=>
|
||||
(let ((x 0))
|
||||
(reset
|
||||
(let ((l #f))
|
||||
(let ((k (shift k (k k))))
|
||||
(if (< x 10)
|
||||
(begin (set! l (begin (print x)
|
||||
(begin (set! l (begin (write x)
|
||||
(set! x (+ 1 x))))
|
||||
(k k))
|
||||
l)))))
|
||||
|
|
|
|||
|
|
@ -19,7 +19,5 @@
|
|||
s))
|
||||
|
||||
(for-each (lambda (n)
|
||||
(begin
|
||||
(princ (bin-draw (string.lpad (number->string n 2) 63 #\0)))
|
||||
(newline)))
|
||||
(displayln (bin-draw (string.lpad (number->string n 2) 63 #\0))))
|
||||
(nestlist rule30-step (uint64 #x0000000080000000) 32))
|
||||
|
|
|
|||
|
|
@ -1 +1 @@
|
|||
(print *argv*) (princ "\n")
|
||||
(writeln *argv*)
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
(define (f x) (begin (list-tail '(1) 3) 3))
|
||||
(f 2)
|
||||
a
|
||||
(trycatch a (lambda (e) (print (stacktrace))))
|
||||
(trycatch a (lambda (e) (write (stacktrace))))
|
||||
|
|
|
|||
|
|
@ -1,18 +1,18 @@
|
|||
(load "test.scm")
|
||||
|
||||
(princ "colorgraph: ")
|
||||
(display "colorgraph: ")
|
||||
(load "tcolor.scm")
|
||||
|
||||
(princ "fib(34): ")
|
||||
(display "fib(34): ")
|
||||
(assert (equal? (time (fib 34)) 5702887))
|
||||
(princ "yfib(32): ")
|
||||
(display "yfib(32): ")
|
||||
(assert (equal? (time (yfib 32)) 2178309))
|
||||
|
||||
(princ "sort: ")
|
||||
(display "sort: ")
|
||||
(set! r (map-int (lambda (x) (mod (+ (* x 9421) 12345) 1024)) 1000))
|
||||
(time (simple-sort r))
|
||||
|
||||
(princ "expand: ")
|
||||
(display "expand: ")
|
||||
(time (dotimes (n 5000) (expand '(dotimes (i 100) body1 body2))))
|
||||
|
||||
(define (my-append . lsts)
|
||||
|
|
@ -24,12 +24,12 @@
|
|||
(append2 (cdr l) d))))))
|
||||
(append2 (car lsts) (apply my-append (cdr lsts)))))))
|
||||
|
||||
(princ "append: ")
|
||||
(display "append: ")
|
||||
(set! L (map-int (lambda (x) (map-int identity 20)) 20))
|
||||
(time (dotimes (n 1000) (apply my-append L)))
|
||||
|
||||
(path.cwd "ast")
|
||||
(princ "p-lambda: ")
|
||||
(display "p-lambda: ")
|
||||
(load "rpasses.scm")
|
||||
(define *input* (load "datetimeR.scm"))
|
||||
(time (set! *output* (compile-ish *input*)))
|
||||
|
|
|
|||
|
|
@ -25,10 +25,10 @@
|
|||
(car lsts) (append-h (cdr lsts)))))))
|
||||
lsts))
|
||||
|
||||
;(princ 'Hello '| | 'world! "\n")
|
||||
;(for-each display '(Hello | | world! "\n"))
|
||||
;(filter (lambda (x) (not (< x 0))) '(1 -1 -2 5 10 -8 0))
|
||||
(define (fib n) (if (< n 2) n (+ (fib (- n 1)) (fib (- n 2)))))
|
||||
;(princ (time (fib 34)) "\n")
|
||||
;(displayln (time (fib 34)))
|
||||
;(dotimes (i 20000) (map-int (lambda (x) (list 'quote x)) 8))
|
||||
;(dotimes (i 40000) (append '(a b) '(1 2 3 4) () '(c) () '(5 6)))
|
||||
;(dotimes (i 80000) (list 1 2 3 4 5))
|
||||
|
|
@ -240,17 +240,17 @@
|
|||
(length (string x)))
|
||||
(cons 'Function
|
||||
(map car pr))))))
|
||||
(princ (string.rpad "Function" width #\ )
|
||||
"#Calls Time (seconds)")
|
||||
(display (string.rpad "Function" width #\ ))
|
||||
(display "#Calls Time (seconds)")
|
||||
(newline)
|
||||
(princ (string.rpad "--------" width #\ )
|
||||
"------ --------------")
|
||||
(display (string.rpad "--------" width #\ ))
|
||||
(display "------ --------------")
|
||||
(newline)
|
||||
(for-each
|
||||
(lambda (p)
|
||||
(princ (string.rpad (string (caddr p)) width #\ )
|
||||
(string.rpad (string (cadr p)) 11 #\ )
|
||||
(car p))
|
||||
(display (string.rpad (string (caddr p)) width #\ ))
|
||||
(display (string.rpad (string (cadr p)) 11 #\ ))
|
||||
(display (car p))
|
||||
(newline))
|
||||
(simple-sort (map (lambda (l) (reverse (to-proper l)))
|
||||
pr)))))
|
||||
|
|
|
|||
|
|
@ -1,7 +1,6 @@
|
|||
(define ones (map (lambda (x) 1) (iota 1000000)))
|
||||
|
||||
(write (apply + ones))
|
||||
(newline)
|
||||
(writeln (apply + ones))
|
||||
|
||||
(define (big n)
|
||||
(if (<= n 0)
|
||||
|
|
@ -10,15 +9,12 @@
|
|||
|
||||
(define nst (big 100000))
|
||||
|
||||
(write (eval nst))
|
||||
(newline)
|
||||
(writeln (eval nst))
|
||||
|
||||
(define longg (cons '+ ones))
|
||||
(write (eval longg))
|
||||
(newline)
|
||||
(writeln (eval longg))
|
||||
|
||||
(define (f x)
|
||||
(begin (write x)
|
||||
(newline)
|
||||
(begin (writeln x)
|
||||
(f (+ x 1))
|
||||
0))
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
(set! b (cdr b))))
|
||||
l))
|
||||
|
||||
(time (begin (print (torus 100 100)) ()))
|
||||
(time (begin (write (torus 100 100)) ()))
|
||||
;(time (dotimes (i 1) (load "100x100.scm")))
|
||||
; with ltable
|
||||
; printing time: 0.415sec
|
||||
|
|
|
|||
|
|
@ -297,10 +297,10 @@
|
|||
(io.tostring! b)))
|
||||
|
||||
(let ((c #\a))
|
||||
(assert (equal? (with-output-to-string #f (lambda () (xwrite (list c c))))
|
||||
(assert (equal? (with-output-to-string #f (lambda () (write (list c c))))
|
||||
"(#\\a #\\a)")))
|
||||
|
||||
(assert-fail (eval '(set! (car (cons 1 2)) 3)))
|
||||
|
||||
(xdisplay "all tests pass\n")
|
||||
(display "all tests pass\n")
|
||||
#t
|
||||
|
|
|
|||
Loading…
Reference in New Issue