diff options
26 files changed, 358 insertions, 351 deletions
diff --git a/documentation/research/database.md b/documentation/research/database.md index 6e36919b8..9d3210e71 100644 --- a/documentation/research/database.md +++ b/documentation/research/database.md @@ -47,6 +47,7 @@ # Index +1. https://www.pilosa.com/ 1. https://en.wikipedia.org/wiki/Fractal_tree_index 1. [Beating hash tables with trees? The ART-ful radix trie](https://www.the-paper-trail.org/post/art-paper-notes/) 1. https://www.ristret.com/s/gnd4yr/brief_history_log_structured_merge_trees diff --git a/documentation/research/game_programming.md b/documentation/research/game_programming.md index 0241e84cc..28796493d 100644 --- a/documentation/research/game_programming.md +++ b/documentation/research/game_programming.md @@ -1,5 +1,6 @@ # Engine +1. https://www.raylib.com/index.html 1. https://github.com/GoogleCloudPlatform/agones 1. https://luxeengine.com/ 1. https://www.haroldserrano.com/blog/books-i-used-to-develop-a-game-engine diff --git a/documentation/research/math.md b/documentation/research/math.md index fc3d8b495..fd016f7b0 100644 --- a/documentation/research/math.md +++ b/documentation/research/math.md @@ -1,3 +1,8 @@ +# Period + +1. https://en.wikipedia.org/wiki/Ring_of_periods +1. [PERIODS](http://www.ihes.fr/~maxim/TEXTS/Periods.pdf) + # Proof theory 1. [Mathematical Components](https://math-comp.github.io/mcb/) @@ -40,6 +45,7 @@ # _Compendium of resources_ +1. [ALL IN ONE MATHEMATICS CHEAT SHEET](https://ourway.keybase.pub/mathematics_cheat_sheet.pdf) 1. https://github.com/llSourcell/learn_math_fast 1. https://www.algorithm-archive.org/ 1. [3b1b featured creators #1](https://www.youtube.com/watch?v=VcgJro0sTiM) diff --git a/documentation/research/text_editor & ide.md b/documentation/research/text_editor & ide.md index 3b63f1e2e..34127863a 100644 --- a/documentation/research/text_editor & ide.md +++ b/documentation/research/text_editor & ide.md @@ -11,6 +11,7 @@ 1. Hovering/selecting an input to a function inside a function-call should display the name of the input in the function declaration. This would help understand the purpose of the value while in the function call without needing Lux/the-language to have named inputs as a feature. 1. https://www.emacswiki.org/emacs/UndoTree 1. https://jameshfisher.com/2014/05/11/your-syntax-highlighter-is-wrong/ +1. https://medium.com/@evnbr/coding-in-color-3a6db2743a1e # Voice diff --git a/luxc/src/lux/analyser/lux.clj b/luxc/src/lux/analyser/lux.clj index 4353caefa..0a6858a92 100644 --- a/luxc/src/lux/analyser/lux.clj +++ b/luxc/src/lux/analyser/lux.clj @@ -12,8 +12,7 @@ [case :as &&case] [env :as &&env] [module :as &&module] - [record :as &&record] - [meta :as &&meta]))) + [record :as &&record]))) ;; [Utils] ;; TODO: Walk the type to set up the parameter-type, instead of doing a @@ -579,24 +578,12 @@ _ (&&module/declare-tags module-name tags exported? def-value)] (return &/$Nil))) -(def ^:private dummy-cursor - (&/T ["" -1 -1])) - -(defn ^:private alias-annotations [original-module original-name] - (&/T [dummy-cursor - (&/$Record (&/$Cons (&/T [(&/T [dummy-cursor (&/$Tag &&meta/alias-tag)]) - (&/T [dummy-cursor (&/$Identifier (&/T [original-module original-name]))])]) - &/$Nil))])) - (defn analyse-def-alias [?alias ?original] (|let [[r-module r-name] ?original] - (|do [[_ [exported? original-type original-anns original-value]] (&&module/find-def! r-module r-name) + (|do [_ (&&module/find-def r-module r-name) module-name &/get-module-name _ (&/without-repl-closure - (&&module/define module-name ?alias false - original-type - (alias-annotations r-module r-name) - original-value))] + (&&module/define-alias module-name ?alias ?original))] (return &/$Nil)))) (defn ^:private merge-module-states diff --git a/luxc/src/lux/analyser/meta.clj b/luxc/src/lux/analyser/meta.clj deleted file mode 100644 index 53d355867..000000000 --- a/luxc/src/lux/analyser/meta.clj +++ /dev/null @@ -1,44 +0,0 @@ -(ns lux.analyser.meta - (:require (clojure [template :refer [do-template]]) - clojure.core.match - clojure.core.match.array - (lux [base :as & :refer [|let |do return return* |case]]))) - -;; [Utils] -(defn ^:private ident= [x y] - (|let [[px nx] x - [py ny] y] - (and (= px py) - (= nx ny)))) - -(def ^:private tag-prefix "lux") - -;; [Values] -(defn meta-get - "(-> Ident Code (Maybe Code))" - [ident annotations] - (|case annotations - [_ (&/$Record dict)] - (loop [dict dict] - (|case dict - (&/$Cons [_k v] dict*) - (|case _k - [_ (&/$Tag k)] - (if (ident= k ident) - (&/$Some v) - (recur dict*)) - - _ - (recur dict*)) - - (&/$Nil) - &/$None)) - - _ - &/$None)) - -(do-template [<name> <tag-name>] - (def <name> (&/T [tag-prefix <tag-name>])) - - alias-tag "alias" - ) diff --git a/luxc/src/lux/analyser/module.clj b/luxc/src/lux/analyser/module.clj index 25f6428ca..3d53155cb 100644 --- a/luxc/src/lux/analyser/module.clj +++ b/luxc/src/lux/analyser/module.clj @@ -7,8 +7,7 @@ (lux [base :as & :refer [defvariant deftuple |let |do return return* |case]] [type :as &type] [host :as &host]) - [lux.host.generics :as &host-generics] - (lux.analyser [meta :as &meta]))) + [lux.host.generics :as &host-generics])) ;; [Utils] ;; ModuleState @@ -106,10 +105,8 @@ state) nil)))) -(defn define [module name exported? def-type def-meta def-value] +(defn define-alias [module name de-aliased] (fn [state] - (when (and (= "Macro'" name) (= "lux" module)) - (&type/set-macro*-type! def-value)) (|case (&/get$ &/$scopes state) (&/$Cons ?env (&/$Nil)) (return* (->> state @@ -118,7 +115,7 @@ (&/|update module (fn [m] (&/update$ $defs - #(&/|put name (&/T [exported? def-type def-meta def-value]) %) + #(&/|put name (&/$Left de-aliased) %) m)) ms)))) nil) @@ -127,17 +124,25 @@ ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) state)))) -(defn def-type - "(-> Text Text (Lux Type))" - [module name] +(defn define [module name exported? def-type def-meta def-value] (fn [state] - (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] - (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] - (return* state ?type)) - ((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (str module &/+name-separator+ name))) - state)) - ((&/fail-with-loc (str "[Analyser Error] Unknown module: " module)) + (when (and (= "Macro'" name) (= "lux" module)) + (&type/set-macro*-type! def-value)) + (|case (&/get$ &/$scopes state) + (&/$Cons ?env (&/$Nil)) + (return* (->> state + (&/update$ &/$modules + (fn [ms] + (&/|update module + (fn [m] + (&/update$ $defs + #(&/|put name (&/$Right (&/T [exported? def-type def-meta def-value])) %) + m)) + ms)))) + nil) + + _ + ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name))) state)))) (defn type-def @@ -146,7 +151,11 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] + (|case $def + (&/$Left [o-module o-name]) + ((type-def o-module o-name) state) + + (&/$Right [exported? ?type ?meta ?value]) (if (&type/type= &type/Type ?type) (return* state (&/T [exported? ?value])) ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name])) @@ -224,56 +233,50 @@ (fn [state] (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] - (if (.equals ^Object current-module module) - (|case (&meta/meta-get &meta/alias-tag ?meta) - (&/$Some [_ (&/$Identifier [?r-module ?r-name])]) - ((find-def! ?r-module ?r-name) - state) + (|case $def + (&/$Left [?r-module ?r-name]) + ((find-def! ?r-module ?r-name) + state) - _ - (return* state (&/T [(&/T [module name]) $def]))) - (return* state (&/T [(&/T [module name]) $def])))) + (&/$Right $def*) + (return* state (&/T [(&/T [module name]) $def*]))) ((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (str module &/+name-separator+ name) " at module: " current-module)) state)) ((&/fail-with-loc (str "[Analyser Error @ find-def!] Module does not exist: " module " at module: " current-module)) - state)) - ))) + state))))) (defn find-def [module name] (|do [current-module &/get-module-name] (fn [state] - (if (or (= "lux" module) - (= current-module module) - (imports? state module current-module)) - (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] - (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] - (|let [[exported? ?type ?meta ?value] $def] - (if (.equals ^Object current-module module) - (|case (&meta/meta-get &meta/alias-tag ?meta) - (&/$Some [_ (&/$Identifier [?r-module ?r-name])]) - ((find-def ?r-module ?r-name) - state) - - _ - (return* state (&/T [(&/T [module name]) $def]))) - (if exported? - (return* state (&/T [(&/T [module name]) $def])) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name) - " at module: " current-module)) - state)))) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name) - " at module: " current-module)) - state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module + (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))] + (if-let [$def (->> $module (&/get$ $defs) (&/|get name))] + (|case $def + (&/$Left [?r-module ?r-name]) + (if (.equals ^Object current-module module) + ((find-def! ?r-module ?r-name) + state) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use (private) alias: " (str module &/+name-separator+ name) + " at module: " current-module)) + state)) + + (&/$Right [exported? ?type ?meta ?value]) + (if (or (.equals ^Object current-module module) + (and exported? + (or (.equals ^Object module "lux") + (imports? state module current-module)))) + (return* state (&/T [(&/T [module name]) + (&/T [exported? ?type ?meta ?value])])) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name) + " at module: " current-module)) + state))) + ((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name) " at module: " current-module)) state)) - ((&/fail-with-loc (str "[Analyser Error @ find-def] Unknown module: " module + ((&/fail-with-loc (str "[Analyser Error @ find-def] Module does not exist: " module " at module: " current-module)) - state)) - ))) + state))))) (defn defined? [module name] (&/try-all% (&/|list (|do [_ (find-def! module name)] @@ -398,18 +401,7 @@ (def defs (|do [module &/get-module-name] (fn [state] - (return* state - (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs) - (&/|map (fn [kv] - (|let [[k _def-data] kv - [_ _ ?def-meta _] _def-data] - (|case (&meta/meta-get &meta/alias-tag ?def-meta) - (&/$Some [_ (&/$Identifier [?r-module ?r-name])]) - (&/T [k (str ?r-module &/+name-separator+ ?r-name) _def-data]) - - _ - (&/T [k "" _def-data]) - ))))))))) + (return* state (->> state (&/get$ &/$modules) (&/|get module) (&/get$ $defs)))))) (defn fetch-imports [imports] (|case imports diff --git a/luxc/src/lux/compiler/cache.clj b/luxc/src/lux/compiler/cache.clj index 06dabe108..a0f88aa09 100644 --- a/luxc/src/lux/compiler/cache.clj +++ b/luxc/src/lux/compiler/cache.clj @@ -8,8 +8,7 @@ [type :as &type] [host :as &host]) (lux.analyser [base :as &a] - [module :as &a-module] - [meta :as &a-meta]) + [module :as &a-module]) (lux.compiler [core :as &&core] [io :as &&io]) (lux.compiler.cache [type :as &&&type] @@ -99,12 +98,8 @@ (let [parts (.split _def-entry &&core/datum-separator)] (case (alength parts) 2 (let [[_name _alias] parts - [_ __module __name] (re-find #"^(.*)\.(.*)$" _alias) - def-anns (make-record (&/|list (&/T [(make-tag &a-meta/alias-tag) - (make-identifier (&/T [__module __name]))])))] - (|do [def-type (&a-module/def-type __module __name) - def-value (load-def-value __module __name)] - (&a-module/define module _name false def-type def-anns def-value))) + [__module __name] (.split _alias &/+name-separator+)] + (&a-module/define-alias module _name (&/T [__module __name]))) 4 (let [[_name _exported? _type _anns] parts [def-anns _] (&&&ann/deserialize _anns) [def-type _] (&&&type/deserialize-type _type)] diff --git a/luxc/src/lux/compiler/core.clj b/luxc/src/lux/compiler/core.clj index f2fe09887..88da626bd 100644 --- a/luxc/src/lux/compiler/core.clj +++ b/luxc/src/lux/compiler/core.clj @@ -50,13 +50,16 @@ tag-groups &a-module/tag-groups :let [def-entries (->> defs (&/|map (fn [_def] - (|let [[?name ?alias [exported? ?def-type ?def-anns ?def-value]] _def] - (if (= "" ?alias) + (|let [[?name _definition] _def] + (|case _definition + (&/$Left [_dmodule _dname]) + (str ?name datum-separator _dmodule &/+name-separator+ _dname) + + (&/$Right [exported? ?def-type ?def-anns ?def-value]) (str ?name datum-separator (if exported? "1" "0") datum-separator (&&&type/serialize-type ?def-type) - datum-separator (&&&ann/serialize ?def-anns)) - (str ?name datum-separator ?alias))))) + datum-separator (&&&ann/serialize ?def-anns)))))) (&/|interpose entry-separator) (&/fold str "")) import-entries (->> imports diff --git a/luxc/src/lux/compiler/jvm/cache.clj b/luxc/src/lux/compiler/jvm/cache.clj index a42c7afdd..f54eacc92 100644 --- a/luxc/src/lux/compiler/jvm/cache.clj +++ b/luxc/src/lux/compiler/jvm/cache.clj @@ -9,8 +9,7 @@ [host :as &host]) [lux.host.generics :as &host-generics] (lux.analyser [base :as &a] - [module :as &a-module] - [meta :as &a-meta]) + [module :as &a-module]) (lux.compiler [core :as &&core] [io :as &&io]) (lux.compiler.jvm [base :as &&])) diff --git a/luxc/src/lux/compiler/jvm/lux.clj b/luxc/src/lux/compiler/jvm/lux.clj index 28418a6f8..bfa8b2bdb 100644 --- a/luxc/src/lux/compiler/jvm/lux.clj +++ b/luxc/src/lux/compiler/jvm/lux.clj @@ -13,8 +13,7 @@ [optimizer :as &o]) [lux.host.generics :as &host-generics] (lux.analyser [base :as &a] - [module :as &a-module] - [meta :as &a-meta]) + [module :as &a-module]) (lux.compiler.jvm [base :as &&] [function :as &&function])) (:import (org.objectweb.asm Opcodes @@ -268,71 +267,26 @@ (defn compile-def [compile ?name ?body ?meta exported?] (|do [module-name &/get-module-name class-loader &/loader] - (|case (&a-meta/meta-get &a-meta/alias-tag ?meta) - (&/$Some [_ (&/$Identifier [r-module r-name])]) - (|case ?meta - [_ (&/$Record ?meta*)] - (if (= 1 (&/|length ?meta*)) - (|do [:let [current-class (&host-generics/->class-name (str (&host/->module-class r-module) "/" (&host/def-name r-name))) - def-class (&&/load-class! class-loader current-class) - def-value (-> def-class (.getField &/value-field) (.get nil))] - def-type (&a-module/def-type r-module r-name) - _ (&/without-repl-closure - (&a-module/define module-name ?name false def-type ?meta def-value))] - (return nil)) - (&/fail-with-loc (str "[Compilation Error] Aliases cannot contain meta-data: " (str module-name &/+name-separator+ ?name))))) - - (&/$Some _) - (&/fail-with-loc "[Compilation Error] Invalid syntax for lux;alias meta-data. Must be an identifier.") - - _ - (|case (de-ann ?body) - [_ (&o/$function _ _ __scope _ _)] - (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope - false - (de-ann ?body))] - (|do [[file-name _ _] &/cursor - :let [datum-sig "Ljava/lang/Object;" - def-name (&host/def-name ?name) - current-class (str (&host/->module-class module-name) "/" def-name) - =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) - (.visit &host/bytecode-version class-flags - current-class nil &&/function-class (into-array String [])) - (-> (.visitField field-flags &/value-field datum-sig nil nil) - (doto (.visitEnd))) - (.visitSource file-name nil))] - instancer (&&function/compile-function compile (&/$Some =class) _arity _scope _captured ?body+) - _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil) - (|do [^MethodVisitor **writer** &/get-writer - :let [_ (.visitCode **writer**)] - _ instancer - :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)] - :let [_ (doto **writer** - (.visitInsn Opcodes/RETURN) - (.visitMaxs 0 0) - (.visitEnd))]] - (return nil))) - :let [_ (.visitEnd =class)] - _ (&&/save-class! def-name (.toByteArray =class)) - def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?) - :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] - (return def-value))) - - _ + (|case (de-ann ?body) + [_ (&o/$function _ _ __scope _ _)] + (|let [[_ (&o/$function _ _arity _scope _captured ?body+)] (&o/shift-function-body (&/|tail __scope) __scope + false + (de-ann ?body))] (|do [[file-name _ _] &/cursor :let [datum-sig "Ljava/lang/Object;" def-name (&host/def-name ?name) current-class (str (&host/->module-class module-name) "/" def-name) =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) (.visit &host/bytecode-version class-flags - current-class nil "java/lang/Object" (into-array String [])) + current-class nil &&/function-class (into-array String [])) (-> (.visitField field-flags &/value-field datum-sig nil nil) (doto (.visitEnd))) (.visitSource file-name nil))] + instancer (&&function/compile-function compile (&/$Some =class) _arity _scope _captured ?body+) _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil) (|do [^MethodVisitor **writer** &/get-writer :let [_ (.visitCode **writer**)] - _ (compile nil ?body) + _ instancer :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)] :let [_ (doto **writer** (.visitInsn Opcodes/RETURN) @@ -344,7 +298,33 @@ def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?) :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] (return def-value))) - )))) + + _ + (|do [[file-name _ _] &/cursor + :let [datum-sig "Ljava/lang/Object;" + def-name (&host/def-name ?name) + current-class (str (&host/->module-class module-name) "/" def-name) + =class (doto (new ClassWriter ClassWriter/COMPUTE_MAXS) + (.visit &host/bytecode-version class-flags + current-class nil "java/lang/Object" (into-array String [])) + (-> (.visitField field-flags &/value-field datum-sig nil nil) + (doto (.visitEnd))) + (.visitSource file-name nil))] + _ (&/with-writer (.visitMethod =class Opcodes/ACC_STATIC "<clinit>" "()V" nil nil) + (|do [^MethodVisitor **writer** &/get-writer + :let [_ (.visitCode **writer**)] + _ (compile nil ?body) + :let [_ (.visitFieldInsn **writer** Opcodes/PUTSTATIC current-class &/value-field datum-sig)] + :let [_ (doto **writer** + (.visitInsn Opcodes/RETURN) + (.visitMaxs 0 0) + (.visitEnd))]] + (return nil))) + :let [_ (.visitEnd =class)] + _ (&&/save-class! def-name (.toByteArray =class)) + def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported?) + :let [_ (println 'DEF (str module-name &/+name-separator+ ?name))]] + (return def-value)))))) (defn compile-program [compile ?program] (|do [module-name &/get-module-name diff --git a/stdlib/source/lux.lux b/stdlib/source/lux.lux index b75b5bebe..aff2f300a 100644 --- a/stdlib/source/lux.lux +++ b/stdlib/source/lux.lux @@ -419,6 +419,28 @@ #Nil)) #1) +## (type: Alias +## Name) +("lux def" Alias + ("lux check type" + (#Named ["lux" "Alias"] + Name)) + (record$ #Nil) + #1) + +## (type: Global +## (| Alias +## Definition)) +("lux def" Global + ("lux check type" + (#Named ["lux" "Global"] + (#Sum Alias + Definition))) + (record$ (#Cons [(tag$ ["lux" "doc"]) + (text$ "Represents all the data associated with a global constant.")] + #Nil)) + #1) + ## (type: (Bindings k v) ## {#counter Nat ## #mappings (List [k v])}) @@ -525,7 +547,7 @@ ## (type: Module ## {#module-hash Nat ## #module-aliases (List [Text Text]) -## #definitions (List [Text Definition]) +## #definitions (List [Text Global]) ## #imports (List Text) ## #tags (List [Text [Nat (List Name) Bit Type]]) ## #types (List [Text [(List Name) Bit Type]]) @@ -538,7 +560,7 @@ (#Product ## "lux.module-aliases" (#Apply (#Product Text Text) List) (#Product ## "lux.definitions" - (#Apply (#Product Text Definition) List) + (#Apply (#Product Text Global) List) (#Product ## "lux.imports" (#Apply Text List) (#Product ## "lux.tags" @@ -1724,13 +1746,13 @@ #seed seed #expected expected #cursor cursor #extensions extensions #scope-type-vars scope-type-vars} state] ({(#Some {#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _}) - ({(#Some [exported? def-type def-meta def-value]) - ({(#Some [_ (#Identifier real-name)]) + ({(#Some constant) + ({(#Left real-name) (#Right [state real-name]) - - _ + + (#Right [exported? def-type def-meta def-value]) (#Right [state full-name])} - (get-meta ["lux" "alias"] def-meta)) + constant) #None (#Left ($_ text@compose "Unknown definition: " (name@encode full-name)))} @@ -2527,19 +2549,18 @@ [$module (get module modules) gdef (let' [{#module-hash _ #module-aliases _ #definitions bindings #imports _ #tags tags #types types #module-annotations _ #module-state _} ("lux check" Module $module)] (get name bindings))] - (let' [[exported? def-type def-meta def-value] ("lux check" Definition gdef)] - (if (macro-type? def-type) - (if exported? - (#Some ("lux coerce" Macro def-value)) - (if (text@= module current-module) - (#Some ("lux coerce" Macro def-value)) - #None)) - ({(#Some [_ (#Identifier [r-module r-name])]) - (find-macro' modules current-module r-module r-name) - - _ - #None} - (get-meta ["lux" "alias"] def-meta)))))) + ({(#Left [r-module r-name]) + (find-macro' modules current-module r-module r-name) + + (#Right [exported? def-type def-meta def-value]) + (if (macro-type? def-type) + (if exported? + (#Some ("lux coerce" Macro def-value)) + (if (text@= module current-module) + (#Some ("lux coerce" Macro def-value)) + #None)) + #None)} + ("lux check" Global gdef)))) (def:''' (normalize name) #Nil @@ -4227,12 +4248,17 @@ modules)] (case (get module modules) (#Some =module) - (let [to-alias (list@map (: (-> [Text Definition] + (let [to-alias (list@map (: (-> [Text Global] (List Text)) - (function (_ [name [exported? def-type def-meta def-value]]) - (if exported? - (list name) - (list)))) + (function (_ [name definition]) + (case definition + (#Left _) + (list) + + (#Right [exported? def-type def-meta def-value]) + (if exported? + (list name) + (list))))) (let [{#module-hash _ #module-aliases _ #definitions definitions #imports _ #tags tags #types types #module-annotations _ #module-state _} =module] definitions))] (#Right state (list@join to-alias))) @@ -4307,8 +4333,13 @@ #None #None - (#Some [exported? def-type def-meta def-value]) - (#Some def-type))))) + (#Some definition) + (case definition + (#Left de-aliased) + (find-def-type de-aliased state) + + (#Right [exported? def-type def-meta def-value]) + (#Some def-type)))))) (def: (find-def-value name state) (-> Name (Meta [Type Any])) @@ -4326,8 +4357,13 @@ #None (#Left (text@compose "Unknown definition: " (name@encode name))) - (#Some [exported? def-type def-meta def-value]) - (#Right [state [def-type def-value]]))))) + (#Some definition) + (case definition + (#Left de-aliased) + (find-def-value de-aliased state) + + (#Right [exported? def-type def-meta def-value]) + (#Right [state [def-type def-value]])))))) (def: (find-type-var idx bindings) (-> Nat (List [Nat (Maybe Type)]) (Maybe Type)) diff --git a/stdlib/source/lux/control/concurrency/actor.lux b/stdlib/source/lux/control/concurrency/actor.lux index 09ef7e625..a0e44b1bf 100644 --- a/stdlib/source/lux/control/concurrency/actor.lux +++ b/stdlib/source/lux/control/concurrency/actor.lux @@ -169,13 +169,18 @@ (def: #export (<resolve> name) (-> Name (Meta Name)) (do macro.monad - [[_ _ annotations _] (macro.find-def name)] - (case (macro.get-tag-ann (name-of <tag>) annotations) - (#.Some actor-name) - (wrap actor-name) - - _ - (macro.fail (format "Definition is not " <desc> ".")))))] + [constant (macro.find-def name)] + (case constant + (#.Left de-aliased) + (<resolve> de-aliased) + + (#.Right [_ _ annotations _]) + (case (macro.get-tag-ann (name-of <tag>) annotations) + (#.Some actor-name) + (wrap actor-name) + + _ + (macro.fail (format "Definition is not " <desc> "."))))))] [with-actor resolve-actor #..actor "an actor"] [with-message resolve-message #..message "a message"] diff --git a/stdlib/source/lux/host.jvm.lux b/stdlib/source/lux/host.jvm.lux index 9578288c2..c6d636e82 100644 --- a/stdlib/source/lux/host.jvm.lux +++ b/stdlib/source/lux/host.jvm.lux @@ -393,14 +393,19 @@ (do macro.monad [current-module macro.current-module-name definitions (macro.definitions current-module)] - (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) - (function (_ [short-name [_ _ meta _]] imports) - (case (macro.get-text-ann (name-of #..jvm-class) meta) - (#.Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) + (wrap (list@fold (: (-> [Text Global] Class-Imports Class-Imports) + (function (_ [short-name constant] imports) + (case constant + (#.Left _) + imports + + (#.Right [_ _ meta _]) + (case (macro.get-text-ann (name-of #..jvm-class) meta) + (#.Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports)))) empty-imports definitions))))) (#.Left _) (list) diff --git a/stdlib/source/lux/host.old.lux b/stdlib/source/lux/host.old.lux index db8145ab2..1f92a4a3b 100644 --- a/stdlib/source/lux/host.old.lux +++ b/stdlib/source/lux/host.old.lux @@ -369,18 +369,26 @@ (do macro.monad [current-module macro.current-module-name definitions (macro.definitions current-module)] - (wrap (list@fold (: (-> [Text Definition] Class-Imports Class-Imports) - (function (_ [short-name [_ _ meta _]] imports) - (case (macro.get-text-ann (name-of #..jvm-class) meta) - (#.Some full-class-name) - (add-import [short-name full-class-name] imports) - - _ - imports))) + (wrap (list@fold (: (-> [Text Global] Class-Imports Class-Imports) + (function (_ [short-name constant] imports) + (case constant + (#.Left _) + imports + + (#.Right [_ _ meta _]) + (case (macro.get-text-ann (name-of #..jvm-class) meta) + (#.Some full-class-name) + (add-import [short-name full-class-name] imports) + + _ + imports)))) empty-imports definitions))))) - (#.Left _) (list) - (#.Right imports) imports)) + (#.Left _) + (list) + + (#.Right imports) + imports)) (def: java/lang/* (List Text) diff --git a/stdlib/source/lux/macro.lux b/stdlib/source/lux/macro.lux index 23d1223e4..7eedc2f35 100644 --- a/stdlib/source/lux/macro.lux +++ b/stdlib/source/lux/macro.lux @@ -206,15 +206,6 @@ [signature? #.sig? "a signature"] ) -(def: #export (aliased? annotations) - (-> Code Bit) - (case (get-identifier-ann (name-of #.alias) annotations) - (#.Some _) - #1 - - #.None - #0)) - (template [<name> <tag> <type>] [(def: (<name> input) (-> Code (Maybe <type>)) @@ -257,14 +248,17 @@ (Maybe Macro)) (do maybe.monad [$module (get module modules) - [exported? def-type def-anns def-value] (: (Maybe Definition) (|> (: Module $module) (get@ #.definitions) (get name)))] - (if (macro-type? def-type) - (#.Some (:coerce Macro def-value)) - (case (get-identifier-ann (name-of #.alias) def-anns) - (#.Some [r-module r-name]) - (find-macro' modules this-module r-module r-name) - - _ + definition (: (Maybe Global) + (|> (: Module $module) + (get@ #.definitions) + (get name)))] + (case definition + (#.Left [r-module r-name]) + (find-macro' modules this-module r-module r-name) + + (#.Right [exported? def-type def-anns def-value]) + (if (macro-type? def-type) + (#.Some (:coerce Macro def-value)) #.None)))) (def: #export (normalize name) @@ -501,11 +495,11 @@ (def: #export (find-def name) {#.doc "Looks-up a definition's whole data in the available modules (including the current one)."} - (-> Name (Meta Definition)) + (-> Name (Meta Global)) (do ..monad [name (normalize name)] (function (_ compiler) - (case (: (Maybe Definition) + (case (: (Maybe Global) (do maybe.monad [#let [[v-prefix v-name] name] (^slots [#.definitions]) (get v-prefix (get@ #.modules compiler))] @@ -533,8 +527,13 @@ {#.doc "Looks-up a definition's type in the available modules (including the current one)."} (-> Name (Meta Type)) (do ..monad - [[exported? def-type def-data def-value] (find-def name)] - (clean-type def-type))) + [definition (find-def name)] + (case definition + (#.Left de-aliased) + (find-def-type de-aliased) + + (#.Right [exported? def-type def-data def-value]) + (clean-type def-type)))) (def: #export (find-type name) {#.doc "Looks-up the type of either a local variable or a definition."} @@ -553,26 +552,40 @@ {#.doc "Finds the value of a type definition (such as Int, Any or Lux)."} (-> Name (Meta Type)) (do ..monad - [[exported? def-type def-data def-value] (find-def name)] - (wrap (:coerce Type def-value)))) + [definition (find-def name)] + (case definition + (#.Left de-aliased) + (find-type-def de-aliased) + + (#.Right [exported? def-type def-data def-value]) + (wrap (:coerce Type def-value))))) (def: #export (definitions module-name) {#.doc "The entire list of definitions in a module (including the non-exported/private ones)."} - (-> Text (Meta (List [Text Definition]))) + (-> Text (Meta (List [Text Global]))) (function (_ compiler) (case (get module-name (get@ #.modules compiler)) - #.None (#error.Failure ($_ text@compose "Unknown module: " module-name)) - (#.Some module) (#error.Success [compiler (get@ #.definitions module)]) - ))) + #.None + (#error.Failure ($_ text@compose "Unknown module: " module-name)) + + (#.Some module) + (#error.Success [compiler (get@ #.definitions module)])))) (def: #export (exports module-name) {#.doc "All the exported definitions in a module."} (-> Text (Meta (List [Text Definition]))) (do ..monad - [definitions (definitions module-name)] - (wrap (list.filter (function (_ [name [exported? def-type def-anns def-value]]) - exported?) - definitions)))) + [constants (definitions module-name)] + (wrap (do list.monad + [[name definition] constants] + (case definition + (#.Left _) + (list) + + (#.Right [exported? def-type def-data def-value]) + (if exported? + (wrap [name [exported? def-type def-data def-value]]) + (list))))))) (def: #export modules {#.doc "All the available modules (including the current one)."} @@ -689,13 +702,13 @@ {#.doc "Given an aliased definition's name, returns the original definition being referenced."} (-> Name (Meta Name)) (do ..monad - [[_ _ def-anns _] (find-def def-name)] - (case (get-identifier-ann (name-of #.alias) def-anns) - (#.Some real-def-name) - (wrap real-def-name) + [constant (find-def def-name)] + (wrap (case constant + (#.Left real-def-name) + real-def-name - _ - (wrap def-name)))) + (#.Right _) + def-name)))) (def: #export get-compiler {#.doc "Obtains the current state of the compiler."} diff --git a/stdlib/source/lux/target/php.lux b/stdlib/source/lux/target/php.lux index 286d8d397..46689fd29 100644 --- a/stdlib/source/lux/target/php.lux +++ b/stdlib/source/lux/target/php.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code static int if cond or and not comment for) + [lux (#- Code Global static int if cond or and not comment for) [control [pipe (#+ case> cond> new>)]] [data diff --git a/stdlib/source/lux/target/ruby.lux b/stdlib/source/lux/target/ruby.lux index 037cdca5b..f82b5c92a 100644 --- a/stdlib/source/lux/target/ruby.lux +++ b/stdlib/source/lux/target/ruby.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code static int if cond function or and not comment) + [lux (#- Code Global static int if cond function or and not comment) [control [pipe (#+ case> cond> new>)]] [data diff --git a/stdlib/source/lux/target/scheme.lux b/stdlib/source/lux/target/scheme.lux index 886d2ba88..652eb65ef 100644 --- a/stdlib/source/lux/target/scheme.lux +++ b/stdlib/source/lux/target/scheme.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- Code int or and if function cond let) + [lux (#- Code Global int or and if function cond let) [control [pipe (#+ new> cond> case>)]] [data diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux index 4894ce931..6a33171f1 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/module.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/module.lux @@ -118,7 +118,7 @@ [state] #error.Success)))) (def: #export (define name definition) - (-> Text Definition (Operation Any)) + (-> Text Global (Operation Any)) (///extension.lift (do ///.monad [self-name macro.current-module-name @@ -129,7 +129,7 @@ (#error.Success [(update@ #.modules (plist.put self-name (update@ #.definitions - (: (-> (List [Text Definition]) (List [Text Definition])) + (: (-> (List [Text Global]) (List [Text Global])) (|>> (#.Cons [name definition]))) self)) state) diff --git a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux index a484eaebb..c09ea55ba 100644 --- a/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/lux/tool/compiler/phase/analysis/reference.lux @@ -30,12 +30,12 @@ (-> Name (Operation Analysis)) (with-expansions [<return> (wrap (|> def-name ////reference.constant #/.Reference))] (do ///.monad - [[exported? actualT def-anns _] (///extension.lift (macro.find-def def-name))] - (case (macro.get-identifier-ann (name-of #.alias) def-anns) - (#.Some real-def-name) + [constant (///extension.lift (macro.find-def def-name))] + (case constant + (#.Left real-def-name) (definition real-def-name) - - _ + + (#.Right [exported? actualT def-anns _]) (do @ [_ (//type.infer actualT) (^@ def-name [::module ::name]) (///extension.lift (macro.normalize def-name)) diff --git a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux index 2b17c9f8a..992d5a932 100644 --- a/stdlib/source/lux/tool/compiler/phase/extension/statement.lux +++ b/stdlib/source/lux/tool/compiler/phase/extension/statement.lux @@ -4,6 +4,7 @@ ["." monad (#+ do)]] [control [io (#+ IO)] + ["." exception (#+ exception:)] ["p" parser ["s" code (#+ Parser)]]] [data @@ -139,7 +140,7 @@ #let [annotations (:coerce Code annotations)] [type valueT valueN value] (..definition full-name #.None valueC) _ (////statement.lift-analysis - (module.define short-name [exported? type annotations value])) + (module.define short-name (#.Right [exported? type annotations value]))) #let [_ (log! (format "Definition " (%name full-name)))] _ (////statement.lift-generation (///generation.learn full-name valueN)) @@ -179,7 +180,7 @@ [type valueT valueN value] (..definition full-name (#.Some .Type) valueC) _ (////statement.lift-analysis (do ///.monad - [_ (module.define short-name [exported? type annotations value])] + [_ (module.define short-name (#.Right [exported? type annotations value]))] (module.declare-tags tags exported? (:coerce Type value)))) #let [_ (log! (format "Definition " (%name full-name)))] _ (////statement.lift-generation @@ -214,36 +215,35 @@ (wrap {#////statement.imports imports #////statement.referrals (list)})))])) -## TODO: Reify aliasing as a feature of the compiler, instead of -## manifesting it implicitly through definition annotations. -(def: (alias-annotations original) - (-> Name Code) - (` {#.alias (~ (code.identifier original))})) +(exception: #export (cannot-alias-an-alias {local Alias} {foreign Alias} {target Name}) + (exception.report + ["Local alias" (%name local)] + ["Foreign alias" (%name foreign)] + ["Target definition" (%name target)])) (def: (define-alias alias original) (-> Text Name (////analysis.Operation Any)) (do ///.monad - [[exported? original-type original-annotations original-value] - (//.lift (macro.find-def original))] - (module.define alias [false - original-type - (alias-annotations original) - original-value]))) + [current-module (//.lift macro.current-module-name) + constant (//.lift (macro.find-def original))] + (case constant + (#.Left de-aliased) + (///.throw ..cannot-alias-an-alias [[current-module alias] original de-aliased]) + + (#.Right [exported? original-type original-annotations original-value]) + (module.define alias (#.Left original))))) (def: def::alias Handler - (function (_ extension-name phase inputsC+) - (case inputsC+ - (^ (list [_ (#.Identifier ["" alias])] [_ (#.Identifier def-name)])) + (..custom + [($_ p.and s.local-identifier s.identifier) + (function (_ extension-name phase [alias def-name]) (do ///.monad [_ (//.lift (///.sub [(get@ [#////statement.analysis #////statement.state]) (set@ [#////statement.analysis #////statement.state])] (define-alias alias def-name)))] - (wrap ////statement.no-requirements)) - - _ - (///.throw //.invalid-syntax [extension-name %code inputsC+])))) + (wrap ////statement.no-requirements)))])) (template [<mame> <type> <scope>] [(def: <mame> diff --git a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux index 7281a0c0e..b67f4d20a 100644 --- a/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux +++ b/stdlib/source/lux/tool/compiler/phase/generation/php/runtime.lux @@ -1,5 +1,5 @@ (.module: - [lux (#- inc) + [lux (#- Global inc) [abstract [monad (#+ do)]] [control diff --git a/stdlib/source/lux/type/abstract.lux b/stdlib/source/lux/type/abstract.lux index 70ec590da..70b742236 100644 --- a/stdlib/source/lux/type/abstract.lux +++ b/stdlib/source/lux/type/abstract.lux @@ -42,9 +42,13 @@ (undefined)))) (def: (peek-scopes-definition reference source) - (-> Text (List [Text Definition]) (Stack Scope)) + (-> Text (List [Text Global]) (Stack Scope)) (!peek source reference - (let [[exported? scope-type scope-anns scope-value] head] + (case head + (#.Left _) + (undefined) + + (#.Right [exported? scope-type scope-anns scope-value]) (:coerce (Stack Scope) scope-value)))) (def: (peek-scopes reference definition-reference source) @@ -88,13 +92,17 @@ (undefined)))) (def: (push-scope-definition reference scope source) - (-> Text Scope (List [Text Definition]) (List [Text Definition])) + (-> Text Scope (List [Text Global]) (List [Text Global])) (!push source reference - (let [[exported? scopes-type scopes-anns scopes-value] head] - [exported? - scopes-type - scopes-anns - (stack.push scope (:coerce (Stack Scope) scopes-value))]))) + (case head + (#.Left _) + (undefined) + + (#.Right [exported? scopes-type scopes-anns scopes-value]) + (#.Right [exported? + scopes-type + scopes-anns + (stack.push scope (:coerce (Stack Scope) scopes-value))])))) (def: (push-scope [module-reference definition-reference] scope source) (-> Name Scope (List [Text Module]) (List [Text Module])) @@ -110,19 +118,23 @@ []]))) (def: (pop-scope-definition reference source) - (-> Text (List [Text Definition]) (List [Text Definition])) + (-> Text (List [Text Global]) (List [Text Global])) (!push source reference - (let [[exported? scopes-type scopes-anns scopes-value] head] - [exported? - scopes-type - scopes-anns - (let [current-scopes (:coerce (Stack Scope) scopes-value)] - (case (stack.pop current-scopes) - (#.Some current-scopes') - current-scopes' - - #.None - current-scopes))]))) + (case head + (#.Left _) + (undefined) + + (#.Right [exported? scopes-type scopes-anns scopes-value]) + (#.Right [exported? + scopes-type + scopes-anns + (let [current-scopes (:coerce (Stack Scope) scopes-value)] + (case (stack.pop current-scopes) + (#.Some current-scopes') + current-scopes' + + #.None + current-scopes))])))) (def: (pop-scope [module-reference definition-reference] source) (-> Name (List [Text Module]) (List [Text Module])) diff --git a/stdlib/source/lux/type/implicit.lux b/stdlib/source/lux/type/implicit.lux index 90fd32c1c..083a07e4d 100644 --- a/stdlib/source/lux/type/implicit.lux +++ b/stdlib/source/lux/type/implicit.lux @@ -1,7 +1,7 @@ (.module: [lux #* [abstract - ["." monad (#+ do Monad)] + ["." monad (#+ Monad do)] ["eq" equivalence]] [control ["p" parser @@ -111,13 +111,20 @@ [idx tag-list sig-type] (macro.resolve-tag member)] (wrap [idx sig-type]))) -(def: (prepare-definitions this-module-name definitions) - (-> Text (List [Text Definition]) (List [Name Type])) - (|> definitions - (list.filter (function (_ [name [exported? def-type def-anns def-value]]) - (macro.structure? def-anns))) - (list@map (function (_ [name [exported? def-type def-anns def-value]]) - [[this-module-name name] def-type])))) +(def: (prepare-definitions source-module target-module constants) + (-> Text Text (List [Text Global]) (List [Name Type])) + (do list.monad + [[name constant] constants] + (case constant + (#.Left _) + (list) + + (#.Right [exported? def-type def-anns def-value]) + (if (and (macro.structure? def-anns) + (or (text@= target-module source-module) + exported?)) + (list [[source-module name] def-type]) + (list))))) (def: local-env (Meta (List [Name Type])) @@ -137,7 +144,7 @@ (do macro.monad [this-module-name macro.current-module-name definitions (macro.definitions this-module-name)] - (wrap (prepare-definitions this-module-name definitions)))) + (wrap (prepare-definitions this-module-name this-module-name definitions)))) (def: import-structs (Meta (List [Name Type])) @@ -146,8 +153,8 @@ imp-mods (macro.imported-modules this-module-name) export-batches (monad.map @ (function (_ imp-mod) (do @ - [exports (macro.exports imp-mod)] - (wrap (prepare-definitions imp-mod exports)))) + [exports (macro.definitions imp-mod)] + (wrap (prepare-definitions imp-mod this-module-name exports)))) imp-mods)] (wrap (list@join export-batches)))) diff --git a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux index 5d8782a4f..842c23950 100644 --- a/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/phase/analysis/reference.lux @@ -46,7 +46,7 @@ (-> Text [Bit Text] [Bit Text] Check Bit) (|> (do ///.monad [_ (//module.with-module 0 def-module - (//module.define var-name [export? Any (' {}) []]))] + (//module.define var-name (#.Right [export? Any (' {}) []])))] (//module.with-module 0 dependent-module (do @ [_ (if import? @@ -82,7 +82,7 @@ (_.test "Can analyse definition (in the same module)." (let [def-name [def-module var-name]] (|> (do ///.monad - [_ (//module.define var-name [false expectedT (' {}) []])] + [_ (//module.define var-name (#.Right [false expectedT (' {}) []]))] (//type.with-inference (_primitive.phase (code.identifier def-name)))) (//module.with-module 0 def-module) |