diff options
Diffstat (limited to 'stdlib/source/lux/tool/compiler/phase')
10 files changed, 62 insertions, 361 deletions
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 faf7a0c13..084bc8080 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/directive/lux.lux @@ -23,16 +23,16 @@ ["#." bundle] ["#." analysis] ["#/" // - ["#." generation] [analysis ["." module] [".A" type]] ["#/" // #_ - ["#." synthesis (#+ Synthesis)] - ["#." directive (#+ Import Requirements Phase Operation Handler Bundle)] ["#." analysis [macro (#+ Expander)] - ["#/." evaluation]]]]]) + ["#/." evaluation]] + ["#." synthesis (#+ Synthesis)] + ["#." generation] + ["#." directive (#+ Import Requirements Phase Operation Handler Bundle)]]]]) (def: #export (custom [syntax handler]) (All [anchor expression directive s] @@ -53,15 +53,15 @@ ## TODO: Inline "evaluate!'" into "evaluate!" ASAP (def: (evaluate!' generate code//type codeS) (All [anchor expression directive] - (-> (////generation.Phase anchor expression directive) + (-> (/////generation.Phase anchor expression directive) Type Synthesis (Operation anchor expression directive [Type expression Any]))) (/////directive.lift-generation (do ////.monad [codeT (generate codeS) - id ////generation.next - codeV (////generation.evaluate! (format "evaluate" (%.nat id)) codeT)] + id /////generation.next + codeV (/////generation.evaluate! (format "evaluate" (%.nat id)) codeT)] (wrap [code//type codeT codeV])))) (def: #export (evaluate! type codeC) @@ -84,7 +84,7 @@ ## TODO: Inline "definition'" into "definition" ASAP (def: (definition' generate name code//type codeS) (All [anchor expression directive] - (-> (////generation.Phase anchor expression directive) + (-> (/////generation.Phase anchor expression directive) Name Type Synthesis @@ -92,8 +92,8 @@ (/////directive.lift-generation (do ////.monad [codeT (generate codeS) - [target-name value directive] (////generation.define! name codeT) - _ (////generation.save! false name directive)] + [target-name value directive] (/////generation.define! name codeT) + _ (/////generation.save! false name directive)] (wrap [code//type codeT target-name value])))) (def: (definition name expected codeC) @@ -156,7 +156,7 @@ (module.define short-name (#.Right [exported? type (:coerce Code annotations) value]))) #let [_ (log! (format "Definition " (%.name full-name)))] _ (/////directive.lift-generation - (////generation.learn full-name valueN)) + (/////generation.learn full-name valueN)) _ (..refresh expander host-analysis)] (wrap /////directive.no-requirements)) @@ -181,7 +181,7 @@ (module.declare-tags tags exported? (:coerce Type value)))) #let [_ (log! (format "Definition " (%.name full-name)))] _ (/////directive.lift-generation - (////generation.learn full-name valueN)) + (/////generation.learn full-name valueN)) _ (..refresh expander host-analysis)] (wrap /////directive.no-requirements)))])) @@ -272,7 +272,7 @@ ["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] + ["Generation" def::generation (/////generation.Handler anchor expression directive) /////directive.lift-generation] ["Directive" def::directive (/////directive.Handler anchor expression directive) (<|)] ) @@ -296,13 +296,13 @@ (def: (define-program generate program programS) (All [anchor expression directive output] - (-> (////generation.Phase anchor expression directive) + (-> (/////generation.Phase anchor expression directive) (-> expression directive) Synthesis - (////generation.Operation anchor expression directive Any))) + (/////generation.Operation anchor expression directive Any))) (do ////.monad [programG (generate programS)] - (////generation.save! false ["" ""] (program programG)))) + (/////generation.save! false ["" ""] (program programG)))) (def: (def::program program) (All [anchor expression directive] diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux deleted file mode 100644 index ca2d76965..000000000 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ /dev/null @@ -1,298 +0,0 @@ -(.module: - [lux (#- Module) - [abstract - [monad (#+ do)]] - [control - ["." try (#+ Try)] - ["." exception (#+ exception:)]] - [data - ["." product] - ["." name ("#@." equivalence)] - ["." text - ["%" format (#+ format)]] - [collection - ["." row (#+ Row)] - ["." dictionary (#+ Dictionary)] - ["." list ("#@." functor)]]]] - ["." // - ["." extension] - [// - [synthesis (#+ Synthesis)] - [meta - [archive - [descriptor (#+ Module)]]]]]) - -(type: #export Registry - (Dictionary Name Text)) - -(exception: #export (cannot-interpret {error Text}) - (exception.report - ["Error" error])) - -(exception: #export (unknown-lux-name {name Name} {registry Registry}) - (exception.report - ["Name" (%.name name)] - ["Registry" (|> registry - dictionary.keys - (list.sort (:: name.order <)) - (list@map %.name) - (text.join-with text.new-line))])) - -(exception: #export (cannot-overwrite-lux-name {lux-name Name} - {old-host-name Text} - {new-host-name Text}) - (exception.report - ["Lux Name" (%.name lux-name)] - ["Old Host Name" old-host-name] - ["New Host Name" new-host-name])) - -(template [<name>] - [(exception: #export (<name> {name Name}) - (exception.report - ["Output" (%.name name)]))] - - [cannot-overwrite-output] - [no-buffer-for-saving-code] - ) - -(type: #export Context - {#scope-name Text - #inner-functions Nat}) - -(signature: #export (Host expression directive) - (: (-> Text expression (Try Any)) - evaluate!) - (: (-> Text directive (Try Any)) - execute!) - (: (-> Name expression (Try [Text Any directive])) - define!)) - -(type: #export (Buffer directive) (Row [Name directive])) -(type: #export (Output directive) (Row [Module (Buffer directive)])) - -(type: #export (State anchor expression directive) - {#context Context - #anchor (Maybe anchor) - #host (Host expression directive) - #buffer (Maybe (Buffer directive)) - #output (Output directive) - #counter Nat - #name-cache Registry}) - -(template [<special> <general>] - [(type: #export (<special> anchor expression directive) - (<general> (State anchor expression directive) Synthesis expression))] - - [State+ extension.State] - [Operation extension.Operation] - [Phase extension.Phase] - [Handler extension.Handler] - [Bundle extension.Bundle] - ) - -(def: #export (fresh-context scope-name) - (-> Text Context) - {#scope-name scope-name - #inner-functions 0}) - -(def: #export (state host) - (All [anchor expression directive] - (-> (Host expression directive) - (..State anchor expression directive))) - {#context (..fresh-context "") - #anchor #.None - #host host - #buffer #.None - #output row.empty - #counter 0 - #name-cache (dictionary.new name.hash)}) - -(def: #export (with-specific-context specific-scope expr) - (All [anchor expression directive output] - (-> Text - (Operation anchor expression directive output) - (Operation anchor expression directive output))) - (function (_ [bundle state]) - (let [old (get@ #context state)] - (case (expr [bundle (set@ #context (..fresh-context specific-scope) state)]) - (#try.Success [[bundle' state'] - output]) - (#try.Success [[bundle' (set@ #context old state')] - output]) - - (#try.Failure error) - (#try.Failure error))))) - -(def: #export (with-context expr) - (All [anchor expression directive output] - (-> (Operation anchor expression directive output) - (Operation anchor expression directive [Text output]))) - (function (_ [bundle state]) - (let [[old-scope old-inner] (get@ #context state) - new-scope (format old-scope "$c" (%.nat old-inner))] - (case (expr [bundle (set@ #context (..fresh-context new-scope) state)]) - (#try.Success [[bundle' state'] output]) - (#try.Success [[bundle' (set@ #context {#scope-name old-scope - #inner-functions (inc old-inner)} - state')] - [new-scope output]]) - - (#try.Failure error) - (#try.Failure error))))) - -(def: #export context - (All [anchor expression directive] - (Operation anchor expression directive Text)) - (extension.read (|>> (get@ #context) - (get@ #scope-name)))) - -(def: #export empty-buffer Buffer row.empty) - -(template [<tag> - <with-declaration> <with-type> <with-value> - <set> <get> <get-type> <exception>] - [(exception: #export <exception>) - - (def: #export <with-declaration> - (All [anchor expression directive output] <with-type>) - (function (_ body) - (function (_ [bundle state]) - (case (body [bundle (set@ <tag> (#.Some <with-value>) state)]) - (#try.Success [[bundle' state'] output]) - (#try.Success [[bundle' (set@ <tag> (get@ <tag> state) state')] - output]) - - (#try.Failure error) - (#try.Failure error))))) - - (def: #export <get> - (All [anchor expression directive] - (Operation anchor expression directive <get-type>)) - (function (_ (^@ stateE [bundle state])) - (case (get@ <tag> state) - (#.Some output) - (#try.Success [stateE output]) - - #.None - (exception.throw <exception> [])))) - - (def: #export (<set> value) - (All [anchor expression directive] - (-> <get-type> (Operation anchor expression directive Any))) - (function (_ [bundle state]) - (#try.Success [[bundle (set@ <tag> (#.Some value) state)] - []])))] - - [#anchor - (with-anchor anchor) - (-> anchor (Operation anchor expression directive output) - (Operation anchor expression directive output)) - anchor - set-anchor anchor anchor no-anchor] - - [#buffer - with-buffer - (-> (Operation anchor expression directive output) - (Operation anchor expression directive output)) - ..empty-buffer - set-buffer buffer (Buffer directive) no-active-buffer] - ) - -(def: #export output - (All [anchor expression directive] - (Operation anchor expression directive (Output directive))) - (extension.read (get@ #output))) - -(def: #export next - (All [anchor expression directive] - (Operation anchor expression directive Nat)) - (do //.monad - [count (extension.read (get@ #counter)) - _ (extension.update (update@ #counter inc))] - (wrap count))) - -(def: #export (gensym prefix) - (All [anchor expression directive] - (-> Text (Operation anchor expression directive Text))) - (:: //.monad map (|>> %.nat (format prefix)) ..next)) - -(template [<name> <inputT>] - [(def: #export (<name> label code) - (All [anchor expression directive] - (-> Text <inputT> (Operation anchor expression directive Any))) - (function (_ (^@ state+ [bundle state])) - (case (:: (get@ #host state) <name> label code) - (#try.Success output) - (#try.Success [state+ output]) - - (#try.Failure error) - (exception.throw cannot-interpret error))))] - - [evaluate! expression] - [execute! directive] - ) - -(def: #export (define! name code) - (All [anchor expression directive] - (-> Name expression (Operation anchor expression directive [Text Any directive]))) - (function (_ (^@ stateE [bundle state])) - (case (:: (get@ #host state) define! name code) - (#try.Success output) - (#try.Success [stateE output]) - - (#try.Failure error) - (exception.throw cannot-interpret error)))) - -(def: #export (save! execute? name code) - (All [anchor expression directive] - (-> Bit Name directive (Operation anchor expression directive Any))) - (do //.monad - [label (..gensym "save") - _ (if execute? - (execute! label code) - (wrap [])) - ?buffer (extension.read (get@ #buffer))] - (case ?buffer - (#.Some buffer) - (if (row.any? (|>> product.left (name@= name)) buffer) - (//.throw ..cannot-overwrite-output name) - (extension.update (set@ #buffer (#.Some (row.add [name code] buffer))))) - - #.None - (//.throw no-buffer-for-saving-code name)))) - -(def: #export (save-buffer! target) - (All [anchor expression directive] - (-> Module (Operation anchor expression directive (Buffer directive)))) - (do //.monad - [buffer ..buffer - _ (extension.update (update@ #output (row.add [target buffer])))] - (wrap buffer))) - -(def: #export (remember lux-name) - (All [anchor expression directive] - (-> Name (Operation anchor expression directive Text))) - (function (_ (^@ stateE [_ state])) - (let [cache (get@ #name-cache state)] - (case (dictionary.get lux-name cache) - (#.Some host-name) - (#try.Success [stateE host-name]) - - #.None - (exception.throw unknown-lux-name [lux-name cache]))))) - -(def: #export (learn lux-name host-name) - (All [anchor expression directive] - (-> Name Text (Operation anchor expression directive Any))) - (function (_ [bundle state]) - (let [cache (get@ #name-cache state)] - (case (dictionary.get lux-name cache) - #.None - (#try.Success [[bundle - (update@ #name-cache - (dictionary.put lux-name host-name) - state)] - []]) - - (#.Some old-host-name) - (exception.throw cannot-overwrite-lux-name [lux-name old-host-name host-name]))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/extension.lux b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux index 91e1b661c..d0de3e920 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/extension.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/extension.lux @@ -11,11 +11,11 @@ ["." macro (#+ with-gensyms) ["." code] [syntax (#+ syntax:)]]] - ["." // - ["#/" // - ["#." extension] - [// - [synthesis (#+ Synthesis)]]]]) + ["." /// + ["#." extension] + [// + [synthesis (#+ Synthesis)] + ["." generation]]]) (syntax: (Vector {size s.nat} elemT) (wrap (list (` [(~+ (list.repeat size elemT))])))) @@ -32,7 +32,7 @@ [g!input+ (monad.seq @ (list.repeat arity (macro.gensym "input")))] (wrap (list (` (def: #export ((~ (code.local-identifier name)) (~ g!extension)) (All [(~ g!anchor) (~ g!expression) (~ g!directive)] - (-> ((~ type) (~ g!expression)) (//.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) + (-> ((~ type) (~ g!expression)) (generation.Handler (~ g!anchor) (~ g!expression) (~ g!directive)))) (function ((~ g!_) (~ g!name) (~ g!phase) (~ g!inputs)) (case (~ g!inputs) (^ (list (~+ g!input+))) @@ -53,7 +53,7 @@ (def: #export (variadic extension) (All [anchor expression directive] - (-> (Variadic expression) (//.Handler anchor expression directive))) + (-> (Variadic expression) (generation.Handler anchor expression directive))) (function (_ extension-name) (function (_ phase inputsS) (do ///.monad diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux index cdb84ad6a..7f33f383b 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/case.lux @@ -20,8 +20,8 @@ [//// [reference (#+ Register)] ["." synthesis (#+ Path Synthesis)] - ["." phase ("operation@." monad) - ["." generation]]]]) + ["." generation] + ["." phase ("operation@." monad)]]]) (def: equals-name "equals") diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux index 7b14d2c07..84af963d2 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/extension/host.lux @@ -49,7 +49,7 @@ [variable ["." foreign]]]] ["//#" /// - ["." generation + [generation [extension (#+ Nullary Unary Binary Trinary Variadic nullary unary binary trinary variadic)]] [extension @@ -57,9 +57,10 @@ [analysis ["/" jvm]]] ["/#" // - [analysis (#+ Environment)] ["#." reference (#+ Variable)] - ["#." synthesis (#+ Synthesis Path %synthesis)]]]]]) + [analysis (#+ Environment)] + ["#." synthesis (#+ Synthesis Path %synthesis)] + ["#." generation]]]]]) (template [<name> <0> <1>] [(def: <name> @@ -1032,7 +1033,7 @@ self-name arguments returnT exceptionsT bodyS]) (do @ - [bodyG (generation.with-specific-context class-name + [bodyG (//////generation.with-specific-context class-name (generate bodyS))] (wrap (method.method ($_ modifier@compose method.public @@ -1059,7 +1060,7 @@ (list& (..with-anonymous-init class total-environment super-class inputsTI) method-definitions) (row.row))) - _ (generation.save! true ["" class-name] [class-name bytecode])] + _ (//////generation.save! true ["" class-name] [class-name bytecode])] (anonymous-instance class total-environment)))])) (def: bundle::class diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux index c5b18f6b3..8e7d51475 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/function.lux @@ -44,12 +44,12 @@ ["/#" // #_ ["#." runtime (#+ Operation Phase)] [//// + ["." arity (#+ Arity)] [reference (#+ Register)] [analysis (#+ Environment)] [synthesis (#+ Synthesis Abstraction Apply)] - ["." arity (#+ Arity)] - ["." phase - ["." generation]]]]]) + ["." generation] + ["." phase]]]]) (def: #export (with @begin class environment arity body) (-> Label External Environment Arity (Bytecode Any) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux index f27dbc269..00ceb8ca4 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/loop.lux @@ -19,8 +19,8 @@ [//// [reference (#+ Register)] ["." synthesis (#+ Path Synthesis)] - ["." phase - ["." generation]]]]) + ["." generation] + ["." phase]]]) (def: (invariant? register changeS) (-> Register Synthesis Bit) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux index 9400adf1a..983ac3d1a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/packager.lux @@ -12,16 +12,14 @@ [target [jvm [encoding - ["." name (#+ External)]]]] - [tool - [compiler - [phase - [generation (#+ Buffer Output) - [jvm - [runtime (#+ Definition)]]]] - [meta - [archive - [descriptor (#+ Module)]]]]]]) + ["." name (#+ External)]]]]] + [// + [runtime (#+ Definition)] + [//// + [generation (#+ Buffer Output)] + [meta + [archive + [descriptor (#+ Module)]]]]]) (import: #long java/lang/Object) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux index 13f6bb846..59115f815 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/reference.lux @@ -16,9 +16,9 @@ ["#." value] ["#." type] ["//#" /// ("operation@." monad) - ["." generation] [// - ["." reference (#+ Register Variable)]]]]) + ["." reference (#+ Register Variable)] + ["." generation]]]]) (def: #export this (Bytecode Any) diff --git a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux index 5968ed6c8..bd9cc1850 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/jvm/runtime.lux @@ -41,12 +41,12 @@ [variable [partial ["#/." count]]]]] - ["/#" // - ["/#" // - [// - [arity (#+ Arity)] - [reference (#+ Register)] - ["." synthesis]]]]]) + ["//#" /// + [// + [arity (#+ Arity)] + [reference (#+ Register)] + ["." synthesis] + ["." generation]]]]) (type: #export Byte-Code Binary) @@ -58,17 +58,17 @@ [(type: #export <name> (<base> Anchor (Bytecode Any) Definition))] - [Operation ///.Operation] - [Phase ///.Phase] - [Handler ///.Handler] - [Bundle ///.Bundle] + [Operation generation.Operation] + [Phase generation.Phase] + [Handler generation.Handler] + [Bundle generation.Bundle] ) (type: #export (Generator i) (-> Phase i (Operation (Bytecode Any)))) (type: #export Host - (///.Host (Bytecode Any) Definition)) + (generation.Host (Bytecode Any) Definition)) (def: #export class (type.class "LuxRuntime" (list))) @@ -513,8 +513,8 @@ ..try::method)) (row.row)))] (do ////.monad - [_ (///.execute! class [class bytecode])] - (///.save! .false ["" class] [class bytecode])))) + [_ (generation.execute! class [class bytecode])] + (generation.save! .false ["" class] [class bytecode])))) (def: generate-function (Operation Any) @@ -569,8 +569,8 @@ (list& <init>::method apply::method+) (row.row)))] (do ////.monad - [_ (///.execute! class [class bytecode])] - (///.save! .false ["" class] [class bytecode])))) + [_ (generation.execute! class [class bytecode])] + (generation.save! .false ["" class] [class bytecode])))) (def: #export generate (Operation Any) @@ -584,4 +584,4 @@ ## This shift is done to avoid the possibility of forged labels ## to be in the range of the labels that are generated automatically ## during the evaluation of Bytecode expressions. - (:: ////.monad map (i64.left-shift shift) ///.next))) + (:: ////.monad map (i64.left-shift shift) generation.next))) |