aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source')
-rw-r--r--stdlib/source/library/lux/control/aspect.lux324
-rw-r--r--stdlib/source/library/lux/control/function/mixin.lux71
-rw-r--r--stdlib/source/library/lux/control/parser.lux12
-rw-r--r--stdlib/source/library/lux/meta.lux33
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux14
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux6
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux102
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux10
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux61
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux82
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux2
-rw-r--r--stdlib/source/library/lux/world/net/http/query.lux65
-rw-r--r--stdlib/source/library/lux/world/net/uri/query.lux106
-rw-r--r--stdlib/source/test/lux/control.lux2
-rw-r--r--stdlib/source/test/lux/control/aspect.lux139
-rw-r--r--stdlib/source/test/lux/data/format/json.lux4
-rw-r--r--stdlib/source/test/lux/world/net.lux4
-rw-r--r--stdlib/source/test/lux/world/net/uri/query.lux43
19 files changed, 836 insertions, 246 deletions
diff --git a/stdlib/source/library/lux/control/aspect.lux b/stdlib/source/library/lux/control/aspect.lux
new file mode 100644
index 000000000..ae08932e3
--- /dev/null
+++ b/stdlib/source/library/lux/control/aspect.lux
@@ -0,0 +1,324 @@
+(.require
+ [library
+ [lux (.except Global #Local #location with local global)
+ [abstract
+ [monad (.only do)]]
+ [control
+ ["?" parser]
+ ["[0]" maybe]
+ [function
+ [predicate (.only Predicate)]]]
+ [data
+ ["[0]" text (.use "[1]#[0]" equivalence)
+ ["%" \\format]]
+ [collection
+ ["[0]" list (.use "[1]#[0]" mix)
+ ["[0]" property]]]]
+ ["[0]" meta (.only)
+ [extension (.only analysis declaration)]
+ ["[0]" code (.only)
+ ["?[1]" \\parser]]
+ ["[0]" macro (.only)
+ [syntax (.only syntax)]
+ ["^" pattern]]
+ [type
+ ["[0]" check]]
+ [compiler
+ ["[0]" phase]
+ [language
+ [lux
+ ["[0]" declaration]
+ ["[0]" analysis (.only)
+ ["[0]" module]
+ ["[0]" type]]]]]]]])
+
+(type .public (Advice value)
+ (-> value value))
+
+(type .public After
+ Advice)
+
+(type .public (Around input output)
+ (Advice (-> input output)))
+
+(def .public (before pre)
+ (All (_ input output)
+ (-> (-> input input)
+ (Around input output)))
+ (function (_ it input)
+ (it (pre input))))
+
+(type .public (Reference name)
+ (Record
+ [#name name
+ #type Type]))
+
+(type .public Local
+ (Reference Text))
+
+(type .public Global
+ (Reference Symbol))
+
+(type .public Scenario
+ (Variant
+ {#Local Local}
+ {#Global Global}))
+
+(type .public Join_Point
+ (Record
+ [#location Location
+ #scenario Scenario]))
+
+(type .public Point_Cut
+ (Predicate Join_Point))
+
+(def .public (when_module ?)
+ (-> (Predicate Text)
+ Point_Cut)
+ (|>> (the [#location .#module])
+ ?))
+
+(with_template [<type> <tag> <name>]
+ [(def .public (<name> ?)
+ (-> (Predicate <type>)
+ Point_Cut)
+ (function (_ it)
+ (when (the #scenario it)
+ {<tag> it}
+ (? it)
+
+ _
+ false)))]
+
+ [Local #Local when_local]
+ [Global #Global when_global]
+ )
+
+(def .public (typed? expected)
+ (-> Type
+ Point_Cut)
+ (function (_ it)
+ (when (the #scenario it)
+ (^.or {#Local [_ it]}
+ {#Global [_ it]})
+ (check.subsumes? expected it))))
+
+(type .public Aspect
+ (List [Point_Cut Symbol]))
+
+(def (without_global [module short])
+ (-> Symbol (analysis.Operation Any))
+ (function (_ lux)
+ (let [without_global (is (-> (property.List .Global) (property.List .Global))
+ (property.lacks short))
+ without_global (is (-> .Module .Module)
+ (revised .#definitions without_global))
+ without_global (is (-> (property.List .Module) (property.List .Module))
+ (property.revised module without_global))
+ without_global (is (-> Lux Lux)
+ (revised .#modules without_global))]
+ {.#Right [(without_global lux)
+ []]})))
+
+(def (global_reference name)
+ (-> Symbol (Meta .Global))
+ (do meta.monad
+ [name (meta.normal name)
+ current_module_name meta.current_module_name
+ lux meta.compiler_state]
+ (loop (again [[normal_module normal_short] name])
+ (when (is (Maybe .Global)
+ (do maybe.monad
+ [(open "/[0]") (|> lux
+ (the .#modules)
+ (property.value normal_module))]
+ (property.value normal_short /#definitions)))
+ {.#Some it}
+ (when it
+ {.#Definition [exported? type value]}
+ (if (or exported?
+ (text#= current_module_name normal_module))
+ (in it)
+ (meta.failure (%.format "Global is not an export: " (%.symbol name))))
+
+ {.#Default [exported? type value]}
+ (if (or exported?
+ (text#= current_module_name normal_module))
+ (in it)
+ (meta.failure (%.format "Global is not an export: " (%.symbol name))))
+
+ {.#Alias de_aliased}
+ (again de_aliased))
+
+ {.#None it}
+ (meta.failure (%.format "Unknown global: " (%.symbol name)))))))
+
+(def (with_cached_analysis name then)
+ (All (_ of)
+ (-> Symbol (-> [Code .Global] (analysis.Operation of))
+ (analysis.Operation of)))
+ (do phase.monad
+ [g!cache (macro.symbol "g!cache")
+ global (global_reference name)
+ .let [cache_name (%.code g!cache)]
+ _ (module.define cache_name global)
+ it (then [g!cache global])
+ current_module_name meta.current_module_name
+ _ (without_global [current_module_name cache_name])]
+ (in it)))
+
+(def (with_cached_analysis' name then)
+ (All (_ anchor expression declaration of)
+ (-> Symbol (-> [Code .Global] (declaration.Operation anchor expression declaration of))
+ (declaration.Operation anchor expression declaration of)))
+ (do phase.monad
+ [g!cache (declaration.lifted_analysis
+ (macro.symbol "g!cache"))
+ global (declaration.lifted_analysis
+ (global_reference name))
+ .let [cache_name (%.code g!cache)]
+ _ (declaration.lifted_analysis
+ (module.define cache_name global))
+ it (then [g!cache global])
+ current_module_name (declaration.lifted_analysis
+ meta.current_module_name)
+ _ (declaration.lifted_analysis
+ (without_global [current_module_name cache_name]))]
+ (in it)))
+
+(def (with_temporary_global [name new] then)
+ (All (_ of)
+ (-> [Symbol .Global] (analysis.Operation of)
+ (analysis.Operation of)))
+ (do phase.monad
+ [old (global_reference name)
+ _ (module.override_definition name new)
+ it then
+ _ (module.override_definition name old)]
+ (in it)))
+
+(def (with_temporary_global' [name new] then)
+ (All (_ anchor expression declaration of)
+ (-> [Symbol .Global] (declaration.Operation anchor expression declaration of)
+ (declaration.Operation anchor expression declaration of)))
+ (do phase.monad
+ [old (declaration.lifted_analysis
+ (global_reference name))
+ _ (declaration.lifted_analysis
+ (module.override_definition name new))
+ it then
+ _ (declaration.lifted_analysis
+ (module.override_definition name old))]
+ (in it)))
+
+(def (expression type term)
+ (-> Type analysis.Analysis Analysis)
+ (analysis (_ phase archive [])
+ (do phase.monad
+ [_ (type.inference type)]
+ (in term))))
+
+(def (with_cached_expression [type term] then)
+ (All (_ of)
+ (-> [Type analysis.Analysis]
+ (-> (-> Code (analysis.Operation of))
+ (analysis.Operation of))))
+ (do phase.monad
+ [g!cache (macro.symbol "g!cache")
+ .let [cache_name (%.code g!cache)]
+ _ (module.define cache_name {.#Definition [false Analysis (expression type term)]})
+ it (then g!cache)
+ current_module_name meta.current_module_name
+ _ (without_global [current_module_name cache_name])]
+ (in it)))
+
+(with_template [<name> <parameters> <term> <scenario> <advised>]
+ [(def (<name> original aspect)
+ (-> Code Aspect Analysis)
+ (analysis (_ phase archive <parameters>)
+ (do [! phase.monad]
+ [[type term] (type.inferring
+ (phase archive <term>))
+ _ (type.inference type)
+ location meta.location
+ .let [join_point [#location location
+ #scenario {<scenario> [it type]}]]]
+ (when (list.one (function (_ [point_cut advice])
+ (if (point_cut join_point)
+ {.#Some advice}
+ {.#None}))
+ aspect)
+ {.#Some advice}
+ (<| (with_cached_expression [type term])
+ (function (_ analysis))
+ (phase archive <advised>))
+
+ {.#None}
+ (in term)))))]
+
+ [local [it ?code.local]
+ (` ((, original) (, (code.local it))))
+ #Local
+ (` ((, (code.symbol advice)) ((, analysis))))]
+ [global [quoted_module ?code.any
+ it ?code.global]
+ (` ((, original) (, quoted_module) (, (code.symbol it))))
+ #Global
+ (let [[advice_module _] advice]
+ (` (((, original) (, (code.text advice_module)) (, (code.symbol advice)))
+ ((, analysis)))))]
+ )
+
+(def with|analysis
+ Analysis
+ (analysis (_ phase archive [aspect ?code.any
+ body ?code.any])
+ (do [! phase.monad]
+ [aspect (meta.eval Aspect aspect)
+ .let [aspect (as Aspect aspect)]]
+ (list#mix (function (_ [original value] then)
+ (<| (with_cached_analysis original)
+ (function (_ [g!original original_global]))
+ (with_temporary_global [original {.#Definition [true Analysis (value g!original aspect)]}])
+ then))
+ (phase archive body)
+ (list [(symbol .local#) ..local]
+ [(symbol .global#) ..global])))))
+
+(def with|declaration
+ Declaration
+ (declaration (_ phase archive [aspect ?code.any
+ body ?code.any])
+ (do [! phase.monad]
+ [aspect (declaration.lifted_analysis
+ (meta.eval Aspect aspect))
+ .let [aspect (as Aspect aspect)]]
+ (list#mix (function (_ [original value] then)
+ (<| (with_cached_analysis' original)
+ (function (_ [g!original original_global]))
+ (with_temporary_global' [original {.#Definition [true Analysis (value g!original aspect)]}])
+ then))
+ (phase archive body)
+ (list [(symbol .local#) ..local]
+ [(symbol .global#) ..global])))))
+
+(def expression?
+ (Meta Bit)
+ (function (_ lux)
+ {.#Right [lux
+ (when (the .#expected lux)
+ {.#Some _} true
+ {.#None _} false)]}))
+
+(def .public with
+ (syntax (_ [aspect ?code.any
+ body ?code.any])
+ (do meta.monad
+ [? ..expression?
+ .let [[@ _] (symbol .._)
+ <with> (if ?
+ (` ..with|analysis)
+ (` ..with|declaration))]]
+ (in (list (` ((.in_module# (, (code.text @)) (, <with>))
+ (, aspect)
+ (, body))))))))
diff --git a/stdlib/source/library/lux/control/function/mixin.lux b/stdlib/source/library/lux/control/function/mixin.lux
index 36610827b..57405979d 100644
--- a/stdlib/source/library/lux/control/function/mixin.lux
+++ b/stdlib/source/library/lux/control/function/mixin.lux
@@ -11,56 +11,71 @@
[function
[predicate (.only Predicate)]]]]])
-(type .public (Mixin i o)
- (-> (-> i o) (-> i o) (-> i o)))
+(type .public (Mixin input output)
+ (-> (-> input output) (-> input output)
+ (-> input output)))
(def .public (fixed f)
- (All (_ i o) (-> (Mixin i o) (-> i o)))
+ (All (_ input output)
+ (-> (Mixin input output)
+ (-> input output)))
(function (mix input)
((f mix mix) input)))
(def .public nothing
Mixin
- (function (_ delegate recur)
- delegate))
+ (function (_ next again)
+ next))
(def .public (mixed parent child)
- (All (_ i o) (-> (Mixin i o) (Mixin i o) (Mixin i o)))
- (function (_ delegate recur)
- (parent (child delegate recur) recur)))
+ (All (_ input output)
+ (-> (Mixin input output) (Mixin input output)
+ (Mixin input output)))
+ (function (_ next again)
+ (parent (child next again) again)))
(def .public monoid
- (All (_ i o) (Monoid (Mixin i o)))
+ (All (_ input output)
+ (Monoid (Mixin input output)))
(implementation
(def identity ..nothing)
(def composite ..mixed)))
(def .public (advice when then)
- (All (_ i o) (-> (Predicate i) (Mixin i o) (Mixin i o)))
- (function (_ delegate recur input)
+ (All (_ input output)
+ (-> (Predicate input) (Mixin input output)
+ (Mixin input output)))
+ (function (_ next again input)
(if (when input)
- ((then delegate recur) input)
- (delegate input))))
+ ((then next again) input)
+ (next input))))
-(def .public (before monad action)
- (All (_ ! i o) (-> (Monad !) (-> i (! Any)) (Mixin i (! o))))
- (function (_ delegate recur input)
- (do monad
+(def .public (before ! action)
+ (All (_ ! input output)
+ (-> (Monad !) (-> input (! Any))
+ (Mixin input (! output))))
+ (function (_ next again input)
+ (do !
[_ (action input)]
- (delegate input))))
+ (next input))))
-(def .public (after monad action)
- (All (_ ! i o) (-> (Monad !) (-> i o (! Any)) (Mixin i (! o))))
- (function (_ delegate recur input)
- (do monad
- [output (delegate input)
+(def .public (after ! action)
+ (All (_ ! input output)
+ (-> (Monad !) (-> input output (! Any))
+ (Mixin input (! output))))
+ (function (_ next again input)
+ (do !
+ [output (next input)
_ (action input output)]
(in output))))
-(type .public (Recursive i o)
- (-> (-> i o) (-> i o)))
+(type .public (Recursive input output)
+ (-> (-> input output)
+ (-> input output)))
(def .public (of_recursive recursive)
- (All (_ i o) (-> (Recursive i o) (Mixin i o)))
- (function (_ delegate recur)
- (recursive recur)))
+ (All (_ input output)
+ (-> (Recursive input output)
+ (Mixin input output)))
+ (function (_ next again)
+ (recursive again)))
diff --git a/stdlib/source/library/lux/control/parser.lux b/stdlib/source/library/lux/control/parser.lux
index 2330b8606..0d7fd1217 100644
--- a/stdlib/source/library/lux/control/parser.lux
+++ b/stdlib/source/library/lux/control/parser.lux
@@ -119,8 +119,8 @@
{try.#Failure _}
(that tokens)
- output
- output)))
+ success
+ success)))
(def .public (some parser)
(All (_ s a)
@@ -224,11 +224,11 @@
(All (_ s a) (-> a (Parser s a) (Parser s a)))
(function (_ input)
(when (parser input)
- {try.#Success [input' output]}
- {try.#Success [input' output]}
-
{try.#Failure error}
- {try.#Success [input value]})))
+ {try.#Success [input value]}
+
+ success
+ success)))
(def .public remaining
(All (_ s) (Parser s s))
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index f1dcddff0..131e88b0d 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -427,39 +427,6 @@
[configuration [.#info .#configuration] (List [Text Text])]
)
-(def .public (local name)
- (-> Symbol (Meta Global))
- (do ..monad
- [name (..normal name)
- current_module_name ..current_module_name
- lux ..compiler_state]
- (loop (again [[normal_module normal_short] name])
- (when (is (Maybe Global)
- (do maybe.monad
- [(open "/[0]") (|> lux
- (the .#modules)
- (property.value normal_module))]
- (property.value normal_short /#definitions)))
- {.#Some it}
- (when it
- {.#Definition [exported? type value]}
- (if (or exported?
- (text#= current_module_name normal_module))
- (in it)
- (failure (all text#composite "Global is not an export: " (symbol#encoded name))))
-
- {.#Default [exported? type value]}
- (if (or exported?
- (text#= current_module_name normal_module))
- (in it)
- (failure (all text#composite "Global is not an export: " (symbol#encoded name))))
-
- {.#Alias de_aliased}
- (again de_aliased))
-
- {.#None it}
- (failure (all text#composite "Unknown global: " (symbol#encoded name)))))))
-
(def .public (definition_type name)
(-> Symbol (Meta Type))
(do ..monad
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux
index 0145f2162..cc976b37e 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux
@@ -42,7 +42,9 @@
["[0]" version (.only Version)]
["[0]" phase]
["[0]" reference (.only Reference)
- ["[0]" variable (.only Register Variable)]]]]])
+ ["[0]" variable (.only Register Variable)]]
+ [meta
+ [archive (.only Archive)]]]]])
(type .public (Branch' e)
(Record
@@ -390,3 +392,13 @@
.#extensions []
.#eval (as (-> Type Code (Meta Any)) [])
.#host []])
+
+(def .public (delegated extender analysis archive extension parameters)
+ (-> Extender Phase Archive Symbol (List Code) (Operation Analysis))
+ (do phase.monad
+ [lux phase.state]
+ (extension.application extender
+ lux analysis archive
+ .Analysis false extension parameters
+ (|>>)
+ (function (_ _) {.#None}))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux
index 4c50af1f4..2714a2a98 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis.lux
@@ -107,7 +107,7 @@
[lux meta.compiler_state]
(extension.application extender
lux analysis archive
- .Analysis def_name argsC+
+ .Analysis true def_name argsC+
(|>>)
(function (_ _) {.#None}))))
(/function.apply analysis argsC+ function_type function_analysis archive functionC)))
@@ -135,7 +135,7 @@
[lux meta.compiler_state]
(extension.application extender
lux analysis archive
- .Analysis global argsC+
+ .Analysis false global argsC+
(|>>)
(function (_ _)
{.#Some (term_application extender expander analysis archive functionC argsC+)})))
@@ -162,7 +162,7 @@
[.#Rev /simple.rev])
[[quoted_module @line @row] {.#Symbol value}]
- (/reference.reference quoted_module value)
+ (/reference.reference extender analysis archive quoted_module value)
(^.` [(^.,* elems)])
(/complex.record analysis archive elems)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux
index d9c88a463..733295658 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux
@@ -3,97 +3,31 @@
[lux (.except Analysis)
[abstract
[monad (.only do)]]
- [control
- ["[0]" exception (.only Exception)]]
- [data
- ["[0]" text (.use "[1]#[0]" equivalence)
- ["%" \\format (.only format)]]]
["[0]" meta (.only)
- [macro
- ["^" pattern]]]]]
- ["[0]" //
- ["/[1]" //
- [//
- ["/" analysis (.only Analysis Operation)
- ["[1][0]" type]
- ["[1][0]" scope]]
- [///
- ["[1][0]" reference]
- ["[1]" phase]]]]])
-
-(exception.def .public (foreign_module_has_not_been_imported [current foreign quoted definition])
- (Exception [Text Text Text Symbol])
- (exception.report
- (list ["Current" current]
- ["Foreign" foreign]
- ["Quoted" quoted]
- ["Definition" (%.symbol definition)])))
-
-(exception.def .public (definition_has_not_been_exported definition)
- (Exception Symbol)
- (exception.report
- (list ["Definition" (%.symbol definition)])))
-
-(exception.def .public (defaults_are_not_definitions global)
- (Exception Symbol)
- (exception.report
- (list ["Default" (%.symbol global)])))
-
-(def (definition quoted_module def_name)
- (-> Text Symbol (Operation Analysis))
- (with_expansions [<return> (in (|> def_name ///reference.constant {/.#Reference}))]
- (do [! ///.monad]
- [constant (meta.definition def_name)]
- (when constant
- {.#Alias real_def_name}
- (definition quoted_module real_def_name)
-
- {.#Definition [exported? actualT _]}
- (do !
- [_ (/type.inference actualT)
- (^.let def_name [::module ::name]) (meta.normal def_name)
- current meta.current_module_name]
- (if (text#= current ::module)
- <return>
- (if exported?
- (do !
- [imported! (meta.imported_by? ::module current)]
- (if (or imported!
- (text#= quoted_module ::module))
- <return>
- (/.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name])))
- (/.except ..definition_has_not_been_exported [def_name]))))
-
- {.#Default _}
- (/.except ..defaults_are_not_definitions [def_name])))))
-
-(def (variable var_name)
- (-> Text (Operation (Maybe Analysis)))
- (do [! ///.monad]
- [?var (/scope.variable var_name)]
- (when ?var
- {.#Some [actualT ref]}
- (do !
- [_ (/type.inference actualT)]
- (in {.#Some (|> ref ///reference.variable {/.#Reference})}))
-
- {.#None}
- (in {.#None}))))
-
-(def .public (reference quoted_module it)
- (-> Text Symbol (Operation Analysis))
+ ["[0]" code]]]]
+ ["[0]" ///
+ [//
+ ["/" analysis (.only Analysis Operation Phase Extender)
+ ["[0]" scope]]
+ [///
+ ["[0]" phase]
+ [meta
+ [archive (.only Archive)]]]]])
+
+(def .public (reference extender analysis archive quoted_module it)
+ (-> Extender Phase Archive Text Symbol (Operation Analysis))
(when it
["" short]
- (do [! ///.monad]
- [?var (variable short)]
+ (do [! phase.monad]
+ [?var (scope.variable short)]
(when ?var
- {.#Some varA}
- (in varA)
+ {.#Some _}
+ (/.delegated extender analysis archive (symbol .local#) (list (code.symbol it)))
{.#None}
(do !
[this_module meta.current_module_name]
- (definition quoted_module [this_module short]))))
+ (/.delegated extender analysis archive (symbol .global#) (list (code.text quoted_module) (code.symbol [this_module short]))))))
_
- (definition quoted_module it)))
+ (/.delegated extender analysis archive (symbol .global#) (list (code.text quoted_module) (code.symbol it)))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux
index dfadd0040..18e067716 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/declaration.lux
@@ -63,10 +63,10 @@
(def (macro_or_extension analysis archive whole_term function_term)
(All (_ anchor expression declaration)
- (-> analysis.Phase Archive Code Code (Operation anchor expression declaration Symbol)))
+ (-> analysis.Phase Archive Code Code (Operation anchor expression declaration [Bit Symbol])))
(when function_term
[_ {.#Symbol it}]
- (phase#in it)
+ (phase#in [false it])
function_term
(do phase.monad
@@ -77,7 +77,7 @@
(analysis.constant definition)
(if (or (check.subsumes? .Macro type)
(check.subsumes? .Declaration type))
- (in definition)
+ (in [true definition])
(phase.except ..not_a_declaration [whole_term]))
_
@@ -102,10 +102,10 @@
(when code
[_ {.#Form (list.partial term inputs)}]
(do !
- [macro|extension (macro_or_extension analysis archive code term)
+ [[validated? macro|extension] (macro_or_extension analysis archive code term)
expansion|requirements (extension.application extender
(the [/.#analysis /.#state] state) again archive
- .Declaration macro|extension inputs
+ .Declaration validated? macro|extension inputs
(|>> {#Done})
(function (_ _)
{.#Some (do !
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux
index 7de2dbea9..c0ad23cb1 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension.lux
@@ -1,19 +1,21 @@
(.require
[library
- [lux (.except)
+ [lux (.except global)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]
[monad (.only do)]]
[control
+ ["[0]" maybe]
["[0]" try]
["[0]" exception (.only Exception)]]
[data
["[0]" product]
- ["[0]" text (.only)
+ ["[0]" text (.use "[1]#[0]" equivalence)
["%" \\format (.only Format)]]
[collection
- ["[0]" list]
+ ["[0]" list (.only)
+ ["[0]" property]]
["[0]" dictionary (.only Dictionary)]]]
["[0]" meta (.only)
["[0]" symbol]
@@ -74,10 +76,45 @@
{#Normal Any}
{#Special Any}))
-(def (global_value name)
- (-> Symbol (Meta [Type Value]))
+(def (global validated_global? name)
+ (-> Bit Symbol (Meta Global))
(do meta.monad
- [global (meta.local name)]
+ [name (meta.normal name)
+ current_module_name meta.current_module_name
+ lux meta.compiler_state]
+ (loop (again [[normal_module normal_short] name])
+ (when (is (Maybe Global)
+ (do maybe.monad
+ [(open "/[0]") (|> lux
+ (the .#modules)
+ (property.value normal_module))]
+ (property.value normal_short /#definitions)))
+ {.#Some it}
+ (when it
+ {.#Definition [exported? type value]}
+ (if (or validated_global?
+ exported?
+ (text#= current_module_name normal_module))
+ (in it)
+ (meta.failure (%.format "Global is not an export: " (%.symbol name))))
+
+ {.#Default [exported? type value]}
+ (if (or validated_global?
+ exported?
+ (text#= current_module_name normal_module))
+ (in it)
+ (meta.failure (%.format "Global is not an export: " (%.symbol name))))
+
+ {.#Alias de_aliased}
+ (again de_aliased))
+
+ {.#None it}
+ (meta.failure (%.format "Unknown global: " (%.symbol name)))))))
+
+(def (global_value validated_global? name)
+ (-> Bit Symbol (Meta [Type Value]))
+ (do meta.monad
+ [global (..global validated_global? name)]
(when global
{.#Definition [exported? type value]}
(in [type {#Normal value}])
@@ -88,28 +125,28 @@
{.#Alias _}
(undefined))))
-(def (global_extension expected_type name)
- (-> Type Symbol (Meta Value))
+(def (global_extension expected_type validated_global? name)
+ (-> Type Bit Symbol (Meta Value))
(do meta.monad
- [[actual_type value] (global_value name)]
+ [[actual_type value] (global_value validated_global? name)]
(if (check.subsumes? expected_type actual_type)
(in value)
(meta.failure (exception.error ..invalid [name expected_type actual_type])))))
(def .public (application extender
lux phase archive
- expected_type global parameters
+ expected_type validated_global? global parameters
when_valid
when_invalid)
(All (_ state input raw_output processed_output)
(-> (Extender state input raw_output)
Lux (Phase state input raw_output) Archive
- Type Symbol (List input)
+ Type Bit Symbol (List input)
(-> raw_output processed_output)
(-> Text (Maybe (Operation state processed_output)))
(Operation state processed_output)))
(when (|> (do [! meta.monad]
- [value (global_extension expected_type global)]
+ [value (global_extension expected_type validated_global? global)]
(in ((when value
{#Normal definition}
(extender definition)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux
index 501ca50ad..114928b77 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Analysis)
+ [lux (.except Analysis global local)
[abstract
["[0]" monad (.only do)]]
[control
@@ -9,7 +9,7 @@
["[0]" try]
["[0]" exception (.only Exception)]]
[data
- ["[0]" text (.only)
+ ["[0]" text (.use "[1]#[0]" equivalence)
[char (.only Char)]
["%" \\format (.only format)]]
[collection
@@ -30,11 +30,13 @@
[//
["[0]" analysis (.only Analysis Operation Phase Handler Bundle)
[evaluation (.only Eval)]
- ["[0]A" type]]
+ ["[0]A" type]
+ ["[0]" scope]]
["[0]" synthesis]
["[0]" generation]
["[0]" declaration]
[///
+ ["[0]" reference]
["[0]" phase]
[meta
[archive (.only Archive)]]]]]])
@@ -206,13 +208,85 @@
(<| (typeA.expecting input)
(phase archive valueC))))]))
+(exception.def .public (foreign_module_has_not_been_imported [current foreign quoted global])
+ (Exception [Text Text Text Symbol])
+ (exception.report
+ (list ["Current" current]
+ ["Foreign" foreign]
+ ["Quoted" quoted]
+ ["Global" (%.symbol global)])))
+
+(exception.def .public (global_has_not_been_exported global)
+ (Exception Symbol)
+ (exception.report
+ (list ["Global" (%.symbol global)])))
+
+(exception.def .public (defaults_cannot_be_referenced global)
+ (Exception Symbol)
+ (exception.report
+ (list ["Default" (%.symbol global)])))
+
+(def global
+ (-> Text Handler)
+ (..custom
+ [(<>.and <code>.text <code>.global)
+ (function (again extension_name phase archive [quoted_module def_name])
+ (with_expansions [<return> (in (|> def_name reference.constant {analysis.#Reference}))]
+ (do [! phase.monad]
+ [constant (meta.definition def_name)]
+ (when constant
+ {.#Alias real_def_name}
+ (again extension_name phase archive [quoted_module real_def_name])
+
+ {.#Definition [exported? actualT _]}
+ (do !
+ [_ (typeA.inference actualT)
+ (^.let def_name [::module ::name]) (meta.normal def_name)
+ current meta.current_module_name]
+ (if (text#= current ::module)
+ <return>
+ (if exported?
+ (do !
+ [imported! (meta.imported_by? ::module current)]
+ (if (or imported!
+ (text#= quoted_module ::module))
+ <return>
+ (analysis.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name])))
+ (analysis.except ..global_has_not_been_exported [def_name]))))
+
+ {.#Default _}
+ (analysis.except ..defaults_cannot_be_referenced [def_name])))))]))
+
+(exception.def .public (unknown_local name)
+ (Exception Text)
+ (exception.report
+ (list ["Name" (%.text name)])))
+
+(def local
+ (-> Text Handler)
+ (..custom
+ [<code>.local
+ (function (_ extension_name phase archive [it])
+ (do [! phase.monad]
+ [?var (scope.variable it)]
+ (when ?var
+ {.#Some [local_type local_reference]}
+ (do !
+ [_ (typeA.inference local_type)]
+ (in (|> local_reference reference.variable {analysis.#Reference})))
+
+ {.#None}
+ (analysis.except ..unknown_local [it]))))]))
+
(def with_basic_extensions
(-> Bundle Bundle)
(|>> (install "is_type#" (..caster .Type .Type))
(install "is?#" lux::is?)
(install "try#" lux::try)
(install "in_module#" lux::in_module)
- (install "when_char#" lux::syntax_char_case!)))
+ (install "when_char#" lux::syntax_char_case!)
+ (install "local#" ..local)
+ (install "global#" ..global)))
(def with_io_extensions
(-> Bundle Bundle)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux
index d8c4eb180..c293cb44c 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/generation/jvm.lux
@@ -93,7 +93,7 @@
(/function.apply phase archive application)
{synthesis.#Extension [name parameters]}
- (extension.application extender lux phase archive .Generation name parameters
+ (extension.application extender lux phase archive .Generation false name parameters
(|>>)
(function (_ _) {.#None}))
)))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux
index 9e632c9a1..83605d36c 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/synthesis.lux
@@ -94,7 +94,7 @@
(/function.abstraction phase environmentA archive bodyA)
{///analysis.#Extension name parameters}
- (extension.application extender lux phase archive .Synthesis name parameters
+ (extension.application extender lux phase archive .Synthesis false name parameters
(|>>)
(function (_ _)
{.#Some (|> parameters
diff --git a/stdlib/source/library/lux/world/net/http/query.lux b/stdlib/source/library/lux/world/net/http/query.lux
deleted file mode 100644
index 2541a9c6d..000000000
--- a/stdlib/source/library/lux/world/net/http/query.lux
+++ /dev/null
@@ -1,65 +0,0 @@
-(.require
- [library
- [lux (.except)
- [control
- pipe
- [monad (.only do)]
- ["[0]" try (.only Try)]
- ["p" parser
- ["l" text (.only Parser)]]]
- [data
- [number
- ["[0]" nat]]
- ["[0]" text
- ["%" \\format (.only format)]]
- [format
- ["[0]" context (.only Context)]]
- [collection
- ["[0]" dictionary]]]]])
-
-(def component
- (Parser Text)
- (p.rec
- (function (_ component)
- (do [! p.monad]
- [head (l.some (l.none_of "+%&;"))]
- (all p.either
- (p.after (p.either l.end
- (l.this "&"))
- (in head))
- (do !
- [_ (l.this "+")
- tail component]
- (in (format head " " tail)))
- (do !
- [_ (l.this "%")
- code (|> (l.exactly 2 l.hexadecimal)
- (p.codec nat.hex)
- (at ! each text.from_code))
- tail component]
- (in (format head code tail))))))))
-
-(def (form context)
- (-> Context (Parser Context))
- (all p.either
- (do p.monad
- [_ l.end]
- (in context))
- (do [! p.monad]
- [key (l.some (l.none_of "=&;"))
- key (l.local key ..component)]
- (p.either (do !
- [_ (l.this "=")
- value ..component]
- (form (dictionary.has key value context)))
- (do !
- [_ (all p.or
- (l.one_of "&;")
- l.end)]
- (form (dictionary.has key "" context)))))
- ... if invalid form data, just stop parsing...
- (at p.monad in context)))
-
-(def .public (parameters raw)
- (-> Text (Try Context))
- (l.result raw (..form context.empty)))
diff --git a/stdlib/source/library/lux/world/net/uri/query.lux b/stdlib/source/library/lux/world/net/uri/query.lux
new file mode 100644
index 000000000..24b03512b
--- /dev/null
+++ b/stdlib/source/library/lux/world/net/uri/query.lux
@@ -0,0 +1,106 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]
+ [codec (.only Codec)]
+ [equivalence (.only Equivalence)]]
+ [control
+ ["?" parser]
+ ["[0]" try (.only Try)]]
+ [data
+ ["[0]" text (.only)
+ ["%" \\format]
+ ["?[1]" \\parser (.only Parser)]]
+ [collection
+ ["[0]" list (.use "[1]#[0]" functor)]
+ ["[0]" dictionary (.only Dictionary)]]]
+ [math
+ [number
+ ["[0]" nat]]]
+ [world
+ [net
+ ["[0]" uri
+ ["[1]" encoding]]]]]])
+
+(type .public Query
+ (Dictionary Text Text))
+
+(def .public empty
+ Query
+ (dictionary.empty text.hash))
+
+(def .public equivalence
+ (Equivalence Query)
+ (dictionary.equivalence text.equivalence))
+
+(def component
+ (Parser Text)
+ (?.rec
+ (function (_ component)
+ (do [! ?.monad]
+ [head (?text.some (?text.none_of "+%&;"))]
+ (all ?.either
+ (?.after (?.either ?text.end
+ (?text.this "&"))
+ (in head))
+ (do !
+ [_ (?text.this "+")
+ tail component]
+ (in (%.format head " " tail)))
+ (do !
+ [_ (?text.this "%")
+ code (|> (?text.exactly 2 ?text.hexadecimal)
+ (?.codec nat.hex)
+ (at ! each text.of_char))
+ tail component]
+ (in (%.format head code tail))))))))
+
+(def separators
+ "&;")
+
+(def assignment
+ "=")
+
+(def invalid
+ (%.format "=" "&;"))
+
+(def (form query)
+ (-> Query (Parser Query))
+ (all ?.either
+ (do ?.monad
+ [_ ?text.end]
+ (in query))
+ (do [! ?.monad]
+ [key (?text.some (?text.none_of ..invalid))
+ key (?text.local key ..component)
+ key (?.lifted (uri.decoded key))]
+ (?.either (do !
+ [_ (?text.this ..assignment)
+ value ..component
+ value (?.lifted (uri.decoded value))]
+ (form (dictionary.has key value query)))
+ (do !
+ [_ (all ?.or
+ (?text.one_of ..separators)
+ ?text.end)]
+ (form (dictionary.has key "" query)))))
+ ... if invalid form data, just stop parsing...
+ (at ?.monad in query)))
+
+(def format
+ (%.Format Query)
+ (|>> dictionary.entries
+ (list#each (function (_ [key value])
+ (%.format (uri.encoded key) "=" (uri.encoded value))))
+ (text.interposed "&")))
+
+(def query
+ (-> Text (Try Query))
+ (?text.result (..form ..empty)))
+
+(def .public codec
+ (Codec Text Query)
+ (implementation
+ (def encoded ..format)
+ (def decoded ..query)))
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index 5a57ac13d..67903a051 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -4,6 +4,7 @@
[test
["_" property (.only Test)]]]]
["[0]" /
+ ["[1][0]" aspect]
["[1][0]" concatenative]
["[1][0]" concurrency
["[1]/[0]" actor]
@@ -66,6 +67,7 @@
(def .public test
Test
(all _.and
+ /aspect.test
/concatenative.test
..concurrency
/continuation.test
diff --git a/stdlib/source/test/lux/control/aspect.lux b/stdlib/source/test/lux/control/aspect.lux
new file mode 100644
index 000000000..a98d83918
--- /dev/null
+++ b/stdlib/source/test/lux/control/aspect.lux
@@ -0,0 +1,139 @@
+(.require
+ [library
+ [lux (.except global)
+ [abstract
+ [monad (.only do)]]
+ [control
+ [function
+ ["?" predicate]]]
+ [data
+ ["[0]" text (.use "[1]#[0]" equivalence)
+ ["%" \\format]]]
+ [math
+ ["[0]" random (.only Random)]
+ [number
+ ["n" nat]]]
+ [meta
+ ["[0]" symbol (.use "[1]#[0]" equivalence)]
+ ["[0]" static]
+ ["[0]" code]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def (double it)
+ (/.After Nat)
+ (n.+ it it))
+
+(def can_double
+ (Random Nat)
+ (random.only (function (_ it)
+ (not (n.= it (double it))))
+ random.nat))
+
+(def global
+ Nat
+ (static.random code.nat ..can_double))
+
+(def (triple it)
+ (-> Nat Nat)
+ (all n.+ it it it))
+
+(def pre_double
+ (/.Around Nat Nat)
+ (/.before ..double))
+
+(def after_aspect
+ /.Aspect
+ (list [(all ?.or
+ (/.when_global (|>> (the /.#name)
+ (symbol#= (symbol ..global))))
+ (/.when_local ?.all))
+ (symbol ..double)]))
+
+(def before_aspect
+ /.Aspect
+ (list [(/.when_global (|>> (the /.#name)
+ (symbol#= (symbol ..triple))))
+ (symbol ..pre_double)]))
+
+(def this_module
+ Text
+ (let [[module _] (symbol .._)]
+ module))
+
+(def another_module
+ Text
+ (let [[module _] (symbol /._)]
+ module))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [local ..can_double])
+ (_.for [/.Aspect])
+ (all _.and
+ (_.for [/.with]
+ (all _.and
+ (_.for [/.Advice /.After]
+ (_.for [/.Reference /.#name /.#type
+ /.Scenario /.#Global /.#Local]
+ (all _.and
+ (_.coverage [/.Local]
+ (n.= (double local)
+ (/.with ..after_aspect
+ local)))
+ (_.coverage [/.Global]
+ (n.= (double ..global)
+ (/.with ..after_aspect
+ ..global))))))
+ (_.coverage [/.Around /.before]
+ (n.= (triple (double local))
+ (/.with ..before_aspect
+ (triple local))))
+ ))
+ (_.for [/.Join_Point /.#location /.#scenario
+ /.Point_Cut]
+ (all _.and
+ (_.coverage [/.when_local]
+ (and (n.= (triple (double local))
+ (/.with (list [(/.when_local ?.all)
+ (symbol ..double)])
+ (triple local)))
+ (n.= (triple local)
+ (/.with (list [(/.when_local ?.none)
+ (symbol ..double)])
+ (triple local)))))
+ (_.coverage [/.when_global]
+ (and (n.= (triple (double local))
+ (/.with (list [(/.when_global ?.all)
+ (symbol ..pre_double)])
+ (triple local)))
+ (n.= (triple local)
+ (/.with (list [(/.when_global ?.none)
+ (symbol ..pre_double)])
+ (triple local)))))
+ (_.coverage [/.when_module]
+ (and (n.= (triple (double local))
+ (/.with (list [(?.and (/.when_module (text#= this_module))
+ (/.when_local ?.all))
+ (symbol ..double)])
+ (triple local)))
+ (n.= (triple local)
+ (/.with (list [(?.and (/.when_module (text#= another_module))
+ (/.when_local ?.all))
+ (symbol ..double)])
+ (triple local)))))
+ (_.coverage [/.typed?]
+ (and (n.= (triple (double local))
+ (/.with (list [(/.typed? Nat)
+ (symbol ..double)])
+ (triple local)))
+ (n.= ((pre_double triple) local)
+ (/.with (list [(/.typed? (-> Nat Nat))
+ (symbol ..pre_double)])
+ (triple local)))))
+ ))
+ )))
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index 691f4d357..caabbe222 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -357,7 +357,7 @@
(do random.monad
[sample ..random]
- (_.coverage [/.Null /.null?]
+ (_.coverage [/.Null /.#Null /.null?]
(at bit.equivalence =
(/.null? sample)
(when sample
@@ -422,7 +422,7 @@
[(do random.monad
[key (random.alphabetic 1)
value <random>]
- (_.coverage [<type> <field>]
+ (_.coverage [<type> <tag> <field>]
(|> (/.object (list [key {<tag> value}]))
(<field> key)
(try#each (at <equivalence> = value))
diff --git a/stdlib/source/test/lux/world/net.lux b/stdlib/source/test/lux/world/net.lux
index 9856b8a00..b2c286fc0 100644
--- a/stdlib/source/test/lux/world/net.lux
+++ b/stdlib/source/test/lux/world/net.lux
@@ -20,7 +20,8 @@
["[1][0]" uri
["[1]/[0]" encoding]
["[1]/[0]" scheme]
- ["[1]/[0]" path]]])
+ ["[1]/[0]" path]
+ ["[1]/[0]" query]]])
(def .public test
Test
@@ -48,4 +49,5 @@
/uri/encoding.test
/uri/scheme.test
/uri/path.test
+ /uri/query.test
)))
diff --git a/stdlib/source/test/lux/world/net/uri/query.lux b/stdlib/source/test/lux/world/net/uri/query.lux
new file mode 100644
index 000000000..ecdd3c2c4
--- /dev/null
+++ b/stdlib/source/test/lux/world/net/uri/query.lux
@@ -0,0 +1,43 @@
+(.require
+ [library
+ [lux (.except)
+ [abstract
+ [monad (.only do)]
+ [\\specification
+ ["[0]S" equivalence]
+ ["[0]S" codec]]]
+ [data
+ [collection
+ ["[0]" dictionary]]]
+ [math
+ ["[0]" random (.only Random) (.use "[1]#[0]" monad)]]
+ [test
+ ["_" property (.only Test)]]]]
+ [\\library
+ ["[0]" /]])
+
+(def .public (random size)
+ (-> Nat (Random /.Query))
+ (when size
+ 0 (random#in /.empty)
+ _ (do random.monad
+ [key (random.alphabetic size)
+ value (random.unicode size)
+ query (random (-- size))]
+ (in (dictionary.has key value query)))))
+
+(def .public test
+ Test
+ (<| (_.covering /._)
+ (do [! random.monad]
+ [])
+ (_.for [/.Query])
+ (all _.and
+ (_.for [/.equivalence]
+ (equivalenceS.spec /.equivalence (..random 2)))
+ (_.for [/.codec]
+ (codecS.spec /.equivalence /.codec (..random 3)))
+
+ (_.coverage [/.empty]
+ (dictionary.empty? /.empty))
+ )))