aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--lux-js/project.clj2
-rw-r--r--lux-js/source/program.lux5
-rw-r--r--stdlib/source/lux.lux8
-rw-r--r--stdlib/source/lux/control/concatenative.lux4
-rw-r--r--stdlib/source/lux/control/concurrency/actor.lux8
-rw-r--r--stdlib/source/lux/control/exception.lux2
-rw-r--r--stdlib/source/lux/control/parser/text.lux8
-rw-r--r--stdlib/source/lux/control/security/capability.lux4
-rw-r--r--stdlib/source/lux/data/binary.lux2
-rw-r--r--stdlib/source/lux/data/product.lux2
-rw-r--r--stdlib/source/lux/data/sum.lux2
-rw-r--r--stdlib/source/lux/data/text.lux2
-rw-r--r--stdlib/source/lux/data/text/format.lux2
-rw-r--r--stdlib/source/lux/debug.lux6
-rw-r--r--stdlib/source/lux/host.js.lux173
-rw-r--r--stdlib/source/lux/macro/code.lux2
-rw-r--r--stdlib/source/lux/macro/poly.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/annotations.lux4
-rw-r--r--stdlib/source/lux/macro/syntax/check.lux2
-rw-r--r--stdlib/source/lux/macro/syntax/declaration.lux2
-rw-r--r--stdlib/source/lux/macro/syntax/definition.lux18
-rw-r--r--stdlib/source/lux/macro/syntax/export.lux2
-rw-r--r--stdlib/source/lux/macro/template.lux4
-rw-r--r--stdlib/source/lux/meta.lux18
-rw-r--r--stdlib/source/lux/test.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/generation.lux2
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/analysis/function.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/directive.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/extension/generation/js/common.lux19
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/generation/js.lux5
-rw-r--r--stdlib/source/lux/tool/compiler/language/lux/phase/synthesis.lux4
-rw-r--r--stdlib/source/lux/tool/compiler/phase.lux14
-rw-r--r--stdlib/source/lux/type.lux21
-rw-r--r--stdlib/source/lux/type/abstract.lux4
-rw-r--r--stdlib/source/lux/type/unit.lux12
-rw-r--r--stdlib/source/lux/world/console.lux3
-rw-r--r--stdlib/source/lux/world/file/watch.lux3
-rw-r--r--stdlib/source/lux/world/shell.lux85
-rw-r--r--stdlib/source/program/aedifex.lux3
-rw-r--r--stdlib/source/test/aedifex/artifact.lux3
-rw-r--r--stdlib/source/test/aedifex/artifact/time_stamp.lux33
-rw-r--r--stdlib/source/test/lux/control/pipe.lux3
-rw-r--r--stdlib/source/test/lux/data/product.lux4
-rw-r--r--stdlib/source/test/lux/data/sum.lux6
-rw-r--r--stdlib/source/test/lux/data/text.lux4
-rw-r--r--stdlib/source/test/lux/data/text/format.lux2
-rw-r--r--stdlib/source/test/lux/extension.lux3
-rw-r--r--stdlib/source/test/lux/macro/syntax.lux180
-rw-r--r--stdlib/source/test/lux/macro/syntax/annotations.lux4
-rw-r--r--stdlib/source/test/lux/macro/syntax/check.lux6
-rw-r--r--stdlib/source/test/lux/macro/syntax/declaration.lux4
-rw-r--r--stdlib/source/test/lux/macro/syntax/definition.lux8
-rw-r--r--stdlib/source/test/lux/macro/syntax/export.lux4
-rw-r--r--stdlib/source/test/lux/meta.lux415
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