From 9eaaaf953ba7ce1eeb805603f4e113aa15f5178f Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 8 Jan 2018 21:40:06 -0400 Subject: - Moved all translation code under the JVM path (in preparation for porting the JS back-end). --- .../luxc/lang/translation/jvm/imports.jvm.lux | 149 +++++++++++++++++++++ 1 file changed, 149 insertions(+) create mode 100644 new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux (limited to 'new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux') diff --git a/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux new file mode 100644 index 000000000..892dd869f --- /dev/null +++ b/new-luxc/source/luxc/lang/translation/jvm/imports.jvm.lux @@ -0,0 +1,149 @@ +(.module: + lux + (lux (control [monad #+ do] + ["p" parser] + ["ex" exception #+ exception:] + pipe) + (concurrency [promise #+ Promise] + [stm #+ Var STM]) + (data ["e" error #+ Error] + [maybe] + [product] + [text "text/" Eq] + text/format + (coll [list "list/" Functor Fold] + [dict #+ Dict])) + [macro] + (macro [code] + ["s" syntax]) + [io #+ IO Process io] + [host]) + (luxc ["&" lang] + (lang [".L" module]))) + +(exception: #export Invalid-Imports) +(exception: #export Module-Cannot-Import-Itself) +(exception: #export Circular-Dependency) + +(host.import (java/util/concurrent/Future a) + (get [] #io a)) + +(host.import (java/util/concurrent/CompletableFuture a) + (new []) + (complete [a] boolean) + (#static [a] completedFuture [a] (CompletableFuture a))) + +(type: Import + {#module Text + #alias Text}) + +(def: import (s.Syntax Import) (s.tuple (p.seq s.text s.text))) + +(def: compilations + (Var (Dict Text (CompletableFuture (Error Compiler)))) + (stm.var (dict.new text.Hash))) + +(def: (promise-to-future promise) + (All [a] (-> (Promise a) (Future a))) + (let [future (CompletableFuture::new [])] + (exec (:: promise.Functor map + (function [value] (CompletableFuture::complete [value] future)) + promise) + future))) + +(def: from-io + (All [a] (-> (IO a) (Process a))) + (:: io.Monad map (|>> #e.Success))) + +(def: (translate-dependency translate-module dependency compiler) + (-> (-> Text Compiler (Process Compiler)) + (-> Text Compiler (IO (Future (Error Compiler))))) + (<| (Future::get []) + promise-to-future + (do promise.Monad + [[new? future] (stm.commit (: (STM [Bool (CompletableFuture (Error Compiler))]) + (do stm.Monad + [current-compilations (stm.read compilations)] + (case (dict.get dependency current-compilations) + (#.Some ongoing) + (wrap [false ongoing]) + + #.None + (do @ + [#let [pending (: (CompletableFuture (Error Compiler)) + (CompletableFuture::new []))] + _ (stm.write (dict.put dependency pending current-compilations) + compilations)] + (wrap [true pending]))))))] + (if new? + (exec (promise.future (io (CompletableFuture::complete [(io.run (translate-module dependency compiler))] + future))) + (wrap future)) + (wrap future))))) + +(def: compiled? + (-> Module Bool) + (|>> (get@ #.module-state) + (case> + (^or #.Cached #.Compiled) + true + + _ + false))) + +(def: (merge-modules current-module from-dependency from-current) + (-> Text (List [Text Module]) (List [Text Module]) (List [Text Module])) + (|> from-dependency + (list.filter (|>> product.right compiled?)) + (list/fold (function [[dep-name dep-module] total] (&.pl-put dep-name dep-module total)) + from-current))) + +(def: (merge-compilers current-module dependency total) + (-> Text Compiler Compiler Compiler) + (|> total + (update@ #.modules (merge-modules current-module (get@ #.modules dependency))) + (set@ #.seed (get@ #.seed dependency)))) + +(def: #export (translate-imports translate-module annotations) + (-> (-> Text Compiler (Process Compiler)) + Code + (Meta (Process Compiler))) + (do macro.Monad + [_ (moduleL.set-annotations annotations) + current-module macro.current-module-name + imports (let [imports (|> (macro.get-tuple-ann (ident-for #.imports) annotations) + (maybe.default (list)))] + (case (s.run imports (p.some import)) + (#e.Success imports) + (wrap imports) + + (#e.Error error) + (&.throw Invalid-Imports (%code (code.tuple imports))))) + dependencies (monad.map @ (: (-> [Text Text] (Meta (IO (Future (Error Compiler))))) + (function [[dependency alias]] + (do @ + [_ (&.assert Module-Cannot-Import-Itself current-module + (not (text/= current-module dependency))) + already-seen? (moduleL.exists? dependency) + circular-dependency? (if already-seen? + (moduleL.active? dependency) + (wrap false)) + _ (&.assert Circular-Dependency (format "From: " current-module "\n" + " To: " dependency) + (not circular-dependency?)) + _ (moduleL.import dependency) + _ (if (text/= "" alias) + (wrap []) + (moduleL.alias alias dependency)) + compiler macro.get-compiler] + (if already-seen? + (wrap (io (CompletableFuture::completedFuture [(#e.Success compiler)]))) + (wrap (translate-dependency translate-module dependency compiler)))))) + imports) + compiler macro.get-compiler] + (wrap (do io.Monad + [dependencies (monad.seq io.Monad (list/map from-io dependencies)) + dependencies (|> dependencies + (list/map (Future::get [])) + (monad.seq io.Monad))] + (wrap (list/fold (merge-compilers current-module) compiler dependencies)))))) -- cgit v1.2.3