From 725bcd5670a5d83c201fac147aedce01d9283d03 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sat, 11 Aug 2018 14:44:42 -0400 Subject: Moved interpreter (REPL) code to stdlib. --- stdlib/source/lux.lux | 6 +- stdlib/source/lux/compiler/cli.lux | 36 ++-- stdlib/source/lux/compiler/default.lux | 24 +-- .../lux/compiler/default/phase/extension.lux | 3 +- stdlib/source/lux/compiler/default/repl/type.lux | 203 ------------------- stdlib/source/lux/interpreter.lux | 217 +++++++++++++++++++++ stdlib/source/lux/interpreter/type.lux | 203 +++++++++++++++++++ stdlib/source/lux/world/console.lux | 108 +++++----- 8 files changed, 507 insertions(+), 293 deletions(-) delete mode 100644 stdlib/source/lux/compiler/default/repl/type.lux create mode 100644 stdlib/source/lux/interpreter.lux create mode 100644 stdlib/source/lux/interpreter/type.lux (limited to 'stdlib') diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index 7faad6c0a..9bf515bdb 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -652,19 +652,19 @@ ## (type: Mode ## #Build ## #Eval -## #REPL) +## #Interpreter) ("lux def" Mode (#Named ["lux" "Mode"] (#Sum ## Build Any (#Sum ## Eval Any - ## REPL + ## Interpreter Any))) (record$ (#Cons [(tag$ ["lux" "tags"]) (tuple$ (#Cons (text$ "Build") (#Cons (text$ "Eval") - (#Cons (text$ "REPL") + (#Cons (text$ "Interpreter") #Nil))))] (#Cons [(tag$ ["lux" "doc"]) (text$ "A sign that shows the conditions under which the compiler is running.")] diff --git a/stdlib/source/lux/compiler/cli.lux b/stdlib/source/lux/compiler/cli.lux index a73eb5a15..55ce35145 100644 --- a/stdlib/source/lux/compiler/cli.lux +++ b/stdlib/source/lux/compiler/cli.lux @@ -8,46 +8,32 @@ (type: #export Configuration {#sources (List File) - #target File}) - -(type: #export Build - [Configuration Text]) - -(type: #export REPL - Configuration) + #target File + #module Text}) (type: #export Service - (#Build Build) - (#REPL REPL)) + (#Compilation Configuration) + (#Interpretation Configuration)) (do-template [ ] [(def: #export (CLI Text) (cli.parameter [ ]))] - [source "-s" "--source"] - [target "-t" "--target"] - [program "-p" "--program"] + [source "-s" "--source"] + [target "-t" "--target"] + [module "-m" "--module"] ) (def: #export configuration (CLI Configuration) ($_ p.and (p.some ..source) - ..target)) - -(def: #export build - (CLI Build) - ($_ p.and - configuration - ..program)) - -(def: #export repl - (CLI REPL) - ..configuration) + ..target + ..module)) (def: #export service (CLI Service) ($_ p.or - (p.after (cli.this "build") ..build) - (p.after (cli.this "repl") ..repl))) + (p.after (cli.this "build") ..configuration) + (p.after (cli.this "repl") ..configuration))) diff --git a/stdlib/source/lux/compiler/default.lux b/stdlib/source/lux/compiler/default.lux index cb93fdba4..ac3fb7aa8 100644 --- a/stdlib/source/lux/compiler/default.lux +++ b/stdlib/source/lux/compiler/default.lux @@ -118,15 +118,15 @@ _ (loop-module-compilation module-name)] (end-module-compilation module-name))) - (def: #export (compile-module platform configuration module-name compiler) + (def: #export (compile-module platform configuration compiler) (All [fs anchor expression statement] - (-> Configuration Text (fs ))) + (-> Configuration (fs ))) (do (:: (get@ #file-system platform) &monad) [source (context.read (get@ #file-system platform) (get@ #cli.sources configuration) - module-name) - ## _ (&io.prepare-module target-dir module-name) - ## _ (write-module target-dir file-name module-name module artifacts) + (get@ #cli.module configuration)) + ## _ (&io.prepare-module target-dir (get@ #cli.module configuration)) + ## _ (write-module target-dir file-name (get@ #cli.module configuration) module artifacts) ] (<| (:: @ map product.left) (:: (get@ #file-system platform) lift) @@ -135,9 +135,9 @@ { platform} { - (perform-module-compilation module-name source)})))) + (perform-module-compilation (get@ #cli.module configuration) source)})))) - (def: (initialize-runtime platform configuration) + (def: #export (initialize platform configuration) (All [fs anchor expression statement] (-> Configuration (fs ))) (|> platform @@ -174,13 +174,13 @@ ## (io.fail error)) ) - (def: #export (compile platform configuration program) + (def: #export (compile platform configuration) (All [fs anchor expression statement] - (-> Configuration Text (fs Any))) + (-> Configuration (fs Any))) (do (:: (get@ #file-system platform) &monad) - [compiler (initialize-runtime platform configuration) - _ (compile-module platform configuration ..prelude compiler) - _ (compile-module platform configuration program compiler) + [compiler (initialize platform configuration) + _ (compile-module platform (set@ #cli.module ..prelude configuration) compiler) + _ (compile-module platform configuration compiler) ## _ (cache/io.clean target ...) ] (wrap (log! "Compilation complete!")))) diff --git a/stdlib/source/lux/compiler/default/phase/extension.lux b/stdlib/source/lux/compiler/default/phase/extension.lux index 3783b741a..808c6b4fd 100644 --- a/stdlib/source/lux/compiler/default/phase/extension.lux +++ b/stdlib/source/lux/compiler/default/phase/extension.lux @@ -24,7 +24,8 @@ )) (type: #export (State s i o) - [(Bundle s i o) s]) + {#bundle (Bundle s i o) + #state s}) (type: #export (Operation s i o v) (//.Operation (State s i o) v)) diff --git a/stdlib/source/lux/compiler/default/repl/type.lux b/stdlib/source/lux/compiler/default/repl/type.lux deleted file mode 100644 index 7d3ac0d9c..000000000 --- a/stdlib/source/lux/compiler/default/repl/type.lux +++ /dev/null @@ -1,203 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - ["ex" exception (#+ exception:)] - ["p" parser] - pipe] - [data - ["." error (#+ Error)] - [text - format] - [format - [xml (#+ XML)] - [json (#+ JSON)]] - [collection - ["." list]]] - [time - [instant (#+ Instant)] - [duration (#+ Duration)] - [date (#+ Date)]] - ["." function] - ["." type] - ["." macro - ["." code] - ["." poly (#+ Poly)]]]) - -(exception: #export (cannot-represent-value {type Type}) - (ex.report ["Type" (%type type)])) - -(type: Representation (-> Any Text)) - -(def: primitive-representation - (Poly Representation) - (`` ($_ p.either - (do p.Monad - [_ (poly.exactly Any)] - (wrap (function.constant "[]"))) - - (~~ (do-template [ ] - [(do p.Monad - [_ (poly.sub )] - (wrap (|>> (:coerce ) )))] - - [Bit %b] - [Nat %n] - [Int %i] - [Rev %r] - [Frac %f] - [Text %t]))))) - -(def: (special-representation representation) - (-> (Poly Representation) (Poly Representation)) - (`` ($_ p.either - (~~ (do-template [ ] - [(do p.Monad - [_ (poly.sub )] - (wrap (|>> (:coerce ) )))] - - [Type %type] - [Code %code] - [Instant %instant] - [Duration %duration] - [Date %date] - [JSON %json] - [XML %xml])) - - (do p.Monad - [[_ elemT] (poly.apply (p.and (poly.exactly List) poly.any)) - elemR (poly.local (list elemT) representation)] - (wrap (|>> (:coerce (List Any)) (%list elemR)))) - - (do p.Monad - [[_ elemT] (poly.apply (p.and (poly.exactly Maybe) poly.any)) - elemR (poly.local (list elemT) representation)] - (wrap (|>> (:coerce (Maybe Any)) - (case> #.None - "#.None" - - (#.Some elemV) - (format "(#.Some " (elemR elemV) ")")))))))) - -(def: (record-representation tags representation) - (-> (List Name) (Poly Representation) (Poly Representation)) - (do p.Monad - [membersR+ (poly.tuple (p.many representation)) - _ (p.assert "Number of tags does not match record type size." - (n/= (list.size tags) (list.size membersR+)))] - (wrap (function (_ recordV) - (let [record-body (loop [pairs-left (list.zip2 tags membersR+) - recordV recordV] - (case pairs-left - #.Nil - "" - - (#.Cons [tag repr] #.Nil) - (format (%code (code.tag tag)) " " (repr recordV)) - - (#.Cons [tag repr] tail) - (let [[leftV rightV] (:coerce [Any Any] recordV)] - (format (%code (code.tag tag)) " " (repr leftV) " " - (recur tail rightV)))))] - (format "{" record-body "}")))))) - -(def: (variant-representation tags representation) - (-> (List Name) (Poly Representation) (Poly Representation)) - (do p.Monad - [casesR+ (poly.variant (p.many representation)) - #let [num-tags (list.size tags)] - _ (p.assert "Number of tags does not match variant type size." - (n/= num-tags (list.size casesR+)))] - (wrap (function (_ variantV) - (loop [cases-left (list.zip3 tags - (list.indices num-tags) - casesR+) - variantV variantV] - (case cases-left - #.Nil - "" - - (#.Cons [tag-name tag-idx repr] #.Nil) - (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)] - (if (n/= tag-idx _tag) - (format "(" (%code (code.tag tag-name)) " " (repr _value) ")") - (undefined))) - - (#.Cons [tag-name tag-idx repr] tail) - (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)] - (if (n/= tag-idx _tag) - (format "(" (%code (code.tag tag-name)) " " (repr _value) ")") - (recur tail variantV))))))))) - -(def: (tagged-representation compiler representation) - (-> Lux (Poly Representation) (Poly Representation)) - (do p.Monad - [[name anonymous] poly.named] - (case (macro.run compiler (macro.tags-of name)) - (#error.Success ?tags) - (case ?tags - (#.Some tags) - (poly.local (list anonymous) - (p.either (record-representation tags representation) - (variant-representation tags representation))) - - #.None - representation) - - (#error.Error error) - (p.fail error)))) - -(def: (tuple-representation representation) - (-> (Poly Representation) (Poly Representation)) - (do p.Monad - [membersR+ (poly.tuple (p.many representation))] - (wrap (function (_ tupleV) - (let [tuple-body (loop [representations membersR+ - tupleV tupleV] - (case representations - #.Nil - "" - - (#.Cons lastR #.Nil) - (lastR tupleV) - - (#.Cons headR tailR) - (let [[leftV rightV] (:coerce [Any Any] tupleV)] - (format (headR leftV) " " (recur tailR rightV)))))] - (format "[" tuple-body "]")))))) - -(def: (representation compiler) - (-> Lux (Poly Representation)) - (p.rec - (function (_ representation) - ($_ p.either - primitive-representation - (special-representation representation) - (tagged-representation compiler representation) - (tuple-representation representation) - - (do p.Monad - [[funcT inputsT+] (poly.apply (p.and poly.any (p.many poly.any)))] - (case (type.apply inputsT+ funcT) - (#.Some outputT) - (poly.local (list outputT) representation) - - #.None - (p.fail ""))) - - (do p.Monad - [[name anonymous] poly.named] - (poly.local (list anonymous) representation)) - - (p.fail "") - )))) - -(def: #export (represent compiler type value) - (-> Lux Type Any Text) - (case (poly.run type (representation compiler)) - (#error.Success representation) - (ex.report ["Type" (%type type)] - ["Value" (representation value)]) - - (#error.Error error) - (ex.construct cannot-represent-value [type]))) diff --git a/stdlib/source/lux/interpreter.lux b/stdlib/source/lux/interpreter.lux new file mode 100644 index 000000000..2feb4b81c --- /dev/null +++ b/stdlib/source/lux/interpreter.lux @@ -0,0 +1,217 @@ +(.module: + [lux #* + [control + [monad (#+ Monad do)] + ["ex" exception (#+ exception:)]] + [data + ["." error (#+ Error)] + [text ("text/." Equivalence) + format]] + [type (#+ :share) + ["." check]] + [compiler + ["." cli (#+ Configuration)] + ["." default (#+ Platform) + ["." syntax] + ["." init] + ["." phase + ["." analysis + ["." module] + ["." type]] + ["." translation] + ["." statement (#+ State+ Operation) + ["." total]] + ["." extension]]]] + [world + ["." file (#+ File)] + ["." console (#+ Console)]]] + ["." /type]) + +(exception: #export (error {message Text}) + message) + +(def: #export module "") + +(def: fresh-source Source [[..module 1 0] 0 ""]) + +(def: (add-line line [where offset input]) + (-> Text Source Source) + [where offset (format input "\n" line)]) + +(def: exit-command Text "exit") + +(def: welcome-message + Text + (format "\n" + "Welcome to the interpreter!" "\n" + "Type \"exit\" to leave." "\n" + "\n")) + +(def: farewell-message + Text + "Till next time...") + +(def: enter-module + (All [anchor expression statement] + (Operation anchor expression statement Any)) + (statement.lift-analysis + (do phase.Monad + [_ (module.create 0 ..module)] + (analysis.set-current-module ..module)))) + +(def: (initialize Monad Console platform configuration) + (All [! anchor expression statement] + (-> (Monad !) + (Console !) (Platform ! anchor expression statement) + Configuration + (! (State+ anchor expression statement)))) + (do Monad + [state (default.initialize platform configuration) + state (default.compile-module platform + (set@ #cli.module default.prelude configuration) + (set@ [#extension.state + #statement.analysis #statement.state + #extension.state + #.info #.mode] + #.Interpreter + state)) + [state _] (:: (get@ #default.file-system platform) + lift (phase.run' state enter-module)) + _ (:: Console write ..welcome-message)] + (wrap state))) + +(with-expansions [ (as-is (Operation anchor expression statement [Type Any]))] + + (def: (interpret-statement code) + (All [anchor expression statement] + (-> Code )) + (do phase.Monad + [_ (total.phase code) + _ init.refresh] + (wrap [Any []]))) + + (def: (interpret-expression code) + (All [anchor expression statement] + (-> Code )) + (do phase.Monad + [state (extension.lift phase.get-state) + #let [analyse (get@ [#statement.analysis #statement.phase] state) + synthesize (get@ [#statement.synthesis #statement.phase] state) + translate (get@ [#statement.translation #statement.phase] state)] + [_ codeT codeA] (statement.lift-analysis + (analysis.with-scope + (type.with-fresh-env + (do @ + [[codeT codeA] (type.with-inference + (analyse code)) + codeT (type.with-env + (check.clean codeT))] + (wrap [codeT codeA]))))) + codeS (statement.lift-synthesis + (synthesize codeA))] + (statement.lift-translation + (translation.with-buffer + (do @ + [codeH (translate codeS) + count translation.next + codeV (translation.evaluate! (format "interpretation_" (%n count)) codeH)] + (wrap [codeT codeV])))))) + + (def: (interpret configuration code) + (All [anchor expression statement] + (-> Configuration Code )) + (function (_ state) + (case (<| (phase.run' state) + (:share [anchor expression statement] + {(State+ anchor expression statement) + state} + { + (interpret-statement code)})) + (#error.Success [state' output]) + (#error.Success [state' output]) + + (#error.Error error) + (if (ex.match? total.unrecognized-statement error) + (<| (phase.run' state) + (:share [anchor expression statement] + {(State+ anchor expression statement) + state} + { + (interpret-expression code)})) + (#error.Error error))))) + ) + +(def: (execute configuration code) + (All [anchor expression statement] + (-> Configuration Code (Operation anchor expression statement Text))) + (do phase.Monad + [[codeT codeV] (interpret configuration code) + state phase.get-state] + (wrap (/type.represent (get@ [#extension.state + #statement.analysis #statement.state + #extension.state] + state) + codeT + codeV)))) + +(type: (Context anchor expression statement) + {#configuration Configuration + #state (State+ anchor expression statement) + #source Source}) + +(with-expansions [ (as-is (Context anchor expression statement))] + (def: (read-eval-print context) + (All [anchor expression statement] + (-> (Error [ Text]))) + (do error.Monad + [[source' input] (syntax.read ..module syntax.no-aliases (get@ #source context)) + [state' representation] (let [## TODO: Simplify ASAP + state (:share [anchor expression statement] + { + context} + {(State+ anchor expression statement) + (get@ #state context)})] + (<| (phase.run' state) + ## TODO: Simplify ASAP + (:share [anchor expression statement] + { + context} + {(Operation anchor expression statement Text) + (execute (get@ #configuration context) input)})))] + (wrap [(|> context + (set@ #state state') + (set@ #source source')) + representation])))) + +(def: #export (run Monad Console platform configuration) + (All [! anchor expression statement] + (-> (Monad !) + (Console !) (Platform ! anchor expression statement) + Configuration + (! Any))) + (do Monad + [state (initialize Monad Console platform configuration)] + (loop [context {#configuration configuration + #state state + #source ..fresh-source} + multi-line? #0] + (do @ + [_ (if multi-line? + (:: Console write " ") + (:: Console write "> ")) + line (:: Console read-line)] + (if (and (not multi-line?) + (text/= ..exit-command line)) + (:: Console write ..farewell-message) + (case (read-eval-print (update@ #source (add-line line) context)) + (#error.Success [context' representation]) + (do @ + [_ (:: Console write representation)] + (recur context' #0)) + + (#error.Error error) + (if (ex.match? syntax.end-of-file error) + (recur context #1) + (exec (log! (ex.construct ..error error)) + (recur (set@ #source ..fresh-source context) #0)))))) + ))) diff --git a/stdlib/source/lux/interpreter/type.lux b/stdlib/source/lux/interpreter/type.lux new file mode 100644 index 000000000..7d3ac0d9c --- /dev/null +++ b/stdlib/source/lux/interpreter/type.lux @@ -0,0 +1,203 @@ +(.module: + [lux #* + [control + [monad (#+ do)] + ["ex" exception (#+ exception:)] + ["p" parser] + pipe] + [data + ["." error (#+ Error)] + [text + format] + [format + [xml (#+ XML)] + [json (#+ JSON)]] + [collection + ["." list]]] + [time + [instant (#+ Instant)] + [duration (#+ Duration)] + [date (#+ Date)]] + ["." function] + ["." type] + ["." macro + ["." code] + ["." poly (#+ Poly)]]]) + +(exception: #export (cannot-represent-value {type Type}) + (ex.report ["Type" (%type type)])) + +(type: Representation (-> Any Text)) + +(def: primitive-representation + (Poly Representation) + (`` ($_ p.either + (do p.Monad + [_ (poly.exactly Any)] + (wrap (function.constant "[]"))) + + (~~ (do-template [ ] + [(do p.Monad + [_ (poly.sub )] + (wrap (|>> (:coerce ) )))] + + [Bit %b] + [Nat %n] + [Int %i] + [Rev %r] + [Frac %f] + [Text %t]))))) + +(def: (special-representation representation) + (-> (Poly Representation) (Poly Representation)) + (`` ($_ p.either + (~~ (do-template [ ] + [(do p.Monad + [_ (poly.sub )] + (wrap (|>> (:coerce ) )))] + + [Type %type] + [Code %code] + [Instant %instant] + [Duration %duration] + [Date %date] + [JSON %json] + [XML %xml])) + + (do p.Monad + [[_ elemT] (poly.apply (p.and (poly.exactly List) poly.any)) + elemR (poly.local (list elemT) representation)] + (wrap (|>> (:coerce (List Any)) (%list elemR)))) + + (do p.Monad + [[_ elemT] (poly.apply (p.and (poly.exactly Maybe) poly.any)) + elemR (poly.local (list elemT) representation)] + (wrap (|>> (:coerce (Maybe Any)) + (case> #.None + "#.None" + + (#.Some elemV) + (format "(#.Some " (elemR elemV) ")")))))))) + +(def: (record-representation tags representation) + (-> (List Name) (Poly Representation) (Poly Representation)) + (do p.Monad + [membersR+ (poly.tuple (p.many representation)) + _ (p.assert "Number of tags does not match record type size." + (n/= (list.size tags) (list.size membersR+)))] + (wrap (function (_ recordV) + (let [record-body (loop [pairs-left (list.zip2 tags membersR+) + recordV recordV] + (case pairs-left + #.Nil + "" + + (#.Cons [tag repr] #.Nil) + (format (%code (code.tag tag)) " " (repr recordV)) + + (#.Cons [tag repr] tail) + (let [[leftV rightV] (:coerce [Any Any] recordV)] + (format (%code (code.tag tag)) " " (repr leftV) " " + (recur tail rightV)))))] + (format "{" record-body "}")))))) + +(def: (variant-representation tags representation) + (-> (List Name) (Poly Representation) (Poly Representation)) + (do p.Monad + [casesR+ (poly.variant (p.many representation)) + #let [num-tags (list.size tags)] + _ (p.assert "Number of tags does not match variant type size." + (n/= num-tags (list.size casesR+)))] + (wrap (function (_ variantV) + (loop [cases-left (list.zip3 tags + (list.indices num-tags) + casesR+) + variantV variantV] + (case cases-left + #.Nil + "" + + (#.Cons [tag-name tag-idx repr] #.Nil) + (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)] + (if (n/= tag-idx _tag) + (format "(" (%code (code.tag tag-name)) " " (repr _value) ")") + (undefined))) + + (#.Cons [tag-name tag-idx repr] tail) + (let [[_tag _last? _value] (:coerce [Nat Text Any] variantV)] + (if (n/= tag-idx _tag) + (format "(" (%code (code.tag tag-name)) " " (repr _value) ")") + (recur tail variantV))))))))) + +(def: (tagged-representation compiler representation) + (-> Lux (Poly Representation) (Poly Representation)) + (do p.Monad + [[name anonymous] poly.named] + (case (macro.run compiler (macro.tags-of name)) + (#error.Success ?tags) + (case ?tags + (#.Some tags) + (poly.local (list anonymous) + (p.either (record-representation tags representation) + (variant-representation tags representation))) + + #.None + representation) + + (#error.Error error) + (p.fail error)))) + +(def: (tuple-representation representation) + (-> (Poly Representation) (Poly Representation)) + (do p.Monad + [membersR+ (poly.tuple (p.many representation))] + (wrap (function (_ tupleV) + (let [tuple-body (loop [representations membersR+ + tupleV tupleV] + (case representations + #.Nil + "" + + (#.Cons lastR #.Nil) + (lastR tupleV) + + (#.Cons headR tailR) + (let [[leftV rightV] (:coerce [Any Any] tupleV)] + (format (headR leftV) " " (recur tailR rightV)))))] + (format "[" tuple-body "]")))))) + +(def: (representation compiler) + (-> Lux (Poly Representation)) + (p.rec + (function (_ representation) + ($_ p.either + primitive-representation + (special-representation representation) + (tagged-representation compiler representation) + (tuple-representation representation) + + (do p.Monad + [[funcT inputsT+] (poly.apply (p.and poly.any (p.many poly.any)))] + (case (type.apply inputsT+ funcT) + (#.Some outputT) + (poly.local (list outputT) representation) + + #.None + (p.fail ""))) + + (do p.Monad + [[name anonymous] poly.named] + (poly.local (list anonymous) representation)) + + (p.fail "") + )))) + +(def: #export (represent compiler type value) + (-> Lux Type Any Text) + (case (poly.run type (representation compiler)) + (#error.Success representation) + (ex.report ["Type" (%type type)] + ["Value" (representation value)]) + + (#error.Error error) + (ex.construct cannot-represent-value [type]))) diff --git a/stdlib/source/lux/world/console.lux b/stdlib/source/lux/world/console.lux index 93365f61e..85db061c8 100644 --- a/stdlib/source/lux/world/console.lux +++ b/stdlib/source/lux/world/console.lux @@ -7,66 +7,76 @@ ["." error] ["." text format]] - [concurrency - ["." promise] - ["." task (#+ Task)]] ["." io (#+ IO Process io)] - [host (#+ import:)]]) + [host (#+ import:)] + [compiler + ["." host]]]) -(exception: #export (cannot-close) - "") +(do-template [] + [(exception: #export () + "")] -(signature: #export (Console m) - (: (-> [] (m Nat)) + [cannot-open] + [cannot-close] + ) + +(signature: #export (Console !) + (: (-> [] (! Nat)) read) - (: (-> [] (m Text)) + (: (-> [] (! Text)) read-line) - (: (-> [Text] (m Any)) + (: (-> Text (! Any)) write) - (: (-> [] (m Any)) + (: (-> [] (! Any)) close)) -(for {"JVM" - (as-is (import: java/lang/String) +(`` (for {(~~ (static host.jvm)) + (as-is (import: java/lang/String) + + (import: #long java/io/Console + (readLine [] #io #try String)) - (import: #long java/io/Console - (readLine [] #io #try String)) + (import: java/io/InputStream + (read [] #io #try int)) - (import: java/io/InputStream - (read [] #io #try int)) + (import: java/io/PrintStream + (print [String] #io #try void)) - (import: java/io/PrintStream - (print [String] #io #try void)) + (import: java/lang/System + (#static console [] #io #? java/io/Console) + (#static in java/io/InputStream) + (#static out java/io/PrintStream)) - (import: java/lang/System - (#static console [] #io #try java/io/Console) - (#static in java/io/InputStream) - (#static out java/io/PrintStream)) + (def: #export open + (Process (Console Process)) + (do io.Monad + [?jvm-console (System::console [])] + (case ?jvm-console + #.None + (io.fail (ex.construct cannot-open [])) - (def: #export open - (Process (Console Task)) - (do io.Monad - [jvm-console (System::console []) - #let [jvm-input System::in - jvm-output System::out]] - (wrap (: (Console Task) - (structure - (def: (read _) - (|> jvm-input - (InputStream::read []) - (:: io.Functor map .nat) - promise.future)) - - (def: (read-line _) - (|> jvm-console (java/io/Console::readLine []) promise.future)) - - (def: (write message) - (|> jvm-output (PrintStream::print [message]) promise.future)) - - (def: close - (|>> (ex.construct cannot-close) task.fail)))))))) - }) + (#.Some jvm-console) + (let [jvm-input System::in + jvm-output System::out] + (<| io.from-io + wrap + (: (Console Process)) ## TODO: Remove ASAP + (structure + (def: (read _) + (|> jvm-input + (InputStream::read []) + (:: io.Functor map .nat))) + + (def: (read-line _) + (|> jvm-console (java/io/Console::readLine []))) + + (def: (write message) + (|> jvm-output (PrintStream::print [message]))) + + (def: close + (|>> (ex.construct cannot-close) io.fail))))))))) + })) -(def: #export (write-line message console) - (All [m] (-> Text (Console m) (m Any))) - (:: console write (format message ""))) +(def: #export (write-line message Console) + (All [!] (-> Text (Console !) (! Any))) + (:: Console write (format message ""))) -- cgit v1.2.3