diff options
Diffstat (limited to 'new-luxc/source/luxc/lang')
-rw-r--r-- | new-luxc/source/luxc/lang/translation.lux | 278 | ||||
-rw-r--r-- | new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux | 4 |
2 files changed, 2 insertions, 280 deletions
diff --git a/new-luxc/source/luxc/lang/translation.lux b/new-luxc/source/luxc/lang/translation.lux deleted file mode 100644 index 3348953bb..000000000 --- a/new-luxc/source/luxc/lang/translation.lux +++ /dev/null @@ -1,278 +0,0 @@ -(.module: - lux - (lux (control [monad #+ do] - ["ex" exception #+ exception:]) - (concurrency ["P" promise] - ["T" task]) - (data [product] - ["e" error] - [text "text/" Hash<Text>] - text/format - (coll [list "list/" Functor<List>] - (dictionary ["dict" unordered]))) - [macro] - (lang [syntax #+ Aliases] - (type ["tc" check])) - [host] - [io #+ IO Process io] - (world [binary #+ Binary] - [file #+ File])) - (luxc ["&" lang] - ["&." io] - [cache] - [cache/description] - [cache/io] - (lang [".L" module] - [".L" host] - [".L" macro] - [".L" extension] - [".L" init] - (host ["$" jvm]) - (analysis [".A" expression] - [".A" common]) - (synthesis [".S" expression]) - ["&." eval])) - (/ ## [js] - (jvm [".T" runtime] - [".T" statement] - [".T" common #+ Artifacts] - [".T" expression] - [".T" eval] - [".T" imports]))) - -(def: analyse - (&.Analyser) - (expressionA.analyser &eval.eval)) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [Macro-Expansion-Failed] - [Unrecognized-Statement] - [Invalid-Macro] - ) - -(def: (process-annotations annsC) - (-> Code (Meta [## js.Expression - $.Inst - Code])) - (do macro.Monad<Meta> - [[_ annsA] (&.with-scope - (&.with-type Code - (analyse annsC))) - syntheses extensionL.all-syntheses - annsI (expressionT.translate (expressionS.synthesize syntheses annsA)) - annsV (evalT.eval annsI)] - (wrap [annsI (:coerce Code annsV)]))) - -(def: (switch-compiler new-compiler) - (-> Lux (Meta Aliases)) - (function (_ old-compiler) - ((do macro.Monad<Meta> - [this macro.current-module] - (wrap (|> this (get@ #.module-aliases) (dict.from-list text.Hash<Text>) (: Aliases)))) - new-compiler))) - -(def: #export (translate translate-module aliases code) - (-> (-> Text Lux (Process Lux)) Aliases Code (Meta Aliases)) - (case code - (^code ("lux module" (~ annsC))) - (do macro.Monad<Meta> - [[annsI annsV] (process-annotations annsC) - process (importsT.translate-imports translate-module annsV)] - (case (io.run process) - (#e.Success compiler') - (switch-compiler compiler') - - (#e.Error error) - (macro.fail error))) - - (^code ((~ [_ (#.Text statement)]) (~+ argsC+))) - (do macro.Monad<Meta> - [statement (extensionL.find-statement statement) - _ (statement argsC+)] - (wrap aliases)) - - (^code ((~ macroC) (~+ argsC+))) - (do macro.Monad<Meta> - [[_ macroA] (&.with-scope - (&.with-type Macro - (analyse macroC))) - [_macroT _macroM _macroV] (case macroA - [_ (#.Identifier macro-name)] - (macro.find-def macro-name) - - _ - (&.throw Invalid-Macro (%code code))) - expansion (: (Meta (List Code)) - (function (_ compiler) - (case (macroL.expand (:coerce Macro _macroV) argsC+ compiler) - (#e.Error error) - ((&.throw Macro-Expansion-Failed error) compiler) - - output - output))) - expansion-aliases (monad.map @ (translate translate-module aliases) expansion)] - (wrap (if (dict.empty? aliases) - (loop [expansion-aliases expansion-aliases] - (case expansion-aliases - #.Nil - aliases - - (#.Cons head tail) - (if (dict.empty? head) - (recur tail) - head))) - aliases))) - - _ - (&.throw Unrecognized-Statement (%code code)))) - -(def: (forgive-eof action) - (-> (Meta Any) (Meta Any)) - (function (_ compiler) - (case (action compiler) - (#e.Error error) - (if (ex.match? syntax.end-of-file error) - (#e.Success [compiler []]) - (#e.Error error)) - - output - output))) - -(def: #export prelude Text "lux") - -(def: (with-active-compilation [module-name file-name source-code] action) - (All [a] (-> [Text Text Text] (Meta a) (Meta a))) - (do macro.Monad<Meta> - [output (&.with-source-code (initL.source file-name source-code) - action) - _ (moduleL.flag-compiled! module-name)] - (wrap output))) - -(def: (read current-module aliases) - (-> Text Aliases (Meta Code)) - (function (_ compiler) - (case (syntax.read current-module aliases (get@ #.source compiler)) - (#e.Error error) - (#e.Error error) - - (#e.Success [source' output]) - (#e.Success [(set@ #.source source' compiler) - output])))) - -(for {"JVM" (as-is (host.import: java/lang/String - (getBytes [String] #try (Array byte))) - - (def: text-to-binary - (-> Text Binary) - (|>> (:coerce String) - (String::getBytes ["UTF-8"]) - e.assume)))}) - -## (def: (write-module target-dir file-name module-name module artifacts) -## (-> File Text Text Module Artifacts (Process Any)) -## (do io.Monad<Process> -## [_ (monad.map @ (product.uncurry (&io.write target-dir)) -## (dict.entries artifacts))] -## (&io.write target-dir -## (format module-name "/" cache.descriptor-name) -## (text-to-binary (%code (cache/description.write file-name module)))))) - -(def: no-aliases Aliases (dict.new text.Hash<Text>)) - -(def: #export (translate-module source-dirs target-dir module-name compiler) - (-> (List File) File Text Lux (Process Lux)) - (do io.Monad<Process> - [[file-name file-content] (&io.read source-dirs module-name) - #let [module-hash (text/hash file-content) - translate-module (translate-module source-dirs target-dir)]] - (case (macro.run' compiler - (do macro.Monad<Meta> - [[module _] (moduleL.with-module module-hash module-name - (with-active-compilation [module-name - file-name - file-content] - (forgive-eof - (loop [aliases no-aliases] - (do @ - [code (read module-name aliases) - #let [[cursor _] code] - aliases' (&.with-cursor cursor - (translate translate-module aliases code))] - (forgive-eof (recur aliases')))))))] - (wrap module))) - (#e.Success [compiler module]) - (do @ - [## _ (&io.prepare-module target-dir module-name) - ## _ (write-module target-dir file-name module-name module artifacts) - ] - (wrap compiler)) - - (#e.Error error) - (io.fail error)) - ## (case (macro.run' compiler - ## (do macro.Monad<Meta> - ## [[module artifacts _] (moduleL.with-module module-hash module-name - ## (commonT.with-artifacts - ## (with-active-compilation [module-name - ## file-name - ## file-content] - ## (forgive-eof - ## (loop [aliases no-aliases] - ## (do @ - ## [code (read module-name aliases) - ## #let [[cursor _] code] - ## aliases' (&.with-cursor cursor - ## (translate translate-module aliases code))] - ## (forgive-eof (recur aliases'))))))))] - ## (wrap [module artifacts]))) - ## (#e.Success [compiler [module artifacts]]) - ## (do @ - ## [## _ (&io.prepare-module target-dir module-name) - ## ## _ (write-module target-dir file-name module-name module artifacts) - ## ] - ## (wrap compiler)) - - ## (#e.Error error) - ## (io.fail error)) - )) - -(def: (initialize sources target) - (-> (List File) File (Process Lux)) - (do io.Monad<Process> - [compiler (case (runtimeT.translate ## (initL.compiler (io.run js.init)) - (initL.compiler (io.run hostL.init-host)) - ) - ## (#e.Success [compiler disk-write]) - ## (do @ - ## [_ (&io.prepare-target target) - ## _ disk-write - ## ## _ (cache/io.pre-load sources target (commonT.load-definition compiler)) - ## ] - ## (wrap (|> compiler - ## (set@ [#.info #.mode] #.Build)))) - - (#e.Success [compiler [runtime-bc function-bc]]) - (do @ - [_ (&io.prepare-target target) - ## _ (&io.write target (format hostL.runtime-class ".class") runtime-bc) - ## _ (&io.write target (format hostL.function-class ".class") function-bc) - ## _ (cache/io.pre-load sources target (commonT.load-definition compiler)) - ] - (wrap (|> compiler - (set@ [#.info #.mode] #.Build)))) - - (#e.Error error) - (io.fail error))] - (translate-module sources target prelude compiler))) - -(def: #export (translate-program sources target program) - (-> (List File) File Text (Process Any)) - (do io.Monad<Process> - [compiler (initialize sources target) - _ (translate-module sources target program compiler) - ## _ (cache/io.clean target ...) - #let [_ (log! "Compilation complete!")]] - (wrap []))) diff --git a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux index eec57610d..4b3259efd 100644 --- a/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux +++ b/new-luxc/source/luxc/lang/translation/jvm/runtime.jvm.lux @@ -415,8 +415,8 @@ (wrap bytecode)))) (def: #export translate - (Operation [ByteCode ByteCode]) + (Operation Any) (do phase.Monad<Operation> [runtime-bc translate-runtime function-bc translate-function] - (wrap [runtime-bc function-bc]))) + (wrap []))) |