aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--source/lux.lux40
-rw-r--r--src/lux/analyser/def.clj33
-rw-r--r--src/lux/analyser/env.clj10
-rw-r--r--src/lux/analyser/lux.clj16
-rw-r--r--src/lux/base.clj67
-rw-r--r--src/lux/compiler.clj2
6 files changed, 80 insertions, 88 deletions
diff --git a/source/lux.lux b/source/lux.lux
index 8816589e7..a005da3da 100644
--- a/source/lux.lux
+++ b/source/lux.lux
@@ -136,28 +136,33 @@
Text])])))
(export' Reader)
+## (deftype HostState
+## (& #writer (^ org.objectweb.asm.ClassWriter)
+## #loader (^ java.net.URLClassLoader)
+## #eval-ctor Int))
+(def' HostState
+ (:' Type
+ (#RecordT (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
+ (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
+ (#Cons [["lux;eval-ctor" Int]
+ #Nil])])]))))
+
## (deftype CompilerState
## (& #source (Maybe Reader)
## #modules (List Any)
## #module-aliases (List Any)
-## #global-env (Maybe (Env Text Any))
-## #local-envs (List (Env Text Any))
+## #envs (List (Env Text Any))
## #types (Bindings Int Type)
-## #writer (^ org.objectweb.asm.ClassWriter)
-## #loader (^ java.net.URLClassLoader)
-## #eval-ctor Int))
+## #host HostState))
(def' CompilerState
(:' Type
- (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])]
- (#Cons [["lux;modules" (#AppT [List Any])]
- (#Cons [["lux;module-aliases" (#AppT [List Any])]
- (#Cons [["lux;global-env" (#AppT [Maybe (#AppT [(#AppT [Env Text]) Any])])]
- (#Cons [["lux;local-envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])]
- (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
- (#Cons [["lux;writer" (#DataT "org.objectweb.asm.ClassWriter")]
- (#Cons [["lux;loader" (#DataT "java.lang.ClassLoader")]
- (#Cons [["lux;eval-ctor" Int]
- #Nil])])])])])])])])]))))
+ (#RecordT (#Cons [["lux;source" (#AppT [Maybe Reader])]
+ (#Cons [["lux;modules" (#AppT [List Any])]
+ (#Cons [["lux;module-aliases" (#AppT [List Any])]
+ (#Cons [["lux;envs" (#AppT [List (#AppT [(#AppT [Env Text]) Any])])]
+ (#Cons [["lux;types" (#AppT [(#AppT [Bindings Int]) Type])]
+ (#Cons [["lux;host" HostState]
+ #Nil])])])])])]))))
(export' CompilerState)
## (deftype (Syntax' w)
@@ -819,8 +824,7 @@
## (& #source (Maybe Reader)
## #modules (List Any)
## #module-aliases (List Any)
-## #global-env (Maybe (Env Text Any))
-## #local-envs (List (Env Text Any))
+## #envs (List (Env Text Any))
## #types (Bindings Int Type)
## #writer (^ org.objectweb.asm.ClassWriter)
## #loader (^ java.net.URLClassLoader)
@@ -839,7 +843,7 @@
## (let [[module name] ident]
## (case' state
## {#source source #modules modules #module-aliases module-aliases
-## #global-env global-env #local-envs local-envs #types types
+## #envs envs #types types
## #writer writer #loader loader #eval-ctor eval-ctor}
## (when-let [bindings (get module modules)
## bound (get name bindings)]
diff --git a/src/lux/analyser/def.clj b/src/lux/analyser/def.clj
index eb637f66b..a2d70c938 100644
--- a/src/lux/analyser/def.clj
+++ b/src/lux/analyser/def.clj
@@ -29,21 +29,24 @@
(fn [state]
(let [full-name (str module &/+name-separator+ name)
bound (&/V "Expression" (&/T (&/V "global" (&/T module name)) type))]
- (return* (->> state
- (&/update$ "lux;modules" (fn [ms] (&/|update module (fn [m] (&/update$ "lux;defs" #(&/|put name type %) m)) ms)))
- (&/update$ "lux;global-env" #(matchv ::M/objects [%]
- [["lux;None" _]]
- (assert false)
-
- [["lux;Some" table]]
- (&/V "lux;Some" (&/update$ "lux;locals" (fn [locals]
- (&/update$ "lux;mappings" (fn [mappings]
- (&/|merge (&/|table full-name bound, name bound)
- mappings))
- locals))
- table))
- )))
- nil))))
+ (matchv ::M/objects [(&/get$ &/$ENVS state)]
+ [["lux;Cons" [?env ["lux;Nil" _]]]]
+ (return* (->> state
+ (&/update$ "lux;modules" (fn [ms]
+ (&/|update module (fn [m]
+ (&/update$ "lux;defs" #(&/|put full-name type %)
+ m))
+ ms)))
+ (&/set$ &/$ENVS (&/|list (&/update$ "lux;locals" (fn [locals]
+ (&/update$ "lux;mappings" (fn [mappings]
+ (&/|put full-name bound mappings))
+ locals))
+ ?env))))
+ nil)
+
+ [_]
+ (fail "[Analyser Error] Can't create a new global definition outside of a global environment."))
+ )))
(defn module-exists? [name]
(fn [state]
diff --git a/src/lux/analyser/env.clj b/src/lux/analyser/env.clj
index a083801ed..4c78c4faf 100644
--- a/src/lux/analyser/env.clj
+++ b/src/lux/analyser/env.clj
@@ -7,13 +7,13 @@
;; [Exports]
(def next-local-idx
(fn [state]
- (return* state (->> state (&/get$ "lux;local-envs") &/|head (&/get$ "lux;locals") (&/get$ "lux;counter")))))
+ (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ "lux;locals") (&/get$ "lux;counter")))))
(defn with-local [name type body]
;; (prn 'with-local name)
(fn [state]
- (let [old-mappings (->> state (&/get$ "lux;local-envs") &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings"))
- =return (body (&/update$ "lux;local-envs"
+ (let [old-mappings (->> state (&/get$ &/$ENVS) &/|head (&/get$ "lux;locals") (&/get$ "lux;mappings"))
+ =return (body (&/update$ &/$ENVS
(fn [stack]
(let [bound-unit (&/V "local" (->> (&/|head stack) (&/get$ "lux;locals") (&/get$ "lux;counter")))]
(&/|cons (->> (&/|head stack)
@@ -23,7 +23,7 @@
state))]
(matchv ::M/objects [=return]
[["lux;Right" [?state ?value]]]
- (return* (&/update$ "lux;local-envs" (fn [stack*]
+ (return* (&/update$ &/$ENVS (fn [stack*]
(&/|cons (->> (&/|head stack*)
(&/update$ "lux;locals" #(&/update$ "lux;counter" dec %))
(&/update$ "lux;locals" #(&/set$ "lux;mappings" old-mappings %)))
@@ -42,4 +42,4 @@
(def captured-vars
(fn [state]
- (return* state (->> state (&/get$ "lux;local-envs") &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings")))))
+ (return* state (->> state (&/get$ &/$ENVS) &/|head (&/get$ "lux;closure") (&/get$ "lux;mappings")))))
diff --git a/src/lux/analyser/lux.clj b/src/lux/analyser/lux.clj
index b22b1932a..74654fb75 100644
--- a/src/lux/analyser/lux.clj
+++ b/src/lux/analyser/lux.clj
@@ -113,20 +113,24 @@
(|let [[?module ?name] ident
local-ident (str ?module ";" ?name)
global-ident (str (if (= "" ?module) module-name ?module) ";" ?name)
- stack (&/get$ "lux;local-envs" state)
+ 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;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))
[inner outer] (&/|split-with no-binding? stack)]
(matchv ::M/objects [outer]
[["lux;Nil" _]]
- (if-let [global (->> state (&/get$ "lux;global-env") &/from-some (&/get$ "lux;locals") (&/get$ "lux;mappings") (&/|get global-ident))]
+ (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))]
(&/run-state (type-test exo-type global)
;; (|do [btype (&&/expr-type global)
;; _ (&type/check exo-type btype)]
;; (return (&/|list global)))
state)
- (do ;; (prn (str "((" (->> stack (&/|map show-frame) &/->seq (interpose " ") (reduce str "")) "))"))
- (fail* (str "[Analyser Error] Unrecognized identifier: " local-ident))))
+ (fail* ""))
[["lux;Cons" [top-outer _]]]
(|let [scopes (&/|tail (&/folds #(&/|cons (&/get$ "lux;name" %2) %1)
@@ -145,7 +149,7 @@
;; (|do [btype (&&/expr-type =local)
;; _ (&type/check exo-type btype)]
;; (return (&/|list =local)))
- (&/set$ "lux;local-envs" (&/|++ inner* outer) state)))
+ (&/set$ &/$ENVS (&/|++ inner* outer) state)))
)))
))
diff --git a/src/lux/base.clj b/src/lux/base.clj
index e989b681e..6c4c8e145 100644
--- a/src/lux/base.clj
+++ b/src/lux/base.clj
@@ -8,6 +8,7 @@
(def $LOADER "lux;loader")
(def $EVAL-CTOR "lux;eval-ctor")
(def $HOST "lux;host")
+(def $ENVS "lux;envs")
;; [Exports]
(def +name-separator+ ";")
@@ -542,8 +543,7 @@
(R "lux;source" (V "lux;None" nil)
"lux;modules" (|table)
"lux;module-aliases" (|table)
- "lux;global-env" (V "lux;None" nil)
- "lux;local-envs" (|list)
+ $ENVS (|list)
"lux;types" +init-bindings+
$HOST (host nil)))
@@ -574,22 +574,11 @@
(def get-top-local-env
(fn [state]
- (try (let [top (|head (get$ "lux;local-envs" state))]
+ (try (let [top (|head (get$ $ENVS state))]
(return* state top))
(catch Throwable _
(fail "No local environment.")))))
-(def get-current-module-env
- (fn [state]
- (let [global-env* (get$ "lux;global-env" state)]
- ;; (prn 'get-current-module-env (aget global-env* 0))
- (matchv ::M/objects [global-env*]
- [["lux;Some" datum]]
- (return* state datum)
-
- [_]
- (fail* "Module hasn't been set.")))))
-
(defn ->seq [xs]
(matchv ::M/objects [xs]
[["lux;Nil" _]]
@@ -609,46 +598,41 @@
(|list)))
(def get-module-name
- (|do [module get-current-module-env]
- (return (get$ "lux;name" module))))
+ (fn [state]
+ (matchv ::M/objects [(|reverse (get$ $ENVS state))]
+ [["lux;Nil"]]
+ (fail* "[Analyser Error] Can't get the module-name without a module.")
+
+ [["lux;Cons" [?global _]]]
+ (return* state (get$ "lux;name" ?global)))))
(defn with-scope [name body]
(fn [state]
- (let [output (body (update$ "lux;local-envs" #(|cons (env name) %) state))]
+ (let [output (body (update$ $ENVS #(|cons (env name) %) state))]
(matchv ::M/objects [output]
[["lux;Right" [state* datum]]]
- (return* (update$ "lux;local-envs" |tail state*) datum)
+ (return* (update$ $ENVS |tail state*) datum)
[_]
output))))
+(defn run-state [monad state]
+ (monad state))
+
(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))))))]
- (matchv ::M/objects [closure-info]
- [[local? closure-name]]
- (fn [state]
- (let [body* (with-scope closure-name
- body)]
- (body* (if local?
- (update$ "lux;local-envs" #(|cons (update$ "lux;inner-closures" inc (|head %))
- (|tail %))
- state)
- (update$ "lux;global-env" #(matchv ::M/objects [%]
- [["lux;Some" global-env]]
- (V "lux;Some" (update$ "lux;inner-closures" inc global-env))
-
- [_]
- %)
- state)))))
- )))
+ (|do [closure-name (|do [top get-top-local-env]
+ (return (->> top (get$ "lux;inner-closures") str)))]
+ (fn [state]
+ (let [body* (with-scope closure-name
+ body)]
+ (run-state body* (update$ $ENVS #(|cons (update$ "lux;inner-closures" inc (|head %))
+ (|tail %))
+ state))))))
(def get-scope-name
(|do [module-name get-module-name]
(fn [state]
- (return* state (->> state (get$ "lux;local-envs") (|map #(get$ "lux;name" %)) |reverse (|cons module-name))))))
+ (return* state (->> state (get$ $ENVS) (|map #(get$ "lux;name" %)) |reverse (|cons module-name))))))
(defn with-writer [writer body]
(fn [state]
@@ -661,9 +645,6 @@
[_]
output))))
-(defn run-state [monad state]
- (monad state))
-
(defn show-ast [ast]
;; (prn 'show-ast (aget ast 0))
;; (prn 'show-ast (aget ast 1 1 0))
diff --git a/src/lux/compiler.clj b/src/lux/compiler.clj
index 410b11abf..471fcda77 100644
--- a/src/lux/compiler.clj
+++ b/src/lux/compiler.clj
@@ -373,7 +373,7 @@
(&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$ "lux;global-env" (&/V "lux;Some" (&/env name)))
+ (&/set$ &/$ENVS (&/|list (&/env name)))
(&/update$ &/$HOST #(&/set$ &/$WRITER (&/V "lux;Some" =class) %))
(&/update$ "lux;modules" #(&/|put name &a-def/init-module %))))]
[["lux;Right" [?state _]]]
generated by cgit v1.2.3 (git 2.25.1) at 2024-08-24 13:49:00 +0000