aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/lux/analyser.clj13
-rw-r--r--src/lux/analyser/base.clj4
-rw-r--r--src/lux/analyser/lux.clj51
-rw-r--r--src/lux/base.clj43
-rw-r--r--src/lux/compiler/lux.clj9
-rw-r--r--src/lux/repl.clj56
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)))
))))
)))