diff options
| author | Eduardo Julian | 2021-01-08 19:23:52 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2021-01-08 19:23:52 -0400 |
| commit | 1ce30d50abaa330ab2125b110e245de6deda27c7 (patch) | |
| tree | 6b40e5d5f1282d33dbd31e64b1753fd0c31be79b | |
| parent | 75102dcfa7c2c0afd32cb5bf5ac012df2db6a7a1 (diff) | |
Moved "log!" function under "lux/debug".
54 files changed, 712 insertions, 443 deletions
diff --git a/lux-js/project.clj b/lux-js/project.clj index 28fcfff87..dfaaf2f5d 100644 --- a/lux-js/project.clj +++ b/lux-js/project.clj @@ -22,7 +22,7 @@ :plugins [[com.github.luxlang/lein-luxc ~version]] :dependencies [[com.github.luxlang/lux-bootstrapper ~version] [com.github.luxlang/stdlib ~version] - [org.openjdk.nashorn/nashorn-core "15.0"]] + [org.openjdk.nashorn/nashorn-core "15.1"]] :manifest {"lux" ~version} :source-paths ["source"] diff --git a/lux-js/source/program.lux b/lux-js/source/program.lux index e402a550f..80e53eade 100644 --- a/lux-js/source/program.lux +++ b/lux-js/source/program.lux @@ -382,7 +382,8 @@ #.None (if (org/openjdk/nashorn/api/scripting/JSObject::isFunction js_object) (exception.return js_object) - (exception.throw ..unknown_kind_of_host_object (:coerce java/lang/Object js_object)))))) + ## (exception.throw ..unknown_kind_of_host_object (:coerce java/lang/Object js_object)) + (exception.return js_object))))) #.None) ## else (exception.throw ..unknown_kind_of_host_object (:coerce java/lang/Object js_object)) @@ -540,7 +541,7 @@ (def: define! ..define!) (def: (ingest context content) - (|> content encoding.from_utf8 try.assume (:coerce _.Statement))) + (|> content (\ encoding.utf8 decode) try.assume (:coerce _.Statement))) (def: (re_learn context content) (..execute! content)) diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 8aa5b344b..bd492b4aa 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -1669,14 +1669,6 @@ (#Cons [[k' v'] (put k v dict')]))} dict)) -(def:''' #export (log! message) - (list [(tag$ ["lux" "doc"]) - (text$ ($_ "lux text concat" - "Logs message to standard output." __paragraph - "Useful for debugging."))]) - (-> Text Any) - ("lux io log" message)) - (def:''' (text\compose x y) #Nil (-> Text Text Text) diff --git a/stdlib/source/lux/control/concatenative.lux b/stdlib/source/lux/control/concatenative.lux index ab6f6940f..23411ad27 100644 --- a/stdlib/source/lux/control/concatenative.lux +++ b/stdlib/source/lux/control/concatenative.lux @@ -109,8 +109,8 @@ {annotations (<>.default |annotations|.empty |annotations|.parser)} type {commands (<>.some <c>.any)}) - (wrap (list (` (def: (~+ (|export|.write export)) (~ (code.local_identifier name)) - (~ (|annotations|.write annotations)) + (wrap (list (` (def: (~+ (|export|.format export)) (~ (code.local_identifier name)) + (~ (|annotations|.format annotations)) (~ type) (|>> (~+ commands))))))) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 21c2b2d58..5c6baa792 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -314,10 +314,10 @@ [g!type (meta.gensym (format name "_abstract_type")) #let [g!actor (code.local_identifier name) g!vars (list\map code.local_identifier vars)]] - (wrap (list (` ((~! abstract:) (~+ (|export|.write export)) ((~ g!type) (~+ g!vars)) + (wrap (list (` ((~! abstract:) (~+ (|export|.format export)) ((~ g!type) (~+ g!vars)) (~ state_type) - (def: (~+ (|export|.write export)) (~ g!actor) + (def: (~+ (|export|.format export)) (~ g!actor) (All [(~+ g!vars)] (..Behavior (~ state_type) ((~ g!type) (~+ g!vars)))) {#..on_init (|>> ((~! abstract.:abstraction) (~ g!type))) @@ -382,8 +382,8 @@ g!inputsT (|> signature (get@ #inputs) (list\map product.right)) g!state (|> signature (get@ #state) code.local_identifier) g!self (|> signature (get@ #self) code.local_identifier)]] - (wrap (list (` (def: (~+ (|export|.write export)) ((~ g!message) (~+ g!inputsC)) - (~ (|annotations|.write annotations)) + (wrap (list (` (def: (~+ (|export|.format export)) ((~ g!message) (~+ g!inputsC)) + (~ (|annotations|.format annotations)) (All [(~+ g!all_vars)] (-> (~+ g!inputsT) (..Message (~ (get@ #abstract.abstraction actor_scope)) diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux index dcbb6ecfc..8f05916d7 100644 --- a/stdlib/source/lux/control/exception.lux +++ b/stdlib/source/lux/control/exception.lux @@ -104,7 +104,7 @@ [current_module meta.current_module_name #let [descriptor ($_ text\compose "{" current_module "." name "}" text.new_line) g!self (code.local_identifier name)]] - (wrap (list (` (def: (~+ (|export|.write export)) + (wrap (list (` (def: (~+ (|export|.format export)) (~ g!self) (All [(~+ (list\map |type_variable|.format t_vars))] (..Exception [(~+ (list\map (get@ #|input|.type) inputs))])) diff --git a/stdlib/source/lux/control/parser/text.lux b/stdlib/source/lux/control/parser/text.lux index 9fe3b55fd..8065e0794 100644 --- a/stdlib/source/lux/control/parser/text.lux +++ b/stdlib/source/lux/control/parser/text.lux @@ -117,7 +117,7 @@ (exception: #export (cannot_match {reference Text}) (exception.report - ["Reference" (/.encode reference)])) + ["Reference" (/.format reference)])) (def: #export (this reference) {#.doc "Lex a text if it matches the given sample."} @@ -202,8 +202,8 @@ (template [<name>] [(exception: #export (<name> {options Text} {character Char}) (exception.report - ["Options" (/.encode options)] - ["Character" (/.encode (/.from_code character))]))] + ["Options" (/.format options)] + ["Character" (/.format (/.from_code character))]))] [character_should_be] [character_should_not_be] @@ -251,7 +251,7 @@ (exception: #export (character_does_not_satisfy_predicate {character Char}) (exception.report - ["Character" (/.encode (/.from_code character))])) + ["Character" (/.format (/.from_code character))])) (def: #export (satisfies p) {#.doc "Only lex characters that satisfy a predicate."} diff --git a/stdlib/source/lux/control/security/capability.lux b/stdlib/source/lux/control/security/capability.lux index b94bd79cf..301753e2f 100644 --- a/stdlib/source/lux/control/security/capability.lux +++ b/stdlib/source/lux/control/security/capability.lux @@ -52,8 +52,8 @@ g!brand (\ ! map (|>> %.code code.text) (meta.gensym (format (%.name [this_module name])))) #let [capability (` (..Capability (.primitive (~ g!brand)) (~ input) (~ output)))]] - (wrap (list (` (type: (~+ (|export|.write export)) - (~ (|declaration|.write declaration)) + (wrap (list (` (type: (~+ (|export|.format export)) + (~ (|declaration|.format declaration)) (~ capability))) (` (def: (~ (code.local_identifier forge)) (All [(~+ (list\map code.local_identifier vars))] diff --git a/stdlib/source/lux/data/binary.lux b/stdlib/source/lux/data/binary.lux index fc0ba98ec..cc4273079 100644 --- a/stdlib/source/lux/data/binary.lux +++ b/stdlib/source/lux/data/binary.lux @@ -298,7 +298,7 @@ <for_jvm>} ## Default - (let [how_many (n._ from to)] + (let [how_many (n.- from to)] (..copy how_many from binary 0 (..create how_many))))) (exception.throw ..slice_out_of_bounds [size from to])) (exception.throw ..inverted_slice [size from to])))) diff --git a/stdlib/source/lux/data/product.lux b/stdlib/source/lux/data/product.lux index 616dcc63f..19878a1b4 100644 --- a/stdlib/source/lux/data/product.lux +++ b/stdlib/source/lux/data/product.lux @@ -35,7 +35,7 @@ (let [[x y] xy] [y x])) -(def: #export (both f g) +(def: #export (apply f g) (All [a b c d] (-> (-> a c) (-> b d) (-> (& a b) (& c d)))) diff --git a/stdlib/source/lux/data/sum.lux b/stdlib/source/lux/data/sum.lux index 2daefe6a4..1a39d770b 100644 --- a/stdlib/source/lux/data/sum.lux +++ b/stdlib/source/lux/data/sum.lux @@ -22,7 +22,7 @@ (0 #0 l) (fl l) (0 #1 r) (fr r)))) -(def: #export (each fl fr) +(def: #export (apply fl fr) (All [l l' r r'] (-> (-> l l') (-> r r') (-> (| l r) (| l' r')))) diff --git a/stdlib/source/lux/data/text.lux b/stdlib/source/lux/data/text.lux index b27a42eec..9fbfecf36 100644 --- a/stdlib/source/lux/data/text.lux +++ b/stdlib/source/lux/data/text.lux @@ -265,7 +265,7 @@ (-> Text Text Text) (enclose [boundary boundary] content)) -(def: #export encode +(def: #export format (-> Text Text) (..enclose' ..double_quote)) diff --git a/stdlib/source/lux/data/text/format.lux b/stdlib/source/lux/data/text/format.lux index 0775eaa45..2232e0b6d 100644 --- a/stdlib/source/lux/data/text/format.lux +++ b/stdlib/source/lux/data/text/format.lux @@ -62,7 +62,7 @@ [rev Rev (\ rev.decimal encode)] [frac Frac (\ frac.decimal encode)] [ratio ratio.Ratio (\ ratio.codec encode)] - [text Text text.encode] + [text Text text.format] [name Name (\ name.codec encode)] [code Code code.format] [type Type type.format] diff --git a/stdlib/source/lux/debug.lux b/stdlib/source/lux/debug.lux index c537148c8..088504f2d 100644 --- a/stdlib/source/lux/debug.lux +++ b/stdlib/source/lux/debug.lux @@ -298,3 +298,9 @@ (wrap (list (` ("lux in-module" (~ (code.text module)) (~ (code.identifier definition)))))))) + +(def: #export (log! message) + {#.doc (doc "Logs message to standard output." + "Useful for debugging.")} + (-> Text Any) + ("lux io log" message)) diff --git a/stdlib/source/lux/host.js.lux b/stdlib/source/lux/host.js.lux index aa07be184..7ca58be58 100644 --- a/stdlib/source/lux/host.js.lux +++ b/stdlib/source/lux/host.js.lux @@ -1,6 +1,6 @@ (.module: [lux #* - ["." meta (#+ with-gensyms)] + ["." meta (#+ with_gensyms)] [abstract [monad (#+ do)]] [control @@ -24,9 +24,10 @@ (abstract: #export (Object brand) Any) (template [<name>] - [(with-expansions [<brand> (template.identifier [<name> "'"])] + [(with_expansions [<brand> (template.identifier [<name> "'"])] (abstract: #export <brand> Any) - (type: #export <name> (Object <brand>)))] + (type: #export <name> + (Object <brand>)))] [Function] [Symbol] @@ -35,14 +36,16 @@ ) (template [<name> <type>] - [(type: #export <name> <type>)] + [(type: #export <name> + <type>)] [Boolean Bit] [Number Frac] [String Text] ) -(type: Nullable [Bit Code]) +(type: Nullable + [Bit Code]) (def: nullable (Parser Nullable) @@ -51,14 +54,16 @@ (<>.after (<>.not (<c>.this! token))) <c>.any))) -(type: Constructor (List Nullable)) +(type: Constructor + (List Nullable)) (def: constructor (Parser Constructor) (<c>.form (<>.after (<c>.this! (' new)) (<c>.tuple (<>.some ..nullable))))) -(type: Field [Bit Text Nullable]) +(type: Field + [Bit Text Nullable]) (def: static! (Parser Any) @@ -68,10 +73,10 @@ (Parser Field) (<c>.form ($_ <>.and (<>.parses? ..static!) - <c>.local-identifier + <c>.local_identifier ..nullable))) -(type: Common-Method +(type: Common_Method {#name Text #alias (Maybe Text) #inputs (List Nullable) @@ -79,30 +84,30 @@ #try? Bit #output Nullable}) -(type: Static-Method Common-Method) -(type: Virtual-Method Common-Method) +(type: Static_Method Common_Method) +(type: Virtual_Method Common_Method) (type: Method - (#Static Static-Method) - (#Virtual Virtual-Method)) + (#Static Static_Method) + (#Virtual Virtual_Method)) -(def: common-method - (Parser Common-Method) +(def: common_method + (Parser Common_Method) ($_ <>.and - <c>.local-identifier - (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local-identifier)) + <c>.local_identifier + (<>.maybe (<>.after (<c>.this! (' #as)) <c>.local_identifier)) (<c>.tuple (<>.some ..nullable)) (<>.parses? (<c>.this! (' #io))) (<>.parses? (<c>.this! (' #try))) ..nullable)) -(def: static-method - (<>.after ..static! ..common-method)) +(def: static_method + (<>.after ..static! ..common_method)) (def: method (Parser Method) - (<c>.form (<>.or ..static-method - ..common-method))) + (<c>.form (<>.or ..static_method + ..common_method))) (type: Member (#Constructor Constructor) @@ -117,19 +122,19 @@ ..method )) -(def: input-variables +(def: input_variables (-> (List Nullable) (List [Bit Code])) (|>> list.enumeration (list\map (function (_ [idx [nullable? type]]) - [nullable? (|> idx %.nat code.local-identifier)])))) + [nullable? (|> idx %.nat code.local_identifier)])))) -(def: (nullable-type [nullable? type]) +(def: (nullable_type [nullable? type]) (-> Nullable Code) (if nullable? (` (.Maybe (~ type))) type)) -(def: (with-null g!temp [nullable? input]) +(def: (with_null g!temp [nullable? input]) (-> Code [Bit Code] Code) (if nullable? (` (case (~ input) @@ -140,7 +145,7 @@ ("js object null"))) input)) -(def: (without-null g!temp [nullable? outputT] output) +(def: (without_null g!temp [nullable? outputT] output) (-> Code Nullable Code Code) (if nullable? (` (let [(~ g!temp) (~ output)] @@ -151,136 +156,136 @@ (type: Import (#Class [Text (List Member)]) - (#Function Static-Method)) + (#Function Static_Method)) (def: import ($_ <>.or ($_ <>.and - <c>.local-identifier + <c>.local_identifier (<>.some member)) - (<c>.form ..common-method) + (<c>.form ..common_method) )) (syntax: #export (try expression) - {#.doc (doc (case (try (risky-computation input)) + {#.doc (doc (case (try (risky_computation input)) (#.Right success) - (do-something success) + (do_something success) (#.Left error) - (recover-from-failure error)))} + (recover_from_failure error)))} (wrap (list (` ("lux try" ((~! io.io) (~ expression))))))) -(def: (with-io with? without) +(def: (with_io with? without) (-> Bit Code Code) (if with? (` (io.io (~ without))) without)) -(def: (io-type io? rawT) +(def: (io_type io? rawT) (-> Bit Code Code) (if io? (` (io.IO (~ rawT))) rawT)) -(def: (with-try with? without-try) +(def: (with_try with? without_try) (-> Bit Code Code) (if with? - (` (..try (~ without-try))) - without-try)) + (` (..try (~ without_try))) + without_try)) -(def: (try-type try? rawT) +(def: (try_type try? rawT) (-> Bit Code Code) (if try? (` (.Either .Text (~ rawT))) rawT)) -(def: (make-function g!method g!temp source inputsT io? try? outputT) +(def: (make_function g!method g!temp source inputsT io? try? outputT) (-> Code Code Text (List Nullable) Bit Bit Nullable Code) - (let [g!inputs (input-variables inputsT)] + (let [g!inputs (input_variables inputsT)] (` (def: ((~ g!method) [(~+ (list\map product.right g!inputs))]) - (-> [(~+ (list\map nullable-type inputsT))] - (~ (|> (nullable-type outputT) - (try-type try?) - (io-type io?)))) + (-> [(~+ (list\map nullable_type inputsT))] + (~ (|> (nullable_type outputT) + (try_type try?) + (io_type io?)))) (:assume - (~ (<| (with-io io?) - (with-try try?) - (without-null g!temp outputT) + (~ (<| (with_io io?) + (with_try try?) + (without_null g!temp outputT) (` ("js apply" ("js constant" (~ (code.text source))) - (~+ (list\map (with-null g!temp) g!inputs))))))))))) + (~+ (list\map (with_null g!temp) g!inputs))))))))))) (syntax: #export (import: {import ..import}) - (with-gensyms [g!temp] + (with_gensyms [g!temp] (case import (#Class [class members]) - (with-gensyms [g!object] + (with_gensyms [g!object] (let [qualify (: (-> Text Code) - (|>> (format class "::") code.local-identifier)) - g!type (code.local-identifier class) - real-class (text.replace-all "/" "." class)] + (|>> (format class "::") code.local_identifier)) + g!type (code.local_identifier class) + real_class (text.replace_all "/" "." class)] (wrap (list& (` (type: (~ g!type) - (..Object (primitive (~ (code.text real-class)))))) + (..Object (primitive (~ (code.text real_class)))))) (list\map (function (_ member) (case member (#Constructor inputsT) - (let [g!inputs (input-variables inputsT)] + (let [g!inputs (input_variables inputsT)] (` (def: ((~ (qualify "new")) [(~+ (list\map product.right g!inputs))]) - (-> [(~+ (list\map nullable-type inputsT))] + (-> [(~+ (list\map nullable_type inputsT))] (~ g!type)) (:assume ("js object new" - ("js constant" (~ (code.text real-class))) - [(~+ (list\map (with-null g!temp) g!inputs))]))))) + ("js constant" (~ (code.text real_class))) + [(~+ (list\map (with_null g!temp) g!inputs))]))))) (#Field [static? field fieldT]) (if static? (` ((~! syntax:) ((~ (qualify field))) (\ (~! meta.monad) (~' wrap) - (list (` (.:coerce (~ (nullable-type fieldT)) - ("js constant" (~ (code.text (format real-class "." field)))))))))) + (list (` (.:coerce (~ (nullable_type fieldT)) + ("js constant" (~ (code.text (format real_class "." field)))))))))) (` (def: ((~ (qualify field)) (~ g!object)) (-> (~ g!type) - (~ (nullable-type fieldT))) + (~ (nullable_type fieldT))) (:assume - (~ (without-null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) + (~ (without_null g!temp fieldT (` ("js object get" (~ (code.text field)) (~ g!object))))))))) (#Method method) (case method (#Static [method alias inputsT io? try? outputT]) - (..make-function (qualify (maybe.default method alias)) + (..make_function (qualify (maybe.default method alias)) g!temp - (format real-class "." method) + (format real_class "." method) inputsT io? try? outputT) (#Virtual [method alias inputsT io? try? outputT]) - (let [g!inputs (input-variables inputsT)] + (let [g!inputs (input_variables inputsT)] (` (def: ((~ (qualify (maybe.default method alias))) [(~+ (list\map product.right g!inputs))] (~ g!object)) - (-> [(~+ (list\map nullable-type inputsT))] + (-> [(~+ (list\map nullable_type inputsT))] (~ g!type) - (~ (|> (nullable-type outputT) - (try-type try?) - (io-type io?)))) + (~ (|> (nullable_type outputT) + (try_type try?) + (io_type io?)))) (:assume - (~ (<| (with-io io?) - (with-try try?) - (without-null g!temp outputT) + (~ (<| (with_io io?) + (with_try try?) + (without_null g!temp outputT) (` ("js object do" (~ (code.text method)) (~ g!object) - [(~+ (list\map (with-null g!temp) g!inputs))]))))))))))) + [(~+ (list\map (with_null g!temp) g!inputs))]))))))))))) members))))) (#Function [name alias inputsT io? try? outputT]) - (wrap (list (..make-function (code.local-identifier (maybe.default name alias)) + (wrap (list (..make_function (code.local_identifier (maybe.default name alias)) g!temp name inputsT @@ -289,17 +294,17 @@ outputT))) ))) -(template: #export (type-of object) +(template: #export (type_of object) ("js type-of" object)) (syntax: #export (constant type - {[head tail] (<c>.tuple (<>.and <c>.local-identifier (<>.some <c>.local-identifier)))}) - (with-gensyms [g!_] + {[head tail] (<c>.tuple (<>.and <c>.local_identifier (<>.some <c>.local_identifier)))}) + (with_gensyms [g!_] (let [constant (` ("js constant" (~ (code.text head))))] (case tail #.Nil (wrap (list (` (: (.Maybe (~ type)) - (case (..type-of (~ constant)) + (case (..type_of (~ constant)) "undefined" #.None @@ -309,13 +314,13 @@ (#.Cons [next tail]) (let [separator "."] (wrap (list (` (: (.Maybe (~ type)) - (case (..type-of (~ constant)) + (case (..type_of (~ constant)) "undefined" #.None (~ g!_) - (..constant (~ type) [(~ (code.local-identifier (format head "." next))) - (~+ (list\map code.local-identifier tail))]))))))))))) + (..constant (~ type) [(~ (code.local_identifier (format head "." next))) + (~+ (list\map code.local_identifier tail))]))))))))))) (template: (!defined? <constant>) (.case (..constant Any <constant>) @@ -330,11 +335,11 @@ Bit (!defined? <constant>))] - [on-browser? [window]] - [on-nashorn? [java lang Object]] + [on_browser? [window]] + [on_nashorn? [java lang Object]] ) -(def: #export on-node-js? +(def: #export on_node_js? Bit (case (..constant (Object Any) [process]) (#.Some process) diff --git a/stdlib/source/lux/macro/code.lux b/stdlib/source/lux/macro/code.lux index b208522ce..9249198d7 100644 --- a/stdlib/source/lux/macro/code.lux +++ b/stdlib/source/lux/macro/code.lux @@ -105,7 +105,7 @@ [#.Identifier name.codec]) [_ (#.Text value)] - (text.encode value) + (text.format value) [_ (#.Tag name)] (text\compose "#" (\ name.codec encode name)) diff --git a/stdlib/source/lux/macro/poly.lux b/stdlib/source/lux/macro/poly.lux index 8f571f61c..f97199209 100644 --- a/stdlib/source/lux/macro/poly.lux +++ b/stdlib/source/lux/macro/poly.lux @@ -28,7 +28,7 @@ body) (with_gensyms [g!_ g!type g!output] (let [g!name (code.identifier ["" name])] - (wrap (.list (` ((~! syntax:) (~+ (|export|.write export)) ((~ g!name) {(~ g!type) (~! s.identifier)}) + (wrap (.list (` ((~! syntax:) (~+ (|export|.format export)) ((~ g!name) {(~ g!type) (~! s.identifier)}) ((~! do) (~! meta.monad) [(~ g!type) ((~! meta.find_type_def) (~ g!type))] (case (: (.Either .Text .Code) @@ -75,7 +75,7 @@ #.None (` ((~ (code.identifier poly_func)) (~+ (list\map code.identifier poly_args)))))]] - (wrap (.list (` (def: (~+ (|export|.write export)) + (wrap (.list (` (def: (~+ (|export|.format export)) (~ (code.identifier ["" name])) {#.struct? #1} (~ impl))))))) diff --git a/stdlib/source/lux/macro/syntax/annotations.lux b/stdlib/source/lux/macro/syntax/annotations.lux index e1ee52274..a0453771a 100644 --- a/stdlib/source/lux/macro/syntax/annotations.lux +++ b/stdlib/source/lux/macro/syntax/annotations.lux @@ -27,9 +27,9 @@ Annotations (list)) -(def: #export write +(def: #export format (-> Annotations Code) - (let [entry (product.both code.tag function.identity)] + (let [entry (product.apply code.tag function.identity)] (|>> (list\map entry) code.record))) diff --git a/stdlib/source/lux/macro/syntax/check.lux b/stdlib/source/lux/macro/syntax/check.lux index 081e394b0..d3007b2b8 100644 --- a/stdlib/source/lux/macro/syntax/check.lux +++ b/stdlib/source/lux/macro/syntax/check.lux @@ -27,7 +27,7 @@ code.equivalence )) -(def: #export (write (^slots [#type #value])) +(def: #export (format (^slots [#type #value])) (-> Check Code) (` ((~ (code.text ..extension)) (~ type) diff --git a/stdlib/source/lux/macro/syntax/declaration.lux b/stdlib/source/lux/macro/syntax/declaration.lux index 9a72a8a0c..92158b842 100644 --- a/stdlib/source/lux/macro/syntax/declaration.lux +++ b/stdlib/source/lux/macro/syntax/declaration.lux @@ -35,7 +35,7 @@ (<code>.form (<>.and <code>.local_identifier (<>.some <code>.local_identifier))))) -(def: #export (write value) +(def: #export (format value) (-> Declaration Code) (let [g!name (code.local_identifier (get@ #name value))] (case (get@ #arguments value) diff --git a/stdlib/source/lux/macro/syntax/definition.lux b/stdlib/source/lux/macro/syntax/definition.lux index cdb382dc1..ac233d069 100644 --- a/stdlib/source/lux/macro/syntax/definition.lux +++ b/stdlib/source/lux/macro/syntax/definition.lux @@ -14,7 +14,7 @@ ["." bit] ["." name] ["." text - ["%" format (#+ format)]] + ["%" format]] [collection ["." list]]] [macro @@ -47,21 +47,21 @@ (def: extension "lux def") -(def: (write_tag [module short]) +(def: (format_tag [module short]) (-> Name Code) (` [(~ (code.text module)) (~ (code.text short))])) -(def: (write_annotations value) +(def: (format_annotations value) (-> Annotations Code) (case value #.Nil (` #.Nil) (#.Cons [name value] tail) - (` (#.Cons [(~ (..write_tag name)) + (` (#.Cons [(~ (..format_tag name)) (~ value)] - (~ (write_annotations tail)))))) + (~ (format_annotations tail)))))) (def: dummy Code @@ -69,17 +69,17 @@ #.line (~ (code.nat (get@ #.line location.dummy))) #.column (~ (code.nat (get@ #.column location.dummy)))})) -(def: #export (write (^slots [#name #value #anns #export?])) +(def: #export (format (^slots [#name #value #anns #export?])) (-> Definition Code) (` ((~ (code.text ..extension)) (~ (code.local_identifier name)) (~ (case value (#.Left check) - (//check.write check) + (//check.format check) (#.Right value) value)) - [(~ ..dummy) (#.Record (~ (..write_annotations anns)))] + [(~ ..dummy) (#.Record (~ (..format_annotations anns)))] (~ (code.bit export?))))) (def: tag_parser @@ -125,7 +125,7 @@ (exception: #export (lacks_type! {definition Definition}) (exception.report - ["Definition" (%.code (..write definition))])) + ["Definition" (%.code (..format definition))])) (def: #export (typed compiler) {#.doc "Only works for typed definitions."} diff --git a/stdlib/source/lux/macro/syntax/export.lux b/stdlib/source/lux/macro/syntax/export.lux index e89f908e4..fceecc6e7 100644 --- a/stdlib/source/lux/macro/syntax/export.lux +++ b/stdlib/source/lux/macro/syntax/export.lux @@ -7,7 +7,7 @@ (def: token (' #export)) -(def: #export (write exported?) +(def: #export (format exported?) (-> Bit (List Code)) (if exported? (list ..token) diff --git a/stdlib/source/lux/macro/template.lux b/stdlib/source/lux/macro/template.lux index a98e1c2d0..4a5a15606 100644 --- a/stdlib/source/lux/macro/template.lux +++ b/stdlib/source/lux/macro/template.lux @@ -160,8 +160,8 @@ (exception: #export (cannot_shadow_definition {module Text} {definition Text}) (exception.report - ["Module" (text.encode module)] - ["Definition" (text.encode definition)])) + ["Module" (text.format module)] + ["Definition" (text.format definition)])) (def: (push module_name local module) (-> Text Local Module (Try Module)) diff --git a/stdlib/source/lux/meta.lux b/stdlib/source/lux/meta.lux index 8cc4842e7..aeeb71cf1 100644 --- a/stdlib/source/lux/meta.lux +++ b/stdlib/source/lux/meta.lux @@ -183,10 +183,10 @@ (get@ #.definitions) (get name)))] (case definition - (#.Left [r_module r_name]) + (#.Alias [r_module r_name]) (find_macro' modules this_module r_module r_name) - (#.Right [exported? def_type def_anns def_value]) + (#.Definition [exported? def_type def_anns def_value]) (if (macro_type? def_type) (#.Some (:coerce Macro def_value)) #.None)))) @@ -496,7 +496,13 @@ (find_type_def de_aliased) (#.Right [exported? def_type def_data def_value]) - (wrap (:coerce Type def_value))))) + (let [type_to_code ("lux in-module" "lux" .type_to_code)] + (if (or (is? .Type def_type) + (\ code.equivalence = + (type_to_code .Type) + (type_to_code def_type))) + (wrap (:coerce Type def_value)) + (..fail ($_ text\compose "Definition is not a type: " (name\encode name)))))))) (def: #export (globals module) {#.doc "The entire list of globals in a module (including the non-exported/private ones)."} @@ -691,10 +697,10 @@ (do ..monad [location ..location output (<func> token) - #let [_ (log! ($_ text\compose (name\encode (name_of <macro>)) " @ " (location.format location))) - _ (list\map (|>> code.format log!) + #let [_ ("lux io log" ($_ text\compose (name\encode (name_of <macro>)) " @ " (location.format location))) + _ (list\map (|>> code.format "lux io log") output) - _ (log! "")]] + _ ("lux io log" "")]] (wrap (if omit? (list) output))) diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index fb3e9a990..d3951e5a3 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -1,6 +1,7 @@ (.module: {#.doc "Tools for unit & property-based/generative testing."} [lux (#- and for) ["." meta] + ["." debug] [abstract ["." monad (#+ do)]] [control @@ -233,9 +234,9 @@ [counters documentation] (|> test (random.run prng) product.right) post (promise.future instant.now) #let [duration (instant.span pre post) - _ (log! (format documentation text.new_line text.new_line - (tally duration counters) - text.new_line))]] + _ (debug.log! (format documentation text.new_line text.new_line + (tally duration counters) + text.new_line))]] (promise.future (\ program.default exit (case (get@ #failures counters) 0 ..success_exit_code diff --git a/stdlib/source/lux/tool/compiler/language/lux/generation.lux b/stdlib/source/lux/tool/compiler/language/lux/generation.lux index bdcaeae42..fb63247be 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/generation.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/generation.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Module log!) + [lux (#- Module) [abstract [monad (#+ do)]] [control diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux index dfd9c1015..3b654fffd 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -22,7 +22,9 @@ [// ["/" analysis (#+ Analysis Operation Phase)] [/// - ["#" phase]]]]]) + ["#" phase] + [reference (#+) + [variable (#+)]]]]]]) (exception: #export (cannot_analyse {expected Type} {function Text} {argument Text} {body Code}) (ex.report ["Type" (%.type expected)] diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux index 7176b3c3a..088bed17a 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux @@ -19,7 +19,9 @@ ["#." analysis ["#/." macro (#+ Expander)]] [/// - ["//" phase]]]]) + ["//" phase] + [reference (#+) + [variable (#+)]]]]]) (exception: #export (not_a_directive {code Code}) (exception.report diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux index 03b2ca14b..4c1ab473f 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux @@ -91,24 +91,6 @@ (//runtime.io//log messageG) //runtime.unit)) -(def: (io//exit codeG) - (Unary Expression) - (let [exit_node_js! (let [@@process (_.var "process")] - (|> (_.not (_.= _.undefined (_.type_of @@process))) - (_.and (_.the "exit" @@process)) - (_.and (_.do "exit" (list (//runtime.i64//to_number codeG)) @@process)))) - close_browser_window! (let [@@window (_.var "window")] - (|> (_.not (_.= _.undefined (_.type_of @@window))) - (_.and (_.the "close" @@window)) - (_.and (_.do "close" (list) @@window)))) - reload_page! (let [@@location (_.var "location")] - (|> (_.not (_.= _.undefined (_.type_of @@location))) - (_.and (_.the "reload" @@location)) - (_.and (_.do "reload" (list) @@location))))] - (|> exit_node_js! - (_.or close_browser_window!) - (_.or reload_page!)))) - (def: (io//current_time _) (Nullary Expression) (|> (_.new (_.var "Date") (list)) @@ -204,7 +186,6 @@ (|> /.empty (/.install "log" (unary io//log)) (/.install "error" (unary //runtime.io//error)) - (/.install "exit" (unary io//exit)) (/.install "current-time" (nullary io//current_time))))) (def: #export bundle diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux index b2ede6b94..b8dbfc4ce 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux @@ -19,9 +19,12 @@ ["/#" // #_ ["." extension] ["/#" // #_ + [analysis (#+)] ["." synthesis] ["//#" /// #_ - ["#." phase ("#\." monad)]]]]]]) + ["#." phase ("#\." monad)] + [reference (#+) + [variable (#+)]]]]]]]) (exception: #export cannot-recur-as-an-expression) diff --git a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux index 8bb16efeb..e6bd713f7 100644 --- a/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux +++ b/stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux @@ -20,7 +20,9 @@ ["#." analysis (#+ Analysis)] ["/" synthesis (#+ Synthesis Phase)] [/// - ["." phase ("#\." monad)]]]]]) + ["." phase ("#\." monad)] + [reference (#+) + [variable (#+)]]]]]]) (def: (primitive analysis) (-> ///analysis.Primitive /.Primitive) diff --git a/stdlib/source/lux/tool/compiler/phase.lux b/stdlib/source/lux/tool/compiler/phase.lux index 20cba5fc1..0d6543c33 100644 --- a/stdlib/source/lux/tool/compiler/phase.lux +++ b/stdlib/source/lux/tool/compiler/phase.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." debug] [abstract [monad (#+ Monad do)]] [control @@ -107,10 +108,11 @@ [_ (wrap []) #let [pre (io.run instant.now)] output operation - #let [_ (log! (|> instant.now - io.run - instant.relative - (duration.difference (instant.relative pre)) - %.duration - (format (%.name definition) " [" description "]: ")))]] + #let [_ (|> instant.now + io.run + instant.relative + (duration.difference (instant.relative pre)) + %.duration + (format (%.name definition) " [" description "]: ") + debug.log!)]] (wrap output))) diff --git a/stdlib/source/lux/type.lux b/stdlib/source/lux/type.lux index d0c0dfe0c..b34addbc5 100644 --- a/stdlib/source/lux/type.lux +++ b/stdlib/source/lux/type.lux @@ -370,16 +370,17 @@ (do meta.monad [location meta.location valueT (meta.find_type valueN) - #let [_ (log! ($_ text\compose - (name\encode (name_of ..:log!)) " " (location.format location) text.new_line - "Expression: " (case valueC - (#.Some valueC) - (code.format valueC) - - #.None - (name\encode valueN)) - text.new_line - " Type: " (..format valueT)))]] + #let [_ ("lux io log" + ($_ text\compose + (name\encode (name_of ..:log!)) " " (location.format location) text.new_line + "Expression: " (case valueC + (#.Some valueC) + (code.format valueC) + + #.None + (name\encode valueN)) + text.new_line + " Type: " (..format valueT)))]] (wrap (list (code.identifier valueN)))) (#.Right valueC) diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 0bfb00872..2c7c00506 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -220,8 +220,8 @@ type_varsC abstraction_declaration representation_declaration])] - (wrap (list& (` (type: (~+ (|export|.write export)) (~ abstraction_declaration) - (~ (|annotations|.write annotations)) + (wrap (list& (` (type: (~+ (|export|.format export)) (~ abstraction_declaration) + (~ (|annotations|.format annotations)) (primitive (~ (code.text (abstraction_type_name [current_module name]))) [(~+ type_varsC)]))) (` (type: (~ representation_declaration) diff --git a/stdlib/source/lux/type/unit.lux b/stdlib/source/lux/type/unit.lux index ff6d3bb3a..0a3d5c61a 100644 --- a/stdlib/source/lux/type/unit.lux +++ b/stdlib/source/lux/type/unit.lux @@ -73,10 +73,10 @@ {export |export|.parser} {name s.local_identifier} {annotations (p.default |annotations|.empty |annotations|.parser)}) - (wrap (list (` (type: (~+ (|export|.write export)) (~ (code.local_identifier name)) - (~ (|annotations|.write annotations)) + (wrap (list (` (type: (~+ (|export|.format export)) (~ (code.local_identifier name)) + (~ (|annotations|.format annotations)) (primitive (~ (code.text (unit_name name)))))) - (` (def: (~+ (|export|.write export)) (~ (code.local_identifier (format "@" name))) + (` (def: (~+ (|export|.format export)) (~ (code.local_identifier (format "@" name))) (~ (code.local_identifier name)) (:assume []))) ))) @@ -98,10 +98,10 @@ {(^slots [#ratio.numerator #ratio.denominator]) ratio^} {annotations (p.default |annotations|.empty |annotations|.parser)}) (let [g!scale (code.local_identifier name)] - (wrap (list (` (type: (~+ (|export|.write export)) ((~ g!scale) (~' u)) - (~ (|annotations|.write annotations)) + (wrap (list (` (type: (~+ (|export|.format export)) ((~ g!scale) (~' u)) + (~ (|annotations|.format annotations)) (primitive (~ (code.text (scale_name name))) [(~' u)]))) - (` (structure: (~+ (|export|.write export)) (~ (code.local_identifier (format "@" name))) + (` (structure: (~+ (|export|.format export)) (~ (code.local_identifier (format "@" name))) (..Scale (~ g!scale)) (def: (~' scale) (|>> ..out diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 68e1d056f..0f4e6405f 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -112,7 +112,8 @@ (..can_close (|>> (exception.throw ..cannot_close) wrap))))))))))] (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) + @.jvm (as_is <jvm>)} + (as_is))) (def: #export (write_line message console) (All [!] (-> Text (Console !) (! (Try Any)))) diff --git a/stdlib/source/lux/world/file/watch.lux b/stdlib/source/lux/world/file/watch.lux index 948219013..b3951068c 100644 --- a/stdlib/source/lux/world/file/watch.lux +++ b/stdlib/source/lux/world/file/watch.lux @@ -450,4 +450,5 @@ ))))) )] (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) + @.jvm (as_is <jvm>)} + (as_is))) diff --git a/stdlib/source/lux/world/shell.lux b/stdlib/source/lux/world/shell.lux index d64e70b9a..1b1fd7bbe 100644 --- a/stdlib/source/lux/world/shell.lux +++ b/stdlib/source/lux/world/shell.lux @@ -291,50 +291,51 @@ (import: java/lang/System ["#::." (#static getProperty [java/lang/String] #io #try java/lang/String)]) + + ## https://en.wikipedia.org/wiki/Code_injection#Shell_injection + (def: windows? + (IO (Try Bit)) + (\ (try.with io.monad) map + (|>> java/lang/String::toLowerCase (text.starts_with? "windows")) + (java/lang/System::getProperty "os.name"))) + + (def: (jvm::process_builder policy command arguments) + (All [?] + (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?)) + java/lang/ProcessBuilder)) + (|> (list\map (\ policy value) arguments) + (list& (\ policy value command)) + ..jvm::arguments_array + java/lang/ProcessBuilder::new)) + + (structure: #export default + (Shell IO) + + (def: execute + (..can_execute + (function (_ [environment working_directory command arguments]) + (with_expansions [<jvm> (as_is (do {! (try.with io.monad)} + [windows? ..windows? + #let [builder (if windows? + (..jvm::process_builder ..windows_policy + (\ ..windows_policy command command) + (list\map (\ ..windows_policy argument) arguments)) + (..jvm::process_builder ..unix_policy + (\ ..unix_policy command command) + (list\map (\ ..unix_policy argument) arguments)))] + _ (|> builder + (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)) + java/lang/ProcessBuilder::environment + (\ try.functor map (..jvm::load_environment environment)) + (\ io.monad wrap)) + process (java/lang/ProcessBuilder::start builder)] + (..default_process process)))] + (for {@.old (as_is <jvm>) + @.jvm (as_is <jvm>)})))))) )] (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})) - -## https://en.wikipedia.org/wiki/Code_injection#Shell_injection -(def: windows? - (IO (Try Bit)) - (\ (try.with io.monad) map - (|>> java/lang/String::toLowerCase (text.starts_with? "windows")) - (java/lang/System::getProperty "os.name"))) - -(def: (jvm::process_builder policy command arguments) - (All [?] - (-> (Policy ?) (Safe Command ?) (List (Safe Argument ?)) - java/lang/ProcessBuilder)) - (|> (list\map (\ policy value) arguments) - (list& (\ policy value command)) - ..jvm::arguments_array - java/lang/ProcessBuilder::new)) - -(structure: #export default - (Shell IO) - - (def: execute - (..can_execute - (function (_ [environment working_directory command arguments]) - (with_expansions [<jvm> (as_is (do {! (try.with io.monad)} - [windows? ..windows? - #let [builder (if windows? - (..jvm::process_builder ..windows_policy - (\ ..windows_policy command command) - (list\map (\ ..windows_policy argument) arguments)) - (..jvm::process_builder ..unix_policy - (\ ..unix_policy command command) - (list\map (\ ..unix_policy argument) arguments)))] - _ (|> builder - (java/lang/ProcessBuilder::directory (java/io/File::new working_directory)) - java/lang/ProcessBuilder::environment - (\ try.functor map (..jvm::load_environment environment)) - (\ io.monad wrap)) - process (java/lang/ProcessBuilder::start builder)] - (..default_process process)))] - (for {@.old (as_is <jvm>) - @.jvm (as_is <jvm>)})))))) + @.jvm (as_is <jvm>)} + (as_is))) (signature: #export (Simulation s) (: (-> s (Try [s Text])) diff --git a/stdlib/source/program/aedifex.lux b/stdlib/source/program/aedifex.lux index 051bba9b1..4b812bef4 100644 --- a/stdlib/source/program/aedifex.lux +++ b/stdlib/source/program/aedifex.lux @@ -1,6 +1,7 @@ (.module: [lux (#- Name) [program (#+ program:)] + ["." debug] [abstract [monad (#+ do)]] [control @@ -93,7 +94,7 @@ (def: (fail! error) (-> Text (IO Any)) (exec - (log! error) + (debug.log! error) (\ program.default exit shell.error))) (def: (command action) diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 60619f78b..dc2de91f7 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -21,7 +21,7 @@ ["." / #_ ["#." type] ["#." extension] - ["#." time_stamp #_ + ["#." time_stamp ["#/." date] ["#/." time]]] {#program @@ -45,6 +45,7 @@ /type.test /extension.test + /time_stamp.test /time_stamp/date.test /time_stamp/time.test )))) diff --git a/stdlib/source/test/aedifex/artifact/time_stamp.lux b/stdlib/source/test/aedifex/artifact/time_stamp.lux new file mode 100644 index 000000000..7dea57392 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/time_stamp.lux @@ -0,0 +1,33 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]] + [time + ["." instant]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Time_Stamp]) + ($_ _.and + (do random.monad + [expected random.instant] + (_.cover [/.format /.parser] + (|> expected + /.format + (<text>.run /.parser) + (try\map (\ instant.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index cd57863b7..a9adcbf2e 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." debug] [abstract [monad (#+ do)]] [data @@ -70,7 +71,7 @@ (_.cover [/.exec>] (n.= (n.* 10 sample) (|> sample - (/.exec> [%.nat (format "sample = ") log!]) + (/.exec> [%.nat (format "sample = ") debug.log!]) (n.* 10)))) (_.cover [/.tuple>] (let [[left middle right] (|> sample diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index c33e60dd1..c20e7f5e9 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -62,8 +62,8 @@ (<| (_.cover [/.curry]) (n.= (n.+ left right) ((/.curry (/.uncurry n.+)) left right))) - (<| (_.cover [/.both]) - (let [[left' right'] (/.both (n.+ shift) (n.- shift) [left right])] + (<| (_.cover [/.apply]) + (let [[left' right'] (/.apply (n.+ shift) (n.- shift) [left right])] (and (n.= (n.+ shift left) left') (n.= (n.- shift right) right')))))) )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index da108ede8..3b37382ae 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -60,14 +60,14 @@ (: (| Nat Nat)) (/.either (n.+ shift) (n.- shift)) (n.= (n.- shift expected))))) - (_.cover [/.each] + (_.cover [/.apply] (and (|> (/.left expected) (: (| Nat Nat)) - (/.each (n.+ shift) (n.- shift)) + (/.apply (n.+ shift) (n.- shift)) (case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false)) (|> (/.right expected) (: (| Nat Nat)) - (/.each (n.+ shift) (n.- shift)) + (/.apply (n.+ shift) (n.- shift)) (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) (do ! [size (\ ! map (n.% 5) random.nat) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 4308f8e95..a5d11685f 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -69,8 +69,8 @@ (let [value (/.enclose [left right] inner)] (and (/.starts_with? left value) (/.ends_with? right value)))) - (_.cover [/.encode] - (let [sample (/.encode inner)] + (_.cover [/.format] + (let [sample (/.format inner)] (and (/.encloses? /.double_quote sample) (/.contains? inner sample)))) )))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index 2aa33d2d4..0f61caa1f 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -134,7 +134,7 @@ (text\= (<alias> sample) (<format> sample))))] - [/.text text.encode (random.unicode 5)] + [/.text text.format (random.unicode 5)] [/.code code.format $///code.random] [/.type type.format $///type.random] [/.location location.format diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 9e8699c55..855c6e8bb 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." debug] ["@" target ["." jvm] ["." js]] @@ -85,7 +86,7 @@ ## Directive (directive: (..my_directive self phase archive {parameters (<>.some <c>.any)}) (do phase.monad - [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]] + [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] (wrap directive.no_requirements))) (`` ((~~ (static ..my_directive)))) diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index c2a1e63a5..f2fbe2010 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -1,158 +1,44 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] ["_" test (#+ Test)] [abstract - [equivalence (#+ Equivalence)]] - [control - ["." try (#+ Try)] - ["p" parser - ["s" code (#+ Parser)]]] - [data - ["." bit] - ["." name] - ["." text]] - [macro - ["." code]] + [monad (#+ do)]] [math - [random (#+ Random)] + ["." random] [number - ["." nat] - ["." int] - ["." rev] - ["." frac]]]] + ["n" nat]]]] {1 - ["." / (#+ syntax:)]}) - -(def: (enforced? parser input) - (-> (Parser []) (List Code) Bit) - (case (p.run parser input) - (#.Right [_ []]) - #1 - - _ - #0)) - -(def: (found? parser input) - (-> (Parser Bit) (List Code) Bit) - (case (p.run parser input) - (#.Right [_ #1]) - #1 - - _ - #0)) - -(def: (equals? Equivalence<a> reference parser input) - (All [a] (-> (Equivalence a) a (Parser a) (List Code) Bit)) - (case (p.run parser input) - (#.Right [_ output]) - (\ Equivalence<a> = reference output) - - _ - #0)) - -(def: (fails? input) - (All [a] (-> (Try a) Bit)) - (case input - (#.Left _) - #1 - - _ - #0)) - -(syntax: (match pattern input) - (wrap (list (` (case (~ input) - (^ (#.Right [(~' _) (~ pattern)])) - #1 - - (~' _) - #0))))) - -(def: simple_values - Test - (`` ($_ _.and - (~~ (template [<assertion> <value> <ctor> <Equivalence> <get>] - [(_.test <assertion> - (and (equals? <Equivalence> <value> <get> (list (<ctor> <value>))) - (found? (p.parses? (s.this! (<ctor> <value>))) (list (<ctor> <value>))) - (enforced? (s.this! (<ctor> <value>)) (list (<ctor> <value>)))))] - - ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit] - ["Can parse Nat syntax." 123 code.nat nat.equivalence s.nat] - ["Can parse Int syntax." +123 code.int int.equivalence s.int] - ["Can parse Rev syntax." .123 code.rev rev.equivalence s.rev] - ["Can parse Frac syntax." +123.0 code.frac frac.equivalence s.frac] - ["Can parse Text syntax." text.new_line code.text text.equivalence s.text] - ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier] - ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag] - )) - (_.test "Can parse identifiers belonging to the current namespace." - (and (match "yolo" - (p.run s.local_identifier - (list (code.local_identifier "yolo")))) - (fails? (p.run s.local_identifier - (list (code.identifier ["yolo" "lol"])))))) - (_.test "Can parse tags belonging to the current namespace." - (and (match "yolo" - (p.run s.local_tag - (list (code.local_tag "yolo")))) - (fails? (p.run s.local_tag - (list (code.tag ["yolo" "lol"])))))) - ))) - -(def: complex_values - Test - (`` ($_ _.and - (~~ (template [<type> <parser> <ctor>] - [(_.test (format "Can parse " <type> " syntax.") - (and (match [#1 +123] - (p.run (<parser> (p.and s.bit s.int)) - (list (<ctor> (list (code.bit #1) (code.int +123)))))) - (match #1 - (p.run (<parser> s.bit) - (list (<ctor> (list (code.bit #1)))))) - (fails? (p.run (<parser> s.bit) - (list (<ctor> (list (code.bit #1) (code.int +123)))))) - (match (#.Left #1) - (p.run (<parser> (p.or s.bit s.int)) - (list (<ctor> (list (code.bit #1)))))) - (match (#.Right +123) - (p.run (<parser> (p.or s.bit s.int)) - (list (<ctor> (list (code.int +123)))))) - (fails? (p.run (<parser> (p.or s.bit s.int)) - (list (<ctor> (list (code.frac +123.0))))))))] - - ["form" s.form code.form] - ["tuple" s.tuple code.tuple])) - (_.test "Can parse record syntax." - (match [#1 +123] - (p.run (s.record (p.and s.bit s.int)) - (list (code.record (list [(code.bit #1) (code.int +123)])))))) - ))) + ["." /]} + ["." / #_ + ["#." annotations] + ["#." check] + ["#." declaration] + ["#." definition] + ["#." export] + ["#." input] + ["#." type #_ + ["#/." variable]]]) + +(/.syntax: (+/3 a b c) + (wrap (list (` ($_ n.+ (~ a) (~ b) (~ c)))))) (def: #export test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.covering /._) ($_ _.and - ..simple_values - ..complex_values - ($_ _.and - (_.test "Can parse any Code." - (match [_ (#.Bit #1)] - (p.run s.any - (list (code.bit #1) (code.int +123))))) - (_.test "Can check whether the end has been reached." - (and (match #1 - (p.run s.end? - (list))) - (match #0 - (p.run s.end? - (list (code.bit #1)))))) - (_.test "Can ensure the end has been reached." - (and (match [] - (p.run s.end! - (list))) - (fails? (p.run s.end! - (list (code.bit #1)))))) - )))) + (do random.monad + [x random.nat + y random.nat + z random.nat] + (_.cover [/.syntax:] + (n.= ($_ n.+ x y z) + (+/3 x y z)))) + + /annotations.test + /check.test + /declaration.test + /definition.test + /export.test + /input.test + /type/variable.test + ))) diff --git a/stdlib/source/test/lux/macro/syntax/annotations.lux b/stdlib/source/test/lux/macro/syntax/annotations.lux index 564af4ea1..dac3c1e16 100644 --- a/stdlib/source/test/lux/macro/syntax/annotations.lux +++ b/stdlib/source/test/lux/macro/syntax/annotations.lux @@ -42,9 +42,9 @@ (list.empty? /.empty)) (do random.monad [expected ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (<code>.run /.parser - (list (/.write expected))) + (list (/.format expected))) (#try.Failure _) false diff --git a/stdlib/source/test/lux/macro/syntax/check.lux b/stdlib/source/test/lux/macro/syntax/check.lux index 898ad8abb..d5036d9b2 100644 --- a/stdlib/source/test/lux/macro/syntax/check.lux +++ b/stdlib/source/test/lux/macro/syntax/check.lux @@ -36,10 +36,10 @@ (do random.monad [[type value] ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (<code>.run /.parser - (list (/.write {#/.type type - #/.value value}))) + (list (/.format {#/.type type + #/.value value}))) (#try.Failure _) false diff --git a/stdlib/source/test/lux/macro/syntax/declaration.lux b/stdlib/source/test/lux/macro/syntax/declaration.lux index a9bc23296..2cb737caf 100644 --- a/stdlib/source/test/lux/macro/syntax/declaration.lux +++ b/stdlib/source/test/lux/macro/syntax/declaration.lux @@ -37,9 +37,9 @@ (do random.monad [expected ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (<code>.run /.parser - (list (/.write expected))) + (list (/.format expected))) (#try.Failure _) false diff --git a/stdlib/source/test/lux/macro/syntax/definition.lux b/stdlib/source/test/lux/macro/syntax/definition.lux index d6b101894..be6f05449 100644 --- a/stdlib/source/test/lux/macro/syntax/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/definition.lux @@ -67,9 +67,9 @@ type $///code.random untyped_value $///code.random] ($_ _.and - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (<code>.run (/.parser compiler) - (list (/.write expected))) + (list (/.format expected))) (#try.Failure error) false @@ -78,7 +78,7 @@ (_.cover [/.typed] (let [expected (set@ #/.value (#.Left [type untyped_value]) expected)] (case (<code>.run (/.typed compiler) - (list (/.write expected))) + (list (/.format expected))) (#try.Failure error) false @@ -87,7 +87,7 @@ (_.cover [/.lacks_type!] (let [expected (set@ #/.value (#.Right untyped_value) expected)] (case (<code>.run (/.typed compiler) - (list (/.write expected))) + (list (/.format expected))) (#try.Failure error) (exception.match? /.lacks_type! error) diff --git a/stdlib/source/test/lux/macro/syntax/export.lux b/stdlib/source/test/lux/macro/syntax/export.lux index 59b72eb0f..34c19a11f 100644 --- a/stdlib/source/test/lux/macro/syntax/export.lux +++ b/stdlib/source/test/lux/macro/syntax/export.lux @@ -19,9 +19,9 @@ (<| (_.covering /._) (do random.monad [expected random.bit] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (<code>.run /.parser - (/.write expected)) + (/.format expected)) (#try.Failure _) false diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 2315165ef..c1972a991 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -11,8 +11,11 @@ [control ["." try]] [data + ["." bit ("#\." equivalence)] ["." text ("#\." equivalence) - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [collection + ["." list]]] [meta ["." location]] [math @@ -41,10 +44,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) - expected_short (random.ascii/upper_alpha 1) - dummy_module (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) expected_gensym (random.ascii/upper_alpha 1) #let [expected_lux {#.info {#.target target #.version version @@ -166,17 +165,26 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) expected_short (random.ascii/upper_alpha 1) dummy_module (random.filter (|>> (text\= expected_current_module) not) (random.ascii/upper_alpha 1)) - #let [expected_lux {#.info {#.target target + #let [expected_module {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active} + expected_modules (list [expected_current_module + expected_module]) + expected_lux {#.info {#.target target #.version version #.mode #.Build} #.source [location.dummy 0 source_code] #.location location.dummy #.current_module (#.Some expected_current_module) - #.modules (list) + #.modules expected_modules #.scopes (list) #.type_context {#.ex_counter 0 #.var_counter 0 @@ -192,6 +200,28 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_current_module) (text\= expected_current_module actual_current_module))))) + (_.cover [/.current_module] + (|> /.current_module + (/.run expected_lux) + (!expect (^multi (#try.Success actual_module) + (is? expected_module actual_module))))) + (_.cover [/.find_module] + (|> (/.find_module expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_module) + (is? expected_module actual_module))))) + (_.cover [/.module_exists?] + (and (|> (/.module_exists? expected_current_module) + (/.run expected_lux) + (!expect (#try.Success #1))) + (|> (/.module_exists? dummy_module) + (/.run expected_lux) + (!expect (#try.Success #0))))) + (_.cover [/.modules] + (|> /.modules + (/.run expected_lux) + (!expect (^multi (#try.Success actual_modules) + (is? expected_modules actual_modules))))) (_.cover [/.normalize] (and (|> (/.normalize ["" expected_short]) (/.run expected_lux) @@ -212,6 +242,342 @@ random.nat random.nat)) +(def: context_related + (do {! random.monad} + [target (random.ascii/upper_alpha 1) + version (random.ascii/upper_alpha 1) + source_code (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper_alpha 1)) + expected_seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected_gensym (random.ascii/upper_alpha 1) + expected_location ..random_location + #let [expected_lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [location.dummy 0 source_code] + #.location expected_location + #.current_module (#.Some expected_current_module) + #.modules (list) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected (#.Some expected_type) + #.seed expected_seed + #.scope_type_vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.count] + (|> (do /.monad + [pre /.count + post /.count] + (wrap [pre post])) + (/.run expected_lux) + (!expect (^multi (#try.Success [actual_pre actual_post]) + (and (n.= expected_seed actual_pre) + (n.= (inc expected_seed) actual_post)))))) + (_.cover [/.gensym] + (|> (/.gensym expected_gensym) + (\ /.monad map %.code) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_gensym) + (and (text.contains? expected_gensym actual_gensym) + (text.contains? (%.nat expected_seed) actual_gensym)))))) + (_.cover [/.location] + (|> /.location + (/.run expected_lux) + (!expect (^multi (#try.Success actual_location) + (is? expected_location actual_location))))) + (_.cover [/.expected_type] + (|> /.expected_type + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type))))) + ))) + +(def: definition_related + Test + (do {! random.monad} + [expected_current_module (random.ascii/upper_alpha 1) + expected_macro_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + expected_short (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper_alpha 1)) + expected_value (random.either (wrap .def:) + (wrap .macro:)) + #let [expected_lux + (: (-> Bit (Maybe Type) + [(List [Text .Global]) + (List [Text .Global]) + Lux]) + (function (_ exported? def_type) + (let [current_globals (: (List [Text .Global]) + (list [expected_short + (#.Alias [expected_macro_module expected_short])])) + macro_globals (: (List [Text .Global]) + (case def_type + (#.Some def_type) + (list [expected_short + (#.Definition [exported? def_type (' []) expected_value])]) + + #.None + (list)))] + [current_globals + macro_globals + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some expected_current_module) + #.modules (list [expected_current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions current_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [expected_macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions macro_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []}])))]] + ($_ _.and + (_.cover [/.globals] + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro)) + + current_globals! + (|> (/.globals expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_globals) + (is? current_globals actual_globals)))) + + macro_globals! + (|> (/.globals expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_globals) + (is? macro_globals actual_globals))))] + (and current_globals! + macro_globals!))) + (_.cover [/.definitions] + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (and (|> (/.definitions expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + (|> (/.definitions expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 1 (list.size actual_definitions))))) + ))) + (_.cover [/.exports] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (and (|> (/.exports expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 1 (list.size actual_definitions))))) + )) + (let [[current_globals macro_globals expected_lux] + (expected_lux false (#.Some .Macro))] + (and (|> (/.exports expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + )))) + ))) + +(def: search_related + Test + (do {! random.monad} + [expected_exported? random.bit + expected_current_module (random.ascii/upper_alpha 1) + expected_macro_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + expected_short (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper_alpha 1)) + #let [expected_annotations (' [])] + expected_value (random.either (wrap .def:) + (wrap .macro:)) + #let [expected_lux + (: (-> Bit (Maybe Type) + [(List [Text .Global]) + (List [Text .Global]) + Lux]) + (function (_ exported? def_type) + (let [current_globals (: (List [Text .Global]) + (list [expected_short + (#.Alias [expected_macro_module expected_short])])) + macro_globals (: (List [Text .Global]) + (case def_type + (#.Some def_type) + (list [expected_short + (#.Definition [exported? def_type expected_annotations expected_value])]) + + #.None + (list)))] + [current_globals + macro_globals + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some expected_current_module) + #.modules (list [expected_current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions current_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [expected_macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions macro_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []}])))]] + ($_ _.and + (_.cover [/.find_macro] + (let [same_module! + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (|> (/.find_macro [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Some actual_value)) + (is? expected_value actual_value))))) + + not_macro! + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some expected_type))] + (|> (/.find_macro [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Success #.None)))) + + not_found! + (let [[current_globals macro_globals expected_lux] + (expected_lux true #.None)] + (|> (/.find_macro [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Success #.None)))) + + aliasing! + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (|> (/.find_macro [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Some actual_value)) + (is? expected_value actual_value)))))] + (and same_module! + not_macro! + not_found! + aliasing!))) + (_.cover [/.find_def] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? (#.Some expected_type)) + + definition! + (|> (/.find_def [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Definition [actual_exported? actual_type actual_annotations actual_value])) + (and (bit\= expected_exported? actual_exported?) + (is? expected_type actual_type) + (is? expected_annotations actual_annotations) + (is? (:coerce Any expected_value) actual_value))))) + + alias! + (|> (/.find_def [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Alias [actual_module actual_short])) + (and (is? expected_macro_module actual_module) + (is? expected_short actual_short)))))] + (and definition! + alias!))) + (_.cover [/.find_def_type] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? (#.Some expected_type)) + + definition! + (|> (/.find_def_type [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type)))) + + alias! + (|> (/.find_def_type [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type))))] + (and definition! + alias!))) + (_.cover [/.find_type_def] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? (#.Some .Type)) + + definition! + (|> (/.find_type_def [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_value) + (is? (:coerce .Type expected_value) actual_value)))) + + alias! + (|> (/.find_type_def [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_value) + (is? (:coerce .Type expected_value) actual_value))))] + (and definition! + alias!))) + ))) + (def: injection (Injection Meta) (\ /.monad wrap)) @@ -242,10 +608,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) - expected_short (random.ascii/upper_alpha 1) - dummy_module (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location #let [expected_lux {#.info {#.target target @@ -275,32 +637,9 @@ ..compiler_related ..error_handling ..module_related - (_.cover [/.count] - (|> (do /.monad - [pre /.count - post /.count] - (wrap [pre post])) - (/.run expected_lux) - (!expect (^multi (#try.Success [actual_pre actual_post]) - (and (n.= expected_seed actual_pre) - (n.= (inc expected_seed) actual_post)))))) - (_.cover [/.gensym] - (|> (/.gensym expected_gensym) - (\ /.monad map %.code) - (/.run expected_lux) - (!expect (^multi (#try.Success actual_gensym) - (and (text.contains? expected_gensym actual_gensym) - (text.contains? (%.nat expected_seed) actual_gensym)))))) - (_.cover [/.location] - (|> /.location - (/.run expected_lux) - (!expect (^multi (#try.Success actual_location) - (is? expected_location actual_location))))) - (_.cover [/.expected_type] - (|> /.expected_type - (/.run expected_lux) - (!expect (^multi (#try.Success actual_type) - (is? expected_type actual_type))))) + ..context_related + ..definition_related + ..search_related )) /annotation.test |