aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/lux/analyser/def.clj29
-rw-r--r--src/lux/analyser/env.clj16
-rw-r--r--src/lux/analyser/lambda.clj10
-rw-r--r--src/lux/analyser/lux.clj20
-rw-r--r--src/lux/base.clj104
-rw-r--r--src/lux/compiler.clj6
-rw-r--r--src/lux/reader.clj8
-rw-r--r--src/lux/type.clj24
8 files changed, 122 insertions, 95 deletions
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
index a2d70c938..779afb683 100644
--- a/src/lux/analyser/def.clj
+++ b/src/lux/analyser/def.clj
@@ -5,24 +5,29 @@
(lux [base :as & :refer [|do return return* fail]])
[lux.analyser.base :as &&]))
+(def $DEFS 0)
+(def $MACROS 1)
+
;; [Exports]
(def init-module
- (&/R "lux;defs" (&/|table)
- "lux;macros" (&/|table)))
+ (&/R ;; "lux;defs"
+ (&/|table)
+ ;; "lux;macros"
+ (&/|table)))
(do-template [<name> <category>]
(defn <name> [module name]
(fn [state]
(return* state
- (->> state (&/get$ "lux;modules") (&/|get module) (&/get$ <category>) (&/|contains? name)))))
+ (->> state (&/get$ &/$MODULES) (&/|get module) (&/get$ <category>) (&/|contains? name)))))
- defined? "lux;defs"
- macro? "lux;macros"
+ defined? $DEFS
+ macro? $MACROS
)
(defn declare-macro [module name]
(fn [state]
- (return* (&/update$ "lux;modules" (fn [ms] (&/|update module (fn [m] (&/update$ "lux;macros" #(&/|put name true %) m)) ms)) state)
+ (return* (&/update$ &/$MODULES (fn [ms] (&/|update module (fn [m] (&/update$ $MACROS #(&/|put name true %) m)) ms)) state)
nil)))
(defn define [module name type]
@@ -32,13 +37,13 @@
(matchv ::M/objects [(&/get$ &/$ENVS state)]
[["lux;Cons" [?env ["lux;Nil" _]]]]
(return* (->> state
- (&/update$ "lux;modules" (fn [ms]
+ (&/update$ &/$MODULES (fn [ms]
(&/|update module (fn [m]
- (&/update$ "lux;defs" #(&/|put full-name type %)
+ (&/update$ $DEFS #(&/|put full-name type %)
m))
ms)))
- (&/set$ &/$ENVS (&/|list (&/update$ "lux;locals" (fn [locals]
- (&/update$ "lux;mappings" (fn [mappings]
+ (&/set$ &/$ENVS (&/|list (&/update$ &/$LOCALS (fn [locals]
+ (&/update$ &/$MAPPINGS (fn [mappings]
(&/|put full-name bound mappings))
locals))
?env))))
@@ -51,10 +56,10 @@
(defn module-exists? [name]
(fn [state]
(return* state
- (->> state (&/get$ "lux;modules") (&/|contains? name)))))
+ (->> state (&/get$ &/$MODULES) (&/|contains? name)))))
(defn unalias-module [name]
(fn [state]
- (if-let [real-name (->> state (&/get$ "lux;module-aliases") (&/|get name))]
+ (if-let [real-name (->> state (&/get$ &/$MODULE-ALIASES) (&/|get name))]
(return* state real-name)
(fail "Unknown alias."))))
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index 4c78c4faf..52743879d 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -7,26 +7,26 @@
;; [Exports]
(def next-local-idx
(fn [state]
- (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ "lux;locals") (&/get$ "lux;counter")))))
+ (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))))
(defn with-local [name type body]
;; (prn 'with-local name)
(fn [state]
- (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings"))
+ (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS))
=return (body (&/update$ &/$ENVS
(fn [stack]
- (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ "lux;locals") (&/get$ "lux;counter")))]
+ (let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ &/$LOCALS) (&/get$ &/$COUNTER)))]
(&/|cons (->> (&/|head stack)
- (&/update$ "lux;locals" #(&/update$ "lux;counter" inc %))
- (&/update$ "lux;locals" #(&/update$ "lux;mappings" (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
+ (&/update$ &/$LOCALS #(&/update$ &/$COUNTER inc %))
+ (&/update$ &/$LOCALS #(&/update$ &/$MAPPINGS (fn [m] (&/|put name (&/V "Expression" (&/T bound-unit type)) m)) %)))
(&/|tail stack))))
state))]
(matchv ::M/objects [=return]
[["lux;Right" [?state ?value]]]
(return* (&/update$ &/$ENVS (fn [stack*]
(&/|cons (->> (&/|head stack*)
- (&/update$ "lux;locals" #(&/update$ "lux;counter" dec %))
- (&/update$ "lux;locals" #(&/set$ "lux;mappings" old-mappings %)))
+ (&/update$ &/$LOCALS #(&/update$ &/$COUNTER dec %))
+ (&/update$ &/$LOCALS #(&/set$ &/$MAPPINGS old-mappings %)))
(&/|tail stack*)))
?state)
?value)
@@ -42,4 +42,4 @@
(def captured-vars
(fn [state]
- (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings")))))
+ (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS)))))
diff --git a/src/lux/analyser/lambda.clj b/src/lux/analyser/lambda.clj
index da9d6b044..59df63b20 100644
--- a/src/lux/analyser/lambda.clj
+++ b/src/lux/analyser/lambda.clj
@@ -25,16 +25,16 @@
;; (&host/location scope)
;; (&host/location (&/|list ident))
;; register
- ;; (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter")))
+ ;; (->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER)))
(matchv ::M/objects [register]
[["Expression" [_ register-type]]]
(|let [register* (&/V "Expression" (&/T (&/V "captured" (&/T scope
- (->> frame (&/get$ "lux;closure") (&/get$ "lux;counter"))
+ (->> frame (&/get$ &/$CLOSURE) (&/get$ &/$COUNTER))
register))
register-type))
[?module ?name] ident
full-name (str ?module ";" ?name)]
- (&/T register* (&/update$ "lux;closure" #(->> %
- (&/update$ "lux;counter" inc)
- (&/update$ "lux;mappings" (fn [mps] (&/|put full-name register* mps))))
+ (&/T register* (&/update$ &/$CLOSURE #(->> %
+ (&/update$ &/$COUNTER inc)
+ (&/update$ &/$MAPPINGS (fn [mps] (&/|put full-name register* mps))))
frame)))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index 74654fb75..28b25a492 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -91,7 +91,7 @@
(return (&/|list (&/V "Expression" (&/T (&/V "lux;record" =elems) (&/V "lux;RecordT" =elems-types)))))))
(defn ^:private show-frame [frame]
- (str "{{" (->> frame (&/get$ "lux;locals") (&/get$ "lux;mappings")
+ (str "{{" (->> frame (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS)
&/|keys &/->seq (interpose " ") (reduce str ""))
"}}"))
@@ -114,17 +114,17 @@
local-ident (str ?module ";" ?name)
global-ident (str (if (= "" ?module) module-name ?module) ";" ?name)
stack (&/get$ &/$ENVS state)
- no-binding? #(and (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? local-ident) not)
- (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? local-ident) not)
- (->> % (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|contains? global-ident) not)
- (->> % (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|contains? global-ident) not))
+ no-binding? #(and (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)
+ (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? local-ident) not)
+ (->> % (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|contains? global-ident) not)
+ (->> % (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|contains? global-ident) not))
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
(fail* (str "[Analyser Error] Unrecognized identifier: " local-ident))
[["lux;Cons" [?genv ["lux;Nil" _]]]]
- (if-let [global (->> ?genv (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get global-ident))]
+ (if-let [global (->> ?genv (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get global-ident))]
(&/run-state (type-test exo-type global)
;; (|do [btype (&&/expr-type global)
;; _ (&type/check exo-type btype)]
@@ -133,16 +133,16 @@
(fail* ""))
[["lux;Cons" [top-outer _]]]
- (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1)
- (&/|map #(&/get$ "lux;name" %) outer)
+ (|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ &/$NAME %2) %1)
+ (&/|map #(&/get$ &/$NAME %) outer)
(&/|reverse inner)))
[=local inner*] (&/fold (fn [register+new-inner frame+in-scope]
(|let [[register new-inner] register+new-inner
[frame in-scope] frame+in-scope
[register* frame*] (&&lambda/close-over (&/|cons module-name (&/|reverse in-scope)) ident register frame)]
(&/T register* (&/|cons frame* new-inner))))
- (&/T (or (->> top-outer (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get local-ident))
- (->> top-outer (&/get$ "lux;closure") (&/get$ "lux;mappings") (&/|get local-ident)))
+ (&/T (or (->> top-outer (&/get$ &/$LOCALS) (&/get$ &/$MAPPINGS) (&/|get local-ident))
+ (->> top-outer (&/get$ &/$CLOSURE) (&/get$ &/$MAPPINGS) (&/|get local-ident)))
(&/|list))
(&/zip2 (&/|reverse inner) scopes))]
(&/run-state (type-test exo-type =local)
diff --git a/src/lux/base.clj b/src/lux/base.clj
index 6c4c8e145..6a4d93007 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -4,11 +4,28 @@
clojure.core.match.array))
;; [Fields]
-(def $WRITER "lux;writer")
-(def $LOADER "lux;loader")
-(def $EVAL-CTOR "lux;eval-ctor")
-(def $HOST "lux;host")
-(def $ENVS "lux;envs")
+;; Binding
+(def $COUNTER 0)
+(def $MAPPINGS 1)
+
+;; Env
+(def $CLOSURE 0)
+(def $INNER-CLOSURES 1)
+(def $LOCALS 2)
+(def $NAME 3)
+
+;; Host
+(def $EVAL-CTOR 0)
+(def $LOADER 1)
+(def $WRITER 2)
+
+;; CompilerState
+(def $ENVS 0)
+(def $HOST 1)
+(def $MODULE-ALIASES 2)
+(def $MODULES 3)
+(def $SOURCE 4)
+(def $TYPES 5)
;; [Exports]
(def +name-separator+ ";")
@@ -23,25 +40,13 @@
(to-array kvs))
(defn get$ [slot record]
- ;; (prn 'get$ slot)
- (let [size (alength record)]
- (loop [idx 0]
- (if (< idx size)
- (if (= slot (aget record idx))
- (aget record (+ 1 idx))
- (recur (+ 2 idx)))
- (assert false)))))
+ (aget record slot))
(defn set$ [slot value record]
- (let [record (aclone record)
+ (let [record* (aclone record)
size (alength record)]
- (loop [idx 0]
- (if (< idx size)
- (if (= slot (aget record idx))
- (doto record
- (aset (+ 1 idx) value))
- (recur (+ 2 idx)))
- (assert false)))))
+ (aset record* slot value)
+ record*))
(defmacro update$ [slot f record]
`(let [record# ~record]
@@ -440,7 +445,7 @@
(def source-consumed?
(fn [state]
- (matchv ::M/objects [(get$ "lux;source" state)]
+ (matchv ::M/objects [(get$ $SOURCE state)]
[["lux;None" _]]
(fail* "No source code.")
@@ -525,27 +530,44 @@
(return* state (->> state (get$ $HOST) (get$ $LOADER)))))
(def +init-bindings+
- (R "lux;counter" 0
- "lux;mappings" (|table)))
+ (R ;; "lux;counter"
+ 0
+ ;; "lux;mappings"
+ (|table)))
(defn env [name]
- (R "lux;name" name
- "lux;inner-closures" 0
- "lux;locals" +init-bindings+
- "lux;closure" +init-bindings+))
+ (R ;; "lux;closure"
+ +init-bindings+
+ ;; "lux;inner-closures"
+ 0
+ ;; "lux;locals"
+ +init-bindings+
+ ;; "lux;name"
+ name
+ ))
(defn host [_]
- (R $WRITER (V "lux;None" nil)
- $LOADER (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)
- $EVAL-CTOR 0))
+ (R ;; "lux;eval-ctor"
+ 0
+ ;; "lux;loader"
+ (-> (java.io.File. "./output/") .toURL vector into-array java.net.URLClassLoader.)
+ ;; "lux;writer"
+ (V "lux;None" nil)))
(defn init-state [_]
- (R "lux;source" (V "lux;None" nil)
- "lux;modules" (|table)
- "lux;module-aliases" (|table)
- $ENVS (|list)
- "lux;types" +init-bindings+
- $HOST (host nil)))
+ (R ;; "lux;envs"
+ (|list)
+ ;; "lux;host"
+ (host nil)
+ ;; "lux;module-aliases"
+ (|table)
+ ;; "lux;modules"
+ (|table)
+ ;; "lux;source"
+ (V "lux;None" nil)
+ ;; "lux;types"
+ +init-bindings+
+ ))
(defn from-some [some]
(matchv ::M/objects [some]
@@ -604,7 +626,7 @@
(fail* "[Analyser Error] Can't get the module-name without a module.")
[["lux;Cons" [?global _]]]
- (return* state (get$ "lux;name" ?global)))))
+ (return* state (get$ $NAME ?global)))))
(defn with-scope [name body]
(fn [state]
@@ -621,18 +643,18 @@
(defn with-closure [body]
(|do [closure-name (|do [top get-top-local-env]
- (return (->> top (get$ "lux;inner-closures") str)))]
+ (return (->> top (get$ $INNER-CLOSURES) str)))]
(fn [state]
(let [body* (with-scope closure-name
body)]
- (run-state body* (update$ $ENVS #(|cons (update$ "lux;inner-closures" inc (|head %))
+ (run-state body* (update$ $ENVS #(|cons (update$ $INNER-CLOSURES inc (|head %))
(|tail %))
state))))))
(def get-scope-name
(|do [module-name get-module-name]
(fn [state]
- (return* state (->> state (get$ $ENVS) (|map #(get$ "lux;name" %)) |reverse (|cons module-name))))))
+ (return* state (->> state (get$ $ENVS) (|map #(get$ $NAME %)) |reverse (|cons module-name))))))
(defn with-writer [writer body]
(fn [state]
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 471fcda77..7bd31779a 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -366,16 +366,16 @@
)]
(defn ^:private compile-module [name]
(fn [state]
- (if (->> state (&/get$ "lux;modules") (&/|contains? name))
+ (if (->> state (&/get$ &/$MODULES) (&/|contains? name))
(fail "[Compiler Error] Can't redefine a module!")
(let [=class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS)
(.visit Opcodes/V1_5 (+ Opcodes/ACC_PUBLIC Opcodes/ACC_SUPER)
(&host/->class name) nil "java/lang/Object" nil))]
(matchv ::M/objects [(&/run-state (&/exhaust% compiler-step) (->> state
- (&/set$ "lux;source" (&/V "lux;Some" (&reader/from (str "source/" name ".lux"))))
+ (&/set$ &/$SOURCE (&/V "lux;Some" (&reader/from (str "source/" name ".lux"))))
(&/set$ &/$ENVS (&/|list (&/env name)))
(&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
- (&/update$ "lux;modules" #(&/|put name &a-def/init-module %))))]
+ (&/update$ &/$MODULES #(&/|put name &a-def/init-module %))))]
[["lux;Right" [?state _]]]
(do (.visitEnd =class)
;; (prn 'compile-module 'DONE name)
diff --git a/src/lux/reader.clj b/src/lux/reader.clj
index d5d7b453c..2eacdafcc 100644
--- a/src/lux/reader.clj
+++ b/src/lux/reader.clj
@@ -7,7 +7,7 @@
;; [Utils]
(defn ^:private with-line [body]
(fn [state]
- (matchv ::M/objects [(&/get$ "lux;source" state)]
+ (matchv ::M/objects [(&/get$ &/$SOURCE state)]
[["lux;None" _]]
(fail* "[Reader Error] No source code.")
@@ -21,11 +21,11 @@
(fail* msg)
[["Yes" [meta ["lux;None" _]]]]
- (return* (&/set$ "lux;source" (&/V "lux;Some" more) state)
+ (return* (&/set$ &/$SOURCE (&/V "lux;Some" more) state)
meta)
[["Yes" [meta ["lux;Some" line-meta]]]]
- (return* (&/set$ "lux;source" (&/V "lux;Some" (&/|cons line-meta more)) state)
+ (return* (&/set$ &/$SOURCE (&/V "lux;Some" (&/|cons line-meta more)) state)
meta))
)))
@@ -87,7 +87,7 @@
(def current-line
(fn [state]
- (matchv ::M/objects [(&/get$ "lux;source" state)]
+ (matchv ::M/objects [(&/get$ &/$SOURCE state)]
[["lux;None" _]]
(fail* "[Reader Error] No source code.")
diff --git a/src/lux/type.clj b/src/lux/type.clj
index 1e64bc235..35190da27 100644
--- a/src/lux/type.clj
+++ b/src/lux/type.clj
@@ -45,7 +45,7 @@
(defn bound? [id]
(fn [state]
- (if-let [type* (->> state (&/get$ "lux;types") (&/get$ "lux;mappings") (&/|get id))]
+ (if-let [type* (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
(matchv ::M/objects [type*]
[["lux;Some" _]]
(return* state true)
@@ -56,7 +56,7 @@
(defn deref [id]
(fn [state]
- (let [mappings (->> state (&/get$ "lux;types") (&/get$ "lux;mappings"))]
+ (let [mappings (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS))]
(do ;; (prn 'deref/mappings (&/->seq (&/|keys mappings)))
(if-let [type* (->> mappings (&/|get id))]
(do ;; (prn 'deref/type* (aget type* 0))
@@ -70,14 +70,14 @@
(defn set-var [id type]
(fn [state]
- (if-let [tvar (->> state (&/get$ "lux;types") (&/get$ "lux;mappings") (&/|get id))]
+ (if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
(do ;; (prn 'set-var (aget tvar 0))
(matchv ::M/objects [tvar]
[["lux;Some" bound]]
(fail* (str "[Type Error] Can't rebind type var: " id " | Current type: " (show-type bound)))
[["lux;None" _]]
- (return* (&/update$ "lux;types" (fn [ts] (&/update$ "lux;mappings" #(&/|put id (&/V "lux;Some" type) %)
+ (return* (&/update$ &/$TYPES (fn [ts] (&/update$ &/$MAPPINGS #(&/|put id (&/V "lux;Some" type) %)
ts))
state)
nil)))
@@ -87,20 +87,20 @@
;; Type vars
(def ^:private create-var
(fn [state]
- (let [id (->> state (&/get$ "lux;types") (&/get$ "lux;counter"))]
- (return* (&/update$ "lux;types" #(->> %
- (&/update$ "lux;counter" inc)
- (&/update$ "lux;mappings" (fn [ms] (&/|put id (&/V "lux;None" nil) ms))))
+ (let [id (->> state (&/get$ &/$TYPES) (&/get$ &/$COUNTER))]
+ (return* (&/update$ &/$TYPES #(->> %
+ (&/update$ &/$COUNTER inc)
+ (&/update$ &/$MAPPINGS (fn [ms] (&/|put id (&/V "lux;None" nil) ms))))
state)
id))))
(defn ^:private delete-var [id]
(fn [state]
;; (prn 'delete-var id)
- (if-let [tvar (->> state (&/get$ "lux;types") (&/get$ "lux;mappings") (&/|get id))]
- (return* (&/update$ "lux;types" #(->> %
- (&/update$ "lux;counter" dec)
- (&/update$ "lux;mappings" (fn [ms] (&/|remove id ms))))
+ (if-let [tvar (->> state (&/get$ &/$TYPES) (&/get$ &/$MAPPINGS) (&/|get id))]
+ (return* (&/update$ &/$TYPES #(->> %
+ (&/update$ &/$COUNTER dec)
+ (&/update$ &/$MAPPINGS (fn [ms] (&/|remove id ms))))
state)
nil)
(fail* (str "[Type Error] Unknown type-var: " id)))))