diff options
Diffstat (limited to '')
-rw-r--r-- | src/lux/analyser/def.clj | 33 | ||||
-rw-r--r-- | src/lux/analyser/env.clj | 10 | ||||
-rw-r--r-- | src/lux/analyser/lux.clj | 16 | ||||
-rw-r--r-- | src/lux/base.clj | 67 | ||||
-rw-r--r-- | src/lux/compiler.clj | 2 |
5 files changed, 58 insertions, 70 deletions
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 _]]] |