diff options
18 files changed, 454 insertions, 93 deletions
diff --git a/lux-mode/lux-mode.el b/lux-mode/lux-mode.el index 7f67ac1f0..26b31f03c 100644 --- a/lux-mode/lux-mode.el +++ b/lux-mode/lux-mode.el @@ -255,7 +255,7 @@ Called by `imenu--generic-function'." (type//capability (altRE "capability:")) ;; Data (data//record (altRE "get@" "set@" "update@")) - (data//signature (altRE "signature:" "structure:" "open:" "structure" "::")) + (data//signature (altRE "open:" "structure" "::")) (data//implicit (altRE "implicit:" "implicit" ":::")) (data//collection (altRE "list" "list&" "row" "tree")) ;; Code @@ -268,7 +268,14 @@ Called by `imenu--generic-function'." (alternative-format (altRE "char" "bin" "oct" "hex")) (documentation (altRE "doc" "comment")) (function-application (altRE "|>" "|>>" "<|" "<<|" "_\\$" "\\$_")) - (remember (altRE "remember" "to-do" "fix-me"))) + (remember (altRE "remember" "to-do" "fix-me")) + (definition (altRE "\\.module:" + "def:" "type:" "program:" + "signature:" "structure:" + "macro:" "syntax:" + "exception:" + "word:" + "analysis:" "synthesis:" "generation:" "directive:"))) (let ((control (altRE control//flow control//pattern-matching control//logic @@ -294,22 +301,19 @@ Called by `imenu--generic-function'." type data code - ;; ;;;;;;;;;;;;;;;;;;;;;; + ;;;;;;;;;;;;;;;;;;;;;;;; actor jvm-host alternative-format documentation function-application remember - ;; ;;;;;;;;;;;;;;;;;;;;;; - "\\.module:" - "def:" "type:" "program:" - "macro:" "syntax:" + definition + ;;;;;;;;;;;;;;;;;;;;;;;; "with-expansions" - "exception:" - "word:" "function" "undefined" "name-of" "static" - "for" "io" + "for" + "io" "infix" "format" "regex") diff --git a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux index a46813232..c3b806dd7 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/extension/common.lux @@ -42,7 +42,7 @@ (-> Text Phase s (Operation Inst))] Handler)) (function (_ extension-name phase input) - (case (<s>.run input parser) + (case (<s>.run parser input) (#try.Success input') (handler extension-name phase input') diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 91b42c981..f975d2a87 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -24,7 +24,7 @@ [compiler [phase ["." macro (#+ Expander)] - [extension + [extension (#+ Phase Bundle Operation Handler Extender) ["." analysis #_ ["#" jvm]]]] [default @@ -60,19 +60,27 @@ (java/lang/Class java/lang/Object) (host.class-for java/lang/Object)) -(def: _apply-args +(def: _apply2-args (Array (java/lang/Class java/lang/Object)) (|> (host.array (java/lang/Class java/lang/Object) 2) (host.array-write 0 _object-class) (host.array-write 1 _object-class))) +(def: _apply4-args + (Array (java/lang/Class java/lang/Object)) + (|> (host.array (java/lang/Class java/lang/Object) 4) + (host.array-write 0 _object-class) + (host.array-write 1 _object-class) + (host.array-write 2 _object-class) + (host.array-write 3 _object-class))) + (def: #export (expander macro inputs lux) Expander (do try.monad [apply-method (|> macro (:coerce java/lang/Object) (java/lang/Object::getClass) - (java/lang/Class::getMethod "apply" _apply-args))] + (java/lang/Class::getMethod "apply" _apply2-args))] (:coerce (Try (Try [Lux (List Code)])) (java/lang/reflect/Method::invoke (:coerce java/lang/Object macro) @@ -158,6 +166,34 @@ run-ioI $i.RETURN))))])) +(def: extender + Extender + ## TODO: Stop relying on coercions ASAP. + (<| (:coerce Extender) + (function (@self handler)) + (:coerce Handler) + (function (@self name phase)) + (:coerce Phase) + (function (@self parameters)) + (:coerce Operation) + (function (@self state)) + (:coerce Try) + try.assume + (:coerce Try) + (do try.monad + [method (|> handler + (:coerce java/lang/Object) + (java/lang/Object::getClass) + (java/lang/Class::getMethod "apply" _apply4-args))] + (java/lang/reflect/Method::invoke + (:coerce java/lang/Object handler) + (|> (host.array java/lang/Object 4) + (host.array-write 0 (:coerce java/lang/Object name)) + (host.array-write 1 (:coerce java/lang/Object phase)) + (host.array-write 2 (:coerce java/lang/Object parameters)) + (host.array-write 3 (:coerce java/lang/Object state))) + method)))) + (program: [{service /cli.service}] (let [(^slots [#/cli.target #/cli.module]) (case service (#/cli.Compilation configuration) configuration @@ -171,5 +207,6 @@ translation.bundle directive.bundle ..program + ..extender service [(packager.package ..program-class) jar-path]))) 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")))) |