aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/lux/analyser.clj9
-rw-r--r--src/lux/analyser/case.clj5
-rw-r--r--src/lux/analyser/host.clj42
-rw-r--r--src/lux/analyser/lux.clj4
-rw-r--r--src/lux/base.clj64
-rw-r--r--src/lux/compiler.clj2
6 files changed, 58 insertions, 68 deletions
diff --git a/src/lux/analyser.clj b/src/lux/analyser.clj
index 9097168e2..f4c7cce86 100644
--- a/src/lux/analyser.clj
+++ b/src/lux/analyser.clj
@@ -101,18 +101,23 @@
["lux;Nil" _]]]]]]]]]
(&&lux/analyse-import analyse ?path)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-check analyse eval! exo-type ?type ?value)
- [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!"]]]]
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":!'"]]]]
["lux;Cons" [?type
["lux;Cons" [?value
["lux;Nil" _]]]]]]]]]]]
(&&lux/analyse-coerce analyse eval! ?type ?value)
+ [["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "export'"]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ?ident]]]
+ ["lux;Nil" _]]]]]]]]]
+ (&&lux/analyse-export analyse ?ident)
+
;; Host special forms
;; Integer arithmetic
[["lux;Meta" [meta ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" "jvm-iadd"]]]] ["lux;Cons" [?y ["lux;Cons" [?x ["lux;Nil" _]]]]]]]]]]]
diff --git a/src/lux/analyser/case.clj b/src/lux/analyser/case.clj
index e1f5c4c84..0c459f0de 100644
--- a/src/lux/analyser/case.clj
+++ b/src/lux/analyser/case.clj
@@ -205,8 +205,9 @@
(defn ^:private check-totality [value-type struct]
;; (prn 'check-totality (aget value-type 0) (aget struct 0) (&type/show-type value-type))
(matchv ::M/objects [struct]
- [["BoolTotal" [?total _]]]
- (return ?total)
+ [["BoolTotal" [?total ?values]]]
+ (return (or ?total
+ (= #{true false} (set (&/->seq ?values)))))
[["IntTotal" [?total _]]]
(return ?total)
diff --git a/src/lux/analyser/host.clj b/src/lux/analyser/host.clj
index 299471ee8..7b27a2a92 100644
--- a/src/lux/analyser/host.clj
+++ b/src/lux/analyser/host.clj
@@ -167,27 +167,27 @@
(defn analyse-jvm-interface [analyse ?name ?members]
;; (prn 'analyse-jvm-interface ?name ?members)
(|do [=members (&/map% (fn [member]
- ;; (prn 'analyse-jvm-interface (&/show-ast member))
- (matchv ::M/objects [member]
- [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ":"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?member-name]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]]
- ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]]
- ["lux;Nil" _]]]]]]]]]]
- ["lux;Nil" _]]]]]]]]]]]
- (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
- (|do [inputs* (&/map% extract-ident ?inputs)]
- (return [?member-name [inputs* ?output]])))
-
- [_]
- (fail "[Analyser Error] Invalid method signature!")))
- ?members)
- :let [;; _ (prn '=members =members)
- =methods (into {} (for [[method [inputs output]] (&/->seq =members)]
- [method {:access :public
- :type [inputs output]}]))]
- $module &/get-module-name]
+ ;; (prn 'analyse-jvm-interface (&/show-ast member))
+ (matchv ::M/objects [member]
+ [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" ["" ":'"]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Form" ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ "->"]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Tuple" ?inputs]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?output]]]]
+ ["lux;Nil" _]]]]]]]]]]
+ ["lux;Cons" [["lux;Meta" [_ ["lux;Symbol" [_ ?member-name]]]]
+ ["lux;Nil" _]]]]]]]]]]]
+ (do ;; (prn 'analyse-jvm-interface ?member-name ?inputs ?output)
+ (|do [inputs* (&/map% extract-ident ?inputs)]
+ (return [?member-name [inputs* ?output]])))
+
+ [_]
+ (fail "[Analyser Error] Invalid method signature!")))
+ ?members)
+ :let [;; _ (prn '=members =members)
+ =methods (into {} (for [[method [inputs output]] (&/->seq =members)]
+ [method {:access :public
+ :type [inputs output]}]))]
+ $module &/get-module-name]
(return (&/|list (&/V "Statement" (&/V "jvm-interface" (&/T $module ?name =methods)))))))
(defn analyse-jvm-try [analyse ?body [?catches ?finally]]
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 68d612db6..b22b1932a 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -297,7 +297,9 @@
(fail "Can't declare macros from foreign modules."))))
(defn analyse-import [analyse exo-type ?path]
- (assert false)
+ (return (&/|list)))
+
+(defn analyse-export [analyse ?ident]
(return (&/|list)))
(defn analyse-check [analyse eval! exo-type ?type ?value]
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 6771c9290..e989b681e 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -3,6 +3,12 @@
[clojure.core.match :as M :refer [matchv]]
clojure.core.match.array))
+;; [Fields]
+(def $WRITER "lux;writer")
+(def $LOADER "lux;loader")
+(def $EVAL-CTOR "lux;eval-ctor")
+(def $HOST "lux;host")
+
;; [Exports]
(def +name-separator+ ";")
@@ -16,6 +22,7 @@
(to-array kvs))
(defn get$ [slot record]
+ ;; (prn 'get$ slot)
(let [size (alength record)]
(loop [idx 0]
(if (< idx size)
@@ -514,7 +521,7 @@
(def loader
(fn [state]
- (return* state (get$ "lux;loader" state))))
+ (return* state (->> state (get$ $HOST) (get$ $LOADER)))))
(def +init-bindings+
(R "lux;counter" 0
@@ -526,6 +533,11 @@
"lux;locals" +init-bindings+
"lux;closure" +init-bindings+))
+(defn host [_]
+ (R $WRITER (V "lux;None" nil)
+ $LOADER (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)
+ $EVAL-CTOR 0))
+
(defn init-state [_]
(R "lux;source" (V "lux;None" nil)
"lux;modules" (|table)
@@ -533,9 +545,7 @@
"lux;global-env" (V "lux;None" nil)
"lux;local-envs" (|list)
"lux;types" +init-bindings+
- "lux;writer" (V "lux;None" nil)
- "lux;loader" (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)
- "lux;eval-ctor" 0))
+ $HOST (host nil)))
(defn from-some [some]
(matchv ::M/objects [some]
@@ -545,43 +555,14 @@
[_]
(assert false)))
-(defn show-state [state]
- (let [source (get$ "lux;source" state)
- modules (get$ "lux;modules" state)
- global-env (get$ "lux;global-env" state)
- local-envs (get$ "lux;local-envs" state)
- types (get$ "lux;types" state)
- writer (get$ "lux;writer" state)
- loader (get$ "lux;loader" state)
- eval-ctor (get$ "lux;eval-ctor" state)]
- (str "{"
- (->> (for [slot ["lux;source", "lux;modules", "lux;global-env", "lux;local-envs", "lux;types", "lux;writer", "lux;loader", "lux;eval-ctor"]
- :let [value (get$ slot state)]]
- (str "#" slot " " (case slot
- "lux;source" "???"
- "lux;modules" "???"
- "lux;global-env" (->> value from-some (get$ "lux;locals") (get$ "lux;mappings") show-table)
- "lux;local-envs" (str "("
- (->> value
- (|map #(->> % (get$ "lux;locals") (get$ "lux;mappings") show-table))
- (|interpose " ")
- (fold str ""))
- ")")
- "lux;types" "???"
- "lux;writer" "???"
- "lux;loader" "???"
- "lux;eval-ctor" value)))
- (interpose " ")
- (reduce str ""))
- "}")))
-
(def get-eval-ctor
(fn [state]
- (return* (update$ "lux;eval-ctor" inc state) (get$ "lux;eval-ctor" state))))
+ (return* (update$ $HOST #(update$ $EVAL-CTOR inc %) state)
+ (get$ $EVAL-CTOR (get$ $HOST state)))))
(def get-writer
(fn [state]
- (let [writer* (get$ "lux;writer" state)]
+ (let [writer* (->> state (get$ $HOST) (get$ $WRITER))]
;; (prn 'get-writer (class writer*))
;; (prn 'get-writer (aget writer* 0))
(matchv ::M/objects [writer*]
@@ -643,9 +624,9 @@
(defn with-closure [body]
(|do [closure-info (try-all% (|list (|do [top get-top-local-env]
- (return (T true (->> top (get$ "lux;inner-closures") str))))
- (|do [global get-current-module-env]
- (return (T false (->> global (get$ "lux;inner-closures") str))))))]
+ (return (T true (->> top (get$ "lux;inner-closures") str))))
+ (|do [global get-current-module-env]
+ (return (T false (->> global (get$ "lux;inner-closures") str))))))]
(matchv ::M/objects [closure-info]
[[local? closure-name]]
(fn [state]
@@ -671,10 +652,11 @@
(defn with-writer [writer body]
(fn [state]
- (let [output (body (set$ "lux;writer" (V "lux;Some" writer) state))]
+ (let [output (body (update$ $HOST #(set$ $WRITER (V "lux;Some" writer) %) state))]
(matchv ::M/objects [output]
[["lux;Right" [?state ?value]]]
- (return* (set$ "lux;writer" (get$ "lux;writer" state) ?state) ?value)
+ (return* (update$ $HOST #(set$ $WRITER (->> state (get$ $HOST) (get$ $WRITER)) %) ?state)
+ ?value)
[_]
output))))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 9576fc1a2..410b11abf 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -374,7 +374,7 @@
(matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state
(&/set$ "lux;source" (&/V "lux;Some" (&reader/from (str "source/" name ".lux"))))
(&/set$ "lux;global-env" (&/V "lux;Some" (&/env name)))
- (&/set$ "lux;writer" (&/V "lux;Some" =class))
+ (&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
(&/update$ "lux;modules" #(&/|put name &a-def/init-module %))))]
[["lux;Right" [?state _]]]
(do (.visitEnd =class)