1 files changed, 222 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/tool/interpreter.lux b/stdlib/source/library/lux/tool/interpreter.lux
new file mode 100644
index 000000000..df48eb420
--- /dev/null
+++ b/stdlib/source/library/lux/tool/interpreter.lux
@@ -0,0 +1,222 @@
+(.module:
+  [library
+   [lux #*
+    [control
+     [monad (#+ Monad do)]
+     ["." try (#+ Try)]
+     ["ex" exception (#+ exception:)]]
+    [data
+     ["." text ("#\." equivalence)
+      ["%" format (#+ format)]]]
+    [type (#+ :share)
+     ["." check]]
+    [compiler
+     ["." phase
+      ["." analysis
+       ["." module]
+       ["." type]]
+      ["." generation]
+      ["." directive (#+ State+ Operation)
+       ["." total]]
+      ["." extension]]
+     ["." default
+      ["." syntax]
+      ["." platform (#+ Platform)]
+      ["." init]]
+     ["." cli (#+ Configuration)]]
+    [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 text.new-line line)])
+
+(def: exit-command Text "exit")
+
+(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))
+
+(def: farewell-message
+  Text
+  "Till next time...")
+
+(def: enter-module
+  (All [anchor expression directive]
+    (Operation anchor expression directive Any))
+  (directive.lift-analysis
+   (do phase.monad
+     [_ (module.create 0 ..module)]
+     (analysis.set-current-module ..module))))
+
+(def: (initialize Monad<!> Console<!> platform configuration generation-bundle)
+  (All [! anchor expression directive]
+    (-> (Monad !)
+        (Console !) (Platform ! anchor expression directive)
+        Configuration
+        (generation.Bundle anchor expression directive)
+        (! (State+ anchor expression directive))))
+  (do Monad<!>
+    [state (platform.initialize platform generation-bundle)
+     state (platform.compile platform
+                             (set@ #cli.module syntax.prelude configuration)
+                             (set@ [#extension.state
+                                    #directive.analysis #directive.state
+                                    #extension.state
+                                    #.info #.mode]
+                                   #.Interpreter
+                                   state))
+     [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)
+                (:share [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)
+              (:share [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]
+    (wrap (/type.represent (get@ [#extension.state
+                                  #directive.analysis #directive.state
+                                  #extension.state]
+                                 state)
+                           codeT
+                           codeV))))
+
+(type: (Context anchor expression directive)
+  {#configuration Configuration
+   #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 (:share [anchor expression directive]
+                                                   {<Context>
+                                                    context}
+                                                   {(State+ anchor expression directive)
+                                                    (get@ #state context)})]
+                                 (<| (phase.run' state)
+                                     ## TODO: Simplify ASAP
+                                     (:share [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)
+        Configuration
+        (generation.Bundle anchor expression directive)
+        (! 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))
+            (#try.Success [context' representation])
+            (do !
+              [_ (\ Console<!> write representation)]
+              (recur context' #0))
+
+            (#try.Failure 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))))))
+      )))