diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/lux/debug.lux | 86 |
1 files changed, 43 insertions, 43 deletions
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index 962ffeefe..cf6fb803c 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -132,7 +132,7 @@ (-> Inspector Inspector) (with_expansions [<adaption> (for {@.lua (~~ (as_is ..tuple_array))} (~~ (as_is)))] - (`` (|>> (:coerce (array.Array Any)) + (`` (|>> (:as (array.Array Any)) <adaption> array.to_list (list\map inspect) @@ -141,21 +141,21 @@ (def: #export (inspect value) Inspector - (with_expansions [<jvm> (let [object (:coerce java/lang/Object value)] + (with_expansions [<jvm> (let [object (:as java/lang/Object value)] (`` (<| (~~ (template [<class> <processing>] [(case (ffi.check <class> object) (#.Some value) (`` (|> value (~~ (template.splice <processing>)))) #.None)] - [java/lang/Boolean [(:coerce .Bit) %.bit]] - [java/lang/Long [(:coerce .Int) %.int]] + [java/lang/Boolean [(:as .Bit) %.bit]] + [java/lang/Long [(:as .Int) %.int]] [java/lang/Number [java/lang/Number::doubleValue %.frac]] - [java/lang/String [(:coerce .Text) %.text]] + [java/lang/String [(:as .Text) %.text]] )) (case (ffi.check [java/lang/Object] object) (#.Some value) - (let [value (:coerce (array.Array java/lang/Object) value)] + (let [value (:as (array.Array java/lang/Object) value)] (case (array.read 0 value) (^multi (#.Some tag) [(ffi.check java/lang/Integer tag) @@ -184,9 +184,9 @@ (^template [<type_of> <then>] [<type_of> (`` (|> value (~~ (template.splice <then>))))]) - (["boolean" [(:coerce .Bit) %.bit]] - ["number" [(:coerce .Frac) %.frac]] - ["string" [(:coerce .Text) %.text]] + (["boolean" [(:as .Bit) %.bit]] + ["number" [(:as .Frac) %.frac]] + ["string" [(:as .Text) %.text]] ["undefined" [JSON::stringify]]) "object" @@ -203,7 +203,7 @@ (not (or ("js object undefined?" ("js object get" "_lux_low" value)) ("js object undefined?" ("js object get" "_lux_high" value)))) - (|> value (:coerce .Int) %.int) + (|> value (:as .Int) %.int) (Array::isArray value) (inspect_tuple inspect value) @@ -219,17 +219,17 @@ (^template [<type_of> <class_of> <then>] [(^or <type_of> <class_of>) (`` (|> value (~~ (template.splice <then>))))]) - (["<type 'bool'>" "<class 'bool'>" [(:coerce .Bit) %.bit]] - ["<type 'int'>" "<class 'int'>" [(:coerce .Int) %.int]] - ["<type 'float'>" "<class 'float'>" [(:coerce .Frac) %.frac]] - ["<type 'str'>" "<class 'str'>" [(:coerce .Text) %.text]] - ["<type 'unicode'>" "<class 'unicode'>" [(:coerce .Text) %.text]]) + (["<type 'bool'>" "<class 'bool'>" [(:as .Bit) %.bit]] + ["<type 'int'>" "<class 'int'>" [(:as .Int) %.int]] + ["<type 'float'>" "<class 'float'>" [(:as .Frac) %.frac]] + ["<type 'str'>" "<class 'str'>" [(:as .Text) %.text]] + ["<type 'unicode'>" "<class 'unicode'>" [(:as .Text) %.text]]) (^or "<type 'list'>" "<class 'list'>") (inspect_tuple inspect value) (^or "<type 'tuple'>" "<type 'tuple'>") - (let [variant (:coerce (array.Array Any) value)] + (let [variant (:as (array.Array Any) value)] (case (array.size variant) 3 (let [variant_tag ("python array read" 0 variant) variant_flag ("python array read" 1 variant) @@ -237,7 +237,7 @@ (if (or ("python object none?" variant_tag) ("python object none?" variant_value)) (..str value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (|> variant_flag "python object none?" not %.bit) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -251,14 +251,14 @@ (^template [<type_of> <then>] [<type_of> (`` (|> value (~~ (template.splice <then>))))]) - (["boolean" [(:coerce .Bit) %.bit]] - ["string" [(:coerce .Text) %.text]] + (["boolean" [(:as .Bit) %.bit]] + ["string" [(:as .Text) %.text]] ["nil" [(new> "nil" [])]]) "number" (case (math::type [value]) - (#.Some "integer") (|> value (:coerce .Int) %.int) - (#.Some "float") (|> value (:coerce .Frac) %.frac) + (#.Some "integer") (|> value (:as .Int) %.int) + (#.Some "float") (|> value (:as .Frac) %.frac) _ (..tostring value)) @@ -270,7 +270,7 @@ (if (or ("lua object nil?" variant_tag) ("lua object nil?" variant_value)) (inspect_tuple inspect value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("lua object nil?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -281,17 +281,17 @@ @.ruby (template.let [(class_of <literal>) [(|> <literal> - (:coerce ..Object) + (:as ..Object) (Object::class []))] (to_s <object>) [(|> <object> - (:coerce ..Object) + (:as ..Object) (Object::to_s []))]] (let [value_class (class_of value)] (`` (cond (~~ (template [<literal> <type> <format>] [(is? (class_of <literal>) value_class) - (|> value (:coerce <type>) <format>)] + (|> value (:as <type>) <format>)] [#0 Bit %.bit] [#1 Bit %.bit] @@ -308,7 +308,7 @@ (if (or ("ruby object nil?" variant_tag) ("ruby object nil?" variant_value)) (inspect_tuple inspect value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("ruby object nil?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -324,10 +324,10 @@ (^template [<type_of> <then>] [<type_of> (`` (|> value (~~ (template.splice <then>))))]) - (["boolean" [(:coerce .Bit) %.bit]] - ["integer" [(:coerce .Int) %.int]] - ["double" [(:coerce .Frac) %.frac]] - ["string" [(:coerce .Text) %.text]] + (["boolean" [(:as .Bit) %.bit]] + ["integer" [(:as .Int) %.int]] + ["double" [(:as .Frac) %.frac]] + ["string" [(:as .Text) %.text]] ["NULL" [(new> "null" [])]] ["array" [(inspect_tuple inspect)]]) @@ -338,7 +338,7 @@ (if (or ("php object null?" variant_tag) ("php object null?" variant_value)) (..strval value) - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("php object null?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"])))) @@ -351,10 +351,10 @@ [(<when> value) (`` (|> value (~~ (template.splice <then>))))] - [..boolean? [(:coerce .Bit) %.bit]] - [..integer? [(:coerce .Int) %.int]] - [..real? [(:coerce .Frac) %.frac]] - [..string? [(:coerce .Text) %.text]] + [..boolean? [(:as .Bit) %.bit]] + [..integer? [(:as .Int) %.int]] + [..real? [(:as .Frac) %.frac]] + [..string? [(:as .Text) %.text]] ["scheme object nil?" [(new> "()" [])]] [..vector? [(inspect_tuple inspect)]])) @@ -362,11 +362,11 @@ (let [variant_tag (..car value) variant_rest (..cdr value)] (if (and (..integer? variant_tag) - (i.> +0 (:coerce Int variant_tag)) + (i.> +0 (:as Int variant_tag)) (..pair? variant_rest)) (let [variant_flag (..car variant_rest) variant_value (..cdr variant_rest)] - (|> (%.format (|> variant_tag (:coerce .Nat) %.nat) + (|> (%.format (|> variant_tag (:as .Nat) %.nat) " " (%.bit (not ("scheme object nil?" variant_flag))) " " (inspect variant_value)) (text.enclose ["(" ")"]))) @@ -394,7 +394,7 @@ (~~ (template [<type> <formatter>] [(do <>.monad [_ (<type>.sub <type>)] - (wrap (|>> (:coerce <type>) <formatter>)))] + (wrap (|>> (:as <type>) <formatter>)))] [Bit %.bit] [Nat %.nat] @@ -410,7 +410,7 @@ (~~ (template [<type> <formatter>] [(do <>.monad [_ (<type>.sub <type>)] - (wrap (|>> (:coerce <type>) <formatter>)))] + (wrap (|>> (:as <type>) <formatter>)))] [Ratio %.ratio] [Name %.name] @@ -431,12 +431,12 @@ (do <>.monad [[_ elemT] (<type>.apply (<>.and (<type>.exactly List) <type>.any)) elemR (<type>.local (list elemT) representation)] - (wrap (|>> (:coerce (List Any)) (%.list elemR)))) + (wrap (|>> (:as (List Any)) (%.list elemR)))) (do <>.monad [[_ elemT] (<type>.apply (<>.and (<type>.exactly Maybe) <type>.any)) elemR (<type>.local (list elemT) representation)] - (wrap (|>> (:coerce (Maybe Any)) + (wrap (|>> (:as (Maybe Any)) (%.maybe elemR))))))) (def: (variant_representation representation) @@ -449,7 +449,7 @@ variantV variantV] (case representations (#.Cons leftR (#.Cons rightR extraR+)) - (case (:coerce (| Any Any) variantV) + (case (:as (| Any Any) variantV) (#.Left left) [lefts #0 (leftR left)] @@ -480,7 +480,7 @@ (lastR tupleV) (#.Cons headR tailR) - (let [[leftV rightV] (:coerce [Any Any] tupleV)] + (let [[leftV rightV] (:as [Any Any] tupleV)] (%.format (headR leftV) " " (recur tailR rightV)))))] (%.format "[" tuple_body "]")))))) |