Permalink
Switch branches/tags
Nothing to show
Find file Copy path
Fetching contributors…
Cannot retrieve contributors at this time
59 lines (57 sloc) 2.13 KB
(defun print-xapping (xapping stream depth)
(declare (ignore depth))
(format stream
;; Are you ready for this one?
"~:[{~;[~]~:{~S~:[->~S~;~*~]~:^ ~}~:[~; ~]~
~{~S->~^ ~}~:[~; ~]~[~*~;->~S~;->~*~]~:[}~;]~]"
;; Is that clear?
(xectorp xapping)
(do ((vp (xectorp xapping))
(sp (finite-part-is-xetp xapping))
(d (xapping-domain xapping) (cdr d))
(r (xapping-range xapping) (cdr r))
(z '() (cons (list (if vp (car r) (car d))
(or vp sp)
(car r))
z)))
((null d) (reverse z)))
(and (xapping-domain xapping)
(or (xapping-exceptions xapping)
(xapping-infinite xapping)))
(xapping-exceptions xapping)
(and (xapping-exceptions xapping)
(xapping-infinite xapping))
(ecase (xapping-infinite xapping)
((nil) 0)
(:constant 1)
(:universal 2))
(xapping-default xapping)
(xectorp xapping)))
(defun print-xapping (xapping stream depth)
(declare (ignore depth))
(~format (~ stream)
(~wrap (if (xectorp xapping)
(values "[" "]")
(values "{" "}"))
(mapc (let ((vp (xectorp xapping))
(sp (finite-part-is-xetp xapping)))
(lambda (domain range)
(~S (if vp range domain))
(when (or vp sp) "->" (~S range))
((~^ :when :last-sublist))
" "))
(xapping-domain xapping)
(xapping-range xapping))
(when (and (xapping-domain xapping)
(or (xapping-exceptions xapping)
(xapping-infinite xapping)))
" ")
(dolist (~ (xapping-exceptions xapping))
(~S ~) "->" ~^ " ")
(when (and (xapping-exceptions xapping)
(xapping-infinite xapping))
" ")
(ecase (xapping-infinite xapping)
((nil))
(:constant "->" (xapping-default xapping))
(:universal "->")))))