diff options
Diffstat (limited to 'stdlib/source/library/lux/tool/interpreter.lux')
| -rw-r--r-- | stdlib/source/library/lux/tool/interpreter.lux | 234 |
1 files changed, 119 insertions, 115 deletions
diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux index 8008dea25..05daa46aa 100644 --- a/stdlib/source/library/lux/tool/interpreter.lux +++ b/stdlib/source/library/lux/tool/interpreter.lux @@ -34,34 +34,38 @@ (def: #export module "<INTERPRETER>") -(def: fresh-source Source [[..module 1 0] 0 ""]) +(def: fresh_source + Source + [[..module 1 0] 0 ""]) -(def: (add-line line [where offset input]) +(def: (add_line line [where offset input]) (-> Text Source Source) - [where offset (format input text.new-line line)]) + [where offset (format input text.new_line line)]) -(def: exit-command Text "exit") +(def: exit_command + Text + "exit") -(def: welcome-message +(def: welcome_message Text - (format text.new-line - "Welcome to the interpreter!" text.new-line - "Type '" ..exit-command "' to leave." text.new-line - text.new-line)) + (format text.new_line + "Welcome to the interpreter!" text.new_line + "Type '" ..exit_command "' to leave." text.new_line + text.new_line)) -(def: farewell-message +(def: farewell_message Text "Till next time...") -(def: enter-module +(def: enter_module (All [anchor expression directive] (Operation anchor expression directive Any)) - (directive.lift-analysis + (directive.lift_analysis (do phase.monad [_ (module.create 0 ..module)] - (analysis.set-current-module ..module)))) + (analysis.set_current_module ..module)))) -(def: (initialize Monad<!> Console<!> platform configuration generation-bundle) +(def: (initialize Monad<!> Console<!> platform configuration generation_bundle) (All [! anchor expression directive] (-> (Monad !) (Console !) (Platform ! anchor expression directive) @@ -69,7 +73,7 @@ (generation.Bundle anchor expression directive) (! (State+ anchor expression directive)))) (do Monad<!> - [state (platform.initialize platform generation-bundle) + [state (platform.initialize platform generation_bundle) state (platform.compile platform (set@ #cli.module syntax.prelude configuration) (set@ [#extension.state @@ -78,78 +82,78 @@ #.info #.mode] #.Interpreter state)) - [state _] (\ (get@ #platform.file-system platform) - lift (phase.run' state enter-module)) - _ (\ Console<!> write ..welcome-message)] + [state _] (\ (get@ #platform.file_system platform) + lift (phase.run' state enter_module)) + _ (\ Console<!> write ..welcome_message)] (wrap state))) -(with-expansions [<Interpretation> (as-is (Operation anchor expression directive [Type Any]))] - - (def: (interpret-directive code) - (All [anchor expression directive] - (-> Code <Interpretation>)) - (do phase.monad - [_ (total.phase code) - _ init.refresh] - (wrap [Any []]))) - - (def: (interpret-expression code) - (All [anchor expression directive] - (-> Code <Interpretation>)) - (do {! phase.monad} - [state (extension.lift phase.get-state) - #let [analyse (get@ [#directive.analysis #directive.phase] state) - synthesize (get@ [#directive.synthesis #directive.phase] state) - generate (get@ [#directive.generation #directive.phase] state)] - [_ codeT codeA] (directive.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 (directive.lift-synthesis - (synthesize codeA))] - (directive.lift-generation - (generation.with-buffer - (do ! - [codeH (generate codeS) - count generation.next - codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] - (wrap [codeT codeV])))))) - - (def: (interpret configuration code) - (All [anchor expression directive] - (-> Configuration Code <Interpretation>)) - (function (_ state) - (case (<| (phase.run' state) - (:sharing [anchor expression directive] - {(State+ anchor expression directive) - state} - {<Interpretation> - (interpret-directive code)})) - (#try.Success [state' output]) - (#try.Success [state' output]) - - (#try.Failure error) - (if (ex.match? total.not-a-directive error) - (<| (phase.run' state) - (:sharing [anchor expression directive] - {(State+ anchor expression directive) - state} - {<Interpretation> - (interpret-expression code)})) - (#try.Failure error))))) - ) +(with_expansions [<Interpretation> (as_is (Operation anchor expression directive [Type Any]))] + + (def: (interpret_directive code) + (All [anchor expression directive] + (-> Code <Interpretation>)) + (do phase.monad + [_ (total.phase code) + _ init.refresh] + (wrap [Any []]))) + + (def: (interpret_expression code) + (All [anchor expression directive] + (-> Code <Interpretation>)) + (do {! phase.monad} + [state (extension.lift phase.get_state) + #let [analyse (get@ [#directive.analysis #directive.phase] state) + synthesize (get@ [#directive.synthesis #directive.phase] state) + generate (get@ [#directive.generation #directive.phase] state)] + [_ codeT codeA] (directive.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 (directive.lift_synthesis + (synthesize codeA))] + (directive.lift_generation + (generation.with_buffer + (do ! + [codeH (generate codeS) + count generation.next + codeV (generation.evaluate! (format "interpretation_" (%.nat count)) codeH)] + (wrap [codeT codeV])))))) + + (def: (interpret configuration code) + (All [anchor expression directive] + (-> Configuration Code <Interpretation>)) + (function (_ state) + (case (<| (phase.run' state) + (:sharing [anchor expression directive] + {(State+ anchor expression directive) + state} + {<Interpretation> + (interpret_directive code)})) + (#try.Success [state' output]) + (#try.Success [state' output]) + + (#try.Failure error) + (if (ex.match? total.not_a_directive error) + (<| (phase.run' state) + (:sharing [anchor expression directive] + {(State+ anchor expression directive) + state} + {<Interpretation> + (interpret_expression code)})) + (#try.Failure error))))) + ) (def: (execute configuration code) (All [anchor expression directive] (-> Configuration Code (Operation anchor expression directive Text))) (do phase.monad [[codeT codeV] (interpret configuration code) - state phase.get-state] + state phase.get_state] (wrap (/type.represent (get@ [#extension.state #directive.analysis #directive.state #extension.state] @@ -162,32 +166,32 @@ #state (State+ anchor expression directive) #source Source}) -(with-expansions [<Context> (as-is (Context anchor expression directive))] - (def: (read-eval-print context) - (All [anchor expression directive] - (-> <Context> (Try [<Context> Text]))) - (do try.monad - [#let [[_where _offset _code] (get@ #source context)] - [source' input] (syntax.parse ..module syntax.no-aliases (text.size _code) (get@ #source context)) - [state' representation] (let [## TODO: Simplify ASAP - state (:sharing [anchor expression directive] - {<Context> - context} - {(State+ anchor expression directive) - (get@ #state context)})] - (<| (phase.run' state) - ## TODO: Simplify ASAP - (:sharing [anchor expression directive] - {<Context> - context} - {(Operation anchor expression directive Text) - (execute (get@ #configuration context) input)})))] - (wrap [(|> context - (set@ #state state') - (set@ #source source')) - representation])))) - -(def: #export (run Monad<!> Console<!> platform configuration generation-bundle) +(with_expansions [<Context> (as_is (Context anchor expression directive))] + (def: (read_eval_print context) + (All [anchor expression directive] + (-> <Context> (Try [<Context> Text]))) + (do try.monad + [#let [[_where _offset _code] (get@ #source context)] + [source' input] (syntax.parse ..module syntax.no_aliases (text.size _code) (get@ #source context)) + [state' representation] (let [## TODO: Simplify ASAP + state (:sharing [anchor expression directive] + {<Context> + context} + {(State+ anchor expression directive) + (get@ #state context)})] + (<| (phase.run' state) + ## TODO: Simplify ASAP + (:sharing [anchor expression directive] + {<Context> + context} + {(Operation anchor expression directive Text) + (execute (get@ #configuration context) input)})))] + (wrap [(|> context + (set@ #state state') + (set@ #source source')) + representation])))) + +(def: #export (run Monad<!> Console<!> platform configuration generation_bundle) (All [! anchor expression directive] (-> (Monad !) (Console !) (Platform ! anchor expression directive) @@ -198,25 +202,25 @@ [state (initialize Monad<!> Console<!> platform configuration)] (loop [context {#configuration configuration #state state - #source ..fresh-source} - multi-line? #0] + #source ..fresh_source} + multi_line? #0] (do ! - [_ (if multi-line? + [_ (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)) + 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)) (#try.Success [context' representation]) (do ! [_ (\ Console<!> write representation)] (recur context' #0)) (#try.Failure error) - (if (ex.match? syntax.end-of-file 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)))))) + (recur (set@ #source ..fresh_source context) #0)))))) ))) |