diff options
| -rw-r--r-- | .gitignore | 3 | ||||
| -rw-r--r-- | commands.md | 10 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm.lux | 24 | ||||
| -rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/function.lux | 1 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/default/platform.lux | 25 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/directive.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/lux/tool/compiler/phase/generation.lux | 18 |
7 files changed, 77 insertions, 34 deletions
diff --git a/.gitignore b/.gitignore index ef15d6b25..95dbbee14 100644 --- a/.gitignore +++ b/.gitignore @@ -6,10 +6,11 @@ pom.xml.asc /.lein-* /.nrepl-port +/jbe + /luxc/target /luxc/classes /luxc/checkouts -/luxc/jbe /stdlib/target diff --git a/commands.md b/commands.md index 43d5838a8..64d877e19 100644 --- a/commands.md +++ b/commands.md @@ -23,6 +23,14 @@ cd ~/lux/lux-scheme/ && lein clean --- +# Read generated bytecode + +``` +cd ~/lux/luxc/jbe/ && ./jbe.sh +``` + +--- + # Old compiler ## Build & install @@ -288,5 +296,7 @@ cd ~/lux/new-luxc/ && java -jar target/program.jar repl --source ~/lux/stdlib/so ``` cd ~/lux/new-luxc/ && time java -jar target/program.jar build --source ~/lux/stdlib/source --target ~/lux/stdlib/target --module test/lux + +cd ~/lux/stdlib/target/ && java -jar program.jar ``` diff --git a/new-luxc/source/luxc/lang/translation/jvm.lux b/new-luxc/source/luxc/lang/translation/jvm.lux index fccbd14bf..cf04d2a1a 100644 --- a/new-luxc/source/luxc/lang/translation/jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm.lux @@ -87,9 +87,25 @@ (def: class-path-separator ".") +(def: #export bytecode-name + (-> Text Text) + (text.replace-all ..class-path-separator .module-separator)) + +## TODO: This is a hackish solution to the issue I have. +## It should be cleaned up ASAP. +(def: #export class-name' + (-> Text Text) + (text.replace-all .module-separator ..class-path-separator)) + +(def: #export (class-name [module name]) + (-> Name Text) + (format (text.replace-all .module-separator ..class-path-separator module) + ..class-path-separator (name.normalize name) + "___" (%.nat (text@hash name)))) + (def: (evaluate! library loader eval-class valueI) (-> Library ClassLoader Text Inst (Try [Any Definition])) - (let [bytecode-name (text.replace-all class-path-separator .module-separator eval-class) + (let [bytecode-name (..bytecode-name eval-class) bytecode (def.class #jvm.V1_6 #jvm.Public jvm.noneC bytecode-name @@ -122,11 +138,9 @@ (loader.store class-name class-bytecode library))] (loader.load class-name loader)))) -(def: (define! library loader [module name] valueI) +(def: (define! library loader definition-name valueI) (-> Library ClassLoader Name Inst (Try [Text Any Definition])) - (let [class-name (format (text.replace-all .module-separator class-path-separator module) - class-path-separator (name.normalize name) - "___" (%.nat (text@hash name)))] + (let [class-name (..class-name definition-name)] (do try.monad [[value definition] (evaluate! library loader class-name valueI)] (wrap [class-name value definition])))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/function.lux b/new-luxc/source/luxc/lang/translation/jvm/function.lux index 7a4bbef4e..d141b2392 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/function.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/function.lux @@ -298,6 +298,7 @@ [function-class bodyI] (generation.with-context (generation.with-anchor [@begin 1] (generate bodyS))) + #let [function-class (//.class-name' function-class)] [functionD instanceI] (with-function @begin function-class env arity bodyI) _ (generation.save! true ["" function-class] [function-class diff --git a/stdlib/source/lux/tool/compiler/default/platform.lux b/stdlib/source/lux/tool/compiler/default/platform.lux index b37e74c2b..aea0ca787 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 (#+ Extender)] + ["." extension (#+ Extender)] ["." generation (#+ Buffer)] [analysis ["." module]]] @@ -57,6 +57,18 @@ <State+> (as-is (///directive.State+ anchor expression directive)) <Bundle> (as-is (generation.Bundle anchor expression directive))] + (def: pause-context + (All <type-vars> + (-> <State+> generation.Context)) + (get@ [#extension.state #///directive.generation #///directive.state #extension.state #generation.context])) + + (def: (resume-context context state) + (All <type-vars> + (-> generation.Context <State+> <State+>)) + (set@ [#extension.state #///directive.generation #///directive.state #extension.state #generation.context] + context + state)) + (def: #export (initialize target expander host-analysis platform generation-bundle host-directive-bundle program extender) (All <type-vars> (-> Text @@ -157,16 +169,18 @@ ## _ (write-module target-dir file-name (get@ #cli.module configuration) module outputs) ] (loop [archive archive - state state + state (..resume-context (generation.fresh-context module) state) compilation (compiler (:coerce ///.Input input))] (do @ - [#let [dependencies (get@ #///.dependencies compilation)] + [#let [dependencies (get@ #///.dependencies compilation) + current-context (..pause-context state)] archive+state (monad.fold @ import! [archive state] (list.filter (bit.complement (archive.archived? archive)) dependencies)) - #let [[archive state] (:share <type-vars> + #let [## TODO: Inline ASAP + [archive state] (:share <type-vars> {<Platform> platform} {[Archive <State+>] @@ -184,9 +198,10 @@ _ ## TODO: The "///analysis.set-current-module" below shouldn't be necessary. Remove it ASAP. + ## TODO: The context shouldn't need to be re-set either. (|> (///analysis.set-current-module module) ///directive.lift-analysis - (///phase.run' state) + (///phase.run' (..resume-context current-context state)) try.assume product.left)) archive) diff --git a/stdlib/source/lux/tool/compiler/phase/directive.lux b/stdlib/source/lux/tool/compiler/phase/directive.lux index f79f2b586..dc4115610 100644 --- a/stdlib/source/lux/tool/compiler/phase/directive.lux +++ b/stdlib/source/lux/tool/compiler/phase/directive.lux @@ -36,12 +36,10 @@ (def: #export (phase expander) (-> Expander Phase) (let [analyze (analysisP.phase expander)] - (function (compile code) + (function (recur code) (case code (^ [_ (#.Form (list& [_ (#.Text name)] inputs))]) - (do //.monad - [requirements (//extension.apply compile [name inputs])] - (wrap requirements)) + (//extension.apply recur [name inputs]) (^ [_ (#.Form (list& macro inputs))]) (do //.monad @@ -58,22 +56,20 @@ (wrap macro) #.None - (//.throw macro-was-not-found macro-name))] + (//.throw ..macro-was-not-found macro-name))] (//extension.lift (//macro.expand expander macro-name macro inputs))) _ - (//.throw invalid-macro-call code)))) - requirements (case expansion - (^ (list& <lux_def_module> referrals)) - (do @ - [requirements (compile <lux_def_module>)] - (wrap (update@ #/.referrals (list;compose referrals) requirements))) + (//.throw ..invalid-macro-call code))))] + (case expansion + (^ (list& <lux_def_module> referrals)) + (|> (recur <lux_def_module>) + (:: @ map (update@ #/.referrals (list;compose referrals)))) - _ - (|> expansion - (monad.map @ compile) - (:: @ map (list;fold /.merge-requirements /.no-requirements))))] - (wrap requirements)) + _ + (|> expansion + (monad.map @ recur) + (:: @ map (list;fold /.merge-requirements /.no-requirements))))) _ - (//.throw not-a-directive code)))))) + (//.throw ..not-a-directive code)))))) diff --git a/stdlib/source/lux/tool/compiler/phase/generation.lux b/stdlib/source/lux/tool/compiler/phase/generation.lux index 2f6e28ed2..35fa850be 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation.lux @@ -90,12 +90,16 @@ [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 {#scope-name "" - #inner-functions 0} + {#context (..fresh-context "") #anchor #.None #host host #buffer #.None @@ -110,7 +114,7 @@ (Operation anchor expression directive output))) (function (_ [bundle state]) (let [old (get@ #context state)] - (case (expr [bundle (set@ #context [specific-scope 0] state)]) + (case (expr [bundle (set@ #context (..fresh-context specific-scope) state)]) (#try.Success [[bundle' state'] output]) (#try.Success [[bundle' (set@ #context old state')] @@ -125,10 +129,12 @@ (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 [new-scope 0] 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 [old-scope (inc old-inner)] state')] + (#try.Success [[bundle' (set@ #context {#scope-name old-scope + #inner-functions (inc old-inner)} + state')] [new-scope output]]) (#try.Failure error) |