From 83c4f63bc285c50ca918f5e00d40b319b39f886f Mon Sep 17 00:00:00 2001 From: Kodi Arfer Date: Tue, 31 Oct 2017 16:48:59 -0700 Subject: [PATCH] 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. --- hy/contrib/hy_repr.hy | 174 +++++++++++++------------- tests/native_tests/contrib/hy_repr.hy | 24 +++- 2 files changed, 108 insertions(+), 90 deletions(-) diff --git a/hy/contrib/hy_repr.hy b/hy/contrib/hy_repr.hy index e47adcf..8c8da65 100644 --- a/hy/contrib/hy_repr.hy +++ b/hy/contrib/hy_repr.hy @@ -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]]) -(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) - (+ - "{" - (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 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)) +(setv -registry {}) +(defn hy-repr-register [types f &optional placeholder] + (for [typ (if (instance? list types) types [types])] + (setv (get -registry typ) (, f placeholder)))) -(defn base-repr [x] +(setv -quoting False) +(setv -seen (set)) +(defn hy-repr [obj] + (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 (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) "\"" "\\\"") "\""))))) +(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 -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 diff --git a/tests/native_tests/contrib/hy_repr.hy b/tests/native_tests/contrib/hy_repr.hy index 3f40fcc..45129c9 100644 --- a/tests/native_tests/contrib/hy_repr.hy +++ b/tests/native_tests/contrib/hy_repr.hy @@ -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")))