aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/lux/control/exception.lux23
-rw-r--r--stdlib/source/lux/control/parser/analysis.lux140
-rw-r--r--stdlib/source/lux/control/parser/code.lux6
-rw-r--r--stdlib/source/lux/control/parser/synthesis.lux39
-rw-r--r--stdlib/source/lux/extension.lux87
-rw-r--r--stdlib/source/lux/tool/compiler/analysis.lux7
-rw-r--r--stdlib/source/lux/tool/compiler/default/init.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/default/platform.lux8
-rw-r--r--stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux14
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension.lux9
-rw-r--r--stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux61
-rw-r--r--stdlib/source/lux/tool/compiler/synthesis.lux12
-rw-r--r--stdlib/source/program/compositor.lux8
-rw-r--r--stdlib/source/test/lux.lux9
-rw-r--r--stdlib/source/test/lux/extension.lux46
15 files changed, 399 insertions, 79 deletions
diff --git a/stdlib/source/lux/control/exception.lux b/stdlib/source/lux/control/exception.lux
index 21bdc1040..118b9ed1a 100644
--- a/stdlib/source/lux/control/exception.lux
+++ b/stdlib/source/lux/control/exception.lux
@@ -15,11 +15,10 @@
["." list ("#@." functor fold)]]]
["." macro
["." code]
- [syntax (#+ syntax:)]
- [syntax
- ["cs" common
- ["csr" reader]
- ["csw" writer]]]]]
+ [syntax (#+ syntax:)
+ ["sc" common
+ ["scr" reader]
+ ["scw" writer]]]]]
[//
["//" try (#+ Try)]])
@@ -83,10 +82,10 @@
(#//.Success [])
(..throw exception message)))
-(syntax: #export (exception: {export csr.export}
- {t-vars (p.default (list) csr.type-variables)}
+(syntax: #export (exception: {export scr.export}
+ {t-vars (p.default (list) scr.type-variables)}
{[name inputs] (p.either (p.and s.local-identifier (wrap (list)))
- (s.form (p.and s.local-identifier (p.some csr.typed-input))))}
+ (s.form (p.and s.local-identifier (p.some scr.typed-input))))}
{body (p.maybe s.any)})
{#.doc (doc "Define a new exception type."
"It moslty just serves as a way to tag error messages for later catching."
@@ -102,13 +101,13 @@
[current-module macro.current-module-name
#let [descriptor ($_ text@compose "{" current-module "." name "}" text.new-line)
g!self (code.local-identifier name)]]
- (wrap (list (` (def: (~+ (csw.export export))
+ (wrap (list (` (def: (~+ (scw.export export))
(~ g!self)
- (All [(~+ (csw.type-variables t-vars))]
- (..Exception [(~+ (list@map (get@ #cs.input-type) inputs))]))
+ (All [(~+ (scw.type-variables t-vars))]
+ (..Exception [(~+ (list@map (get@ #sc.input-type) inputs))]))
(let [(~ g!descriptor) (~ (code.text descriptor))]
{#..label (~ g!descriptor)
- #..constructor (function ((~ g!self) [(~+ (list@map (get@ #cs.input-binding) inputs))])
+ #..constructor (function ((~ g!self) [(~+ (list@map (get@ #sc.input-binding) inputs))])
((~! text@compose) (~ g!descriptor)
(~ (maybe.default (' "") body))))})))))
)))
diff --git a/stdlib/source/lux/control/parser/analysis.lux b/stdlib/source/lux/control/parser/analysis.lux
new file mode 100644
index 000000000..0cef19fd9
--- /dev/null
+++ b/stdlib/source/lux/control/parser/analysis.lux
@@ -0,0 +1,140 @@
+(.module:
+ [lux (#- nat int rev)
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try (#+ Try)]
+ ["." exception (#+ exception:)]]
+ [data
+ ["." bit]
+ ["." name]
+ [number
+ ["." i64]
+ ["." nat]
+ ["." int]
+ ["." rev]
+ ["." frac]]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#@." functor)]]]
+ [tool
+ [compiler
+ [reference (#+)]
+ [arity (#+ Arity)]
+ ["/" analysis (#+ Variant Tuple Environment Analysis)]]]]
+ ["." //])
+
+(def: (remaining-inputs asts)
+ (-> (List Analysis) Text)
+ (format text.new-line "Remaining input: "
+ (|> asts
+ (list@map /.%analysis)
+ (list.interpose " ")
+ (text.join-with ""))))
+
+## TODO: Use "type:" ASAP.
+(def: Input Type (type (List Analysis)))
+
+(exception: #export (cannot-parse {input ..Input})
+ (exception.report
+ ["Input" (exception.enumerate /.%analysis input)]))
+
+(exception: #export (unconsumed-input {input ..Input})
+ (exception.report
+ ["Input" (exception.enumerate /.%analysis input)]))
+
+(exception: #export (wrong-arity {expected Arity} {actual Arity})
+ (exception.report
+ ["Expected" (%.nat expected)]
+ ["Actual" (%.nat actual)]))
+
+(exception: #export empty-input)
+
+(type: #export Parser
+ (//.Parser ..Input))
+
+(def: #export (run parser input)
+ (All [a] (-> (Parser a) ..Input (Try a)))
+ (case (parser input)
+ (#try.Failure error)
+ (#try.Failure error)
+
+ (#try.Success [#.Nil value])
+ (#try.Success value)
+
+ (#try.Success [unconsumed _])
+ (exception.throw ..unconsumed-input unconsumed)))
+
+(def: #export any
+ (Parser Analysis)
+ (function (_ input)
+ (case input
+ #.Nil
+ (exception.throw ..empty-input [])
+
+ (#.Cons [head tail])
+ (#try.Success [tail head]))))
+
+(def: #export end!
+ {#.doc "Ensures there are no more inputs."}
+ (Parser Any)
+ (function (_ tokens)
+ (case tokens
+ #.Nil (#try.Success [tokens []])
+ _ (#try.Failure (format "Expected list of tokens to be empty!"
+ (remaining-inputs tokens))))))
+
+(def: #export end?
+ {#.doc "Checks whether there are no more inputs."}
+ (Parser Bit)
+ (function (_ tokens)
+ (#try.Success [tokens (case tokens
+ #.Nil true
+ _ false)])))
+
+(template [<query> <assertion> <tag> <type> <eq>]
+ [(def: #export <query>
+ (Parser <type>)
+ (function (_ input)
+ (case input
+ (^ (list& (<tag> x) input'))
+ (#try.Success [input' x])
+
+ _
+ (exception.throw ..cannot-parse input))))
+
+ (def: #export (<assertion> expected)
+ (-> <type> (Parser Any))
+ (function (_ input)
+ (case input
+ (^ (list& (<tag> actual) input'))
+ (if (:: <eq> = expected actual)
+ (#try.Success [input' []])
+ (exception.throw ..cannot-parse input))
+
+ _
+ (exception.throw ..cannot-parse input))))]
+
+ [bit bit! /.bit Bit bit.equivalence]
+ [nat nat! /.nat Nat nat.equivalence]
+ [int int! /.int Int int.equivalence]
+ [rev rev! /.rev Rev rev.equivalence]
+ [frac frac! /.frac Frac frac.equivalence]
+ [text text! /.text Text text.equivalence]
+ [local local! /.variable/local Nat nat.equivalence]
+ [foreign foreign! /.variable/foreign Nat nat.equivalence]
+ [constant constant! /.constant Name name.equivalence]
+ )
+
+(def: #export (tuple parser)
+ (All [a] (-> (Parser a) (Parser a)))
+ (function (_ input)
+ (case input
+ (^ (list& (/.tuple head) tail))
+ (do try.monad
+ [output (..run parser head)]
+ (#try.Success [tail output]))
+
+ _
+ (exception.throw ..cannot-parse input))))
diff --git a/stdlib/source/lux/control/parser/code.lux b/stdlib/source/lux/control/parser/code.lux
index 5ea2247d6..30344aaa0 100644
--- a/stdlib/source/lux/control/parser/code.lux
+++ b/stdlib/source/lux/control/parser/code.lux
@@ -152,9 +152,9 @@
{#.doc "Checks whether there are no more inputs."}
(Parser Bit)
(function (_ tokens)
- (case tokens
- #.Nil (#try.Success [tokens #1])
- _ (#try.Success [tokens #0]))))
+ (#try.Success [tokens (case tokens
+ #.Nil true
+ _ false)])))
(def: #export (run syntax inputs)
(All [a] (-> (Parser a) (List Code) (Try a)))
diff --git a/stdlib/source/lux/control/parser/synthesis.lux b/stdlib/source/lux/control/parser/synthesis.lux
index 8fdeb4911..0c52b878c 100644
--- a/stdlib/source/lux/control/parser/synthesis.lux
+++ b/stdlib/source/lux/control/parser/synthesis.lux
@@ -13,14 +13,26 @@
["n" nat]
["." frac]]
["." text
- ["%" format (#+ format)]]]
+ ["%" format (#+ format)]]
+ [collection
+ ["." list ("#@." functor)]]]
[tool
[compiler
+ [reference (#+)]
[arity (#+ Arity)]
[analysis (#+ Variant Tuple Environment)]
["/" synthesis (#+ Synthesis Abstraction)]]]]
["." //])
+(def: (remaining-inputs asts)
+ (-> (List Synthesis) Text)
+ (format text.new-line "Remaining input: "
+ (|> asts
+ (list@map /.%synthesis)
+ (list.interpose " ")
+ (text.join-with ""))))
+
+## TODO: Use "type:" ASAP.
(def: Input Type (type (List Synthesis)))
(exception: #export (cannot-parse {input ..Input})
@@ -41,8 +53,8 @@
(type: #export Parser
(//.Parser ..Input))
-(def: #export (run input parser)
- (All [a] (-> ..Input (Parser a) (Try a)))
+(def: #export (run parser input)
+ (All [a] (-> (Parser a) ..Input (Try a)))
(case (parser input)
(#try.Failure error)
(#try.Failure error)
@@ -63,6 +75,23 @@
(#.Cons [head tail])
(#try.Success [tail head]))))
+(def: #export end!
+ {#.doc "Ensures there are no more inputs."}
+ (Parser Any)
+ (.function (_ tokens)
+ (case tokens
+ #.Nil (#try.Success [tokens []])
+ _ (#try.Failure (format "Expected list of tokens to be empty!"
+ (remaining-inputs tokens))))))
+
+(def: #export end?
+ {#.doc "Checks whether there are no more inputs."}
+ (Parser Bit)
+ (.function (_ tokens)
+ (#try.Success [tokens (case tokens
+ #.Nil true
+ _ false)])))
+
(template [<query> <assertion> <tag> <type> <eq>]
[(def: #export <query>
(Parser <type>)
@@ -101,7 +130,7 @@
(case input
(^ (list& (/.tuple head) tail))
(do try.monad
- [output (..run head parser)]
+ [output (..run parser head)]
(#try.Success [tail output]))
_
@@ -114,7 +143,7 @@
(^ (list& (/.function/abstraction [environment actual body]) tail))
(if (n.= expected actual)
(do try.monad
- [output (..run (list body) parser)]
+ [output (..run parser (list body))]
(#try.Success [tail [environment output]]))
(exception.throw ..wrong-arity [expected actual]))
diff --git a/stdlib/source/lux/extension.lux b/stdlib/source/lux/extension.lux
new file mode 100644
index 000000000..f5bce33a7
--- /dev/null
+++ b/stdlib/source/lux/extension.lux
@@ -0,0 +1,87 @@
+(.module:
+ [lux #*
+ [abstract
+ ["." monad]]
+ [control
+ ["<>" parser ("#@." monad)
+ ["<c>" code (#+ Parser)]
+ ["<a>" analysis]
+ ["<s>" synthesis]]]
+ [data
+ ["." product]
+ [collection
+ ["." list ("#@." functor)]]]
+ [macro (#+ with-gensyms)
+ ["." code]
+ [syntax (#+ syntax:)]]
+ [tool
+ [compiler
+ ["." phase]]]])
+
+(type: Input
+ {#variable Text
+ #parser Code})
+
+(def: (simple default)
+ (-> Code (Parser Input))
+ ($_ <>.and
+ <c>.local-identifier
+ (<>@wrap default)))
+
+(def: complex
+ (Parser Input)
+ (<c>.record ($_ <>.and
+ <c>.local-identifier
+ <c>.any)))
+
+(def: (input default)
+ (-> Code (Parser Input))
+ (<>.either (..simple default)
+ ..complex))
+
+(type: Declaration
+ {#name Code
+ #label Text
+ #phase Text
+ #inputs (List Input)})
+
+(def: (declaration default)
+ (-> Code (Parser Declaration))
+ (<c>.form ($_ <>.and
+ <c>.any
+ <c>.local-identifier
+ <c>.local-identifier
+ (<>.some (..input default)))))
+
+(template [<any> <end> <and> <run> <extension> <name>]
+ [(syntax: #export (<name>
+ {[name extension phase inputs] (..declaration (` <any>))}
+ body)
+ (let [g!parser (case (list@map product.right inputs)
+ #.Nil
+ (` <end>)
+
+ parsers
+ (` (.$_ <and> (~+ parsers))))
+ g!name (code.local-identifier extension)
+ g!phase (code.local-identifier phase)]
+ (with-gensyms [g!handler g!inputs g!error]
+ (wrap (list (` (<extension> (~ name)
+ (.function ((~ g!handler) (~ g!name) (~ g!phase) (~ g!inputs))
+ (.case ((~! <run>) (~ g!parser) (~ g!inputs))
+ (#.Right [(~+ (list@map (|>> product.left
+ code.local-identifier)
+ inputs))])
+ ((~! monad.do) (~! phase.monad)
+ []
+ (~ body))
+
+ (#.Left (~ g!error))
+ ((~! phase.fail) (~ g!error)))
+ ))))))))]
+
+ [<c>.any <c>.end! <c>.and <c>.run "lux def analysis" analysis:]
+ [<a>.any <a>.end! <a>.and <a>.run "lux def synthesis" synthesis:]
+ [<s>.any <s>.end! <s>.and <s>.run "lux def generation" generation:]
+ [<c>.any <c>.end! <c>.and <c>.run "lux def directive" directive:]
+ )
diff --git a/stdlib/source/lux/tool/compiler/analysis.lux b/stdlib/source/lux/tool/compiler/analysis.lux
index e59397ed9..5d9d899ab 100644
--- a/stdlib/source/lux/tool/compiler/analysis.lux
+++ b/stdlib/source/lux/tool/compiler/analysis.lux
@@ -129,8 +129,11 @@
<tag>
content))]
- [variable #reference.Variable]
- [constant #reference.Constant]
+ [variable #reference.Variable]
+ [constant #reference.Constant]
+
+ [variable/local reference.local]
+ [variable/foreign reference.foreign]
)
(template [<name> <tag>]
diff --git a/stdlib/source/lux/tool/compiler/default/init.lux b/stdlib/source/lux/tool/compiler/default/init.lux
index 40549f8d0..c053445f2 100644
--- a/stdlib/source/lux/tool/compiler/default/init.lux
+++ b/stdlib/source/lux/tool/compiler/default/init.lux
@@ -29,11 +29,11 @@
[".P" synthesis]
["." generation]
[".P" directive]
- ["." extension
+ ["." extension (#+ Extender)
[".E" analysis]
[".E" synthesis]
[directive
- [".S" lux]]]]
+ [".D" lux]]]]
[meta
[archive
["." signature]
@@ -47,7 +47,7 @@
#.version //.version
#.mode #.Build})
-(def: #export (state target expander host-analysis host generate generation-bundle host-directive-bundle program)
+(def: #export (state target expander host-analysis host generate generation-bundle host-directive-bundle program extender)
(All [anchor expression directive]
(-> Text
Expander
@@ -57,13 +57,14 @@
(generation.Bundle anchor expression directive)
(///directive.Bundle anchor expression directive)
(-> expression directive)
+ Extender
(///directive.State+ anchor expression directive)))
(let [synthesis-state [synthesisE.bundle ///synthesis.init]
generation-state [generation-bundle (generation.state host)]
eval (//evaluation.evaluator expander synthesis-state generation-state generate)
analysis-state [(analysisE.bundle eval host-analysis)
(///analysis.state (..info target) host)]]
- [(dictionary.merge (luxS.bundle expander host-analysis program)
+ [(dictionary.merge (luxD.bundle expander host-analysis program extender)
host-directive-bundle)
{#///directive.analysis {#///directive.state analysis-state
#///directive.phase (analysisP.phase expander)}
diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux
index 04937092a..b37e74c2b 100644
--- a/stdlib/source/lux/tool/compiler/default/platform.lux
+++ b/stdlib/source/lux/tool/compiler/default/platform.lux
@@ -23,7 +23,7 @@
["#." phase
[macro (#+ Expander)]
## TODO: Get rid of this import ASAP
- [extension (#+)]
+ [extension (#+ Extender)]
["." generation (#+ Buffer)]
[analysis
["." module]]]
@@ -57,7 +57,7 @@
<State+> (as-is (///directive.State+ anchor expression directive))
<Bundle> (as-is (generation.Bundle anchor expression directive))]
- (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program)
+ (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)
(All <type-vars>
(-> Text
Expander
@@ -66,6 +66,7 @@
<Bundle>
(///directive.Bundle anchor expression directive)
(-> expression directive)
+ Extender
(! (Try <State+>))))
(|> (do ///phase.monad
[_ (:share [anchor expression directive]
@@ -95,7 +96,8 @@
(get@ #phase platform)
generation-bundle
host-directive-bundle
- program))
+ program
+ extender))
(:: try.functor map product.left)
(:: (get@ #&monad platform) wrap))
diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux
index 766dc6616..392ae4d8e 100644
--- a/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux
+++ b/stdlib/source/lux/tool/compiler/phase/analysis/primitive.lux
@@ -15,16 +15,16 @@
[_ (//type.infer <type>)]
(wrap (#/.Primitive (<tag> value)))))]
- [bit Bit #/.Bit]
- [nat Nat #/.Nat]
- [int Int #/.Int]
- [rev Rev #/.Rev]
- [frac Frac #/.Frac]
- [text Text #/.Text]
+ [bit .Bit #/.Bit]
+ [nat .Nat #/.Nat]
+ [int .Int #/.Int]
+ [rev .Rev #/.Rev]
+ [frac .Frac #/.Frac]
+ [text .Text #/.Text]
)
(def: #export unit
(Operation Analysis)
(do ///.monad
- [_ (//type.infer Any)]
+ [_ (//type.infer .Any)]
(wrap (#/.Primitive #/.Unit))))
diff --git a/stdlib/source/lux/tool/compiler/phase/extension.lux b/stdlib/source/lux/tool/compiler/phase/extension.lux
index a0564cedd..7ba769476 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension.lux
@@ -61,13 +61,16 @@
(list.sort text@<)
(exception.enumerate %.text))]))
-(def: #export (install name handler)
+(type: #export (Extender s i o)
+ (-> Any (Handler s i o)))
+
+(def: #export (install extender name handler)
(All [s i o]
- (-> Text (Handler s i o) (Operation s i o Any)))
+ (-> (Extender s i o) Text (Handler s i o) (Operation s i o Any)))
(function (_ [bundle state])
(case (dictionary.get name bundle)
#.None
- (#try.Success [[(dictionary.put name handler bundle) state]
+ (#try.Success [[(dictionary.put name (extender handler) bundle) state]
[]])
_
diff --git a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
index 9344169f2..5f62d4d50 100644
--- a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
+++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux
@@ -19,7 +19,7 @@
["." code]]
["." type (#+ :share :by-example) ("#@." equivalence)
["." check]]]
- ["." ///
+ ["." /// (#+ Extender)
["#." bundle]
["#." analysis]
["#/" //
@@ -243,35 +243,38 @@
(define-alias alias def-name)))]
(wrap /////directive.no-requirements)))]))
-(template [<mame> <type> <scope>]
- [(def: <mame>
+(template [<description> <mame> <type> <scope>]
+ [(def: (<mame> extender)
(All [anchor expression directive]
- (Handler anchor expression directive))
+ (-> Extender
+ (Handler anchor expression directive)))
(function (handler extension-name phase inputsC+)
(case inputsC+
- (^ (list [_ (#.Text name)] valueC))
+ (^ (list nameC valueC))
(do ////.monad
- [[_ handlerT handlerV] (evaluate! (:by-example [anchor expression directive]
- {(Handler anchor expression directive)
- handler}
- <type>)
- valueC)
+ [[_ _ name] (evaluate! Text nameC)
+ [_ _ handlerV] (evaluate! (:by-example [anchor expression directive]
+ {(Handler anchor expression directive)
+ handler}
+ <type>)
+ valueC)
_ (<| <scope>
- (///.install name)
+ (///.install extender (:coerce Text name))
(:share [anchor expression directive]
{(Handler anchor expression directive)
handler}
{<type>
- (:assume handlerV)}))]
+ (:assume handlerV)}))
+ #let [_ (log! (format <description> " " (%.text (:coerce Text name))))]]
(wrap /////directive.no-requirements))
_
(////.throw ///.invalid-syntax [extension-name %.code inputsC+]))))]
- [def::analysis /////analysis.Handler /////directive.lift-analysis]
- [def::synthesis /////synthesis.Handler /////directive.lift-synthesis]
- [def::generation (////generation.Handler anchor expression directive) /////directive.lift-generation]
- [def::directive (/////directive.Handler anchor expression directive) (<|)]
+ ["Analysis" def::analysis /////analysis.Handler /////directive.lift-analysis]
+ ["Synthesis" def::synthesis /////synthesis.Handler /////directive.lift-synthesis]
+ ["Generation" def::generation (////generation.Handler anchor expression directive) /////directive.lift-generation]
+ ["Directive" def::directive (/////directive.Handler anchor expression directive) (<|)]
)
## TODO; Both "prepare-program" and "define-program" exist only
@@ -321,25 +324,33 @@
_
(////.throw ///.invalid-syntax [extension-name %.code inputsC+]))))
-(def: (bundle::def expander host-analysis program)
+(def: (bundle::def expander host-analysis program extender)
(All [anchor expression directive]
- (-> Expander /////analysis.Bundle (-> expression directive) (Bundle anchor expression directive)))
+ (-> Expander
+ /////analysis.Bundle
+ (-> expression directive)
+ Extender
+ (Bundle anchor expression directive)))
(<| (///bundle.prefix "def")
(|> ///bundle.empty
(dictionary.put "module" def::module)
(dictionary.put "alias" def::alias)
(dictionary.put "type tagged" (def::type-tagged expander host-analysis))
- (dictionary.put "analysis" def::analysis)
- (dictionary.put "synthesis" def::synthesis)
- (dictionary.put "generation" def::generation)
- (dictionary.put "directive" def::directive)
+ (dictionary.put "analysis" (def::analysis extender))
+ (dictionary.put "synthesis" (def::synthesis extender))
+ (dictionary.put "generation" (def::generation extender))
+ (dictionary.put "directive" (def::directive extender))
(dictionary.put "program" (def::program program))
)))
-(def: #export (bundle expander host-analysis program)
+(def: #export (bundle expander host-analysis program extender)
(All [anchor expression directive]
- (-> Expander /////analysis.Bundle (-> expression directive) (Bundle anchor expression directive)))
+ (-> Expander
+ /////analysis.Bundle
+ (-> expression directive)
+ Extender
+ (Bundle anchor expression directive)))
(<| (///bundle.prefix "lux")
(|> ///bundle.empty
(dictionary.put "def" (lux::def expander host-analysis))
- (dictionary.merge (..bundle::def expander host-analysis program)))))
+ (dictionary.merge (..bundle::def expander host-analysis program extender)))))
diff --git a/stdlib/source/lux/tool/compiler/synthesis.lux b/stdlib/source/lux/tool/compiler/synthesis.lux
index e44432bcb..3d1f7c6e3 100644
--- a/stdlib/source/lux/tool/compiler/synthesis.lux
+++ b/stdlib/source/lux/tool/compiler/synthesis.lux
@@ -228,20 +228,12 @@
<tag>
content))]
+ [variable //reference.variable]
+ [constant //reference.constant]
[variable/local //reference.local]
[variable/foreign //reference.foreign]
)
-(template [<name> <tag>]
- [(template: #export (<name> content)
- (.<| #..Reference
- <tag>
- content))]
-
- [variable //reference.variable]
- [constant //reference.constant]
- )
-
(template [<name> <family> <tag>]
[(template: #export (<name> content)
(.<| #..Control
diff --git a/stdlib/source/program/compositor.lux b/stdlib/source/program/compositor.lux
index b9b2995ad..31f018081 100644
--- a/stdlib/source/program/compositor.lux
+++ b/stdlib/source/program/compositor.lux
@@ -30,6 +30,7 @@
["." directive]
["." phase
[macro (#+ Expander)]
+ [extension (#+ Extender)]
["." generation]]
[default
["." platform (#+ Platform)]
@@ -79,7 +80,9 @@
(#try.Failure error)
(:: io.monad wrap (#try.Failure error)))))
-(def: #export (compiler target partial-host-extension expander host-analysis platform generation-bundle host-directive-bundle program service
+(def: #export (compiler target partial-host-extension
+ expander host-analysis platform generation-bundle host-directive-bundle program extender
+ service
packager,package)
(All [anchor expression directive]
(-> Text
@@ -90,6 +93,7 @@
(generation.Bundle anchor expression directive)
(directive.Bundle anchor expression directive)
(-> expression directive)
+ Extender
Service
[(-> (generation.Output directive) Binary) Path]
(IO Any)))
@@ -104,7 +108,7 @@
{(Platform IO anchor expression directive)
platform}
{(IO (Try (directive.State+ anchor expression directive)))
- (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program)})
+ (platform.initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender)})
[archive state] (:share [anchor expression directive]
{(Platform IO anchor expression directive)
platform}
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux
index d9fbc7b1d..4be2dcf27 100644
--- a/stdlib/source/test/lux.lux
+++ b/stdlib/source/test/lux.lux
@@ -136,6 +136,7 @@
["#." type]
["#." world]
["#." host]
+ ["#." extension]
["#." target #_
["#/." jvm]]]
))
@@ -368,9 +369,11 @@
/tool.test
/type.test
/world.test))
- /host.test
- ($_ _.and
- /target/jvm.test)
+ (!bundle ($_ _.and
+ /host.test
+ /extension.test
+ ($_ _.and
+ /target/jvm.test)))
)))
(program: args
diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux
new file mode 100644
index 000000000..f73ad63a1
--- /dev/null
+++ b/stdlib/source/test/lux/extension.lux
@@ -0,0 +1,46 @@
+(.module:
+ [lux #*
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["<>" parser
+ ["<c>" code]
+ ["<a>" analysis]]]
+ [data
+ ["." text ("#@." equivalence)
+ ["%" format (#+ format)]]]
+ [tool
+ [compiler
+ ["." analysis]
+ ["." synthesis]
+ ["." directive]
+ [phase
+ [analysis
+ ["." type]]]]]
+ ["_" test (#+ Test)]]
+ {1
+ ["." / (#+ analysis: synthesis: directive:)]})
+
+(def: my-extension "example YOLO")
+
+(analysis: (..my-extension self phase {parameters (<>.some <c>.any)})
+ (do @
+ [_ (type.infer .Text)]
+ (wrap (#analysis.Extension self (list)))))
+
+(synthesis: (..my-extension self phase {parameters (<>.some <a>.any)})
+ (wrap (synthesis.text self)))
+
+(directive: (..my-extension self phase {parameters (<>.some <c>.any)})
+ (do @
+ [#let [_ (log! (format "directive: " (%.text self)))]]
+ (wrap directive.no-requirements)))
+
+("example YOLO")
+
+(def: #export test
+ Test
+ (<| (_.context (%.name (name-of /._)))
+ (_.test "Can define and user analysis & synthesis extensions."
+ (text@= ("example YOLO")
+ "example YOLO"))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:18:30 +0000