diff options
| -rw-r--r-- | src/lux/analyser/def.clj | 29 | ||||
| -rw-r--r-- | src/lux/analyser/env.clj | 16 | ||||
| -rw-r--r-- | src/lux/analyser/lambda.clj | 10 | ||||
| -rw-r--r-- | src/lux/analyser/lux.clj | 20 | ||||
| -rw-r--r-- | src/lux/base.clj | 104 | ||||
| -rw-r--r-- | src/lux/compiler.clj | 6 | ||||
| -rw-r--r-- | src/lux/reader.clj | 8 | ||||
| -rw-r--r-- | src/lux/type.clj | 24 |
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))))) |