ref: 325d5ee168304f33680da939509790830da45350
parent: 0a2150a1b68907c22fd93074f2417b687dcd2c39
author: Sigrid Solveig Haflínudóttir <sigrid@ftrv.se>
date: Wed Apr 23 21:54:56 EDT 2025
exception handler: more elaborate depth/length limits on value printing Add *exception-print-level* (default is 3) and *exception-print-length* (default is 64) to limit the sizes.
--- a/boot/sl.boot
+++ b/boot/sl.boot
@@ -121,10 +121,11 @@
#(λ length=) 1arg-lambda? 7)
<= #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JL041<0L2;J5040V340q:A<1<1=62:" 7)) <= 7) > #fn("z1Ib6862086>1_486<^10162:" #(#fn("n21S;JE041<0L2;3;04A<1<1=62:" 7)) > 7) >=-;JL0401<L2;J5040V340q:A<1<1=62:" 7)) >= 7)
+;JL0401<L2;J5040V340q:A<1<1=62:" 7)) >= 7)
#u8(68) aref2 #u8(23) box #u8(50) cadr #u8(36) argc #u8(62) setg #u8(71) load0 #u8(21) nan? #u8(38) fixnum? #u8(41) loadc0 #u8(17) loada0 #u8(0) div0 #u8(59) keyargs #u8(31) call #u8(5) loada.l #u8(69) num? #u8(40) sub2 #u8(78) add2 #u8(29) loadc.l #u8(70) loadc #u8(9) builtin? #u8(43) set-car! #u8(47) vargc.l #u8(80) vec #u8(63) ret #u8(10) loadi8 #u8(66) tapply #u8(77) loadvoid #u8(25) loada1 #u8(1) shift #u8(46) atom? #u8(24) cdr #u8(13) brne.l #u8(83) / #u8(58) equal? #u8(52) apply #u8(54) dup #u8(11) loadt #u8(20) bounda #u8(39) jmp.l #u8(48) = #u8(60) not #u8(35) set-cdr! #u8(30) fn? #u8(44) eq? #u8(33) * #u8(57) load1 #u8(27) bound? #u8(42) box.l #u8(86) < #u8(28) brnn.l #u8(84) jmp #u8(16) loadv #u8(2) for #u8(76) + #u8(55) brne #u8(19) argc.l #u8(79) compare #u8(61) brn #u8(3) neg #u8(37) loadv.l #u8(67) vargc #u8(74) loadc1 #u8(22) setg.l #u8(72) cons? #u8(18) aref #u8(85) sym? #u8(34) aset! #u8(64) car #u8(12) cons #u8(32) tcall.l #u8(82) - #u8(56) brn.l #u8(49) optargs #u8(87) closure #u8(14) vec? #u8(45) pop #u8(4) eqv? #u8(51) list #u8(53) seta #u8(15) seta.l #u8(73) brnn #u8(26) loadnil #u8(65) loadg #u8(7) loada #u8(8) tcall #u8(6))
-(62) setg #u8(71) load0 #u8(21) nan? #u8(38) fixnum? #u8(41) loadc0 #u8(17) loada0 #u8(0) div0 #u8(59) keyargs #u8(31) call #u8(5) loada.l #u8(69) num? #u8(40) sub2 #u8(78) add2 #u8(29) loadc.l #u8(70) loadc #u8(9) builtin? #u8(43) set-car! #u8(47) vargc.l #u8(80) vec #u8(63) ret #u8(10) loadi8 #u8(66) tapply #u8(77) loadvoid #u8(25) loada1 #u8(1) shift #u8(46) atom? #u8(24) cdr #u8(13) brne.l #u8(83) / #u8(58) equal? #u8(52) apply #u8(54) dup #u8(11) loadt #u8(20) bounda #u8(39) jmp.l #u8(48) = #u8(60) not #u8(35) set-cdr! #u8(30) fn? #u8(44) eq? #u8(33) * #u8(57) load1 #u8(27) bound? #u8(42) box.l #u8(86) < #u8(28) brnn.l #u8(84) jmp #u8(16) loadv #u8(2) for #u8(76) + #u8(55) brne #u8(19) argc.l #u8(79) compare #u8(61) brn #u8(3) neg #u8(37) loadv.l #u8(67) vargc #u8(74) loadc1 #u8(22) setg.l #u8(72) cons? #u8(18) aref #u8(85) sym? #u8(34) aset! #u8(64) car #u8(12) cons #u8(32) tcall.l #u8(82) - #u8(56) brn.l #u8(49) optargs #u8(87) closure #u8(14) vec? #u8(45) pop #u8(4) eqv? #u8(51) list #u8(53) seta #u8(15) seta.l #u8(73) brnn #u8(26) loadnil #u8(65) loadg #u8(7) loada #u8(8) tcall #u8(6))
- S #fn("z1700215286380861}2:7223062:" #(getprop constructor error "no default constructor for struct: ") S 8)+ #u8(71) load0 #u8(21) nan? #u8(38) fixnum? #u8(41) loadc0 #u8(17) loada0 #u8(0) div0 #u8(59) keyargs #u8(31) call #u8(5) loada.l #u8(69) num? #u8(40) sub2 #u8(78) add2 #u8(29) loadc.l #u8(70) loadc #u8(9) builtin? #u8(43) set-car! #u8(47) vargc.l #u8(80) vec #u8(63) ret #u8(10) loadi8 #u8(66) tapply #u8(77) loadvoid #u8(25) loada1 #u8(1) shift #u8(46) atom? #u8(24) cdr #u8(13) brne.l #u8(83) / #u8(58) equal? #u8(52) apply #u8(54) dup #u8(11) loadt #u8(20) bounda #u8(39) jmp.l #u8(48) = #u8(60) not #u8(35) set-cdr! #u8(30) fn? #u8(44) eq? #u8(33) * #u8(57) load1 #u8(27) bound? #u8(42) box.l #u8(86) < #u8(28) brnn.l #u8(84) jmp #u8(16) loadv #u8(2) for #u8(76) + #u8(55) brne #u8(19) argc.l #u8(79) compare #u8(61) brn #u8(3) neg #u8(37) loadv.l #u8(67) vargc #u8(74) loadc1 #u8(22) setg.l #u8(72) cons? #u8(18) aref #u8(85) sym? #u8(34) aset! #u8(64) car #u8(12) cons #u8(32) tcall.l #u8(82) - #u8(56) brn.l #u8(49) optargs #u8(87) closure #u8(14) vec? #u8(45) pop #u8(4) eqv? #u8(51) list #u8(53) seta #u8(15) seta.l #u8(73) brnn #u8(26) loadnil #u8(65) loadg #u8(7) loada #u8(8) tcall #u8(6))
+ S #fn("z1700215286380861}2:7223062:" #(getprop constructor error "no default constructor for struct: ") S 8)+ __finish #fn("n120Z3>021220>17062:q:" #(*exit-hooks* #fn(for-each)add2 #u8(29) loadc.l #u8(70) loadc #u8(9) builtin? #u8(43) set-car! #u8(47) vargc.l #u8(80) vec #u8(63) ret #u8(10) loadi8 #u8(66) tapply #u8(77) loadvoid #u8(25) loada1 #u8(1) shift #u8(46) atom? #u8(24) cdr #u8(13) brne.l #u8(83) / #u8(58) equal? #u8(52) apply #u8(54) dup #u8(11) loadt #u8(20) bounda #u8(39) jmp.l #u8(48) = #u8(60) not #u8(35) set-cdr! #u8(30) fn? #u8(44) eq? #u8(33) * #u8(57) load1 #u8(27) bound? #u8(42) box.l #u8(86) < #u8(28) brnn.l #u8(84) jmp #u8(16) loadv #u8(2) for #u8(76) + #u8(55) brne #u8(19) argc.l #u8(79) compare #u8(61) brn #u8(3) neg #u8(37) loadv.l #u8(67) vargc #u8(74) loadc1 #u8(22) setg.l #u8(72) cons? #u8(18) aref #u8(85) sym? #u8(34) aset! #u8(64) car #u8(12) cons #u8(32) tcall.l #u8(82) - #u8(56) brn.l #u8(49) optargs #u8(87) closure #u8(14) vec? #u8(45) pop #u8(4) eqv? #u8(51) list #u8(53) seta #u8(15) seta.l #u8(73) brnn #u8(26) loadnil #u8(65) loadg #u8(7) loada #u8(8) tcall #u8(6))
S #fn("z1700215286380861}2:7223062:" #(getprop constructor error "no default constructor for struct: ") S 8) __finish #fn("n120Z3>021220>17062:q:" #(*exit-hooks* #fn(for-each)@@ -375,8 +376,9 @@
astcdr cddr #fn(nconc)
#fn(map) list λ) expand-lambda 15)
#fn("n20=S;J6040TH3n070051J400:0T71700515187<87=883=072868852@30q42386A<89<152e3:740517505171700515188<88=F<86512627788;52152893?07287898653@30q42623e18792<868<52Pe193<8:8<5263:" #(cddr-2627788;52152893?07287898653@30q42623e18792<868<52Pe193<8:8<5263:" #(cddr
- separate-doc-from-body sym-set-doc def cdadr caadr #fn(nconc)
+2627788;52152893?07287898653@30q42623e18792<868<52Pe193<8:8<5263:" #(cddr
+ separate-doc-from-body sym-set-doc def cdadr caadr #fn(nconc)
+ #fn(map) list) expand-define 17) #fn("n20T20A<71051222324F1>2865215252P:" #(begin cddr #fn(nconc)20A<71051222324F1>2865215252P:" #(begin cddr #fn(nconc)
#fn(map)
#fn("n10<70A<0TF525150Fe3:" #(compile-thunk) 9)) expand-let-syntax 12)@@ -402,14 +404,19 @@
ue
#fn(write)
#fn(io-write)
-o-close)) 12)
- #fn("n1A50420061:" #(#fn(raise)) 6)) make-system-image 11)- map! #fn("n21I1B3B04101<51_41=?1@\x1d/4:" #() map! 8) map-int- #fn("n2E1L2;3S040E51qPqb78786_4K7015121870>2|486:" #(1- #fn("n1A<F051qPN4AA<=_:" 7)) map-int 9)- max #fn("z113;070210163:0:" #(foldl #fn("n201L23401:0:" 6)) max 8) member- #fn("n21<0d3401:13:07001=62:q:" #(member) member 7) memv #fn("n21<0c3401:13:07001=62:q:" #(memv) memv 7)- min #fn("z113;070210163:0:" #(foldl #fn("n201L23400:1:" 6)) min 8) mod- #fn("n207001521i2~:" #(div) mod 8) mod0 #fn("n2001k1i2~:" #() mod0 7) negative?+o-close)) 12)
+ #fn("n1A50420061:" #(#fn(raise)) 6)) make-system-image 11)+ map! #fn("n21I1B3B04101<51_41=?1@\x1d/4:" #() map! 8) map-int+ #fn("n2E1L2;3S040E51qPqb78786_4K7015121870>2|486:" #(1- #fn("n1A<F051qPN4AA<=_:" 7)) map-int 9)+ max #fn("z113;070210163:0:" #(foldl #fn("n201L23401:0:" 6)) max 8) member+ #fn("n21<0d3401:13:07001=62:q:" #(member) member 7) memv #fn("n21<0c3401:13:07001=62:q:" #(memv) memv 7)+ min #fn("z113;070210163:0:" #(foldl #fn("n201L23400:1:" 6)) min 8) mod+ #fn("n207001521i2~:" #(div) mod 8) mod0 #fn("n2001k1i2~:" #() mod0 7) negative?+ #fn("n10EL2:" #() negative? 6) nestlist #fn("n3E82L2;3B041700015182K~53P:" #(nestlist) nestlist 10)+ newline #fn("\x8700001000W0000J7070?04210725247360:" #(*io-out* #fn(io-write)+ *linefeed* void) newline 7)
+ nreconc #fn("n2701062:" #(reverse!-) nreconc 7) odd?+ #fn("n170051S:" #(even?) odd? 6) partition #fn("n2I2021?65148601qe1qe164:" #(#0#) princ
#fn("z070qw042185>1220>12386>1{86504:" #(*print-readably* #fn("n0Aw0:" #(*print-readably*) 4) #fn("n02071A62:" #(#fn(for-each) write) 7)--- a/src/system.sl
+++ b/src/system.sl
@@ -1499,6 +1499,12 @@
(reverse! st))))
(def (print-exception e)
+ (def (print-value v)
+ (with-bindings ((*print-level* (or *exception-print-level*
+ *print-level*))
+ (*print-length* (or *exception-print-length*
+ *print-length)))
+ (print v)))
(let* {[loc (and (list? e)(list? (car e))
(io? (caar e))
@@ -1515,13 +1521,11 @@
(set! a (cdr a)))
(for-each (λ (s) (princ s ": ")) (cddr a))
(princ "expected " (car a) ", got " (type-of (cadr a)) ": ")
- (print (cadr a)))
+ (print-value (cadr a)))
((eq? k 'bounds-error)
(princ "index " (cadr a) " out of bounds for ")
- (if (length> (car a) 128)
- (princ (type-of (car a)) " of length " (length (car a)))
- (print (car a))))
+ (print-value (car a)))
((eq? k 'unbound-error)
(princ "eval: variable " (car a) " has no value"))
@@ -1582,7 +1586,8 @@
(excludes '(*linefeed* *directory-separator* *argv* that *exit-hooks*
*print-pretty* *print-width* *print-readably*
*print-level* *print-length* *os-name* *interactive*
- *prompt* *os-version* ptr)))
+ *prompt* *os-version* *exception-print-level*
+ *exception-print-length* ptr)))
(with-bindings ((*print-pretty* T)
(*print-readably* T))
(let* ((syms
@@ -1610,6 +1615,8 @@
Default function prints `#;> `."
defprompt))
+ (set! *exception-print-level* 3)
+ (set! *exception-print-length* 64)
(set! *directory-separator* (or (and (equal? *os-name* "dos") "\\") "/"))
(set! *linefeed* "\n")
(set! *exit-hooks* NIL)