aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2021-08-29 14:57:15 -0400
committerEduardo Julian2021-08-29 14:57:15 -0400
commit1680d4d8bc4046ed4728413f1e7cfd77aa7e84b7 (patch)
tree7e79997206c0102e4cd63f34e4da2a4336df52f4
parentc5b61d2f46ac19bf511197f3a537c4be0f47df33 (diff)
Made labels (tags & slots) into a form of global binding.
Diffstat (limited to '')
-rw-r--r--lux-bootstrapper/src/lux/analyser.clj16
-rw-r--r--lux-bootstrapper/src/lux/analyser/case.clj12
-rw-r--r--lux-bootstrapper/src/lux/analyser/lux.clj49
-rw-r--r--lux-bootstrapper/src/lux/analyser/module.clj334
-rw-r--r--lux-bootstrapper/src/lux/analyser/record.clj39
-rw-r--r--lux-bootstrapper/src/lux/base.clj7
-rw-r--r--lux-bootstrapper/src/lux/compiler/cache.clj72
-rw-r--r--lux-bootstrapper/src/lux/compiler/cache/type.clj4
-rw-r--r--lux-bootstrapper/src/lux/compiler/core.clj86
-rw-r--r--lux-bootstrapper/src/lux/compiler/jvm/lux.clj15
-rw-r--r--lux-jvm/source/luxc/lang/host/jvm.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/case.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/function.lux2
-rw-r--r--lux-jvm/source/luxc/lang/translation/jvm/runtime.lux2
-rw-r--r--stdlib/source/library/lux.lux287
-rw-r--r--stdlib/source/library/lux/control/function/mutual.lux2
-rw-r--r--stdlib/source/library/lux/control/parser/binary.lux70
-rw-r--r--stdlib/source/library/lux/data/format/binary.lux23
-rw-r--r--stdlib/source/library/lux/macro/template.lux2
-rw-r--r--stdlib/source/library/lux/meta.lux162
-rw-r--r--stdlib/source/library/lux/target/js.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/bytecode.lux2
-rw-r--r--stdlib/source/library/lux/target/jvm/reflection.lux6
-rw-r--r--stdlib/source/library/lux/target/lua.lux2
-rw-r--r--stdlib/source/library/lux/target/php.lux2
-rw-r--r--stdlib/source/library/lux/target/python.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux.lux58
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux85
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux31
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux42
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux11
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux51
-rw-r--r--stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux2
-rw-r--r--stdlib/source/library/lux/tool/compiler/meta/io/archive.lux17
-rw-r--r--stdlib/source/library/lux/type/abstract.lux61
-rw-r--r--stdlib/source/test/lux/macro.lux4
-rw-r--r--stdlib/source/test/lux/meta.lux78
-rw-r--r--stdlib/source/test/lux/target/jvm.lux2
41 files changed, 1008 insertions, 644 deletions
diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj
index e139e085f..ccd0144f6 100644
--- a/lux-bootstrapper/src/lux/analyser.clj
+++ b/lux-bootstrapper/src/lux/analyser.clj
@@ -17,9 +17,7 @@
;; [Utils]
(defn analyse-variant+ [analyse exo-type ident values]
(|do [[module tag-name] (&/normalize ident)
- _ (&&module/ensure-can-see-tag module tag-name)
- idx (&&module/tag-index module tag-name)
- group (&&module/tag-group module tag-name)
+ [exported? wanted-type group idx] (&&module/find-tag module (str "#" tag-name))
:let [is-last? (= idx (dec (&/|length group)))]]
(if (= 1 (&/|length group))
(|do [_location &/location]
@@ -29,8 +27,7 @@
(|do [? (&type/bound? id)]
(if (or ? (&&/type-tag? module tag-name))
(&&lux/analyse-variant analyse (&/$Right exo-type) idx is-last? values)
- (|do [wanted-type (&&module/tag-type module tag-name)
- wanted-type* (&type/instantiate-inference wanted-type)
+ (|do [wanted-type* (&type/instantiate-inference wanted-type)
[[variant-type variant-location] variant-analysis] (&&/cap-1 (&&lux/analyse-variant analyse (&/$Left wanted-type*) idx is-last? values))
_ (&type/check exo-type variant-type)]
(return (&/|list (&&/|meta exo-type variant-location variant-analysis))))))
@@ -149,12 +146,17 @@
(|let [(&/$Item [_ (&/$Identifier "" ?name)]
(&/$Item ?value
(&/$Item ?meta
- (&/$Item [_ (&/$Tuple ?tags)]
+ (&/$Item ?labels
(&/$Item exported?
(&/$End))))
)) parameters]
(&/with-location location
- (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta ?tags exported?)))
+ (|case ?labels
+ [_ (&/$Form ?tags)]
+ (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta false ?tags exported?)
+
+ [_ (&/$Tuple ?slots)]
+ (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value ?meta true ?slots exported?))))
"lux def program"
(|let [(&/$Item ?program (&/$End)) parameters]
diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj
index ba8afd4e8..062467ca3 100644
--- a/lux-bootstrapper/src/lux/analyser/case.clj
+++ b/lux-bootstrapper/src/lux/analyser/case.clj
@@ -347,15 +347,13 @@
(&/$Tag ?ident)
(|do [[=module =name] (&&/resolved-ident ?ident)
must-infer? (&type/unknown? value-type)
+ [_exported? variant-type** group idx] (&module/find-tag =module (str "#" =name))
variant-type (if must-infer?
- (|do [variant-type (&module/tag-type =module =name)
- variant-type* (&type/instantiate-inference variant-type)
+ (|do [variant-type* (&type/instantiate-inference variant-type**)
_ (&type/check value-type variant-type*)]
(return variant-type*))
(return value-type))
value-type* (adjust-type variant-type)
- idx (&module/tag-index =module =name)
- group (&module/tag-group =module =name)
case-type (&type/sum-at idx value-type*)
[=test =kont] (analyse-pattern &/$None case-type unit-tuple kont)]
(return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
@@ -374,15 +372,13 @@
(&/$Form (&/$Item [_ (&/$Tag ?ident)] ?values))
(|do [[=module =name] (&&/resolved-ident ?ident)
must-infer? (&type/unknown? value-type)
+ [_exported? variant-type** group idx] (&module/find-tag =module (str "#" =name))
variant-type (if must-infer?
- (|do [variant-type (&module/tag-type =module =name)
- variant-type* (&type/instantiate-inference variant-type)
+ (|do [variant-type* (&type/instantiate-inference variant-type**)
_ (&type/check value-type variant-type*)]
(return variant-type*))
(return value-type))
value-type* (adjust-type variant-type)
- idx (&module/tag-index =module =name)
- group (&module/tag-group =module =name)
case-type (&type/sum-at idx value-type*)
[=test =kont] (case (int (&/|length ?values))
0 (analyse-pattern &/$None case-type unit-tuple kont)
diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj
index 769b85e30..8b93faea8 100644
--- a/lux-bootstrapper/src/lux/analyser/lux.clj
+++ b/lux-bootstrapper/src/lux/analyser/lux.clj
@@ -248,9 +248,9 @@
(|do [[rec-members rec-type] (&&record/order-record ?elems)]
(|case exo-type
(&/$Var id)
- (|do [? (&type/bound? id)]
- (if ?
- (analyse-tuple analyse (&/$Right exo-type) rec-members)
+ (|do [verdict (&type/bound? id)]
+ (if verdict
+ (analyse-tuple analyse (&/$Right exo-type) rec-members)
(|do [[[tuple-type tuple-location] tuple-analysis] (&&/cap-1 (analyse-tuple analyse (&/$Left rec-type) rec-members))
_ (&type/check exo-type tuple-type)]
(return (&/|list (&&/|meta exo-type tuple-location
@@ -261,7 +261,7 @@
)))
(defn ^:private analyse-global [analyse exo-type module name]
- (|do [[[r-module r-name] [exported? endo-type ?meta ?value]] (&&module/find-def module name)
+ (|do [[[r-module r-name] [exported? endo-type ?annotations ?value]] (&&module/find-def module name)
;; This is a small shortcut to optimize analysis of typing code.
_ (if (and (&type/type= &type/Type endo-type)
(&type/type= &type/Type exo-type))
@@ -376,7 +376,7 @@
(defn analyse-apply [analyse location exo-type macro-caller =fn ?args]
(|case =fn
[_ (&&/$def ?module ?name)]
- (|do [[real-name [exported? ?type ?meta ?value]] (&&module/find-def! ?module ?name)]
+ (|do [[real-name [exported? ?type ?annotations ?value]] (&&module/find-def! ?module ?name)]
(if (&type/type= &type/Macro ?type)
(|do [macro-expansion (fn [state]
(|case (macro-caller ?value ?args state)
@@ -549,7 +549,7 @@
(str "\nThis is an alias for " source-name)))))
(return &/$End))))
-(defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?meta exported? & [?expected-type]]
+(defn analyse-def* [analyse optimize eval! compile-def ?name ?value ?annotations exported? type? & [?expected-type]]
(|do [_ &/ensure-directive
module-name &/get-module-name
_ (ensure-undefined! module-name ?name)
@@ -561,32 +561,29 @@
(&&/analyse-1+ analyse ?value))))
=exported? (&&/analyse-1 analyse &type/Bit exported?)
==exported? (eval! (optimize =exported?))
- =meta (&&/analyse-1 analyse &type/Code ?meta)
- ==meta (eval! (optimize =meta))
- def-value (compile-def ?name (optimize =value) ==meta ==exported?)
+ =annotations (&&/analyse-1 analyse &type/Code ?annotations)
+ ==annotations (eval! (optimize =annotations))
+ def-value (compile-def ?name (optimize =value) ==annotations ==exported? type?)
_ &type/reset-mappings
:let [def-type (&&/expr-type* =value)
_ (println 'DEF (str module-name &/+name-separator+ ?name
" : " (&type/show-type def-type)))]]
(return (&/T [module-name def-type def-value ==exported?]))))
-(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?meta exported?]
- (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta exported?)]
+(defn analyse-def [analyse optimize eval! compile-def ?name ?value ?annotations exported?]
+ (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value ?annotations exported? &/$None)]
(return &/$End)))
-(defn analyse-def-type-tagged [analyse optimize eval! compile-def ?name ?value ?meta tags* exported?]
- (|do [[module-name def-type def-value =exported?] (analyse-def* analyse optimize eval! compile-def ?name ?value ?meta exported? &type/Type)
- _ (&/assert! (&type/type= &type/Type def-type)
- "[Analyser Error] Cannot define tags for non-type.")
- tags (&/map% (fn [tag*]
- (|case tag*
- [_ (&/$Text tag)]
- (return tag)
-
- _
- (&/fail-with-loc "[Analyser Error] Incorrect format for tags.")))
- tags*)
- _ (&&module/declare-tags module-name tags =exported? def-value)]
+(defn analyse-def-type-tagged [analyse optimize eval! compile-def ?name ?value ?annotations record? labels* exported?]
+ (|do [labels (&/map% (fn [tag*]
+ (|case tag*
+ [_ (&/$Text tag)]
+ (return tag)
+
+ _
+ (&/fail-with-loc "[Analyser Error] Incorrect format for labels.")))
+ labels*)
+ _ (analyse-def* analyse optimize eval! compile-def ?name ?value ?annotations exported? (&/$Some (&/T [record? labels])) &type/Type)]
(return &/$End)))
(defn analyse-def-alias [?alias ?original]
@@ -661,9 +658,9 @@
(return (doto (promise)
(deliver (&/$Right _compiler))))))))
-(defn analyse-module [analyse optimize eval! compile-module ?meta ?imports]
+(defn analyse-module [analyse optimize eval! compile-module ?annotations ?imports]
(|do [_ &/ensure-directive
- =anns (&&/analyse-1 analyse &type/Code ?meta)
+ =anns (&&/analyse-1 analyse &type/Code ?annotations)
==anns (eval! (optimize =anns))
module-name &/get-module-name
_ (&&module/set-anns ==anns module-name)
diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj
index 12e6b816a..8c6f06d88 100644
--- a/lux-bootstrapper/src/lux/analyser/module.clj
+++ b/lux-bootstrapper/src/lux/analyser/module.clj
@@ -22,8 +22,6 @@
"module-aliases"
"defs"
"imports"
- "tags"
- "types"
"module-annotations"
"module-state"])
@@ -36,10 +34,6 @@
(&/|table)
;; "lux;imports"
&/$End
- ;; "lux;tags"
- (&/|table)
- ;; "lux;types"
- (&/|table)
;; module-annotations
&/$None
;; "module-state"
@@ -115,7 +109,7 @@
(&/|update module
(fn [m]
(&/update$ $defs
- #(&/|put name (&/$Left de-aliased) %)
+ #(&/|put name (&/$AliasG de-aliased) %)
m))
ms))))
nil)
@@ -134,7 +128,7 @@
(&/|update module
(fn [m]
(&/update$ $defs
- #(&/|put name (&/$Right (&/T [exported? def-type def-meta def-value])) %)
+ #(&/|put name (&/$DefinitionG (&/T [exported? def-type def-meta def-value])) %)
m))
ms))))
nil)
@@ -150,15 +144,26 @@
(if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
(if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
(|case $def
- (&/$Left [o-module o-name])
+ (&/$AliasG [o-module o-name])
((type-def o-module o-name) state)
- (&/$Right [exported? ?type ?meta ?value])
+ (&/$DefinitionG [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]))
"\nMETA: " (&/show-ast ?meta)))
- state)))
+ state))
+
+ (&/$TypeG [exported? ?value labels])
+ (return* state (&/T [exported? ?value]))
+
+ (&/$TagG _)
+ ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name]))))
+ state)
+
+ (&/$SlotG _)
+ ((&/fail-with-loc (str "[Analyser Error] Not a type: " (&/ident->text (&/T [module name]))))
+ state))
((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T [module name]))))
state))
((&/fail-with-loc (str "[Analyser Error] Unknown module: " module))
@@ -226,18 +231,35 @@
ms))))
nil)))
+(def empty_annotations
+ (let [dummy_location (&/T ["" 0 0])]
+ (&/T [dummy_location
+ (&/$Record &/$End)])))
+
(defn find-def! [module name]
(|do [current-module &/get-module-name]
(fn [state]
(if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
(if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
(|case $def
- (&/$Left [?r-module ?r-name])
+ (&/$AliasG [?r-module ?r-name])
((find-def! ?r-module ?r-name)
state)
- (&/$Right $def*)
- (return* state (&/T [(&/T [module name]) $def*])))
+ (&/$DefinitionG $def*)
+ (return* state (&/T [(&/T [module name]) $def*]))
+
+ (&/$TypeG [exported? ?value labels])
+ (return* state (&/T [(&/T [module name])
+ (&/T [exported? &type/Type empty_annotations ?value])]))
+
+ (&/$TagG _)
+ ((&/fail-with-loc (str "[Analyser Error] Not a definition: " (&/ident->text (&/T [module name]))))
+ state)
+
+ (&/$SlotG _)
+ ((&/fail-with-loc (str "[Analyser Error] Not a definition: " (&/ident->text (&/T [module name]))))
+ state))
((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (str module &/+name-separator+ name)
" at module: " current-module))
state))
@@ -251,7 +273,7 @@
(if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
(if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
(|case $def
- (&/$Left [?r-module ?r-name])
+ (&/$AliasG [?r-module ?r-name])
(if (.equals ^Object current-module module)
((find-def! ?r-module ?r-name)
state)
@@ -259,7 +281,7 @@
" at module: " current-module))
state))
- (&/$Right [exported? ?type ?meta ?value])
+ (&/$DefinitionG [exported? ?type ?meta ?value])
(if (or (.equals ^Object current-module module)
(and exported?
(or (.equals ^Object module &/prelude)
@@ -268,7 +290,26 @@
(&/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)))
+ state))
+
+ (&/$TypeG [exported? ?value labels])
+ (if (or (.equals ^Object current-module module)
+ (and exported?
+ (or (.equals ^Object module &/prelude)
+ (imports? state module current-module))))
+ (return* state (&/T [(&/T [module name])
+ (&/T [exported? &type/Type empty_annotations ?value])]))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name)
+ " at module: " current-module))
+ state))
+
+ (&/$TagG _)
+ ((&/fail-with-loc (str "[Analyser Error] Not a definition: " (&/ident->text (&/T [module name]))))
+ state)
+
+ (&/$SlotG _)
+ ((&/fail-with-loc (str "[Analyser Error] Not a definition: " (&/ident->text (&/T [module name]))))
+ state))
((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name)
" at module: " current-module))
state))
@@ -276,6 +317,73 @@
" at module: " current-module))
state)))))
+(do-template [<tag> <find!> <find>]
+ (do (defn <find!> [module name]
+ (|do [current-module &/get-module-name]
+ (fn [state]
+ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
+ (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
+ (|case $def
+ (&/$AliasG [?r-module ?r-name])
+ ((<find!> ?r-module ?r-name)
+ state)
+
+ (<tag> ?payload)
+ (return* state ?payload)
+
+ _
+ ((&/fail-with-loc (str "[Analyser Error] Not a label: " (&/ident->text (&/T [module name]))
+ " @ " (quote <find!>)))
+ state))
+ ((&/fail-with-loc (str "[Analyser Error] Label does not exist: " (str module &/+name-separator+ name)
+ " at module: " current-module
+ " @ " (quote <find!>)))
+ state))
+ ((&/fail-with-loc (str "[Analyser Error] Module does not exist: " module
+ " at module: " current-module
+ " @ " (quote <find!>)))
+ state)))))
+ (defn <find> [module name]
+ (|do [current-module &/get-module-name]
+ (fn [state]
+ (if-let [$module (->> state (&/get$ &/$modules) (&/|get module))]
+ (if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
+ (|case $def
+ (&/$AliasG [?r-module ?r-name])
+ (if (.equals ^Object current-module module)
+ ((<find!> ?r-module ?r-name)
+ state)
+ ((&/fail-with-loc (str "[Analyser Error] Cannot use (private) alias: " (str module &/+name-separator+ name)
+ " at module: " current-module
+ " @ " (quote <find>)))
+ state))
+
+ (<tag> [exported? type group index])
+ (if (or (.equals ^Object current-module module)
+ exported?)
+ (return* state (&/T [exported? type group index]))
+ ((&/fail-with-loc (str "[Analyser Error] Cannot use private label: " (str module &/+name-separator+ name)
+ " at module: " current-module
+ " @ " (quote <find>)))
+ state))
+
+ _
+ ((&/fail-with-loc (str "[Analyser Error] Not a label: " (&/ident->text (&/T [module name]))
+ " @ " (quote <find>)))
+ state))
+ ((&/fail-with-loc (str "[Analyser Error] Label does not exist: " (str module &/+name-separator+ name)
+ " at module: " current-module
+ " @ " (quote <find>)))
+ state))
+ ((&/fail-with-loc (str "[Analyser Error] Module does not exist: " module
+ " at module: " current-module
+ " @ " (quote <find>)))
+ state))))))
+
+ &/$TagG find-tag! find-tag
+ &/$SlotG find-slot! find-slot
+ )
+
(defn defined? [module name]
(&/try-all% (&/|list (|do [_ (find-def! module name)]
(return true))
@@ -291,21 +399,14 @@
(&/set$ &/$current-module (&/$Some name)))
nil)))
-(do-template [<name> <tag> <type>]
- (defn <name>
- <type>
- [module]
- (fn [state]
- (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (return* state (&/get$ <tag> =module))
- ((&/fail-with-loc (str "[Lux Error] Unknown module: " module))
- state))
- ))
-
- tags-by-module $tags "(-> Text (Lux (List (, Text (, Int (List Text) Type)))))"
- types-by-module $types "(-> Text (Lux (List (, Text (, (List Text) Type)))))"
- module-hash $module-hash "(-> Text (Lux Int))"
- )
+(defn module-hash
+ "(-> Text (Lux Int))"
+ [module]
+ (fn [state]
+ (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
+ (return* state (&/get$ $module-hash =module))
+ ((&/fail-with-loc (str "[Lux Error] Unknown module: " module))
+ state))))
(def imports
(|do [module &/get-module-name
@@ -316,85 +417,90 @@
(return (&/T [_module _hash]))))
_imports)))
-(defn ensure-undeclared-tags [module tags]
- (|do [tags-table (tags-by-module module)
- _ (&/map% (fn [tag]
- (if (&/|get tag tags-table)
- (&/fail-with-loc (str "[Analyser Error] Cannot re-declare tag: " (&/ident->text (&/T [module tag]))))
- (return nil)))
- tags)]
- (return nil)))
-
-(defn ensure-undeclared-type [module name]
- (|do [types-table (types-by-module module)
- _ (&/assert! (nil? (&/|get name types-table))
- (str "[Analyser Error] Cannot re-declare type: " (&/ident->text (&/T [module name]))))]
- (return nil)))
-
-(defn declare-tags
+(defn define_tag [module name exported? type group index]
+ (fn [state]
+ (|case (&/get$ &/$scopes state)
+ (&/$Item ?env (&/$End))
+ (return* (->> state
+ (&/update$ &/$modules
+ (fn [ms]
+ (&/|update module
+ (fn [m]
+ (&/update$ $defs
+ #(&/|put name (&/$TagG (&/T [exported? type group index])) %)
+ m))
+ ms))))
+ nil)
+
+ _
+ ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global tag outside of a global environment: " (str module &/+name-separator+ name)))
+ state))))
+
+(defn define_slot [module name exported? type group index]
+ (fn [state]
+ (|case (&/get$ &/$scopes state)
+ (&/$Item ?env (&/$End))
+ (return* (->> state
+ (&/update$ &/$modules
+ (fn [ms]
+ (&/|update module
+ (fn [m]
+ (&/update$ $defs
+ #(&/|put name (&/$SlotG (&/T [exported? type group index])) %)
+ m))
+ ms))))
+ nil)
+
+ _
+ ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global slot outside of a global environment: " (str module &/+name-separator+ name)))
+ state))))
+
+(defn declare-labels
"(-> Text (List Text) Bit Type (Lux Null))"
- [module tag-names was-exported? type]
- (|do [_ (ensure-undeclared-tags module tag-names)
- type-name (&type/type-name type)
+ [module record? label-names was-exported? type]
+ (|do [type-name (&type/type-name type)
:let [[_module _name] type-name]
_ (&/assert! (= module _module)
- (str "[Module Error] Cannot define tags for a type belonging to a foreign module: " (&/ident->text type-name)))
- _ (ensure-undeclared-type _module _name)]
- (fn [state]
- (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (let [tags (&/|map (fn [tag-name] (&/T [module tag-name])) tag-names)]
- (return* (&/update$ &/$modules
- (fn [=modules]
- (&/|update module
- #(->> %
- (&/set$ $tags (&/fold (fn [table idx+tag-name]
- (|let [[idx tag-name] idx+tag-name]
- (&/|put tag-name (&/T [idx tags was-exported? type]) table)))
- (&/get$ $tags %)
- (&/enumerate tag-names)))
- (&/update$ $types (partial &/|put _name (&/T [tags was-exported? type]))))
- =modules))
- state)
- nil))
- ((&/fail-with-loc (str "[Lux Error] Unknown module: " module))
- state)))))
-
-(defn ensure-can-see-tag
- "(-> Text Text (Lux Any))"
- [module tag-name]
- (|do [current-module &/get-module-name]
- (fn [state]
- (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (if-let [^objects idx+tags+exported+type (&/|get tag-name (&/get$ $tags =module))]
- (|let [[?idx ?tags ?exported ?type] idx+tags+exported+type]
- (if (or ?exported
- (= module current-module))
- (return* state &/unit-tag)
- ((&/fail-with-loc (str "[Analyser Error] Cannot access tag #" (&/ident->text (&/T [module tag-name])) " from module " current-module))
- state)))
- ((&/fail-with-loc (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name]))))
- state))
- ((&/fail-with-loc (str "[Module Error] Unknown module: " module))
- state)))))
-
-(do-template [<name> <part> <doc>]
- (defn <name>
- <doc>
- [module tag-name]
- (fn [state]
- (if-let [=module (->> state (&/get$ &/$modules) (&/|get module))]
- (if-let [^objects idx+tags+exported+type (&/|get tag-name (&/get$ $tags =module))]
- (|let [[?idx ?tags ?exported ?type] idx+tags+exported+type]
- (return* state <part>))
- ((&/fail-with-loc (str "[Module Error] Unknown tag: " (&/ident->text (&/T [module tag-name]))))
- state))
- ((&/fail-with-loc (str "[Module Error] Unknown module: " module))
- state))))
-
- tag-index ?idx "(-> Text Text (Lux Int))"
- tag-group ?tags "(-> Text Text (Lux (List Ident)))"
- tag-type ?type "(-> Text Text (Lux Type))"
- )
+ (str "[Module Error] Cannot define labels for a type belonging to a foreign module: " (&/ident->text type-name)))]
+ (if (nil? record?)
+ (return &/unit-tag)
+ (if record?
+ (&/map% (fn [idx+label-name]
+ (|let [[index label-name] idx+label-name]
+ (define_slot module (str "#" label-name) was-exported? type label-names index)))
+ (&/enumerate label-names))
+ (&/map% (fn [idx+label-name]
+ (|let [[index label-name] idx+label-name]
+ (define_tag module (str "#" label-name) was-exported? type label-names index)))
+ (&/enumerate label-names))))))
+
+(defn define-type [module name exported? def-meta def-value record? labels]
+ (|case labels
+ (&/$End)
+ (define module name exported? &type/Type def-meta def-value)
+
+ (&/$Item labelH labelT)
+ (|do [_ (declare-labels module record? labels exported? def-value)]
+ (fn [state]
+ (|case (&/get$ &/$scopes state)
+ (&/$Item ?env (&/$End))
+ (return* (->> state
+ (&/update$ &/$modules
+ (fn [ms]
+ (&/|update module
+ (fn [m]
+ (&/update$ $defs
+ #(&/|put name (&/$TypeG (&/T [exported? def-value (if record?
+ (&/$Right (&/T [labelH labelT]))
+ (&/$Left (&/T [labelH labelT])))]))
+ %)
+ 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))))))
(def defs
(|do [module &/get-module-name]
@@ -417,15 +523,3 @@
_
(&/fail-with-loc "[Analyser Error] Incorrect import syntax.")))
-
-(def ^{:doc "(Lux (List [Text (List Text)]))"}
- tag-groups
- (|do [module &/get-current-module]
- (return (&/|map (fn [pair]
- (|case pair
- [name [tags exported? _]]
- (&/T [name (&/|map (fn [tag]
- (|let [[t-prefix t-name] tag]
- t-name))
- tags)])))
- (&/get$ $types module)))))
diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj
index 53f6c4d5c..7af3c17ac 100644
--- a/lux-bootstrapper/src/lux/analyser/record.clj
+++ b/lux-bootstrapper/src/lux/analyser/record.clj
@@ -10,18 +10,18 @@
(defn order-record
"(-> (List (, Syntax Syntax)) (Lux (List Syntax)))"
[pairs]
- (|do [[tag-group tag-type] (|case pairs
- (&/$End)
- (return (&/T [&/$End &type/Any]))
-
- (&/$Item [[_ (&/$Tag tag1)] _] _)
- (|do [[module name] (&&/resolved-ident tag1)
- tags (&&module/tag-group module name)
- type (&&module/tag-type module name)]
- (return (&/T [tags type])))
+ (|do [[module slot-group slot-type] (|case pairs
+ (&/$End)
+ (|do [module &/get-module-name]
+ (return (&/T [module &/$End &type/Any])))
+
+ (&/$Item [[_ (&/$Tag slot1)] _] _)
+ (|do [[module name] (&&/resolved-ident slot1)
+ [_exported? type slots _index] (&&module/find-slot module (str "#" name))]
+ (return (&/T [module slots type])))
- _
- (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be tags."))
+ _
+ (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots."))
=pairs (&/map% (fn [kv]
(|case kv
[[_ (&/$Tag k)] v]
@@ -29,15 +29,16 @@
(return (&/T [(&/ident->text =k) v])))
_
- (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be tags.")))
+ (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots.")))
pairs)
- _ (let [num-expected (&/|length tag-group)
+ _ (let [num-expected (&/|length slot-group)
num-got (&/|length =pairs)]
(&/assert! (= num-expected num-got)
(str "[Analyser Error] Wrong number of record members. Expected " num-expected ", but got " num-got ".")))
- =members (&/map% (fn [tag]
- (if-let [member (&/|get tag =pairs)]
- (return member)
- (&/fail-with-loc (str "[Analyser Error] Missing tag: " tag))))
- (&/|map &/ident->text tag-group))]
- (return (&/T [=members tag-type]))))
+ =members (&/map% (fn [slot]
+ (let [slot (&/ident->text (&/T [module slot]))]
+ (if-let [member (&/|get slot =pairs)]
+ (return member)
+ (&/fail-with-loc (str "[Analyser Error] Missing slot: " slot)))))
+ slot-group)]
+ (return (&/T [=members slot-type]))))
diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj
index 1367bdc1c..f95c4d6d5 100644
--- a/lux-bootstrapper/src/lux/base.clj
+++ b/lux-bootstrapper/src/lux/base.clj
@@ -148,6 +148,13 @@
("Jvm" 1)
("Js" 1))
+(defvariant
+ ("DefinitionG" 1)
+ ("TypeG" 1)
+ ("TagG" 1)
+ ("SlotG" 1)
+ ("AliasG" 1))
+
(deftuple
["info"
"source"
diff --git a/lux-bootstrapper/src/lux/compiler/cache.clj b/lux-bootstrapper/src/lux/compiler/cache.clj
index bbe9e7882..d2b232f74 100644
--- a/lux-bootstrapper/src/lux/compiler/cache.clj
+++ b/lux-bootstrapper/src/lux/compiler/cache.clj
@@ -69,48 +69,50 @@
(delete-all-module-files (new File (str output-dir-prefix f))))
nil))
-(defn ^:private parse-tag-groups [^String tags-section]
- (if (= "" tags-section)
- &/$End
- (-> tags-section
- (.split &&core/entry-separator)
- seq
- (->> (map (fn [^String _group]
- (let [[_type & _tags] (.split _group &&core/datum-separator)]
- (&/T [_type (->> _tags seq &/->list)])))))
- &/->list)))
-
-(defn ^:private process-tag-group [module group]
- (|let [[_type _tags] group]
- (|do [[was-exported? =type] (&a-module/type-def module _type)]
- (&a-module/declare-tags module _tags was-exported? =type))))
-
(defn make-tag [ident]
(&/T [(&/T ["" 0 0]) (&/$Tag ident)]))
(defn make-identifier [ident]
(&/T [(&/T ["" 0 0]) (&/$Identifier ident)]))
-(defn make-record [ident]
- (&/T [(&/T ["" 0 0]) (&/$Record ident)]))
+(defn make-record [kvs]
+ (&/T [(&/T ["" 0 0]) (&/$Record kvs)]))
(defn ^:private process-def-entry [load-def-value module ^String _def-entry]
(let [parts (.split _def-entry &&core/datum-separator)]
- (case (alength parts)
- 2 (let [[_name ^String _alias] parts
- [__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)]
- (|do [def-value (load-def-value module _name)]
- (&a-module/define module _name (= "1" _exported?) def-type def-anns def-value))))))
+ (case (first parts)
+ "A" (let [[_ _name ^String _alias] parts
+ [__module __name] (.split _alias &/+name-separator+)]
+ (&a-module/define-alias module _name (&/T [__module __name])))
+ "D" (let [[_ _name _exported? _type _anns] parts
+ [def-anns _] (&&&ann/deserialize _anns)
+ [def-type _] (&&&type/deserialize-type _type)]
+ (|do [def-value (load-def-value module _name)]
+ (&a-module/define module _name (= "1" _exported?) def-type def-anns def-value)))
+ ":" (let [[_ _name _exported? _record? _head _tail] parts
+ labels (&/$Item _head (if _tail
+ (&/->list (seq (.split _tail "\\.")))
+ &/$End))]
+ (|do [def-value (load-def-value module _name)]
+ (&a-module/define-type
+ module _name
+ (= "1" _exported?) (make-record &/$End)
+ def-value (= "1" _record?) labels)))
+ ;; "T" (let [[_ _name _exported? _type _index _group] parts
+ ;; [_type _] (&&&type/deserialize-type _type)
+ ;; _group (&/->list (seq (.split _group "\\.")))]
+ ;; (&a-module/define_tag module _name (= "1" _exported?) _type _group (Long/parseLong _index)))
+ ;; "S" (let [[_ _name _exported? _type _index _group] parts
+ ;; [_type _] (&&&type/deserialize-type _type)
+ ;; _group (&/->list (seq (.split _group "\\.")))]
+ ;; (&a-module/define_slot module _name (= "1" _exported?) _type _group (Long/parseLong _index)))
+ )))
(defn ^:private uninstall-cache [module]
(|do [_ (delete module)]
(return false)))
-(defn ^:private install-module [load-def-value module module-hash imports tag-groups ?module-anns def-entries]
+(defn ^:private install-module [load-def-value module module-hash imports ?module-anns def-entries]
(|do [_ (&a-module/create-module module module-hash)
_ (&a-module/flag-cached-module module)
_ (|case ?module-anns
@@ -121,12 +123,11 @@
(return nil))
_ (&a-module/set-imports imports)
_ (&/map% (partial process-def-entry load-def-value module)
- def-entries)
- _ (&/map% (partial process-tag-group module) tag-groups)]
+ def-entries)]
(return nil)))
(defn ^:private process-module [pre-load! source-dirs cache-table module-name module-hash
- _imports-section _tags-section _module-anns-section _defs-section
+ _imports-section _module-anns-section _defs-section
load-def-value install-all-defs-in-module uninstall-all-defs-in-module]
(|do [^String descriptor (&&core/read-module-descriptor! module-name)
:let [imports (let [imports (vec (.split ^String _imports-section &&core/entry-separator))
@@ -143,8 +144,7 @@
imports)]
(if (&/|every? (fn [_module] (contains? cache-table* _module))
imports)
- (let [tag-groups (parse-tag-groups _tags-section)
- [?module-anns _] (if (= "..." _module-anns-section)
+ (let [[?module-anns _] (if (= "..." _module-anns-section)
[&/$None nil]
(let [[module-anns _] (&&&ann/deserialize _module-anns-section)]
[(&/$Some module-anns) _]))
@@ -154,7 +154,7 @@
(&/->list def-entries)))]
(|do [_ (install-all-defs-in-module module-name)
_ (install-module load-def-value module-name module-hash
- imports tag-groups ?module-anns def-entries)
+ imports ?module-anns def-entries)
=module (&/find-module module-name)]
(return (&/T [true (assoc cache-table* module-name =module)]))))
(return (&/T [false cache-table*])))))
@@ -191,14 +191,14 @@
:else
(|do [^String descriptor (&&core/read-module-descriptor! module-name)
- :let [[_compiler _hash _imports-section _tags-section _module-anns-section _defs-section] (.split descriptor &&core/section-separator)
+ :let [[_compiler _hash _imports-section _module-anns-section _defs-section] (.split descriptor &&core/section-separator)
drop-cache! (|do [_ (uninstall-cache module-name)
_ (uninstall-all-defs-in-module module-name)]
(return cache-table))]]
(if (and (= module-hash (Long/parseUnsignedLong ^String _hash))
(= &/version _compiler))
(|do [[success? cache-table*] (process-module pre-load! source-dirs cache-table module-name module-hash
- _imports-section _tags-section _module-anns-section _defs-section
+ _imports-section _module-anns-section _defs-section
load-def-value install-all-defs-in-module uninstall-all-defs-in-module)
_ (if success?
(return nil)
diff --git a/lux-bootstrapper/src/lux/compiler/cache/type.clj b/lux-bootstrapper/src/lux/compiler/cache/type.clj
index f4d33edc1..50e943b73 100644
--- a/lux-bootstrapper/src/lux/compiler/cache/type.clj
+++ b/lux-bootstrapper/src/lux/compiler/cache/type.clj
@@ -97,8 +97,8 @@
[(<type> (Long/parseLong idx)) input*])))
^:private deserialize-parameter "$" &/$Parameter
- ^:private deserialize-ex "!" &/$Ex
- ^:private deserialize-var "?" &/$Var
+ ^:private deserialize-ex "!" &/$Ex
+ ^:private deserialize-var "?" &/$Var
)
(defn ^:private deserialize-named [^String input]
diff --git a/lux-bootstrapper/src/lux/compiler/core.clj b/lux-bootstrapper/src/lux/compiler/core.clj
index 88da626bd..b2d366d5d 100644
--- a/lux-bootstrapper/src/lux/compiler/core.clj
+++ b/lux-bootstrapper/src/lux/compiler/core.clj
@@ -47,40 +47,76 @@
?module-anns (&a-module/get-anns module-name)
defs &a-module/defs
imports &a-module/imports
- tag-groups &a-module/tag-groups
- :let [def-entries (->> defs
- (&/|map (fn [_def]
- (|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))))))
- (&/|interpose entry-separator)
- (&/fold str ""))
+ :let [def-entries (&/fold (fn [def-entries _def]
+ (|let [[?name _definition] _def]
+ (|case _definition
+ (&/$AliasG [_dmodule _dname])
+ (str "A"
+ datum-separator ?name
+ datum-separator _dmodule &/+name-separator+ _dname
+ ;; Next
+ entry-separator def-entries)
+
+ (&/$DefinitionG [exported? ?def-type ?def-anns ?def-value])
+ (str "D"
+ datum-separator ?name
+ datum-separator (if exported? "1" "0")
+ datum-separator (&&&type/serialize-type ?def-type)
+ datum-separator (&&&ann/serialize ?def-anns)
+ ;; Next
+ entry-separator def-entries)
+
+ (&/$TypeG [exported? value labels])
+ (let [[record? head tail] (|case labels
+ (&/$Left [head tail])
+ [false head tail]
+
+ (&/$Right [head tail])
+ [true head tail])]
+ (str ":"
+ datum-separator ?name
+ datum-separator (if exported? "1" "0")
+ datum-separator (if record? "1" "0")
+ datum-separator head
+ datum-separator (->> tail
+ (&/|interpose &/+name-separator+)
+ (&/fold str ""))
+ ;; Next
+ entry-separator def-entries))
+
+ (&/$TagG [?export ?type ?group ?index])
+ def-entries
+ ;; (str "T"
+ ;; datum-separator ?name
+ ;; datum-separator (if ?export "1" "0")
+ ;; datum-separator (&&&type/serialize-type ?type)
+ ;; datum-separator ?index
+ ;; datum-separator (->> ?group
+ ;; (&/|interpose &/+name-separator+)
+ ;; (&/fold str "")))
+
+ (&/$SlotG [?export ?type ?group ?index])
+ def-entries
+ ;; (str "S"
+ ;; datum-separator ?name
+ ;; datum-separator (if ?export "1" "0")
+ ;; datum-separator (&&&type/serialize-type ?type)
+ ;; datum-separator ?index
+ ;; datum-separator (->> ?group
+ ;; (&/|interpose &/+name-separator+)
+ ;; (&/fold str "")))
+ )))
+ ""
+ defs)
import-entries (->> imports
(&/|map (fn [import]
(|let [[_module _hash] import]
(str _module datum-separator _hash))))
(&/|interpose entry-separator)
(&/fold str ""))
- tag-entries (->> tag-groups
- (&/|map (fn [group]
- (|let [[type tags] group]
- (->> tags
- (&/|interpose datum-separator)
- (&/fold str "")
- (str type datum-separator)))))
- (&/|interpose entry-separator)
- (&/fold str ""))
module-descriptor (->> (&/|list &/version
(Long/toUnsignedString file-hash)
import-entries
- tag-entries
(|case ?module-anns
(&/$Some module-anns)
(&&&ann/serialize module-anns)
diff --git a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj
index 973d0e8c6..a93c87ae8 100644
--- a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj
+++ b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj
@@ -250,7 +250,7 @@
(str base "\n\n" "Caused by: " (throwable->text cause))
base)))
-(defn ^:private install-def! [class-loader current-class module-name ?name ?body ?meta exported?]
+(defn ^:private install-def! [class-loader current-class module-name ?name ?body ?meta exported? type?]
(|do [_ (return nil)
:let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
def-type (&a/expr-type* ?body)]
@@ -260,12 +260,17 @@
(str "Error during value initialization:\n"
(throwable->text t)))))
_ (&/without-repl-closure
- (&a-module/define module-name ?name exported? def-type ?meta def-value))]
+ (|case type?
+ (&/$Some [record? labels])
+ (&a-module/define-type module-name ?name exported? ?meta def-value record? labels)
+
+ (&/$None)
+ (&a-module/define module-name ?name exported? def-type ?meta def-value)))]
(return def-value)))
(let [class-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_SUPER)
field-flags (+ Opcodes/ACC_PUBLIC Opcodes/ACC_FINAL Opcodes/ACC_STATIC)]
- (defn compile-def [compile ?name ?body ?meta exported?]
+ (defn compile-def [compile ?name ?body ?meta exported? type?]
(|do [module-name &/get-module-name
class-loader &/loader]
(|case (de-ann ?body)
@@ -296,7 +301,7 @@
(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?)]
+ def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported? type?)]
(return def-value)))
_
@@ -322,7 +327,7 @@
(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?)]
+ def-value (install-def! class-loader current-class module-name ?name ?body ?meta exported? type?)]
(return def-value))))))
(defn compile-program [compile ?program]
diff --git a/lux-jvm/source/luxc/lang/host/jvm.lux b/lux-jvm/source/luxc/lang/host/jvm.lux
index 3b03f1510..df9575ef4 100644
--- a/lux-jvm/source/luxc/lang/host/jvm.lux
+++ b/lux-jvm/source/luxc/lang/host/jvm.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Definition Type)
+ [lux (#- Definition Type Label)
[ffi (#+ import:)]
[abstract
monad]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/case.lux b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
index eb1f37f0b..4c385c0e4 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/case.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/case.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type if let case)
+ [lux (#- Type Label if let case)
[abstract
["." monad (#+ do)]]
[control
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
index 5de412695..7db88c007 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/common.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type)
+ [lux (#- Type Label)
[ffi (#+ import:)]
[abstract
["." monad (#+ do)]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
index e132e9eb9..0b3a0f9fd 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/extension/host.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type primitive int char type)
+ [lux (#- Type Label primitive int char type)
[ffi (#+ import:)]
[abstract
["." monad (#+ do)]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/function.lux b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
index df80c6088..877194de1 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/function.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/function.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type function)
+ [lux (#- Type Label function)
[abstract
["." monad (#+ do)]
["." enum]]
diff --git a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
index 5b1743157..a9f58e932 100644
--- a/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
+++ b/lux-jvm/source/luxc/lang/translation/jvm/runtime.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type try)
+ [lux (#- Type Label try)
[abstract
[monad (#+ do)]
["." enum]]
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index 20614dc2f..804c27ee5 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -53,7 +53,7 @@
(9 #1 (0 #1 [[dummy_location (7 #0 ["library/lux" "type_args"])]
[dummy_location (9 #0 (0 #1 [dummy_location (5 #0 "a")] (0 #0)))]]
(0 #0)))]
- ["End" "Item"]
+ ("End" "Item")
#1)
("lux def" Bit
@@ -135,7 +135,7 @@
(9 #1 (#Item [[dummy_location (7 #0 ["library/lux" "type_args"])]
[dummy_location (9 #0 (#Item [dummy_location (5 #0 "a")] #End))]]
#End))]
- ["None" "Some"]
+ ("None" "Some")
#1)
... (type: .public Type
@@ -196,7 +196,7 @@
("lux type check type" (9 #0 (4 #0 1) (4 #0 0)))))
[dummy_location
(9 #1 #End)]
- ["Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named"]
+ ("Primitive" "Sum" "Product" "Function" "Parameter" "Var" "Ex" "UnivQ" "ExQ" "Apply" "Named")
#1)
... (type: .public Location
@@ -276,7 +276,7 @@
(9 #1 (#Item [[dummy_location (7 #0 ["library/lux" "type_args"])]
[dummy_location (9 #0 (#Item [dummy_location (5 #0 "w")] #End))]]
#End))]
- ["Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record"]
+ ("Bit" "Nat" "Int" "Rev" "Frac" "Text" "Identifier" "Tag" "Form" "Tuple" "Record")
#1)
... (type: .public Code
@@ -420,15 +420,33 @@
(record$ #End)
.public)
+... (type: .public Label
+... [Bit Type (List Text) Nat])
+("lux def" Label
+ ("lux type check type"
+ (#Named ["library/lux" "Label"]
+ (#Product Bit (#Product Type (#Product (#Apply Text List) Nat)))))
+ (record$ #End)
+ .public)
+
... (type: .public Global
-... (#Alias Alias)
-... (#Definition Definition))
+... (Variant
+... (#Definition Definition)
+... (#Type [Bit Type (Either [Text (List Text)] [Text (List Text)])])
+... (#Tag Label)
+... (#Slot Label)
+... (#Alias Alias)))
("lux def type tagged" Global
(#Named ["library/lux" "Global"]
- (#Sum Alias
- Definition))
+ (#Sum Definition
+ (#Sum ({labels
+ (#Product Bit (#Product Type (#Sum labels labels)))}
+ (#Product Text (#Apply Text List)))
+ (#Sum Label
+ (#Sum Label
+ Alias)))))
(record$ #End)
- ["Alias" "Definition"]
+ ("Definition" "Type" "Label" "Slot" "Alias")
.public)
... (type: .public (Bindings k v)
@@ -460,7 +478,7 @@
... Captured
Nat))
(record$ #End)
- ["Local" "Captured"]
+ ("Local" "Captured")
.public)
... (type: .public Scope
@@ -502,7 +520,7 @@
(record$ (#Item [(tag$ ["library/lux" "type_args"])
(tuple$ (#Item (text$ "l") (#Item (text$ "r") #End)))]
#End))
- ["Left" "Right"]
+ ("Left" "Right")
.public)
... (type: .public Source
@@ -529,47 +547,39 @@
... #Cached
Any)))
(record$ #End)
- ["Active" "Compiled" "Cached"]
+ ("Active" "Compiled" "Cached")
.public)
... (type: .public Module
-... {#module_hash Nat
-... #module_aliases (List [Text Text])
-... #definitions (List [Text Global])
-... #imports (List Text)
-... #tags (List [Text [Nat (List Name) Bit Type]])
-... #types (List [Text [(List Name) Bit Type]])
-... #module_annotations (Maybe Code)
-... #module_state Module_State})
+... (Record
+... {#module_hash Nat
+... #module_aliases (List [Text Text])
+... #definitions (List [Text Global])
+... #imports (List Text)
+... #module_annotations (Maybe Code)
+... #module_state Module_State}))
("lux def type tagged" Module
(#Named ["library/lux" "Module"]
- (#Product ... "lux.module_hash"
+ (#Product
+ ... "lux.module_hash"
Nat
- (#Product ... "lux.module_aliases"
+ (#Product
+ ... "lux.module_aliases"
(#Apply (#Product Text Text) List)
- (#Product ... "lux.definitions"
+ (#Product
+ ... "lux.definitions"
(#Apply (#Product Text Global) List)
- (#Product ... "lux.imports"
+ (#Product
+ ... "lux.imports"
(#Apply Text List)
- (#Product ... "lux.tags"
- (#Apply (#Product Text
- (#Product Nat
- (#Product (#Apply Name List)
- (#Product Bit
- Type))))
- List)
- (#Product ... "lux.types"
- (#Apply (#Product Text
- (#Product (#Apply Name List)
- (#Product Bit
- Type)))
- List)
- (#Product ... "lux.module_annotations"
- (#Apply Code Maybe)
- Module_State))
- ))))))
+ (#Product
+ ... "lux.module_annotations"
+ (#Apply Code Maybe)
+ ... module_state
+ Module_State)
+ )))))
(record$ #End)
- ["module_hash" "module_aliases" "definitions" "imports" "tags" "types" "module_annotations" "module_state"]
+ ["module_hash" "module_aliases" "definitions" "imports" "module_annotations" "module_state"]
.public)
... (type: .public Type_Context
@@ -602,7 +612,7 @@
... Interpreter
Any)))
(record$ #End)
- ["Build" "Eval" "Interpreter"]
+ ("Build" "Eval" "Interpreter")
.public)
... (type: .public Info
@@ -1668,13 +1678,22 @@
#scopes scopes #type_context types #host host
#seed seed #expected expected #location location #extensions extensions
#scope_type_vars scope_type_vars #eval _eval} state]
- ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _})
+ ({(#Some {#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _})
({(#Some constant)
- ({(#Left real_name)
+ ({(#Alias real_name)
(#Right [state real_name])
- (#Right [exported? def_type def_meta def_value])
- (#Right [state full_name])}
+ (#Definition [exported? def_type def_meta def_value])
+ (#Right [state full_name])
+
+ (#Type [exported? type labels])
+ (#Right [state full_name])
+
+ (#Label _)
+ (#Left ($_ text\composite "Unknown definition: " (name\encoded full_name)))
+
+ (#Slot _)
+ (#Left ($_ text\composite "Unknown definition: " (name\encoded full_name)))}
constant)
#None
@@ -2189,26 +2208,35 @@
#0}
type))
-(def:''' .private (macro' modules current_module module name)
+(def:''' .private (macro'' modules current_module module name)
#End
(-> ($' List (Tuple Text Module))
Text Text Text
($' Maybe Macro))
(do maybe_monad
[$module (plist\value module modules)
- gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} ("lux type check" Module $module)]
+ gdef (let' [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #module_annotations _ #module_state _} ("lux type check" Module $module)]
(plist\value name bindings))]
- ({(#Left [r_module r_name])
- (macro' modules current_module r_module r_name)
+ ({(#Alias [r_module r_name])
+ (macro'' modules current_module r_module r_name)
- (#Right [exported? def_type def_meta def_value])
+ (#Definition [exported? def_type def_meta def_value])
(if (macro_type? def_type)
(if exported?
(#Some ("lux type as" Macro def_value))
(if (text\= module current_module)
(#Some ("lux type as" Macro def_value))
#None))
- #None)}
+ #None)
+
+ (#Type [exported? type labels])
+ #None
+
+ (#Label _)
+ #None
+
+ (#Slot _)
+ #None}
("lux type check" Global gdef))))
(def:''' .private (normal name)
@@ -2223,7 +2251,7 @@
(in_meta name)}
name))
-(def:''' .private (macro full_name)
+(def:''' .private (macro' full_name)
#End
(-> Name ($' Meta ($' Maybe Macro)))
(do meta_monad
@@ -2235,7 +2263,7 @@
#seed seed #expected expected
#location location #extensions extensions
#scope_type_vars scope_type_vars #eval _eval}
- (#Right state (macro' modules current_module module name))}
+ (#Right state (macro'' modules current_module module name))}
state)))))
(def:''' .private (macro? name)
@@ -2243,7 +2271,7 @@
(-> Name ($' Meta Bit))
(do meta_monad
[name (normal name)
- output (macro name)]
+ output (macro' name)]
(in ({(#Some _) #1
#None #0}
output))))
@@ -2268,7 +2296,7 @@
({[_ (#Form (#Item [_ (#Identifier name)] args))]
(do meta_monad
[name' (normal name)
- ?macro (macro name')]
+ ?macro (macro' name')]
({(#Some macro)
(("lux type as" Macro' macro) args)
@@ -2286,7 +2314,7 @@
({[_ (#Form (#Item [_ (#Identifier name)] args))]
(do meta_monad
[name' (normal name)
- ?macro (macro name')]
+ ?macro (macro' name')]
({(#Some macro)
(do meta_monad
[top_level_expansion (("lux type as" Macro' macro) args)
@@ -2307,7 +2335,7 @@
({[_ (#Form (#Item [_ (#Identifier name)] args))]
(do meta_monad
[name' (normal name)
- ?macro (macro name')]
+ ?macro (macro' name')]
({(#Some macro)
(do meta_monad
[expansion (("lux type as" Macro' macro) args)
@@ -3270,17 +3298,22 @@
_
(#Left ($_ text\composite "Unknown module: " name))))))
-(def: (type_tag [module name])
+(def: (type_slot [module name])
(-> Name (Meta [Nat (List Name) Bit Type]))
(do meta_monad
[=module (..module module)
- .let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags_table #types types #module_annotations _ #module_state _} =module]]
- (case (plist\value name tags_table)
- (#Some output)
- (in_meta output)
+ .let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _} =module]]
+ (case (plist\value (text\composite "#" name) definitions)
+ (#Some (#Slot [exported type group index]))
+ (in_meta [index
+ (list\each (function (_ slot)
+ [module slot])
+ group)
+ exported
+ type])
_
- (failure (text\composite "Unknown tag: " (name\encoded [module name]))))))
+ (failure (text\composite "Unknown slot: " (name\encoded [module name]))))))
(def: (record_slots type)
(-> Type (Meta (Maybe [(List Name) (List Type)])))
@@ -3297,12 +3330,14 @@
(#Named [module name] unnamed)
(do meta_monad
[=module (..module module)
- .let [{#module_hash _ #module_aliases _ #definitions bindings #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]]
- (case (plist\value name types)
- (#Some [tags exported? (#Named _ _type)])
+ .let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _} =module]]
+ (case (plist\value name definitions)
+ (#Some (#Type [exported? (#Named _ _type) (#Right slots)]))
(case (interface_methods _type)
(#Some members)
- (in_meta (#Some [tags members]))
+ (in_meta (#Some [(list\each (function (_ slot) [module slot])
+ (#Item slots))
+ members]))
_
(in_meta #None))
@@ -3520,9 +3555,9 @@
(case (everyP caseP tokens)
(#Some cases)
(in_meta (list (` (..Union (~+ (list\each product\right cases))))
- (tuple$ (list\each (function (_ case)
- (text$ (product\left case)))
- cases))))
+ (form$ (list\each (function (_ case)
+ (text$ (product\left case)))
+ cases))))
#None
(failure "Wrong syntax for Variant")))
@@ -3616,15 +3651,23 @@
#None))
(def: (type_declaration it)
- (-> Code (Meta (Tuple Code (Maybe (List Text)))))
+ (-> Code (Meta (Tuple Code (Maybe (Either (List Text) (List Text))))))
({[_ (#Form (#Item [_ (#Identifier declarer)] parameters))]
(do meta_monad
[declaration (single_expansion (form$ (list& (identifier$ declarer) parameters)))]
(case declaration
- (^ (list type [_ (#Tuple tags)]))
+ (^ (list type [_ (#Form tags)]))
(case (everyP textP tags)
(#Some tags)
- (in_meta [type (#Some tags)])
+ (in_meta [type (#Some (#Left tags))])
+
+ #None
+ (failure "Improper type-definition syntax"))
+
+ (^ (list type [_ (#Tuple slots)]))
+ (case (everyP textP slots)
+ (#Some slots)
+ (in_meta [type (#Some (#Right slots))])
#None
(failure "Improper type-definition syntax"))
@@ -3643,10 +3686,10 @@
(case (typeP tokens)
(#Some [export_policy name args meta type_codes])
(do meta_monad
- [type+tags?? (..type_declaration type_codes)
+ [type+labels?? (..type_declaration type_codes)
module_name current_module_name
.let' [type_name (local_identifier$ name)
- [type tags??] type+tags??
+ [type labels??] type+labels??
type' (: (Maybe Code)
(case args
#End
@@ -3663,13 +3706,22 @@
(let [typeC (` (#.Named [(~ (text$ module_name))
(~ (text$ name))]
(.type (~ type''))))]
- (in_meta (list (case tags??
- (#Some tags)
- (` ("lux def type tagged" (~ type_name)
- (~ typeC)
- (~ total_meta)
- [(~+ (list\each text$ tags))]
- (~ export_policy)))
+ (in_meta (list (case labels??
+ (#Some labels)
+ (case labels
+ (#Left tags)
+ (` ("lux def type tagged" (~ type_name)
+ (~ typeC)
+ (~ total_meta)
+ ((~+ (list\each text$ tags)))
+ (~ export_policy)))
+
+ (#Right slots)
+ (` ("lux def type tagged" (~ type_name)
+ (~ typeC)
+ (~ total_meta)
+ [(~+ (list\each text$ slots))]
+ (~ export_policy))))
_
(` ("lux def" (~ type_name)
@@ -3980,14 +4032,25 @@
(List Text))
(function (_ [name definition])
(case definition
- (#Left _)
+ (#Alias _)
(list)
- (#Right [exported? def_type def_meta def_value])
+ (#Definition [exported? def_type def_meta def_value])
+ (if exported?
+ (list name)
+ (list))
+
+ (#Type [exported? type labels])
(if exported?
(list name)
- (list)))))
- (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #tags tags #types types #module_annotations _ #module_state _} =module]
+ (list))
+
+ (#Label _)
+ (list)
+
+ (#Slot _)
+ (list))))
+ (let [{#module_hash _ #module_aliases _ #definitions definitions #imports _ #module_annotations _ #module_state _} =module]
definitions))]
(#Right state (list\conjoint to_alias)))
@@ -4069,18 +4132,27 @@
#None
#None
- (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _})
+ (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_annotations _ #module_state _})
(case (plist\value v_name definitions)
#None
#None
(#Some definition)
(case definition
- (#Left real_name)
+ (#Alias real_name)
(definition_type real_name state)
- (#Right [exported? def_type def_meta def_value])
- (#Some def_type))))))
+ (#Definition [exported? def_type def_meta def_value])
+ (#Some def_type)
+
+ (#Type [exported? type labels])
+ (#Some ..Type)
+
+ (#Label _)
+ #None
+
+ (#Slot _)
+ #None)))))
(def: (definition_value name state)
(-> Name (Meta [Type Any]))
@@ -4093,18 +4165,27 @@
#None
(#Left (text\composite "Unknown definition: " (name\encoded name)))
- (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #tags tags #types types #module_annotations _ #module_state _})
+ (#Some {#definitions definitions #module_hash _ #module_aliases _ #imports _ #module_annotations _ #module_state _})
(case (plist\value v_name definitions)
#None
(#Left (text\composite "Unknown definition: " (name\encoded name)))
(#Some definition)
(case definition
- (#Left real_name)
+ (#Alias real_name)
(definition_value real_name state)
- (#Right [exported? def_type def_meta def_value])
- (#Right [state [def_type def_value]]))))))
+ (#Definition [exported? def_type def_meta def_value])
+ (#Right [state [def_type def_value]])
+
+ (#Type [exported? type labels])
+ (#Right [state [..Type type]])
+
+ (#Label _)
+ (#Left (text\composite "Unknown definition: " (name\encoded name)))
+
+ (#Slot _)
+ (#Left (text\composite "Unknown definition: " (name\encoded name))))))))
(def: (type_variable idx bindings)
(-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
@@ -4254,7 +4335,7 @@
(^ (list [_ (#Tag slot')] record))
(do meta_monad
[slot (normal slot')
- output (..type_tag slot)
+ output (..type_slot slot)
.let [[idx tags exported? type] output]
g!_ (..identifier "_")
g!output (..identifier "")]
@@ -4366,7 +4447,7 @@
(-> Text Text (Meta Bit))
(do meta_monad
[module (module module_name)
- .let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #tags _ #types _ #module_annotations _ #module_state _} module]]
+ .let [{#module_hash _ #module_aliases _ #definitions _ #imports imports #module_annotations _ #module_state _} module]]
(in (is_member? imports import_name))))
(def: (referrals module_name options)
@@ -4514,7 +4595,7 @@
(^ (list [_ (#Tag slot')] value record))
(do meta_monad
[slot (normal slot')
- output (..type_tag slot)
+ output (..type_slot slot)
.let [[idx tags exported? type] output]]
(case (interface_methods type)
(#Some members)
@@ -4593,7 +4674,7 @@
(^ (list [_ (#Tag slot')] fun record))
(do meta_monad
[slot (normal slot')
- output (..type_tag slot)
+ output (..type_slot slot)
.let [[idx tags exported? type] output]]
(case (interface_methods type)
(#Some members)
@@ -4798,7 +4879,7 @@
.let [[hslot tslots] slots]
hslot (..normal hslot)
tslots (monad\each meta_monad ..normal tslots)
- output (..type_tag hslot)
+ output (..type_slot hslot)
g!_ (..identifier "_")
.let [[idx tags exported? type] output
slot_pairings (list\each (: (-> Name [Text Code])
@@ -5520,3 +5601,7 @@
_
(failure "Wrong syntax for Rec")))
+
+(def: .public macro
+ (-> Macro Macro')
+ (|>> (:as Macro')))
diff --git a/stdlib/source/library/lux/control/function/mutual.lux b/stdlib/source/library/lux/control/function/mutual.lux
index 3d26dedd1..5ef853829 100644
--- a/stdlib/source/library/lux/control/function/mutual.lux
+++ b/stdlib/source/library/lux/control/function/mutual.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Definition let def:)
+ [lux (#- Definition let def: macro)
["." meta]
[abstract
["." monad (#+ do)]]
diff --git a/stdlib/source/library/lux/control/parser/binary.lux b/stdlib/source/library/lux/control/parser/binary.lux
index 409d2a872..6c0f82a06 100644
--- a/stdlib/source/library/lux/control/parser/binary.lux
+++ b/stdlib/source/library/lux/control/parser/binary.lux
@@ -110,16 +110,28 @@
[(do {! //.monad}
[flag (: (Parser Nat)
..bits/8)]
- (`` (case flag
- (^template [<number> <tag> <parser>]
- [<number> (\ ! each (|>> <tag>) <parser>)])
- ((~~ (template.spliced <case>+)))
- _ (//.lifted (exception.except ..invalid_tag [(~~ (template.amount <case>+)) flag])))))])
+ (with_expansions [<case>+' (template.spliced <case>+)]
+ (case flag
+ (^template [<number> <tag> <parser>]
+ [<number> (`` (\ ! each (|>> ((~~ (template.spliced <tag>)))) <parser>))])
+ (<case>+')
+
+ _ (//.lifted (exception.except ..invalid_tag [(template.amount [<case>+]) flag])))))])
(def: .public (or left right)
(All (_ l r) (-> (Parser l) (Parser r) (Parser (Or l r))))
- (!variant [[0 #.Left left]
- [1 #.Right right]]))
+ (!variant [[0 [#.Left] left]
+ [1 [#.Right] right]]))
+
+(def: .public (or/5 p/0 p/1 p/2 p/3 p/4)
+ (All (_ p/0 p/1 p/2 p/3 p/4)
+ (-> (Parser p/0) (Parser p/1) (Parser p/2) (Parser p/3) (Parser p/4)
+ (Parser (Or p/0 p/1 p/2 p/3 p/4))))
+ (!variant [[0 [0 #0] p/0]
+ [1 [1 #0] p/1]
+ [2 [2 #0] p/2]
+ [3 [3 #0] p/3]
+ [4 [3 #1] p/4]]))
(def: .public (rec body)
(All (_ a) (-> (-> (Parser a) (Parser a)) (Parser a)))
@@ -242,17 +254,17 @@
(let [pair (//.and type type)
indexed ..nat
quantified (//.and (..list type) type)]
- (!variant [[0 #.Primitive (//.and ..text (..list type))]
- [1 #.Sum pair]
- [2 #.Product pair]
- [3 #.Function pair]
- [4 #.Parameter indexed]
- [5 #.Var indexed]
- [6 #.Ex indexed]
- [7 #.UnivQ quantified]
- [8 #.ExQ quantified]
- [9 #.Apply pair]
- [10 #.Named (//.and ..name type)]])))))
+ (!variant [[0 [#.Primitive] (//.and ..text (..list type))]
+ [1 [#.Sum] pair]
+ [2 [#.Product] pair]
+ [3 [#.Function] pair]
+ [4 [#.Parameter] indexed]
+ [5 [#.Var] indexed]
+ [6 [#.Ex] indexed]
+ [7 [#.UnivQ] quantified]
+ [8 [#.ExQ] quantified]
+ [9 [#.Apply] pair]
+ [10 [#.Named] (//.and ..name type)]])))))
(def: .public location
(Parser Location)
@@ -264,14 +276,14 @@
(function (_ recur)
(let [sequence (..list recur)]
(//.and ..location
- (!variant [[0 #.Bit ..bit]
- [1 #.Nat ..nat]
- [2 #.Int ..int]
- [3 #.Rev ..rev]
- [4 #.Frac ..frac]
- [5 #.Text ..text]
- [6 #.Identifier ..name]
- [7 #.Tag ..name]
- [8 #.Form sequence]
- [9 #.Tuple sequence]
- [10 #.Record (..list (//.and recur recur))]]))))))
+ (!variant [[0 [#.Bit] ..bit]
+ [1 [#.Nat] ..nat]
+ [2 [#.Int] ..int]
+ [3 [#.Rev] ..rev]
+ [4 [#.Frac] ..frac]
+ [5 [#.Text] ..text]
+ [6 [#.Identifier] ..name]
+ [7 [#.Tag] ..name]
+ [8 [#.Form] sequence]
+ [9 [#.Tuple] sequence]
+ [10 [#.Record] (..list (//.and recur recur))]]))))))
diff --git a/stdlib/source/library/lux/data/format/binary.lux b/stdlib/source/library/lux/data/format/binary.lux
index 109b1c19d..8ffed2724 100644
--- a/stdlib/source/library/lux/data/format/binary.lux
+++ b/stdlib/source/library/lux/data/format/binary.lux
@@ -98,6 +98,29 @@
[1 #.Right right])
)))
+(def: .public (or/5 w/0 w/1 w/2 w/3 w/4)
+ (All (_ w/0 w/1 w/2 w/3 w/4)
+ (-> (Writer w/0) (Writer w/1) (Writer w/2) (Writer w/3) (Writer w/4)
+ (Writer (Or w/0 w/1 w/2 w/3 w/4))))
+ (function (_ altV)
+ (case altV
+ (^template [<number> <tag> <right?> <writer>]
+ [(<tag> <right?> caseV)
+ (let [[caseS caseT] (<writer> caseV)]
+ [(.++ caseS)
+ (function (_ [offset binary])
+ (|> binary
+ (binary.write/8! offset <number>)
+ try.trusted
+ [(.++ offset)]
+ caseT))])])
+ ([0 0 #0 w/0]
+ [1 1 #0 w/1]
+ [2 2 #0 w/2]
+ [3 3 #0 w/3]
+ [4 3 #1 w/4])
+ )))
+
(def: .public (and pre post)
(All (_ a b) (-> (Writer a) (Writer b) (Writer [a b])))
(function (_ [preV postV])
diff --git a/stdlib/source/library/lux/macro/template.lux b/stdlib/source/library/lux/macro/template.lux
index 65b4f96ba..3c18f9f9e 100644
--- a/stdlib/source/library/lux/macro/template.lux
+++ b/stdlib/source/library/lux/macro/template.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- let local)
+ [lux (#- let local macro)
["." meta]
[abstract
["." monad (#+ do)]]
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index 208663367..f19bc2964 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- type)
+ [lux (#- type macro)
[abstract
[functor (#+ Functor)]
[apply (#+ Apply)]
@@ -189,7 +189,16 @@
(#.Definition [exported? def_type def_anns def_value])
(if (macro_type? def_type)
(#.Some (:as Macro def_value))
- #.None))))))])))))
+ #.None)
+
+ (#.Type [exported? type labels])
+ #.None
+
+ (#.Label _)
+ #.None
+
+ (#.Slot _)
+ #.None)))))])))))
(def: .public seed
(Meta Nat)
@@ -315,13 +324,20 @@
(value@ #.definitions)
(list.all (function (_ [def_name global])
(case global
- (#.Definition [exported? _ _ _])
+ (^or (#.Definition [exported? _])
+ (#.Type [exported? _]))
(if (and exported?
(text\= normal_short def_name))
(#.Some (name\encoded [module_name def_name]))
#.None)
(#.Alias _)
+ #.None
+
+ (#.Label _)
+ #.None
+
+ (#.Slot _)
#.None))))))
list.together
(list.sorted text\<)
@@ -348,27 +364,55 @@
(do ..monad
[definition (..definition name)]
(case definition
- (#.Left de_aliased)
- (failure ($_ text\composite
- "Aliases are not considered exports: "
- (name\encoded name)))
-
- (#.Right definition)
+ (#.Definition definition)
(let [[exported? def_type def_data def_value] definition]
(if exported?
(in definition)
- (failure ($_ text\composite "Definition is not an export: " (name\encoded name))))))))
+ (failure ($_ text\composite "Definition is not an export: " (name\encoded name)))))
+
+ (#.Type [exported? type labels])
+ (if exported?
+ (in [exported? .Type (' {}) type])
+ (failure ($_ text\composite "Type is not an export: " (name\encoded name))))
+
+ (#.Alias de_aliased)
+ (failure ($_ text\composite
+ "Aliases are not considered exports: "
+ (name\encoded name)))
+
+ (#.Label _)
+ (failure ($_ text\composite
+ "Tags are not considered exports: "
+ (name\encoded name)))
+
+ (#.Slot _)
+ (failure ($_ text\composite
+ "Slots are not considered exports: "
+ (name\encoded name))))))
(def: .public (definition_type name)
(-> Name (Meta Type))
(do ..monad
[definition (definition name)]
(case definition
- (#.Left de_aliased)
+ (#.Alias de_aliased)
(definition_type de_aliased)
- (#.Right [exported? def_type def_data def_value])
- (clean_type def_type))))
+ (#.Definition [exported? def_type def_data def_value])
+ (clean_type def_type)
+
+ (#.Type [exported? type labels])
+ (in .Type)
+
+ (#.Label _)
+ (failure ($_ text\composite
+ "Tags have no type: "
+ (name\encoded name)))
+
+ (#.Slot _)
+ (failure ($_ text\composite
+ "Slots have no type: "
+ (name\encoded name))))))
(def: .public (type name)
(-> Name (Meta Type))
@@ -385,17 +429,26 @@
(do ..monad
[definition (definition name)]
(case definition
- (#.Left de_aliased)
+ (#.Alias de_aliased)
(type_definition de_aliased)
- (#.Right [exported? def_type def_data def_value])
+ (#.Definition [exported? def_type def_data def_value])
(let [type_code (`` ("lux in-module" (~~ (static .prelude_module)) .type_code))]
(if (or (same? .Type def_type)
(\ code.equivalence =
(type_code .Type)
(type_code def_type)))
(in (:as Type def_value))
- (..failure ($_ text\composite "Definition is not a type: " (name\encoded name))))))))
+ (..failure ($_ text\composite "Definition is not a type: " (name\encoded name)))))
+
+ (#.Type [exported? type labels])
+ (in type)
+
+ (#.Label _)
+ (..failure ($_ text\composite "Tag is not a type: " (name\encoded name)))
+
+ (#.Slot _)
+ (..failure ($_ text\composite "Slot is not a type: " (name\encoded name))))))
(def: .public (globals module)
(-> Text (Meta (List [Text Global])))
@@ -412,11 +465,20 @@
(\ ..monad each
(list.all (function (_ [name global])
(case global
- (#.Left de_aliased)
+ (#.Alias de_aliased)
#.None
- (#.Right definition)
- (#.Some [name definition]))))
+ (#.Definition definition)
+ (#.Some [name definition])
+
+ (#.Type [exported? type labels])
+ (#.Some [name [exported? .Type (' {}) type]])
+
+ (#.Label _)
+ #.None
+
+ (#.Slot _)
+ #.None)))
(..globals module)))
(def: .public (exports module_name)
@@ -440,11 +502,12 @@
(def: .public (tags_of type_name)
(-> Name (Meta (Maybe (List Name))))
(do ..monad
- [.let [[module name] type_name]
- module (..module module)]
- (case (plist.value name (value@ #.types module))
- (#.Some [tags _])
- (in (#.Some tags))
+ [.let [[module_name name] type_name]
+ module (..module module_name)]
+ (case (plist.value name (value@ #.definitions module))
+ (#.Some (#.Type [exported? type (#.Right slots)]))
+ (in (#.Some (list\each (|>> [module_name])
+ (#.Item slots))))
_
(in #.None))))
@@ -489,33 +552,41 @@
=module (..module module)
this_module_name ..current_module_name
imported! (..imported? module)]
- (case (plist.value name (value@ #.tags =module))
- (#.Some [idx tag_list exported? type])
+ (case (plist.value (text\composite "#" name) (value@ #.definitions =module))
+ (^or (#.Some (#.Label [exported? type group idx]))
+ (#.Some (#.Slot [exported? type group idx])))
(if (or (text\= this_module_name module)
(and imported! exported?))
- (in [idx tag_list type])
+ (in [idx (list\each (|>> [module]) group) type])
(..failure ($_ text\composite "Cannot access tag: " (name\encoded tag_name) " from module " this_module_name)))
_
(..failure ($_ text\composite
- "Unknown tag: " (name\encoded tag_name) text.new_line
- " Known tags: " (|> =module
- (value@ #.tags)
- (list\each (|>> product.left [module] name\encoded (text.prefix text.new_line)))
- text.together)
- )))))
+ "Unknown tag: " (name\encoded tag_name))))))
(def: .public (tag_lists module)
(-> Text (Meta (List [(List Name) Type])))
(do ..monad
[=module (..module module)
this_module_name ..current_module_name]
- (in (|> (value@ #.types =module)
- (list.only (function (_ [type_name [tag_list exported? type]])
- (or exported?
- (text\= this_module_name module))))
- (list\each (function (_ [type_name [tag_list exported? type]])
- [tag_list type]))))))
+ (in (list.all (function (_ [short global])
+ (case global
+ (#.Type [exported? type labels])
+ (if (or exported?
+ (text\= this_module_name module))
+ (#.Some [(list\each (|>> [module])
+ (case labels
+ (#.Left tags)
+ (#.Item tags)
+
+ (#.Right slots)
+ (#.Item slots)))
+ type])
+ #.None)
+
+ _
+ #.None))
+ (value@ #.definitions =module)))))
(def: .public locals
(Meta (List (List [Text Type])))
@@ -536,10 +607,19 @@
(do ..monad
[constant (..definition def_name)]
(in (case constant
- (#.Left real_def_name)
+ (#.Alias real_def_name)
real_def_name
- (#.Right _)
+ (#.Definition _)
+ def_name
+
+ (#.Type _)
+ def_name
+
+ (#.Label _)
+ def_name
+
+ (#.Slot _)
def_name))))
(def: .public compiler_state
diff --git a/stdlib/source/library/lux/target/js.lux b/stdlib/source/library/lux/target/js.lux
index 07318b451..62ce204c5 100644
--- a/stdlib/source/library/lux/target/js.lux
+++ b/stdlib/source/library/lux/target/js.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Location Code or and function if cond undefined for comment not int try ++ --)
+ [lux (#- Location Code Label or and function if cond undefined for comment not int try ++ --)
[control
[pipe (#+ case>)]]
[data
diff --git a/stdlib/source/library/lux/target/jvm.lux b/stdlib/source/library/lux/target/jvm.lux
index ce273f401..50543961c 100644
--- a/stdlib/source/library/lux/target/jvm.lux
+++ b/stdlib/source/library/lux/target/jvm.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type)
+ [lux (#- Type Label)
[data
[collection
[row (#+ Row)]]]
diff --git a/stdlib/source/library/lux/target/jvm/bytecode.lux b/stdlib/source/library/lux/target/jvm/bytecode.lux
index 9c106e442..53886c7b5 100644
--- a/stdlib/source/library/lux/target/jvm/bytecode.lux
+++ b/stdlib/source/library/lux/target/jvm/bytecode.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type int try)
+ [lux (#- Type Label int try)
["." ffi (#+ import:)]
[abstract
[monoid (#+ Monoid)]
diff --git a/stdlib/source/library/lux/target/jvm/reflection.lux b/stdlib/source/library/lux/target/jvm/reflection.lux
index 3fdf491bc..55316e26f 100644
--- a/stdlib/source/library/lux/target/jvm/reflection.lux
+++ b/stdlib/source/library/lux/target/jvm/reflection.lux
@@ -174,7 +174,7 @@
(do {! try.monad}
[paramsT (|> reflection
java/lang/reflect/ParameterizedType::getActualTypeArguments
- array.list
+ (array.list #.None)
(monad.each ! parameter))]
(in (/.class (|> raw
(:as (java/lang/Class java/lang/Object))
@@ -297,7 +297,7 @@
(case type
(#.Primitive name params)
(let [class_name (java/lang/Class::getName class)
- class_params (array.list (java/lang/Class::getTypeParameters class))
+ class_params (array.list #.None (java/lang/Class::getTypeParameters class))
num_class_params (list.size class_params)
num_type_params (list.size params)]
(if (text\= class_name name)
@@ -360,7 +360,7 @@
(def: .public deprecated?
(-> (array.Array java/lang/annotation/Annotation) Bit)
- (|>> array.list
+ (|>> (array.list #.None)
(list.all (|>> (ffi.check java/lang/Deprecated)))
list.empty?
not))
diff --git a/stdlib/source/library/lux/target/lua.lux b/stdlib/source/library/lux/target/lua.lux
index 42d8d60e5..faac1b184 100644
--- a/stdlib/source/library/lux/target/lua.lux
+++ b/stdlib/source/library/lux/target/lua.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Location Code int if cond function or and not let ^ local)
+ [lux (#- Location Code Label int if cond function or and not let ^ local)
["@" target]
[abstract
[equivalence (#+ Equivalence)]
diff --git a/stdlib/source/library/lux/target/php.lux b/stdlib/source/library/lux/target/php.lux
index 0e228dc57..a14b3e0ce 100644
--- a/stdlib/source/library/lux/target/php.lux
+++ b/stdlib/source/library/lux/target/php.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Location Code Global static int if cond or and not comment for try global)
+ [lux (#- Location Code Global Label static int if cond or and not comment for try global)
["@" target]
[abstract
[equivalence (#+ Equivalence)]
diff --git a/stdlib/source/library/lux/target/python.lux b/stdlib/source/library/lux/target/python.lux
index 8a41d3ae8..6b24b6ae2 100644
--- a/stdlib/source/library/lux/target/python.lux
+++ b/stdlib/source/library/lux/target/python.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Location Code not or and list if cond int comment exec try)
+ [lux (#- Location Code Label not or and list if cond int comment exec try)
["@" target]
["." ffi]
[abstract
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux.lux
index e86bd51aa..5bb42e533 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux.lux
@@ -24,24 +24,23 @@
(Writer .Module)
(let [definition (: (Writer Definition)
($_ _.and _.bit _.type _.code _.any))
+ labels (: (Writer [Text (List Text)])
+ (_.and _.text (_.list _.text)))
+ global_type (: (Writer [Bit Type (Either [Text (List Text)]
+ [Text (List Text)])])
+ ($_ _.and _.bit _.type (_.or labels labels)))
+ global_label (: (Writer .Label)
+ ($_ _.and _.bit _.type (_.list _.text) _.nat))
name (: (Writer Name)
(_.and _.text _.text))
alias (: (Writer Alias)
(_.and _.text _.text))
global (: (Writer Global)
- (_.or alias
- definition))
- tag (: (Writer [Nat (List Name) Bit Type])
- ($_ _.and
- _.nat
- (_.list name)
- _.bit
- _.type))
- type (: (Writer [(List Name) Bit Type])
- ($_ _.and
- (_.list name)
- _.bit
- _.type))]
+ (_.or/5 definition
+ global_type
+ global_label
+ global_label
+ alias))]
($_ _.and
... #module_hash
_.nat
@@ -51,10 +50,6 @@
(_.list (_.and _.text global))
... #imports
(_.list _.text)
- ... #tags
- (_.list (_.and _.text tag))
- ... #types
- (_.list (_.and _.text type))
... #module_annotations
(_.maybe _.code)
... #module_state
@@ -64,24 +59,23 @@
(Parser .Module)
(let [definition (: (Parser Definition)
($_ <>.and <b>.bit <b>.type <b>.code <b>.any))
+ labels (: (Parser [Text (List Text)])
+ (<>.and <b>.text (<b>.list <b>.text)))
+ global_type (: (Parser [Bit Type (Either [Text (List Text)]
+ [Text (List Text)])])
+ ($_ <>.and <b>.bit <b>.type (<b>.or labels labels)))
+ global_label (: (Parser .Label)
+ ($_ <>.and <b>.bit <b>.type (<b>.list <b>.text) <b>.nat))
name (: (Parser Name)
(<>.and <b>.text <b>.text))
alias (: (Parser Alias)
(<>.and <b>.text <b>.text))
global (: (Parser Global)
- (<b>.or alias
- definition))
- tag (: (Parser [Nat (List Name) Bit Type])
- ($_ <>.and
- <b>.nat
- (<b>.list name)
- <b>.bit
- <b>.type))
- type (: (Parser [(List Name) Bit Type])
- ($_ <>.and
- (<b>.list name)
- <b>.bit
- <b>.type))]
+ (<b>.or/5 definition
+ global_type
+ global_label
+ global_label
+ alias))]
($_ <>.and
... #module_hash
<b>.nat
@@ -91,10 +85,6 @@
(<b>.list (<>.and <b>.text global))
... #imports
(<b>.list <b>.text)
- ... #tags
- (<b>.list (<>.and <b>.text tag))
- ... #types
- (<b>.list (<>.and <b>.text type))
... #module_annotations
(<b>.maybe <b>.code)
... #module_state
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
index 42dc67db6..b6817b6c8 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/module.lux
@@ -28,11 +28,6 @@
(exception.report
["Module" module]))
-(exception: .public (cannot_declare_tag_twice {module Text} {tag Text})
- (exception.report
- ["Module" module]
- ["Tag" tag]))
-
(template [<name>]
[(exception: .public (<name> {tags (List Text)} {owner Type})
(exception.report
@@ -51,7 +46,16 @@
(format "alias " (%.name alias))
(#.Definition definition)
- (format "definition " (%.name name)))]))
+ (format "definition " (%.name name))
+
+ (#.Type _)
+ (format "type " (%.name name))
+
+ (#.Label _)
+ (format "tag " (%.name name))
+
+ (#.Slot _)
+ (format "slot " (%.name name)))]))
(exception: .public (can_only_change_state_of_active_module {module Text} {state Module_State})
(exception.report
@@ -73,8 +77,6 @@
#.module_aliases (list)
#.definitions (list)
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active})
@@ -211,41 +213,20 @@
[set_cached cached? #.Cached]
)
-(template [<name> <tag> <type>]
- [(def: (<name> module_name)
- (-> Text (Operation <type>))
- (///extension.lifted
- (function (_ state)
- (case (|> state (value@ #.modules) (plist.value module_name))
- (#.Some module)
- (#try.Success [state (value@ <tag> module)])
-
- #.None
- ((/.except' unknown_module module_name) state)))))]
+(def: (hash module_name)
+ (-> Text (Operation Nat))
+ (///extension.lifted
+ (function (_ state)
+ (case (|> state (value@ #.modules) (plist.value module_name))
+ (#.Some module)
+ (#try.Success [state (value@ #.module_hash module)])
- [tags #.tags (List [Text [Nat (List Name) Bit Type]])]
- [types #.types (List [Text [(List Name) Bit Type]])]
- [hash #.module_hash Nat]
- )
+ #.None
+ ((/.except' unknown_module module_name) state)))))
-(def: (ensure_undeclared_tags module_name tags)
- (-> Text (List Tag) (Operation Any))
+(def: .public (declare_tags record? tags exported? type)
+ (-> Bit (List Tag) Bit Type (Operation Any))
(do {! ///.monad}
- [bindings (..tags module_name)
- _ (monad.each !
- (function (_ tag)
- (case (plist.value tag bindings)
- #.None
- (in [])
-
- (#.Some _)
- (/.except ..cannot_declare_tag_twice [module_name tag])))
- tags)]
- (in [])))
-
-(def: .public (declare_tags tags exported? type)
- (-> (List Tag) Bit Type (Operation Any))
- (do ///.monad
[self_name (///extension.lifted meta.current_module_name)
[type_module type_name] (case type
(#.Named type_name _)
@@ -253,23 +234,11 @@
_
(/.except ..cannot_declare_tags_for_unnamed_type [tags type]))
- _ (ensure_undeclared_tags self_name tags)
_ (///.assertion cannot_declare_tags_for_foreign_type [tags type]
(text\= self_name type_module))]
- (///extension.lifted
- (function (_ state)
- (case (|> state (value@ #.modules) (plist.value self_name))
- (#.Some module)
- (let [namespaced_tags (list\each (|>> [self_name]) tags)]
- (#try.Success [(revised@ #.modules
- (plist.revised self_name
- (|>> (revised@ #.tags (function (_ tag_bindings)
- (list\mix (function (_ [idx tag] table)
- (plist.has tag [idx namespaced_tags exported? type] table))
- tag_bindings
- (list.enumeration tags))))
- (revised@ #.types (plist.has type_name [namespaced_tags exported? type]))))
- state)
- []]))
- #.None
- ((/.except' unknown_module self_name) state))))))
+ (monad.each ! (function (_ [index short])
+ (..define (format "#" short)
+ (if record?
+ (#.Slot [exported? type tags index])
+ (#.Label [exported? type tags index]))))
+ (list.enumeration tags))))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux
index 92a7a8f9c..d7d19e802 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/analysis/reference.lux
@@ -29,16 +29,20 @@
(exception.report
["Definition" (%.name definition)]))
+(exception: .public (labels_are_not_definitions {definition Name})
+ (exception.report
+ ["Label" (%.name definition)]))
+
(def: (definition def_name)
(-> Name (Operation Analysis))
(with_expansions [<return> (in (|> def_name ///reference.constant #/.Reference))]
(do {! ///.monad}
[constant (///extension.lifted (meta.definition def_name))]
(case constant
- (#.Left real_def_name)
+ (#.Alias real_def_name)
(definition real_def_name)
- (#.Right [exported? actualT def_anns _])
+ (#.Definition [exported? actualT def_anns _])
(do !
[_ (//type.infer actualT)
(^@ def_name [::module ::name]) (///extension.lifted (meta.normal def_name))
@@ -51,7 +55,28 @@
(if imported!
<return>
(/.except foreign_module_has_not_been_imported [current ::module])))
- (/.except definition_has_not_been_exported def_name))))))))
+ (/.except definition_has_not_been_exported def_name))))
+
+ (#.Type [exported? value labels])
+ (do !
+ [_ (//type.infer .Type)
+ (^@ def_name [::module ::name]) (///extension.lifted (meta.normal def_name))
+ current (///extension.lifted meta.current_module_name)]
+ (if (text\= current ::module)
+ <return>
+ (if exported?
+ (do !
+ [imported! (///extension.lifted (meta.imported_by? ::module current))]
+ (if imported!
+ <return>
+ (/.except foreign_module_has_not_been_imported [current ::module])))
+ (/.except definition_has_not_been_exported def_name))))
+
+ (#.Label _)
+ (/.except labels_are_not_definitions [def_name])
+
+ (#.Slot _)
+ (/.except labels_are_not_definitions [def_name])))))
(def: (variable var_name)
(-> Text (Operation (Maybe Analysis)))
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
index d3384588e..30da17c13 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/jvm.lux
@@ -876,13 +876,13 @@
(in [[super_name superT] (java/lang/Class::isAssignableFrom super_class target_class)])))
(case (java/lang/Class::getGenericSuperclass source_class)
(#.Some super)
- (list& super (array.list (java/lang/Class::getGenericInterfaces source_class)))
+ (list& super (array.list #.None (java/lang/Class::getGenericInterfaces source_class)))
#.None
(if (java/lang/reflect/Modifier::isInterface (java/lang/Class::getModifiers source_class))
(#.Item (:as java/lang/reflect/Type (ffi.class_for java/lang/Object))
- (array.list (java/lang/Class::getGenericInterfaces source_class)))
- (array.list (java/lang/Class::getGenericInterfaces source_class)))))))
+ (array.list #.None (java/lang/Class::getGenericInterfaces source_class)))
+ (array.list #.None (java/lang/Class::getGenericInterfaces source_class)))))))
(def: (inheritance_candidate_parents class_loader fromT target_class toT fromC)
(-> java/lang/ClassLoader .Type (java/lang/Class java/lang/Object) .Type Code (Operation (List [[Text .Type] Bit])))
@@ -1092,7 +1092,7 @@
(-> Aliasing (java/lang/Class java/lang/Object) Text Method_Style (List (Type Value)) java/lang/reflect/Method (Operation Bit))
(do phase.monad
[parameters (|> (java/lang/reflect/Method::getGenericParameterTypes method)
- array.list
+ (array.list #.None)
(monad.each try.monad reflection!.type)
phase.lifted)
.let [modifiers (java/lang/reflect/Method::getModifiers method)
@@ -1138,7 +1138,7 @@
(-> Aliasing (java/lang/Class java/lang/Object) (List (Type Value)) (java/lang/reflect/Constructor java/lang/Object) (Operation Bit))
(do phase.monad
[parameters (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor)
- array.list
+ (array.list #.None)
(monad.each try.monad reflection!.type)
phase.lifted)]
(in (and (java/lang/Object::equals class (java/lang/reflect/Constructor::getDeclaringClass constructor))
@@ -1183,15 +1183,15 @@
_
(|> (java/lang/Class::getTypeParameters owner)
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName))))
method_tvars (|> (java/lang/reflect/Method::getTypeParameters method)
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName)))
[owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)]
(do {! phase.monad}
[inputsT (|> (java/lang/reflect/Method::getGenericParameterTypes method)
- array.list
+ (array.list #.None)
(monad.each ! (|>> reflection!.type phase.lifted))
(phase\each (monad.each ! (..reflection_type mapping)))
phase\conjoint)
@@ -1202,7 +1202,7 @@
(phase\each (..reflection_return mapping))
phase\conjoint)
exceptionsT (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
- array.list
+ (array.list #.None)
(monad.each ! (|>> reflection!.type phase.lifted))
(phase\each (monad.each ! (..reflection_type mapping)))
phase\conjoint)
@@ -1223,20 +1223,20 @@
(-> (java/lang/reflect/Constructor java/lang/Object) (Operation Method_Signature))
(let [owner (java/lang/reflect/Constructor::getDeclaringClass constructor)
owner_tvars (|> (java/lang/Class::getTypeParameters owner)
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName)))
method_tvars (|> (java/lang/reflect/Constructor::getTypeParameters constructor)
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName)))
[owner_tvarsT mapping] (jvm_type_var_mapping owner_tvars method_tvars)]
(do {! phase.monad}
[inputsT (|> (java/lang/reflect/Constructor::getGenericParameterTypes constructor)
- array.list
+ (array.list #.None)
(monad.each ! (|>> reflection!.type phase.lifted))
(phase\each (monad.each ! (reflection_type mapping)))
phase\conjoint)
exceptionsT (|> (java/lang/reflect/Constructor::getGenericExceptionTypes constructor)
- array.list
+ (array.list #.None)
(monad.each ! (|>> reflection!.type phase.lifted))
(phase\each (monad.each ! (reflection_type mapping)))
phase\conjoint)
@@ -1270,7 +1270,7 @@
[(def: <name>
(-> <type> (List (Type Var)))
(|>> <method>
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName jvm.var))))]
[class_type_variables (java/lang/Class java/lang/Object) java/lang/Class::getTypeParameters]
@@ -1291,7 +1291,7 @@
.let [expected_class_tvars (class_type_variables class)]
candidates (|> class
java/lang/Class::getDeclaredMethods
- array.list
+ (array.list #.None)
(list.only (|>> java/lang/reflect/Method::getName (text\= method_name)))
(monad.each ! (: (-> java/lang/reflect/Method (Operation Evaluation))
(function (_ method)
@@ -1324,7 +1324,7 @@
.let [expected_class_tvars (class_type_variables class)]
candidates (|> class
java/lang/Class::getConstructors
- array.list
+ (array.list #.None)
(monad.each ! (function (_ constructor)
(do !
[.let [expected_method_tvars (constructor_type_variables constructor)
@@ -1549,23 +1549,23 @@
(-> (java/lang/Class java/lang/Object)
(Try (List [Text (Type Method)])))
(|>> java/lang/Class::getDeclaredMethods
- array.list
+ (array.list #.None)
<only>
(monad.each try.monad
(function (_ method)
(do {! try.monad}
[.let [type_variables (|> (java/lang/reflect/Method::getTypeParameters method)
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName
jvm.var)))]
inputs (|> (java/lang/reflect/Method::getGenericParameterTypes method)
- array.list
+ (array.list #.None)
(monad.each ! reflection!.type))
return (|> method
java/lang/reflect/Method::getGenericReturnType
reflection!.return)
exceptions (|> (java/lang/reflect/Method::getGenericExceptionTypes method)
- array.list
+ (array.list #.None)
(monad.each ! reflection!.class))]
(in [(java/lang/reflect/Method::getName method)
(jvm.method [type_variables inputs return exceptions])]))))))]
@@ -2066,7 +2066,7 @@
[.let [[name actual_parameters] (jvm_parser.read_class class)]
class (phase.lifted (reflection!.load class_loader name))
.let [expected_parameters (|> (java/lang/Class::getTypeParameters class)
- array.list
+ (array.list #.None)
(list\each (|>> java/lang/reflect/TypeVariable::getName)))]
_ (phase.assertion ..class_parameter_mismatch [expected_parameters actual_parameters]
(n.= (list.size expected_parameters)
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
index 7952434ee..278447d11 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/analysis/lux.lux
@@ -199,6 +199,10 @@
(typeA.with_type input
(phase archive valueC))))]))
+(exception: .public (not_a_type {symbol Name})
+ (exception.report
+ ["Symbol" (%.name symbol)]))
+
(def: lux::macro
Handler
(..custom
@@ -210,9 +214,14 @@
(do !
[input_type (///.lifted (meta.definition (name_of .Macro')))]
(case input_type
- (#.Definition [exported? def_type def_data def_value])
+ (^or (#.Definition [exported? def_type def_data def_value])
+ (#.Type [exported? def_value labels]))
(in (:as Type def_value))
+ (^or (#.Label _)
+ (#.Slot _))
+ (////.failure (exception.error ..not_a_type [(name_of .Macro')]))
+
(#.Alias real_name)
(recur real_name))))]
(typeA.with_type input_type
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
index c805124dd..f2ffaccae 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/extension/directive/lux.lux
@@ -228,7 +228,7 @@
[_ _ exported?] (evaluate! archive Bit exported?C)
[_ _ annotations] (evaluate! archive Code annotationsC)
_ (/////directive.lifted_analysis
- (module.define short_name (#.Right [(:as Bit exported?) type (:as Code annotations) value])))
+ (module.define short_name (#.Definition [(:as Bit exported?) type (:as Code annotations) value])))
_ (..refresh expander host_analysis)
_ (..announce_definition! short_name type)]
(in /////directive.no_requirements))
@@ -236,7 +236,7 @@
_
(phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))
-(def: (announce_tags! tags owner)
+(def: (announce_labels! tags owner)
(All (_ anchor expression directive)
(-> (List Text) Type (Operation anchor expression directive (List Any))))
(/////directive.lifted_generation
@@ -247,8 +247,11 @@
(def: (def::type_tagged expander host_analysis)
(-> Expander /////analysis.Bundle Handler)
(..custom
- [($_ <>.and <code>.local_identifier <code>.any <code>.any (<code>.tuple (<>.some <code>.text)) <code>.any)
- (function (_ extension_name phase archive [short_name valueC annotationsC tags exported?C])
+ [($_ <>.and <code>.local_identifier <code>.any <code>.any
+ (<>.or (<code>.form (<>.some <code>.text))
+ (<code>.tuple (<>.some <code>.text)))
+ <code>.any)
+ (function (_ extension_name phase archive [short_name valueC annotationsC labels exported?C])
(do phase.monad
[current_module (/////directive.lifted_analysis
(///.lifted meta.current_module_name))
@@ -258,13 +261,27 @@
.let [exported? (:as Bit exported?)
annotations (:as Code annotations)]
[type valueT value] (..definition archive full_name (#.Some .Type) valueC)
- _ (/////directive.lifted_analysis
- (do phase.monad
- [_ (module.define short_name (#.Right [exported? type annotations value]))]
- (module.declare_tags tags exported? (:as Type value))))
+ labels (/////directive.lifted_analysis
+ (do phase.monad
+ [.let [[record? labels] (case labels
+ (#.Left tags)
+ [false tags]
+
+ (#.Right slots)
+ [true slots])]
+ _ (case labels
+ #.End
+ (module.define short_name (#.Definition [exported? type annotations value]))
+
+ (#.Item labels)
+ (module.define short_name (#.Type [exported? (:as .Type value) (if record?
+ (#.Right labels)
+ (#.Left labels))])))
+ _ (module.declare_tags record? labels exported? (:as .Type value))]
+ (in labels)))
_ (..refresh expander host_analysis)
_ (..announce_definition! short_name type)
- _ (..announce_tags! tags (:as Type value))]
+ _ (..announce_labels! labels (:as Type value))]
(in /////directive.no_requirements)))]))
(def: imports
@@ -300,17 +317,27 @@
["Foreign alias" (%.name foreign)]
["Target definition" (%.name target)]))
+(exception: .public (cannot_alias_a_label {local Alias} {foreign Alias})
+ (exception.report
+ ["Alias" (%.name local)]
+ ["Label" (%.name foreign)]))
+
(def: (define_alias alias original)
(-> Text Name (/////analysis.Operation Any))
(do phase.monad
[current_module (///.lifted meta.current_module_name)
constant (///.lifted (meta.definition original))]
(case constant
- (#.Left de_aliased)
+ (#.Alias de_aliased)
(phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased])
- (#.Right [exported? original_type original_annotations original_value])
- (module.define alias (#.Left original)))))
+ (^or (#.Definition _)
+ (#.Type _))
+ (module.define alias (#.Alias original))
+
+ (^or (#.Label _)
+ (#.Slot _))
+ (phase.except ..cannot_alias_a_label [[current_module alias] original]))))
(def: def::alias
Handler
diff --git a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
index d99cfca3d..54c3ac8ba 100644
--- a/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
+++ b/stdlib/source/library/lux/tool/compiler/language/lux/phase/generation/jvm/runtime.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type Definition case false true try)
+ [lux (#- Type Definition Label case false true try)
[abstract
["." monad (#+ do)]
["." enum]]
diff --git a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
index 25b9ec0b4..a2b2908b3 100644
--- a/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/tool/compiler/meta/io/archive.lux
@@ -323,8 +323,12 @@
content (document.read $.key document)
definitions (monad.each ! (function (_ [def_name def_global])
(case def_global
- (#.Alias alias)
- (in [def_name (#.Alias alias)])
+ (^template [<tag>]
+ [(<tag> payload)
+ (in [def_name (<tag> payload)])])
+ ([#.Alias]
+ [#.Label]
+ [#.Slot])
(#.Definition [exported? type annotations _])
(|> definitions
@@ -332,7 +336,14 @@
try.of_maybe
(\ ! each (|>> [exported? type annotations]
#.Definition
- [def_name])))))
+ [def_name])))
+
+ (#.Type [exported? _ labels])
+ (|> definitions
+ (dictionary.value def_name)
+ try.of_maybe
+ (\ ! each (function (_ def_value)
+ [def_name (#.Type [exported? (:as .Type def_value) labels])])))))
(value@ #.definitions content))]
(in [(document.write $.key (with@ #.definitions definitions content))
bundles])))
diff --git a/stdlib/source/library/lux/type/abstract.lux b/stdlib/source/library/lux/type/abstract.lux
index 837f6ba11..9a0edab98 100644
--- a/stdlib/source/library/lux/type/abstract.lux
+++ b/stdlib/source/library/lux/type/abstract.lux
@@ -60,11 +60,14 @@
(-> Text (List [Text Global]) (Stack Frame))
(!peek source reference
(case head
- (#.Left _)
- (undefined)
+ (#.Definition [exported? frame_type frame_anns frame_value])
+ (:as (Stack Frame) frame_value)
- (#.Right [exported? frame_type frame_anns frame_value])
- (:as (Stack Frame) frame_value))))
+ (^or (#.Type _)
+ (#.Alias _)
+ (#.Label _)
+ (#.Slot _))
+ (undefined))))
(def: (peek_frames reference definition_reference source)
(-> Text Text (List [Text Module]) (Stack Frame))
@@ -117,14 +120,17 @@
(-> Text Frame (List [Text Global]) (List [Text Global]))
(!push source reference
(case head
- (#.Left _)
- (undefined)
-
- (#.Right [exported? frames_type frames_anns frames_value])
- (#.Right [exported?
- frames_type
- frames_anns
- (..push frame (:as (Stack Frame) frames_value))]))))
+ (#.Definition [exported? frames_type frames_anns frames_value])
+ (#.Definition [exported?
+ frames_type
+ frames_anns
+ (..push frame (:as (Stack Frame) frames_value))])
+
+ (^or (#.Type _)
+ (#.Alias _)
+ (#.Label _)
+ (#.Slot _))
+ (undefined))))
(def: (push_frame [module_reference definition_reference] frame source)
(-> Name Frame (List [Text Module]) (List [Text Module]))
@@ -143,20 +149,23 @@
(-> Text (List [Text Global]) (List [Text Global]))
(!push source reference
(case head
- (#.Left _)
- (undefined)
-
- (#.Right [exported? frames_type frames_anns frames_value])
- (#.Right [exported?
- frames_type
- frames_anns
- (let [current_frames (:as (Stack Frame) frames_value)]
- (case (..pop current_frames)
- (#.Some current_frames')
- current_frames'
-
- #.None
- current_frames))]))))
+ (#.Definition [exported? frames_type frames_anns frames_value])
+ (#.Definition [exported?
+ frames_type
+ frames_anns
+ (let [current_frames (:as (Stack Frame) frames_value)]
+ (case (..pop current_frames)
+ (#.Some current_frames')
+ current_frames'
+
+ #.None
+ current_frames))])
+
+ (^or (#.Type _)
+ (#.Alias _)
+ (#.Label _)
+ (#.Slot _))
+ (undefined))))
(def: (pop_frame [module_reference definition_reference] source)
(-> Name (List [Text Module]) (List [Text Module]))
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
index 2e8c199b4..fa117e96b 100644
--- a/stdlib/source/test/lux/macro.lux
+++ b/stdlib/source/test/lux/macro.lux
@@ -79,8 +79,6 @@
(!global /.log_expansion!)
(!global /.log_full_expansion!)))
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}]
[current_module
@@ -91,8 +89,6 @@
(!global ..pow/4)
(!global ..repeated)))
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}])
#.scopes (list)
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index 7d397e5d5..9e0175947 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -183,16 +183,12 @@
#.module_aliases (list)
#.definitions (list)
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}
expected_module {#.module_hash 0
#.module_aliases (list)
#.definitions (list)
#.imports (list imported_module_name)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}
expected_modules (list [expected_current_module
@@ -384,8 +380,6 @@
#.module_aliases (list)
#.definitions current_globals
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}]
[expected_macro_module
@@ -393,8 +387,6 @@
#.module_aliases (list)
#.definitions macro_globals
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}])
#.scopes (list)
@@ -506,8 +498,6 @@
#.module_aliases (list)
#.definitions current_globals
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}]
[expected_macro_module
@@ -515,8 +505,6 @@
#.module_aliases (list)
#.definitions macro_globals
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}])
#.scopes (list)
@@ -655,19 +643,22 @@
(random.ascii/upper 1))
.let [random_tag (\ ! each (|>> [tag_module])
- (random.ascii/upper 1))]
- all_tags (|> random_tag
- (random.set name.hash 10)
- (\ ! each set.list))
- .let [tags_0 (list.first 5 all_tags)
- tags_1 (list.after 5 all_tags)
-
- type_0 (#.Primitive name_0 (list))
+ (random.ascii/upper 1))
+ random_labels (: (Random [Text (List Text)])
+ (do !
+ [head (random.ascii/lower 5)]
+ (|> (random.ascii/lower 5)
+ (random.only (|>> (text\= head) not))
+ (random.set text.hash 3)
+ (\ ! each set.list)
+ (random.and (in head)))))]
+ tags_0 random_labels
+ tags_1 (let [set/0 (set.of_list text.hash (#.Item tags_0))]
+ (random.only (|>> #.Item (list.any? (set.member? set/0))not)
+ random_labels))
+ .let [type_0 (#.Primitive name_0 (list))
type_1 (#.Primitive name_1 (list))
- entry_0 [name_0 [tags_0 false type_0]]
- entry_1 [name_1 [tags_1 true type_1]]
-
expected_lux
(: Lux
{#.info {#.target ""
@@ -681,24 +672,23 @@
#.module_aliases (list)
#.definitions (list)
#.imports (list tag_module)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}]
[tag_module
{#.module_hash 0
#.module_aliases (list)
- #.definitions (list)
+ #.definitions (list& [name_0 (#.Type [false type_0 (#.Left tags_0)])]
+ [name_1 (#.Type [true type_1 (#.Right tags_1)])]
+ ($_ list\composite
+ (|> (#.Item tags_0)
+ list.enumeration
+ (list\each (function (_ [index short])
+ [(format "#" short) (#.Label [false type_0 (#.Item tags_0) index])])))
+ (|> (#.Item tags_1)
+ list.enumeration
+ (list\each (function (_ [index short])
+ [(format "#" short) (#.Slot [true type_1 (#.Item tags_1) index])])))))
#.imports (list)
- #.tags (list\composite (|> tags_0
- list.enumeration
- (list\each (function (_ [index [_ short]])
- [short [index tags_0 false type_0]])))
- (|> tags_1
- list.enumeration
- (list\each (function (_ [index [_ short]])
- [short [index tags_1 true type_1]]))))
- #.types (list entry_0 entry_1)
#.module_annotations #.None
#.module_state #.Active}])
#.scopes (list)
@@ -719,28 +709,29 @@
type.equivalence))]
(|> (/.tag_lists tag_module)
(/.result expected_lux)
- (try\each (\ equivalence = (list [tags_1 type_1])))
+ (try\each (\ equivalence = (list [(list\each (|>> [tag_module]) (#.Item tags_1))
+ type_1])))
(try.else false))))
(_.cover [/.tags_of]
(|> (/.tags_of [tag_module name_1])
(/.result expected_lux)
- (try\each (\ (maybe.equivalence (list.equivalence name.equivalence)) = (#.Some tags_1)))
+ (try\each (\ (maybe.equivalence (list.equivalence name.equivalence)) = (#.Some (list\each (|>> [tag_module]) (#.Item tags_1)))))
(try.else false)))
(_.cover [/.tag]
- (|> tags_1
+ (|> (#.Item tags_1)
list.enumeration
(list.every? (function (_ [expected_index tag])
- (|> tag
+ (|> [tag_module tag]
/.tag
(/.result expected_lux)
- (!expect (^multi (^ (#try.Success [actual_index actual_tags actual_type]))
+ (!expect (^multi (#try.Success [actual_index actual_tags actual_type])
(let [correct_index!
(n.= expected_index
actual_index)
correct_tags!
(\ (list.equivalence name.equivalence) =
- tags_1
+ (list\each (|>> [tag_module]) (#.Item tags_1))
actual_tags)
correct_type!
@@ -748,7 +739,8 @@
actual_type)]
(and correct_index!
correct_tags!
- correct_type!)))))))))
+ correct_type!))))
+ )))))
)))
(def: locals_related
@@ -807,8 +799,6 @@
#.module_aliases (list)
#.definitions globals
#.imports (list)
- #.tags (list)
- #.types (list)
#.module_annotations #.None
#.module_state #.Active}])
#.scopes scopes
diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux
index 9494096f2..6dd299f2c 100644
--- a/stdlib/source/test/lux/target/jvm.lux
+++ b/stdlib/source/test/lux/target/jvm.lux
@@ -1,6 +1,6 @@
(.module:
[library
- [lux (#- Type type primitive int)
+ [lux (#- Type Label type primitive int)
["." ffi (#+ import:)]
["@" target]
[abstract