diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/lux/analyser.clj | 13 | ||||
-rw-r--r-- | src/lux/analyser/base.clj | 4 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 51 | ||||
-rw-r--r-- | src/lux/base.clj | 43 | ||||
-rw-r--r-- | src/lux/compiler/lux.clj | 9 | ||||
-rw-r--r-- | src/lux/repl.clj | 56 |
6 files changed, 118 insertions, 58 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj index c5993ce83..d6cc5cfda 100644 --- a/src/lux/analyser.clj +++ b/src/lux/analyser.clj @@ -196,9 +196,12 @@ =output-type (&type/clean ?var ?output-type)] (return (&&/|meta =output-type ?output-cursor ?output-term)))) -(defn repl-analyse [eval! compile-module compilers] +(defn repl-analyse [optimize eval! compile-module compilers] (|do [asts &parser/parse] - (&type/with-var - (fn [?var] - (|do [outputs (&/flat-map% (partial analyse-ast eval! compile-module compilers ?var) asts)] - (&/map% (partial clean-output ?var) outputs)))))) + (&/flat-map% (fn [ast] + (&type/with-var + (fn [?var] + (|do [=outputs (&/with-closure + (analyse-ast optimize eval! compile-module compilers ?var ast))] + (&/map% (partial clean-output ?var) =outputs))))) + asts))) diff --git a/src/lux/analyser/base.clj b/src/lux/analyser/base.clj index 6e36967e1..fed65bb29 100644 --- a/src/lux/analyser/base.clj +++ b/src/lux/analyser/base.clj @@ -28,6 +28,10 @@ ) ;; [Exports] +(defn expr-meta [analysis] + (|let [[meta _] analysis] + meta)) + (defn expr-type* [analysis] (|let [[[type _] _] analysis] type)) diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj index 805a91b6c..c50f26437 100644 --- a/src/lux/analyser/lux.clj +++ b/src/lux/analyser/lux.clj @@ -393,13 +393,18 @@ (&/$Left error) ((&/fail-with-loc error) state))) module-name &/get-module-name - :let [[r-prefix r-name] real-name - _ (when (= "regex" r-name) - (->> (&/|map &/show-ast macro-expansion) - (&/|interpose "\n") - (&/fold str "") - (prn (&/ident->text real-name) module-name))) - ] + ;; :let [[r-prefix r-name] real-name + ;; _ (when (or (= "actor:" r-name) + ;; ;; (= "|Codec@Json|" r-name) + ;; ;; (= "|Codec@Json//encode|" r-name) + ;; ;; (= "|Codec@Json//decode|" r-name) + ;; ;; (= "derived:" r-name) + ;; ) + ;; (->> (&/|map &/show-ast macro-expansion) + ;; (&/|interpose "\n") + ;; (&/fold str "") + ;; (prn (&/ident->text real-name) module-name))) + ;; ] ] (&/flat-map% (partial analyse exo-type) macro-expansion)) @@ -561,8 +566,9 @@ ? (&&module/defined? module-name ?name)] (if ? (&/fail-with-loc (str "[Analyser Error] Can't redefine " (str module-name ";" ?name))) - (|do [=value (&/with-scope ?name - (&&/analyse-1+ analyse ?value)) + (|do [=value (&/without-repl-closure + (&/with-scope ?name + (&&/analyse-1+ analyse ?value))) =meta (&&/analyse-1 analyse &type/DefMeta ?meta) ==meta (eval! (optimize =meta)) _ (&&module/test-type module-name ?name ==meta (&&/expr-type* =value)) @@ -577,19 +583,20 @@ _ (if (= current-module path) (&/fail-with-loc (str "[Analyser Error] Module can't import itself: " path)) (return nil))] - (&/save-module - (|do [already-compiled? (&&module/exists? path) - active? (&/active-module? path) - _ (&/assert! (not active?) - (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module)) - _ (&&module/add-import path) - ?module-hash (if (not already-compiled?) - (compile-module path) - (&&module/module-hash path)) - _ (if (= "" ex-alias) - (return nil) - (&&module/alias current-module ex-alias path))] - (return &/$Nil))))) + (&/without-repl + (&/save-module + (|do [already-compiled? (&&module/exists? path) + active? (&/active-module? path) + _ (&/assert! (not active?) + (str "[Analyser Error] Can't import a module that is mid-compilation: " path " @ " current-module)) + _ (&&module/add-import path) + ?module-hash (if (not already-compiled?) + (compile-module path) + (&&module/module-hash path)) + _ (if (= "" ex-alias) + (return nil) + (&&module/alias current-module ex-alias path))] + (return &/$Nil)))))) (defn ^:private coerce [new-type analysis] "(-> Type Analysis Analysis)" diff --git a/src/lux/base.clj b/src/lux/base.clj index 2f0425cbf..462bccd69 100644 --- a/src/lux/base.clj +++ b/src/lux/base.clj @@ -134,7 +134,8 @@ (defvariant ("Release" 0) ("Debug" 0) - ("Eval" 0)) + ("Eval" 0) + ("REPL" 0)) (deftuple ["compiler-name" @@ -811,12 +812,18 @@ ($Left msg) (fail* msg)))) -(defn ^:private is-eval? [mode] +(defn in-eval? [mode] "(-> CompilerMode Bool)" (|case mode ($Eval) true _ false)) +(defn in-repl? [mode] + "(-> CompilerMode Bool)" + (|case mode + ($REPL) true + _ false)) + (defn with-eval [body] (fn [state] (let [old-mode (->> state (get$ $info) (get$ $compiler-mode))] @@ -829,7 +836,11 @@ (def get-eval (fn [state] - (return* state (->> state (get$ $info) (get$ $compiler-mode) is-eval?)))) + (return* state (->> state (get$ $info) (get$ $compiler-mode) in-eval?)))) + +(def get-mode + (fn [state] + (return* state (->> state (get$ $info) (get$ $compiler-mode))))) (def get-writer (fn [state] @@ -915,6 +926,32 @@ (|tail %)) state)))))) +(defn without-repl-closure [body] + (|do [_mode get-mode] + (fn [state] + (let [output (body (if (in-repl? _mode) + (update$ $envs |tail state) + state))] + (|case output + ($Right state* datum) + (return* (set$ $envs (get$ $envs state) state*) datum) + + _ + output))))) + +(defn without-repl [body] + (|do [_mode get-mode] + (fn [state] + (let [output (body (if (in-repl? _mode) + (update$ $info #(set$ $compiler-mode $Debug %) state) + state))] + (|case output + ($Right state* datum) + (return* (update$ $info #(set$ $compiler-mode _mode %) state*) datum) + + _ + output))))) + (def get-scope-name (fn [state] (return* state (->> state (get$ $envs) |head (get$ $name))))) diff --git a/src/lux/compiler/lux.clj b/src/lux/compiler/lux.clj index 002bcc503..87113b538 100644 --- a/src/lux/compiler/lux.clj +++ b/src/lux/compiler/lux.clj @@ -225,7 +225,8 @@ def-type (-> def-class (.getField &/type-field) (.get nil)) def-meta ?meta def-value (-> def-class (.getField &/value-field) (.get nil))] - _ (&a-module/define module-name ?name def-type def-meta def-value)] + _ (&/without-repl-closure + (&a-module/define module-name ?name def-type def-meta def-value))] (return nil)) (fail (str "[Compilation Error] Aliases cannot contain meta-data: " module-name ";" ?name))) @@ -288,7 +289,8 @@ false]))) def-meta ?meta def-value (-> def-class (.getField &/value-field) (.get nil))] - _ (&a-module/define module-name ?name def-type def-meta def-value) + _ (&/without-repl-closure + (&a-module/define module-name ?name def-type def-meta def-value)) _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) [true (&/$Some (&/$ListM tags*))] (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) @@ -369,7 +371,8 @@ false]))) def-meta ?meta def-value (-> def-class (.getField &/value-field) (.get nil))] - _ (&a-module/define module-name ?name def-type def-meta def-value) + _ (&/without-repl-closure + (&a-module/define module-name ?name def-type def-meta def-value)) _ (|case (&/T [is-type? (&a-meta/meta-get &a-meta/tags-tag def-meta)]) [true (&/$Some (&/$ListM tags*))] (|do [:let [was-exported? (|case (&a-meta/meta-get &a-meta/export?-tag def-meta) diff --git a/src/lux/repl.clj b/src/lux/repl.clj index 0ffbdc1af..195f3dc3e 100644 --- a/src/lux/repl.clj +++ b/src/lux/repl.clj @@ -11,7 +11,9 @@ [analyser :as &analyser] [optimizer :as &optimizer] [compiler :as &compiler]) + [lux.compiler.cache :as &cache] [lux.analyser.base :as &a-base] + [lux.analyser.lux :as &a-lux] [lux.analyser.module :as &module]) (:import (java.io InputStreamReader BufferedReader))) @@ -19,31 +21,43 @@ ;; [Utils] (def ^:private repl-module "REPL") -(defn ^:private init [] +(defn ^:private repl-cursor [repl-line] + (&/T [repl-module repl-line 0])) + +(defn ^:private init [source-dirs] (do (&compiler/init!) - (|case ((|do [_ (&compiler/compile-module "lux")] - (&module/create-module repl-module 0)) - (&/init-state &/$Debug)) + (|case ((|do [_ (&compiler/compile-module source-dirs "lux") + _ (&cache/delete repl-module) + _ (&module/create-module repl-module 0) + _ (fn [?state] + (return* (&/set$ &/$source + (&/|list (&/T [(repl-cursor -1) "(;import lux)"])) + ?state) + nil)) + analysed-tokens (&analyser/repl-analyse &optimizer/optimize &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/all-compilers) + eval-values (->> analysed-tokens (&/|map &optimizer/optimize) (&/map% &compiler/eval!))] + (return nil)) + (&/init-state &/$REPL)) (&/$Right ?state _) (do (println) (println "Welcome to the REPL!") (println "Type \"exit\" to leave.") (println) - (&/set$ &/$source &/$Nil ?state)) + ?state) (&/$Left ?message) (assert false ?message)) )) -(defn ^:private repl-cursor [repl-line] - (&/T [repl-module repl-line 0])) - ;; [Values] (defn repl [source-dirs] (with-open [input (->> System/in (new InputStreamReader) (new BufferedReader))] - (loop [state (init) - repl-line 0] - (let [_ (.print System/out "> ") + (loop [state (init source-dirs) + repl-line 0 + multi-line? false] + (let [_ (if (not multi-line?) + (.print System/out "> ") + (.print System/out " ")) line (.readLine input)] (if (= "exit" line) (println "Till next time...") @@ -51,16 +65,8 @@ state* (&/update$ &/$source (fn [_source] (&/|++ _source line*)) state)] - (|case ((|do [analysed-tokens (&analyser/repl-analyse &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/all-compilers) - optimized-tokens (->> analysed-tokens - (&/|map &a-base/expr-term) - (&/map% &optimizer/optimize)) - :let [optimized-tokens* (&/->list (map (fn [analysis optim] - (|let [[[_type _cursor] _term] analysis] - (&a-base/|meta _type _cursor optim))) - (&/->seq analysed-tokens) - (&/->seq optimized-tokens)))] - eval-values (&/map% &compiler/eval! optimized-tokens*) + (|case ((|do [analysed-tokens (&analyser/repl-analyse &optimizer/optimize &compiler/eval! (partial &compiler/compile-module source-dirs) &compiler/all-compilers) + eval-values (->> analysed-tokens (&/|map &optimizer/optimize) (&/map% &compiler/eval!)) :let [outputs (map (fn [analysis value] (|let [[[_type _cursor] _term] analysis] [_type value])) @@ -70,14 +76,14 @@ state*) (&/$Right state** outputs) (do (doseq [[_type _value] outputs] - (.println System/out (str "=> " (&type/show-type _type) "\n" (pr-str _value) "\n"))) - (recur state** (inc repl-line))) + (.println System/out (str "=> " (pr-str _value) "\n:: " (&type/show-type _type)"\n"))) + (recur state** (inc repl-line) false)) (&/$Left ^String ?message) (if (or (= "[Reader Error] EOF" ?message) (.contains ?message "[Parser Error] Unbalanced ")) - (recur state* (inc repl-line)) + (recur state* (inc repl-line) true) (do (println ?message) - (recur state (inc repl-line)))) + (recur state (inc repl-line) false))) )))) ))) |