aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/lux/debug.lux
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/lux/debug.lux')
-rw-r--r--stdlib/source/lux/debug.lux597
1 files changed, 0 insertions, 597 deletions
diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux
deleted file mode 100644
index cf6fb803c..000000000
--- a/stdlib/source/lux/debug.lux
+++ /dev/null
@@ -1,597 +0,0 @@
-(.module:
- [lux (#- type)
- ["@" target]
- ["." type]
- ["." ffi (#+ import:)]
- ["." meta]
- [abstract
- ["." monad (#+ do)]]
- [control
- [pipe (#+ new>)]
- ["." function]
- ["." try (#+ Try)]
- ["." exception (#+ exception:)]
- ["<>" parser
- ["<.>" type (#+ Parser)]
- ["<.>" code]]]
- [data
- ["." text
- ["%" format (#+ Format)]]
- [format
- [xml (#+ XML)]
- ["." json]]
- [collection
- ["." array]
- ["." list ("#\." functor)]
- ["." dictionary]]]
- [macro
- ["." template]
- ["." syntax (#+ syntax:)]
- ["." code]]
- [math
- [number
- [ratio (#+ Ratio)]
- ["n" nat]
- ["i" int]]]
- [time (#+ Time)
- [instant (#+ Instant)]
- [duration (#+ Duration)]
- [date (#+ Date)]
- [month (#+ Month)]
- [day (#+ Day)]]])
-
-(with_expansions [<jvm> (as_is (import: java/lang/String)
-
- (import: (java/lang/Class a)
- ["#::."
- (getCanonicalName [] java/lang/String)])
-
- (import: java/lang/Object
- ["#::."
- (new [])
- (toString [] java/lang/String)
- (getClass [] (java/lang/Class java/lang/Object))])
-
- (import: java/lang/Integer
- ["#::."
- (longValue [] long)])
-
- (import: java/lang/Long
- ["#::."
- (intValue [] int)])
-
- (import: java/lang/Number
- ["#::."
- (intValue [] int)
- (longValue [] long)
- (doubleValue [] double)]))]
- (for {@.old (as_is <jvm>)
- @.jvm (as_is <jvm>)
-
- @.js
- (as_is (import: JSON
- ["#::."
- (#static stringify [.Any] ffi.String)])
- (import: Array
- ["#::."
- (#static isArray [.Any] ffi.Boolean)]))
-
- @.python
- (as_is (type: PyType
- (primitive "python_type"))
-
- (import: (type [.Any] PyType))
- (import: (str [.Any] ffi.String)))
-
- @.lua
- (as_is (import: (type [.Any] ffi.String))
- (import: (tostring [.Any] ffi.String))
-
- (import: math
- ["#::."
- (#static type [.Any] #? ffi.String)]))
-
- @.ruby
- (as_is (import: Class)
-
- (import: Object
- ["#::."
- (class [] Class)
- (to_s [] ffi.String)]))
-
- @.php
- (as_is (import: (gettype [.Any] ffi.String))
- (import: (strval [.Any] ffi.String)))
-
- @.scheme
- (as_is (import: (boolean? [.Any] Bit))
- (import: (integer? [.Any] Bit))
- (import: (real? [.Any] Bit))
- (import: (string? [.Any] Bit))
- (import: (vector? [.Any] Bit))
- (import: (pair? [.Any] Bit))
- (import: (car [.Any] .Any))
- (import: (cdr [.Any] .Any))
- (import: (format [Text .Any] Text)))
- }))
-
-(def: Inspector
- (.type (Format Any)))
-
-(for {@.lua (def: (tuple_array tuple)
- (-> (array.Array Any) (array.Array Any))
- (array.from_list
- (loop [idx 0]
- (let [member ("lua array read" idx tuple)]
- (if ("lua object nil?" member)
- #.Nil
- (#.Cons member (recur (inc idx))))))))}
- (as_is))
-
-(def: (inspect_tuple inspect)
- (-> Inspector Inspector)
- (with_expansions [<adaption> (for {@.lua (~~ (as_is ..tuple_array))}
- (~~ (as_is)))]
- (`` (|>> (:as (array.Array Any))
- <adaption>
- array.to_list
- (list\map inspect)
- (text.join_with " ")
- (text.enclose ["[" "]"])))))
-
-(def: #export (inspect value)
- Inspector
- (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 [(:as .Bit) %.bit]]
- [java/lang/Long [(:as .Int) %.int]]
- [java/lang/Number [java/lang/Number::doubleValue %.frac]]
- [java/lang/String [(:as .Text) %.text]]
- ))
- (case (ffi.check [java/lang/Object] object)
- (#.Some value)
- (let [value (:as (array.Array java/lang/Object) value)]
- (case (array.read 0 value)
- (^multi (#.Some tag)
- [(ffi.check java/lang/Integer tag)
- (#.Some tag)]
- [[(array.read 1 value)
- (array.read 2 value)]
- [last?
- (#.Some choice)]])
- (let [last? (case last?
- (#.Some _) #1
- #.None #0)]
- (|> (%.format (%.nat (.nat (java/lang/Integer::longValue tag)))
- " " (%.bit last?)
- " " (inspect choice))
- (text.enclose ["(" ")"])))
-
- _
- (inspect_tuple inspect value)))
- #.None)
- (java/lang/Object::toString object))))]
- (for {@.old <jvm>
- @.jvm <jvm>
-
- @.js
- (case (ffi.type_of value)
- (^template [<type_of> <then>]
- [<type_of>
- (`` (|> value (~~ (template.splice <then>))))])
- (["boolean" [(:as .Bit) %.bit]]
- ["number" [(:as .Frac) %.frac]]
- ["string" [(:as .Text) %.text]]
- ["undefined" [JSON::stringify]])
-
- "object"
- (let [variant_tag ("js object get" "_lux_tag" value)
- variant_flag ("js object get" "_lux_flag" value)
- variant_value ("js object get" "_lux_value" value)]
- (cond (not (or ("js object undefined?" variant_tag)
- ("js object undefined?" variant_flag)
- ("js object undefined?" variant_value)))
- (|> (%.format (JSON::stringify variant_tag)
- " " (%.bit (not ("js object null?" variant_flag)))
- " " (inspect variant_value))
- (text.enclose ["(" ")"]))
-
- (not (or ("js object undefined?" ("js object get" "_lux_low" value))
- ("js object undefined?" ("js object get" "_lux_high" value))))
- (|> value (:as .Int) %.int)
-
- (Array::isArray value)
- (inspect_tuple inspect value)
-
- ## else
- (JSON::stringify value)))
-
- _
- (JSON::stringify value))
-
- @.python
- (case (..str (..type value))
- (^template [<type_of> <class_of> <then>]
- [(^or <type_of> <class_of>)
- (`` (|> value (~~ (template.splice <then>))))])
- (["<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 (: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)
- variant_value ("python array read" 2 variant)]
- (if (or ("python object none?" variant_tag)
- ("python object none?" variant_value))
- (..str value)
- (|> (%.format (|> variant_tag (:as .Nat) %.nat)
- " " (|> variant_flag "python object none?" not %.bit)
- " " (inspect variant_value))
- (text.enclose ["(" ")"]))))
- _ (..str value)))
-
- _
- (..str value))
-
- @.lua
- (case (..type value)
- (^template [<type_of> <then>]
- [<type_of>
- (`` (|> value (~~ (template.splice <then>))))])
- (["boolean" [(:as .Bit) %.bit]]
- ["string" [(:as .Text) %.text]]
- ["nil" [(new> "nil" [])]])
-
- "number"
- (case (math::type [value])
- (#.Some "integer") (|> value (:as .Int) %.int)
- (#.Some "float") (|> value (:as .Frac) %.frac)
-
- _
- (..tostring value))
-
- "table"
- (let [variant_tag ("lua object get" "_lux_tag" value)
- variant_flag ("lua object get" "_lux_flag" value)
- variant_value ("lua object get" "_lux_value" value)]
- (if (or ("lua object nil?" variant_tag)
- ("lua object nil?" variant_value))
- (inspect_tuple inspect value)
- (|> (%.format (|> variant_tag (:as .Nat) %.nat)
- " " (%.bit (not ("lua object nil?" variant_flag)))
- " " (inspect variant_value))
- (text.enclose ["(" ")"]))))
-
- _
- (..tostring value))
-
- @.ruby
- (template.let [(class_of <literal>)
- [(|> <literal>
- (:as ..Object)
- (Object::class []))]
-
- (to_s <object>)
- [(|> <object>
- (:as ..Object)
- (Object::to_s []))]]
- (let [value_class (class_of value)]
- (`` (cond (~~ (template [<literal> <type> <format>]
- [(is? (class_of <literal>) value_class)
- (|> value (:as <type>) <format>)]
-
- [#0 Bit %.bit]
- [#1 Bit %.bit]
- [+1 Int %.int]
- [+1.0 Frac %.frac]
- ["" Text %.text]
- [("ruby object nil") Any (new> "nil" [])]
- ))
-
- (is? (class_of #.None) value_class)
- (let [variant_tag ("ruby object get" "_lux_tag" value)
- variant_flag ("ruby object get" "_lux_flag" value)
- variant_value ("ruby object get" "_lux_value" value)]
- (if (or ("ruby object nil?" variant_tag)
- ("ruby object nil?" variant_value))
- (inspect_tuple inspect value)
- (|> (%.format (|> variant_tag (:as .Nat) %.nat)
- " " (%.bit (not ("ruby object nil?" variant_flag)))
- " " (inspect variant_value))
- (text.enclose ["(" ")"]))))
-
- (is? (class_of [[] []]) value_class)
- (inspect_tuple inspect value)
-
- ## else
- (to_s value)))))
-
- @.php
- (case (..gettype value)
- (^template [<type_of> <then>]
- [<type_of>
- (`` (|> value (~~ (template.splice <then>))))])
- (["boolean" [(:as .Bit) %.bit]]
- ["integer" [(:as .Int) %.int]]
- ["double" [(:as .Frac) %.frac]]
- ["string" [(:as .Text) %.text]]
- ["NULL" [(new> "null" [])]]
- ["array" [(inspect_tuple inspect)]])
-
- "object"
- (let [variant_tag ("php object get" "_lux_tag" value)
- variant_flag ("php object get" "_lux_flag" value)
- variant_value ("php object get" "_lux_value" value)]
- (if (or ("php object null?" variant_tag)
- ("php object null?" variant_value))
- (..strval value)
- (|> (%.format (|> variant_tag (:as .Nat) %.nat)
- " " (%.bit (not ("php object null?" variant_flag)))
- " " (inspect variant_value))
- (text.enclose ["(" ")"]))))
-
- _
- (..strval value))
-
- @.scheme
- (`` (cond (~~ (template [<when> <then>]
- [(<when> value)
- (`` (|> value (~~ (template.splice <then>))))]
-
- [..boolean? [(:as .Bit) %.bit]]
- [..integer? [(:as .Int) %.int]]
- [..real? [(:as .Frac) %.frac]]
- [..string? [(:as .Text) %.text]]
- ["scheme object nil?" [(new> "()" [])]]
- [..vector? [(inspect_tuple inspect)]]))
-
- (..pair? value)
- (let [variant_tag (..car value)
- variant_rest (..cdr value)]
- (if (and (..integer? 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 (:as .Nat) %.nat)
- " " (%.bit (not ("scheme object nil?" variant_flag)))
- " " (inspect variant_value))
- (text.enclose ["(" ")"])))
- (..format ["~s" value])))
-
- ## else
- (..format ["~s" value])
- ))
- })))
-
-(exception: #export (cannot_represent_value {type Type})
- (exception.report
- ["Type" (%.type type)]))
-
-(type: Representation
- (-> Any Text))
-
-(def: primitive_representation
- (Parser Representation)
- (`` ($_ <>.either
- (do <>.monad
- [_ (<type>.exactly Any)]
- (wrap (function.constant "[]")))
-
- (~~ (template [<type> <formatter>]
- [(do <>.monad
- [_ (<type>.sub <type>)]
- (wrap (|>> (:as <type>) <formatter>)))]
-
- [Bit %.bit]
- [Nat %.nat]
- [Int %.int]
- [Rev %.rev]
- [Frac %.frac]
- [Text %.text]))
- )))
-
-(def: (special_representation representation)
- (-> (Parser Representation) (Parser Representation))
- (`` ($_ <>.either
- (~~ (template [<type> <formatter>]
- [(do <>.monad
- [_ (<type>.sub <type>)]
- (wrap (|>> (:as <type>) <formatter>)))]
-
- [Ratio %.ratio]
- [Name %.name]
- [Location %.location]
- [Type %.type]
- [Code %.code]
-
- [Instant %.instant]
- [Duration %.duration]
- [Date %.date]
- [Time %.time]
- [Month %.month]
- [Day %.day]
-
- [json.JSON %.json]
- [XML %.xml]))
-
- (do <>.monad
- [[_ elemT] (<type>.apply (<>.and (<type>.exactly List) <type>.any))
- elemR (<type>.local (list elemT) representation)]
- (wrap (|>> (:as (List Any)) (%.list elemR))))
-
- (do <>.monad
- [[_ elemT] (<type>.apply (<>.and (<type>.exactly Maybe) <type>.any))
- elemR (<type>.local (list elemT) representation)]
- (wrap (|>> (:as (Maybe Any))
- (%.maybe elemR)))))))
-
-(def: (variant_representation representation)
- (-> (Parser Representation) (Parser Representation))
- (do <>.monad
- [membersR+ (<type>.variant (<>.many representation))]
- (wrap (function (_ variantV)
- (let [[lefts right? sub_repr] (loop [lefts 0
- representations membersR+
- variantV variantV]
- (case representations
- (#.Cons leftR (#.Cons rightR extraR+))
- (case (:as (| Any Any) variantV)
- (#.Left left)
- [lefts #0 (leftR left)]
-
- (#.Right right)
- (case extraR+
- #.Nil
- [lefts #1 (rightR right)]
-
- _
- (recur (inc lefts) (#.Cons rightR extraR+) right)))
-
- _
- (undefined)))]
- (%.format "(" (%.nat lefts) " " (%.bit right?) " " sub_repr ")"))))))
-
-(def: (tuple_representation representation)
- (-> (Parser Representation) (Parser Representation))
- (do <>.monad
- [membersR+ (<type>.tuple (<>.many representation))]
- (wrap (function (_ tupleV)
- (let [tuple_body (loop [representations membersR+
- tupleV tupleV]
- (case representations
- #.Nil
- ""
-
- (#.Cons lastR #.Nil)
- (lastR tupleV)
-
- (#.Cons headR tailR)
- (let [[leftV rightV] (:as [Any Any] tupleV)]
- (%.format (headR leftV) " " (recur tailR rightV)))))]
- (%.format "[" tuple_body "]"))))))
-
-(def: representation
- (Parser Representation)
- (<>.rec
- (function (_ representation)
- ($_ <>.either
- ..primitive_representation
- (..special_representation representation)
- (..variant_representation representation)
- (..tuple_representation representation)
-
- (do <>.monad
- [[funcT inputsT+] (<type>.apply (<>.and <type>.any (<>.many <type>.any)))]
- (case (type.apply inputsT+ funcT)
- (#.Some outputT)
- (<type>.local (list outputT) representation)
-
- #.None
- (<>.fail "")))
-
- (do <>.monad
- [[name anonymous] <type>.named]
- (<type>.local (list anonymous) representation))
-
- (<>.fail "")
- ))))
-
-(def: #export (represent type value)
- (-> Type Any (Try Text))
- (case (<type>.run ..representation type)
- (#try.Success representation)
- (#try.Success (representation value))
-
- (#try.Failure _)
- (exception.throw ..cannot_represent_value type)))
-
-(syntax: #export (private {definition <code>.identifier})
- (let [[module _] definition]
- (wrap (list (` ("lux in-module"
- (~ (code.text module))
- (~ (code.identifier definition))))))))
-
-(def: #export (log! message)
- {#.doc "Logs message to standard output."}
- (-> Text Any)
- ("lux io log" message))
-
-(exception: #export (type_hole {location Location} {type Type})
- (exception.report
- ["Location" (%.location location)]
- ["Type" (%.type type)]))
-
-(syntax: #export (:hole)
- (do meta.monad
- [location meta.location
- expectedT meta.expected_type]
- (function.constant (exception.throw ..type_hole [location expectedT]))))
-
-(type: Target
- [Text (Maybe Code)])
-
-(def: target
- (<code>.Parser Target)
- (<>.either (<>.and <code>.local_identifier
- (\ <>.monad wrap #.None))
- (<code>.record (<>.and <code>.local_identifier
- (\ <>.monad map (|>> #.Some) <code>.any)))))
-
-(exception: #export (unknown_local_binding {name Text})
- (exception.report
- ["Name" (%.text name)]))
-
-(syntax: #export (here {targets (: (<code>.Parser (List Target))
- (|> ..target
- <>.some
- (<>.default (list))))})
- (do {! meta.monad}
- [location meta.location
- locals meta.locals
- #let [environment (|> locals
- list.concat
- ## The list is reversed to make sure that, when building the dictionary,
- ## later bindings overshadow earlier ones if they have the same name.
- list.reverse
- (dictionary.from_list text.hash))]
- targets (: (Meta (List Target))
- (case targets
- #.Nil
- (|> environment
- dictionary.keys
- (list\map (function (_ local) [local #.None]))
- wrap)
-
- _
- (monad.map ! (function (_ [name format])
- (if (dictionary.key? environment name)
- (wrap [name format])
- (function.constant (exception.throw ..unknown_local_binding [name]))))
- targets)))]
- (wrap (list (` (..log! ("lux text concat"
- (~ (code.text (%.format (%.location location) text.new_line)))
- ((~! exception.report)
- (~+ (list\map (function (_ [name format])
- (let [format (case format
- #.None
- (` (~! ..inspect))
-
- (#.Some format)
- format)]
- (` [(~ (code.text name))
- ((~ format) (~ (code.local_identifier name)))])))
- targets))))))))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-22 23:33:55 +0000