| ... |
... |
@@ -1837,6 +1837,89 @@ When annotations are present, invoke them at the right positions." |
|
1837
|
1837
|
(funcall (formatter "~:<~W~^~3I ~:_~W~I~@:_~@{ ~W~^~_~}~:>")
|
|
1838
|
1838
|
stream list))
|
|
1839
|
1839
|
|
|
|
1840
|
+(defun pprint-define-vop (stream list &rest noise)
|
|
|
1841
|
+ (declare (ignore noise))
|
|
|
1842
|
+ (pprint-logical-block (stream list :prefix "(" :suffix ")")
|
|
|
1843
|
+ ;; Output "define-vop"
|
|
|
1844
|
+ (output-object (pprint-pop) stream)
|
|
|
1845
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1846
|
+ (write-char #\space stream)
|
|
|
1847
|
+ ;; Output vop name
|
|
|
1848
|
+ (output-object (pprint-pop) stream)
|
|
|
1849
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1850
|
+ (pprint-newline :mandatory stream)
|
|
|
1851
|
+ (pprint-indent :block 0 stream)
|
|
|
1852
|
+ ;; Print out each option starting on a new line
|
|
|
1853
|
+ (loop
|
|
|
1854
|
+ (write-char #\space stream)
|
|
|
1855
|
+ (let ((vop-option (pprint-pop)))
|
|
|
1856
|
+ ;; Figure out what option we have and print it neatly
|
|
|
1857
|
+ (case (car vop-option)
|
|
|
1858
|
+ ((:args :results)
|
|
|
1859
|
+ ;; :args and :results print out each arg/result indented neatly
|
|
|
1860
|
+ (pprint-logical-block (stream vop-option :prefix "(" :suffix ")")
|
|
|
1861
|
+ ;; Output :args/:results
|
|
|
1862
|
+ (output-object (pprint-pop) stream)
|
|
|
1863
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1864
|
+ (write-char #\space stream)
|
|
|
1865
|
+ (pprint-indent :current 0 stream)
|
|
|
1866
|
+ ;; Print each value indented the same amount so the line
|
|
|
1867
|
+ ;; up neatly.
|
|
|
1868
|
+ (loop
|
|
|
1869
|
+ (output-object (pprint-pop) stream)
|
|
|
1870
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1871
|
+ (pprint-newline :mandatory stream))))
|
|
|
1872
|
+ ((:generator)
|
|
|
1873
|
+ (pprint-logical-block (stream vop-option :prefix "(" :suffix ")")
|
|
|
1874
|
+ ;; Output :generator
|
|
|
1875
|
+ (output-object (pprint-pop) stream)
|
|
|
1876
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1877
|
+ (write-char #\space stream)
|
|
|
1878
|
+ ;; Output cost
|
|
|
1879
|
+ (output-object (pprint-pop) stream)
|
|
|
1880
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1881
|
+ ;; Newline and then the body of the generator
|
|
|
1882
|
+ (pprint-newline :mandatory stream)
|
|
|
1883
|
+ (write-char #\space stream)
|
|
|
1884
|
+ (pprint-indent :current 0 stream)
|
|
|
1885
|
+ (loop
|
|
|
1886
|
+ (output-object (pprint-pop) stream)
|
|
|
1887
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1888
|
+ (pprint-newline :mandatory stream))))
|
|
|
1889
|
+ (t
|
|
|
1890
|
+ ;; Everything else just get printed as usual.
|
|
|
1891
|
+ (output-object vop-option stream))))
|
|
|
1892
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1893
|
+ (pprint-newline :linear stream))))
|
|
|
1894
|
+
|
|
|
1895
|
+(defun pprint-sc-case (stream list &rest noise)
|
|
|
1896
|
+ (declare (ignore noise))
|
|
|
1897
|
+ (pprint-logical-block (stream list :prefix "(" :suffix ")")
|
|
|
1898
|
+ ;; Output "sc-case"
|
|
|
1899
|
+ (output-object (pprint-pop) stream)
|
|
|
1900
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1901
|
+ (write-char #\space stream)
|
|
|
1902
|
+ ;; Output variable name
|
|
|
1903
|
+ (output-object (pprint-pop) stream)
|
|
|
1904
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1905
|
+ ;; Start the cases on a new line, indented.
|
|
|
1906
|
+ (pprint-newline :mandatory stream)
|
|
|
1907
|
+ (pprint-indent :block 0 stream)
|
|
|
1908
|
+ ;; Print out each case.
|
|
|
1909
|
+ (loop
|
|
|
1910
|
+ (write-char #\space stream)
|
|
|
1911
|
+ (pprint-logical-block (stream (pprint-pop) :prefix "(" :suffix ")")
|
|
|
1912
|
+ ;; Output the case item
|
|
|
1913
|
+ (output-object (pprint-pop) stream)
|
|
|
1914
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1915
|
+ (pprint-newline :mandatory stream)
|
|
|
1916
|
+ ;; Output everything else, starting on a new line.
|
|
|
1917
|
+ (loop
|
|
|
1918
|
+ (output-object (pprint-pop) stream)
|
|
|
1919
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1920
|
+ (pprint-newline :mandatory stream)))
|
|
|
1921
|
+ (pprint-exit-if-list-exhausted)
|
|
|
1922
|
+ (pprint-newline :mandatory stream))))
|
|
1840
|
1923
|
|
|
1841
|
1924
|
;;;; Interface seen by regular (ugly) printer and initialization routines.
|
|
1842
|
1925
|
|
| ... |
... |
@@ -1952,7 +2035,9 @@ When annotations are present, invoke them at the right positions." |
|
1952
|
2035
|
(vm::with-fixed-allocation pprint-with-like)
|
|
1953
|
2036
|
(kernel::number-dispatch pprint-with-like)
|
|
1954
|
2037
|
(stream::with-stream-class pprint-with-like)
|
|
1955
|
|
- (lisp::with-array-data pprint-with-like)))
|
|
|
2038
|
+ (lisp::with-array-data pprint-with-like)
|
|
|
2039
|
+ (c:define-vop pprint-define-vop)
|
|
|
2040
|
+ (c:sc-case pprint-sc-case)))
|
|
1956
|
2041
|
|
|
1957
|
2042
|
(defun pprint-init ()
|
|
1958
|
2043
|
(setf *initial-pprint-dispatch* (make-pprint-dispatch-table))
|