Raymond Toy pushed to branch issue-291-pprint-handler-case at cmucl / cmucl
Commits:
-
e2c9eeea
by Raymond Toy at 2024-03-25T14:33:02+00:00
-
8ed3d1d3
by Raymond Toy at 2024-03-25T14:33:07+00:00
-
e35e7327
by Raymond Toy at 2024-03-25T07:39:35-07:00
-
41522236
by Raymond Toy at 2024-03-25T08:16:46-07:00
2 changed files:
Changes:
| ... | ... | @@ -1460,8 +1460,8 @@ When annotations are present, invoke them at the right positions." |
| 1460 | 1460 | |
| 1461 | 1461 | (defun pprint-handler-case (stream list &rest noise)
|
| 1462 | 1462 | (declare (ignore noise))
|
| 1463 | - ;; Like pprint-handler-bind, but the each of the error clauses is
|
|
| 1464 | - ;; printed with declaractions and forms on a separate line, indented
|
|
| 1463 | + ;; Like pprint-handler-bind, but each of the error clauses is
|
|
| 1464 | + ;; printed with declarations and forms on a separate line, indented
|
|
| 1465 | 1465 | ;; like a function body. The handler-case part, "~:<~^~W~3I
|
| 1466 | 1466 | ;; ~:_~W~1I~@{ ~:@_...~:>" comes from pprint-handler-bind, but the
|
| 1467 | 1467 | ;; last "~W" is replaced to print out the error clauses in the way
|
| ... | ... | @@ -2089,7 +2089,9 @@ When annotations are present, invoke them at the right positions." |
| 2089 | 2089 | (c:sc-case pprint-sc-case)
|
| 2090 | 2090 | (c:define-assembly-routine pprint-define-assembly)
|
| 2091 | 2091 | (c:deftransform pprint-defun)
|
| 2092 | - (c:defoptimizer pprint-defun)))
|
|
| 2092 | + (c:defoptimizer pprint-defun)
|
|
| 2093 | + (ext:with-float-traps-masked pprint-with-like)
|
|
| 2094 | + (ext:with-float-traps-enabled pprint-with-like)))
|
|
| 2093 | 2095 | |
| 2094 | 2096 | (defun pprint-init ()
|
| 2095 | 2097 | (setf *initial-pprint-dispatch* (make-pprint-dispatch-table))
|
| ... | ... | @@ -10,21 +10,10 @@ |
| 10 | 10 | (assert-equal
|
| 11 | 11 | "
|
| 12 | 12 | (WITH-FLOAT-TRAPS-MASKED (:UNDERFLOW)
|
| 13 | - (LET* ((RATIO
|
|
| 14 | - (/ (* (EXPT 10 PPRINT-TESTS::EXPONENT) NUMBER)
|
|
| 15 | - PPRINT-TESTS::DIVISOR))
|
|
| 16 | - (PPRINT-TESTS::RESULT (COERCE RATIO PPRINT-TESTS::FLOAT-FORMAT)))
|
|
| 17 | - (WHEN (AND (ZEROP PPRINT-TESTS::RESULT) (NOT (ZEROP NUMBER)))
|
|
| 18 | - (ERROR \"Underflow\"))
|
|
| 19 | - PPRINT-TESTS::RESULT))"
|
|
| 13 | + (PRINT \"Hello\"))"
|
|
| 20 | 14 | (with-output-to-string (s)
|
| 21 | 15 | (pprint '(ext:with-float-traps-masked (:underflow)
|
| 22 | - (let* ((ratio (/ (* (expt 10 exponent) number)
|
|
| 23 | - divisor))
|
|
| 24 | - (result (coerce ratio float-format)))
|
|
| 25 | - (when (and (zerop result) (not (zerop number)))
|
|
| 26 | - (error "Underflow"))
|
|
| 27 | - result))
|
|
| 16 | + (print "Hello"))
|
|
| 28 | 17 | s))))
|
| 29 | 18 | |
| 30 | 19 | (define-test pprint.with-float-traps-enabled
|
| ... | ... | @@ -32,21 +21,10 @@ |
| 32 | 21 | (assert-equal
|
| 33 | 22 | "
|
| 34 | 23 | (WITH-FLOAT-TRAPS-ENABLED (:UNDERFLOW)
|
| 35 | - (LET* ((RATIO
|
|
| 36 | - (/ (* (EXPT 10 PPRINT-TESTS::EXPONENT) NUMBER)
|
|
| 37 | - PPRINT-TESTS::DIVISOR))
|
|
| 38 | - (PPRINT-TESTS::RESULT (COERCE RATIO PPRINT-TESTS::FLOAT-FORMAT)))
|
|
| 39 | - (WHEN (AND (ZEROP PPRINT-TESTS::RESULT) (NOT (ZEROP NUMBER)))
|
|
| 40 | - (ERROR \"Underflow\"))
|
|
| 41 | - PPRINT-TESTS::RESULT))"
|
|
| 24 | + (PRINT \"Hello\"))"
|
|
| 42 | 25 | (with-output-to-string (s)
|
| 43 | 26 | (pprint '(ext:with-float-traps-enabled (:underflow)
|
| 44 | - (let* ((ratio (/ (* (expt 10 exponent) number)
|
|
| 45 | - divisor))
|
|
| 46 | - (result (coerce ratio float-format)))
|
|
| 47 | - (when (and (zerop result) (not (zerop number)))
|
|
| 48 | - (error "Underflow"))
|
|
| 49 | - result))
|
|
| 27 | + (print "Hello"))
|
|
| 50 | 28 | s))))
|
| 51 | 29 | |
| 52 | 30 | (define-test pprint.handler-case
|