(.module: lux (lux (control ["ex" exception #+ exception:] pipe [monad #+ do]) (data [bit] [maybe] ["e" error #+ Error] [text "text/" Eq] text/format (coll [array])) [macro] [io #+ IO Process io] [host #+ class: interface: object] (world [file #+ File])) (luxc [lang] (lang [".L" variable #+ Register] (host [ruby #+ Ruby Expression Statement])) [".C" io])) (template [] [(exception: #export ( {message Text}) message)] [No-Active-Module-Buffer] [Cannot-Execute] [No-Anchor] ) (host.import: java/lang/Object) (host.import: java/lang/String (getBytes [String] #try (Array byte))) (host.import: java/lang/CharSequence) (host.import: java/lang/Appendable (append [CharSequence] Appendable)) (host.import: java/lang/StringBuilder (new []) (toString [] String)) (host.import: org/jruby/embed/ScriptingContainer (new []) (runScriptlet [String] #? Object)) (type: #export Anchor [Text Register]) (type: #export Host {#context [Text Nat] #anchor (Maybe Anchor) #interpreter (-> Text (Error Any)) #module-buffer (Maybe StringBuilder) #program-buffer StringBuilder}) (def: #export init (IO Host) (io {#context ["" +0] #anchor #.None #interpreter (let [interpreter (ScriptingContainer::new [])] (function (_ code) ("lux try" (io (: Any (maybe.default [] (ScriptingContainer::runScriptlet [code] interpreter))))))) #module-buffer #.None #program-buffer (StringBuilder::new [])})) (def: #export ruby-module-name Text "module.rb") (def: #export init-module-buffer (Meta Any) (function (_ compiler) (#e.Success [(update@ #.host (|>> (:coerce Host) (set@ #module-buffer (#.Some (StringBuilder::new []))) (:coerce Nothing)) compiler) []]))) (def: #export (with-sub-context expr) (All [a] (-> (Meta a) (Meta [Text a]))) (function (_ compiler) (let [old (:coerce Host (get@ #.host compiler)) [old-name old-sub] (get@ #context old) new-name (format old-name "___" (%i (.int old-sub)))] (case (expr (set@ #.host (:coerce Nothing (set@ #context [new-name +0] old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:coerce Host) (set@ #context [old-name (inc old-sub)]) (:coerce Nothing)) compiler') [new-name output]]) (#e.Error error) (#e.Error error))))) (def: #export context (Meta Text) (function (_ compiler) (#e.Success [compiler (|> (get@ #.host compiler) (:coerce Host) (get@ #context) (let> [name sub] name))]))) (def: #export (with-anchor anchor expr) (All [a] (-> Anchor (Meta a) (Meta a))) (function (_ compiler) (let [old (:coerce Host (get@ #.host compiler))] (case (expr (set@ #.host (:coerce Nothing (set@ #anchor (#.Some anchor) old)) compiler)) (#e.Success [compiler' output]) (#e.Success [(update@ #.host (|>> (:coerce Host) (set@ #anchor (get@ #anchor old)) (:coerce Nothing)) compiler') output]) (#e.Error error) (#e.Error error))))) (def: #export anchor (Meta Anchor) (function (_ compiler) (case (|> compiler (get@ #.host) (:coerce Host) (get@ #anchor)) (#.Some anchor) (#e.Success [compiler anchor]) #.None ((lang.throw No-Anchor "") compiler)))) (def: #export module-buffer (Meta StringBuilder) (function (_ compiler) (case (|> compiler (get@ #.host) (:coerce Host) (get@ #module-buffer)) #.None ((lang.throw No-Active-Module-Buffer "") compiler) (#.Some module-buffer) (#e.Success [compiler module-buffer])))) (def: #export program-buffer (Meta StringBuilder) (function (_ compiler) (#e.Success [compiler (|> compiler (get@ #.host) (:coerce Host) (get@ #program-buffer))]))) (def: (execute code) (-> Expression (Meta Any)) (function (_ compiler) (let [interpreter (|> compiler (get@ #.host) (:coerce Host) (get@ #interpreter))] (case (interpreter code) (#e.Error error) ((lang.throw Cannot-Execute error) compiler) (#e.Success _) (#e.Success [compiler []]))))) (def: #export variant-tag-field "_lux_tag") (def: #export variant-flag-field "_lux_flag") (def: #export variant-value-field "_lux_value") (def: #export unit Text "") (def: #export (definition-name [module name]) (-> Name Text) (lang.normalize-name (format module "$" name))) (def: #export (save code) (-> Ruby (Meta Any)) (do macro.Monad [module-buffer module-buffer #let [_ (Appendable::append [(:coerce CharSequence code)] module-buffer)]] (execute code))) (def: #export (save-module! target) (-> File (Meta (Process Any))) (do macro.Monad [module macro.current-module-name module-buffer module-buffer program-buffer program-buffer #let [module-code (StringBuilder::toString [] module-buffer) _ (Appendable::append [(:coerce CharSequence (format module-code "\n"))] program-buffer)]] (wrap (ioC.write target (format (lang.normalize-name module) "/" ruby-module-name) (|> module-code (String::getBytes ["UTF-8"]) e.assume)))))