Reimplement hy-repr with registered functions

This removes a lot of hy-reprs that were hard-coded into the hy-repr function itself. It also allows you to add a hy-repr for an existing class without monkey-patching the class.
This commit is contained in:
Kodi Arfer 2017-10-31 16:48:59 -07:00
parent a688355777
commit 83c4f63bc2
2 changed files with 108 additions and 90 deletions

View File

@ -7,92 +7,96 @@
[hy._compat [PY3 str-type bytes-type long-type]]
[hy.models [HyObject HyExpression HySymbol HyKeyword HyInteger HyFloat HyComplex HyList HyDict HySet HyString HyBytes]])
(setv -registry {})
(defn hy-repr-register [types f &optional placeholder]
(for [typ (if (instance? list types) types [types])]
(setv (get -registry typ) (, f placeholder))))
(setv -quoting False)
(setv -seen (set))
(defn hy-repr [obj]
(setv seen (set))
; We keep track of objects we've already seen, and avoid
; redisplaying their contents, so a self-referential object
; doesn't send us into an infinite loop.
(defn f [x q]
; `x` is the current object being stringified.
; `q` is True if we're inside a single quote, False otherwise.
(setv old? (in (id x) seen))
(.add seen (id x))
(setv t (type x))
(defn catted []
(if old? "..." (.join " " (list-comp (f it q) [it x]))))
(setv prefix "")
(if (and (not q) (instance? HyObject x))
(setv prefix "'" q True))
(+ prefix (if
(hasattr x "__hy_repr__")
(.__hy-repr__ x)
(is t HyExpression)
(if (and x (symbol? (first x)))
(if
(= (first x) 'quote)
(+ "'" (f (second x) True))
(= (first x) 'quasiquote)
(+ "`" (f (second x) q))
(= (first x) 'unquote)
(+ "~" (f (second x) q))
(= (first x) 'unquote_splice)
(+ "~@" (f (second x) q))
(= (first x) 'unpack_iterable)
(+ "#* " (f (second x) q))
(= (first x) 'unpack_mapping)
(+ "#** " (f (second x) q))
; else
(+ "(" (catted) ")"))
(+ "(" (catted) ")"))
(is t tuple)
(+ "(," (if x " " "") (catted) ")")
(in t [list HyList])
(+ "[" (catted) "]")
(is t HyDict)
(+ "{" (catted) "}")
(is t dict)
(setv [f placeholder] (next
(genexpr (get -registry t)
[t (. (type obj) __mro__)]
(in t -registry))
[-base-repr None]))
(global -quoting)
(setv started-quoting False)
(when (and (not -quoting) (instance? HyObject obj))
(setv -quoting True)
(setv started-quoting True))
(setv oid (id obj))
(when (in oid -seen)
(return (if (none? placeholder) "..." placeholder)))
(.add -seen oid)
(try
(+ (if started-quoting "'" "") (f obj))
(finally
(.discard -seen oid)
(when started-quoting
(setv -quoting False)))))
(hy-repr-register list :placeholder "[...]" (fn [x]
(+ "[" (-cat x) "]")))
(hy-repr-register tuple (fn [x]
(+ "(," (if x " " "") (-cat x) ")")))
(hy-repr-register dict :placeholder "{...}" (fn [x]
(+ "{" (-cat (reduce + (.items x))) "}")))
(hy-repr-register HyDict :placeholder "{...}" (fn [x]
(+ "{" (-cat x) "}")))
(hy-repr-register [set HySet] (fn [x]
(+ "#{" (-cat x) "}")))
(hy-repr-register frozenset (fn [x]
(+ "(frozenset #{" (-cat x) "})")))
(hy-repr-register HyExpression (fn [x]
(setv syntax {
'quote "'"
'quasiquote "`"
'unquote "~"
'unquote_splice "~@"
'unpack_iterable "#* "
'unpack_mapping "#** "})
(if (and x (symbol? (first x)) (in (first x) syntax))
(+ (get syntax (first x)) (hy-repr (second x)))
(+ "(" (-cat x) ")"))))
(hy-repr-register HySymbol str)
(hy-repr-register [str-type bytes-type HyKeyword] (fn [x]
(if (and (instance? str-type x) (.startswith x HyKeyword.PREFIX))
(return (cut x 1)))
(setv r (.lstrip (-base-repr x) "ub"))
(+
"{"
(if old? "..." (.join " " (list-comp
(+ (f k q) " " (f v q))
[[k v] (.items x)])))
"}")
(in t [set HySet])
(+ "#{" (catted) "}")
(is t frozenset)
(+ "(frozenset #{" (catted) "})")
(is t HySymbol)
x
(or (is t HyKeyword) (and (is t str-type) (.startswith x HyKeyword.PREFIX)))
(cut x 1)
(in t [str-type HyString bytes-type HyBytes]) (do
(setv r (.lstrip (base-repr x) "ub"))
(+ (if (in t [bytes-type HyBytes]) "b" "") (if (.startswith "\"" r)
(if (instance? bytes-type x) "b" "")
(if (.startswith "\"" r)
; If Python's built-in repr produced a double-quoted string, use
; that.
r
; Otherwise, we have a single-quoted string, which isn't valid Hy, so
; convert it.
(+ "\"" (.replace (cut r 1 -1) "\"" "\\\"") "\""))))
(and (not PY3) (is t int))
(.format "(int {})" (base-repr x))
(and (not PY3) (in t [long_type HyInteger]))
(.rstrip (base-repr x) "L")
(and (in t [float HyFloat]) (isnan x))
"NaN"
(and (in t [float HyFloat]) (= x Inf))
"Inf"
(and (in t [float HyFloat]) (= x -Inf))
"-Inf"
(in t [complex HyComplex])
(.replace (.replace (.strip (base-repr x) "()") "inf" "Inf") "nan" "NaN")
(is t fraction)
(.format "{}/{}" (f x.numerator q) (f x.denominator q))
; else
(base-repr x))))
(f obj False))
(+ "\"" (.replace (cut r 1 -1) "\"" "\\\"") "\"")))))
(hy-repr-register bool str)
(if (not PY3) (hy-repr-register int (fn [x]
(.format "(int {})" (-base-repr x)))))
(if (not PY3) (hy-repr-register long_type (fn [x]
(.rstrip (-base-repr x) "L"))))
(hy-repr-register float (fn [x]
(if
(isnan x) "NaN"
(= x Inf) "Inf"
(= x -Inf) "-Inf"
(-base-repr x))))
(hy-repr-register complex (fn [x]
(.replace (.replace (.strip (-base-repr x) "()") "inf" "Inf") "nan" "NaN")))
(hy-repr-register fraction (fn [x]
(.format "{}/{}" (hy-repr x.numerator) (hy-repr x.denominator))))
(defn base-repr [x]
(defn -cat [obj]
(.join " " (map hy-repr obj)))
(defn -base-repr [x]
(unless (instance? HyObject x)
(return (repr x)))
; Call (.repr x) using the first class of x that doesn't inherit from

View File

@ -4,7 +4,7 @@
(import
[math [isnan]]
[hy.contrib.hy-repr [hy-repr]])
[hy.contrib.hy-repr [hy-repr hy-repr-register]])
(defn test-hy-repr-roundtrip-from-value []
; Test that a variety of values round-trip properly.
@ -86,10 +86,24 @@
(+ "{" (.join " " p) "}")
[p (permutations ["1 2" "3 [4 {...}]" "6 7"])]))))
(defn test-hy-repr-dunder-method []
(defclass C [list] [__hy-repr__ (fn [self] "cuddles")])
(assert (= (hy-repr (C)) "cuddles")))
(defn test-hy-repr-custom []
(defclass C [object])
(hy-repr-register C (fn [x] "cuddles"))
(assert (= (hy-repr (C)) "cuddles"))
(defclass Container [object]
[__init__ (fn [self value]
(setv self.value value))])
(hy-repr-register Container :placeholder "(Container ...)" (fn [x]
(+ "(Container " (hy-repr x.value) ")")))
(setv container (Container 5))
(setv container.value container)
(assert (= (hy-repr container) "(Container (Container ...))"))
(setv container.value [1 container 3])
(assert (= (hy-repr container) "(Container [1 (Container ...) 3])")))
(defn test-hy-repr-fallback []
(defclass D [list] [__repr__ (fn [self] "cuddles")])
(defclass D [object]
[__repr__ (fn [self] "cuddles")])
(assert (= (hy-repr (D)) "cuddles")))