diff options
Diffstat (limited to '')
3 files changed, 49 insertions, 35 deletions
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))))) |