diff options
-rw-r--r-- | new-luxc/source/luxc/repl.lux | 145 | ||||
-rw-r--r-- | new-luxc/source/program.lux | 48 | ||||
-rw-r--r-- | stdlib/source/lux.lux | 6 | ||||
-rw-r--r-- | stdlib/source/lux/compiler/cli.lux | 36 | ||||
-rw-r--r-- | stdlib/source/lux/compiler/default.lux | 24 | ||||
-rw-r--r-- | stdlib/source/lux/compiler/default/phase/extension.lux | 3 | ||||
-rw-r--r-- | stdlib/source/lux/interpreter.lux | 217 | ||||
-rw-r--r-- | stdlib/source/lux/interpreter/type.lux (renamed from stdlib/source/lux/compiler/default/repl/type.lux) | 0 | ||||
-rw-r--r-- | stdlib/source/lux/world/console.lux | 108 |
9 files changed, 327 insertions, 260 deletions
diff --git a/new-luxc/source/luxc/repl.lux b/new-luxc/source/luxc/repl.lux deleted file mode 100644 index e8da16ae1..000000000 --- a/new-luxc/source/luxc/repl.lux +++ /dev/null @@ -1,145 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ do)] - ["ex" exception (#+ exception:)]] - [data - ["." maybe] - ["e" error (#+ Error)] - [text ("text/" Equivalence<Text>) - format] - [collection - ["." dictionary]]] - ["." macro] - [type - ["." check]] - [language - [syntax (#+ Aliases)] - [".L" init] - [".L" module] - [".L" scope] - [".L" extension - [".E" analysis]]] - [concurrency - ["." promise] - [task (#+ Task)]] - ["." io] - [world - [file (#+ File)] - [console (#+ Console)]]] - [// - ["." lang - [".L" host] - [".L" translation - [jvm - [".T" runtime]]] - [extension - [".E" synthesis] - [".E" translation] - [".E" statement]]]]) - -(do-template [<name>] - [(exception: #export (<name> {message Text}) - message)] - - [repl-initialization-failed] - [repl-error] - ) - -(def: repl-module "<REPL>") - -(def: no-aliases Aliases (dictionary.new text.Hash<Text>)) - -(def: (initialize source-dirs target-dir console) - (-> (List File) File Console (Task Lux)) - (do promise.Monad<Promise> - [output (promise.future - (do io.Monad<IO> - [host hostL.init-host] - (case (macro.run' (initL.compiler host) - (moduleL.with-module 0 repl-module - runtimeT.translate)) - (#e.Success [compiler _]) - (|> compiler - (set@ [#.info #.mode] #.REPL) - (set@ #.extensions - (:coerce Nothing - {#extensionL.analysis analysisE.defaults - #extensionL.synthesis synthesisE.defaults - #extensionL.translation translationE.defaults - #extensionL.statement statementE.defaults})) - (translationL.translate-module source-dirs target-dir translationL.prelude)) - - (#e.Error error) - (wrap (#e.Error error)))))] - (case output - (#e.Success compiler) - (do task.Monad<Task> - [_ (console.write (format "\nWelcome to the REPL!\n" - "Type \"exit\" to leave.\n\n") - console)] - (wrap compiler)) - - (#e.Error message) - (task.throw repl-initialization-failed message)))) - -(def: (add-line line [where offset input]) - (-> Text Source Source) - [where offset (format input "\n" line)]) - -(def: (repl-translate source-dirs target-dir code) - (-> (List File) File Code (Meta [Type Any])) - (function (_ compiler) - (case ((translationL.translate (translationL.translate-module source-dirs target-dir) - no-aliases - code) - compiler) - (#e.Success [compiler' aliases']) - (#e.Success [compiler' [Nothing []]]) - - (#e.Error error) - (if (ex.match? translationL.Unrecognized-Statement error) - ((do macro.Monad<Meta> - [[var-id varT] (lang.with-type-env check.var) - exprV (scopeL.with-scope repl-module - (evalL.eval varT code)) - ?exprT (lang.with-type-env (check.read var-id))] - (wrap [(maybe.assume ?exprT) exprV])) - compiler) - (#e.Error error))))) - -(def: fresh-source Source [[repl-module 1 0] 0 ""]) - -(def: #export (run source-dirs target-dir) - (-> (List File) File (Task Any)) - (do task.Monad<Task> - [console (promise.future console.open) - compiler (initialize source-dirs target-dir console)] - (loop [compiler compiler - source fresh-source - multi-line? #0] - (do @ - [_ (if multi-line? - (console.write " " console) - (console.write "> " console)) - line (console.read-line console)] - (if (text/= "exit" line) - (console.write "Till next time..." console) - (case (do e.Monad<Error> - [[source' exprC] (syntax.read repl-module no-aliases (add-line line source))] - (macro.run' compiler - (lang.with-current-module repl-module - (do macro.Monad<Meta> - [[exprT exprV] (repl-translate source-dirs target-dir exprC)] - (wrap [source' exprT exprV]))))) - (#e.Success [compiler' [source' exprT exprV]]) - (do @ - [_ (console.write (represent compiler' exprT exprV) console)] - (recur compiler' source' #0)) - - (#e.Error error) - (if (ex.match? syntax.end-of-file error) - (recur compiler source #1) - (exec (log! (ex.construct repl-error error)) - (recur compiler fresh-source #0)))))) - ))) diff --git a/new-luxc/source/program.lux b/new-luxc/source/program.lux index 4e0925717..01b3a2eee 100644 --- a/new-luxc/source/program.lux +++ b/new-luxc/source/program.lux @@ -7,7 +7,7 @@ ["." promise (#+ Promise)] ["." task (#+ Task)]] [data - ["e" error] + ["." error] [text format]] ["." io (#+ IO Process io)] @@ -15,12 +15,13 @@ ["." instant]] [cli (#+ program:)] [world - ["." file (#+ File)]] + ["." file (#+ File)] + ["." console]] [compiler ["." cli] - ["." default (#+ Platform)]]] + ["." default (#+ Platform)]] + ["." interpreter]] [luxc - ## ["." repl] [lang ["." host/jvm] [translation @@ -28,19 +29,19 @@ ["." runtime] ["." expression]]]]]) -(def: (or-crash! failure-describer action) +(def: (or-crash! failure-description action) (All [a] - (-> Text (Task a) (Promise a))) - (do promise.Monad<Promise> + (-> Text (Process a) (IO a))) + (do io.Monad<IO> [?output action] (case ?output - (#e.Error error) + (#error.Error error) (exec (log! (format "\n" - failure-describer "\n" + failure-description "\n" error "\n")) - (io.run (io.exit +1))) + (io.exit +1)) - (#e.Success output) + (#error.Success output) (wrap output)))) (def: (timed action) @@ -65,17 +66,14 @@ (program: [{service cli.service}] (do io.Monad<IO> - [platform ..jvm-platform] - (wrap (: (Promise Any) - (case service - (#cli.Build [configuration program]) - (<| (or-crash! "Compilation failed:") - promise.future - ..timed - (default.compile platform configuration program)) - - (#cli.REPL configuration) - (undefined) - ## (<| (or-crash! "REPL failed:") - ## (repl.run sources target)) - ))))) + [platform ..jvm-platform + console (:: @ map error.assume console.open)] + (case service + (#cli.Compilation configuration) + (<| (or-crash! "Compilation failed:") + ..timed + (default.compile platform configuration)) + + (#cli.Interpretation configuration) + (<| (or-crash! "Interpretation failed:") + (interpreter.run io.Monad<Process> console platform configuration))))) 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 [<name> <short> <long>] [(def: #export <name> (CLI Text) (cli.parameter [<short> <long>]))] - [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] - (-> <Platform> Configuration Text <Compiler> (fs <Compiler>))) + (-> <Platform> Configuration <Compiler> (fs <Compiler>))) (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> platform} {<Operation> - (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] (-> <Platform> Configuration (fs <Compiler>))) (|> platform @@ -174,13 +174,13 @@ ## (io.fail error)) ) - (def: #export (compile platform configuration program) + (def: #export (compile platform configuration) (All [fs anchor expression statement] - (-> <Platform> Configuration Text (fs Any))) + (-> <Platform> 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 @@ <Bundle>)) (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/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<Text>) + 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 "<INTERPRETER>") + +(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<Operation> + [_ (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 [<Interpretation> (as-is (Operation anchor expression statement [Type Any]))] + + (def: (interpret-statement code) + (All [anchor expression statement] + (-> Code <Interpretation>)) + (do phase.Monad<Operation> + [_ (total.phase code) + _ init.refresh] + (wrap [Any []]))) + + (def: (interpret-expression code) + (All [anchor expression statement] + (-> Code <Interpretation>)) + (do phase.Monad<Operation> + [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 <Interpretation>)) + (function (_ state) + (case (<| (phase.run' state) + (:share [anchor expression statement] + {(State+ anchor expression statement) + state} + {<Interpretation> + (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} + {<Interpretation> + (interpret-expression code)})) + (#error.Error error))))) + ) + +(def: (execute configuration code) + (All [anchor expression statement] + (-> Configuration Code (Operation anchor expression statement Text))) + (do phase.Monad<Operation> + [[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 [<Context> (as-is (Context anchor expression statement))] + (def: (read-eval-print context) + (All [anchor expression statement] + (-> <Context> (Error [<Context> Text]))) + (do error.Monad<Error> + [[source' input] (syntax.read ..module syntax.no-aliases (get@ #source context)) + [state' representation] (let [## TODO: Simplify ASAP + state (:share [anchor expression statement] + {<Context> + context} + {(State+ anchor expression statement) + (get@ #state context)})] + (<| (phase.run' state) + ## TODO: Simplify ASAP + (:share [anchor expression statement] + {<Context> + 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/compiler/default/repl/type.lux b/stdlib/source/lux/interpreter/type.lux index 7d3ac0d9c..7d3ac0d9c 100644 --- a/stdlib/source/lux/compiler/default/repl/type.lux +++ b/stdlib/source/lux/interpreter/type.lux 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 [<name>] + [(exception: #export (<name>) + "")] -(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<IO> + [?jvm-console (System::console [])] + (case ?jvm-console + #.None + (io.fail (ex.construct cannot-open [])) - (def: #export open - (Process (Console Task)) - (do io.Monad<Process> - [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<Process> 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<Process> 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 ""))) |