aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--lux-bootstrapper/src/lux/analyser.clj19
-rw-r--r--lux-bootstrapper/src/lux/analyser/case.clj434
-rw-r--r--lux-bootstrapper/src/lux/analyser/lux.clj57
-rw-r--r--lux-bootstrapper/src/lux/analyser/module.clj174
-rw-r--r--lux-bootstrapper/src/lux/analyser/record.clj172
-rw-r--r--lux-bootstrapper/src/lux/base.clj25
-rw-r--r--lux-bootstrapper/src/lux/compiler/cache.clj17
-rw-r--r--lux-bootstrapper/src/lux/compiler/core.clj43
-rw-r--r--lux-bootstrapper/src/lux/compiler/jvm/lux.clj15
-rw-r--r--lux-bootstrapper/src/lux/optimizer.clj10
-rw-r--r--lux-bootstrapper/src/lux/type.clj28
-rw-r--r--stdlib/source/library/lux.lux1438
-rw-r--r--stdlib/source/library/lux/data/format/tar.lux4
-rw-r--r--stdlib/source/library/lux/data/format/xml.lux2
-rw-r--r--stdlib/source/library/lux/documentation.lux2
-rw-r--r--stdlib/source/library/lux/ffi/export.jvm.lux2
-rw-r--r--stdlib/source/library/lux/meta.lux200
-rw-r--r--stdlib/source/library/lux/meta/compiler.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/default/platform.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux.lux29
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux46
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux6
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/generation.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux140
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux24
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux46
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux63
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/archive.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/archive/signature.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/archive/unit.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/cli.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/context.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/meta/io/archive.lux17
-rw-r--r--stdlib/source/library/lux/meta/compiler/phase.lux2
-rw-r--r--stdlib/source/library/lux/meta/compiler/reference/variable.lux2
-rw-r--r--stdlib/source/library/lux/meta/target/jvm/attribute.lux2
-rw-r--r--stdlib/source/library/lux/meta/target/jvm/constant.lux2
-rw-r--r--stdlib/source/library/lux/meta/target/jvm/constant/tag.lux2
-rw-r--r--stdlib/source/library/lux/meta/target/jvm/type.lux2
-rw-r--r--stdlib/source/library/lux/meta/type/implicit.lux16
-rw-r--r--stdlib/source/library/lux/meta/type/row.lux2
-rw-r--r--stdlib/source/library/lux/test/tally.lux2
-rw-r--r--stdlib/source/library/lux/world/locale/language.lux2
-rw-r--r--stdlib/source/library/lux/world/locale/territory.lux2
-rw-r--r--stdlib/source/library/lux/world/net/http.lux2
-rw-r--r--stdlib/source/parser/lux/data/format/xml.lux2
-rw-r--r--stdlib/source/test/lux/data/format/json.lux2
-rw-r--r--stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux76
-rw-r--r--stdlib/source/test/lux/meta/macro/context.lux19
58 files changed, 1628 insertions, 1556 deletions
diff --git a/lux-bootstrapper/src/lux/analyser.clj b/lux-bootstrapper/src/lux/analyser.clj
index 8d440598b..0a168b38b 100644
--- a/lux-bootstrapper/src/lux/analyser.clj
+++ b/lux-bootstrapper/src/lux/analyser.clj
@@ -65,10 +65,10 @@
(&/$Variant (&/$Item [command-meta command] parameters))
(|case command
- (&/$Nat idx)
+ (&/$Nat lefts)
(|let [(&/$Item [_ (&/$Bit ?right)] parameters*) parameters]
(&/with-analysis-meta location exo-type
- (&&lux/analyse-variant analyse (&/$Right exo-type) (if ?right (inc idx) idx) ?right parameters*)))
+ (&&lux/analyse-variant analyse (&/$Right exo-type) lefts ?right parameters*)))
(&/$Identifier ?ident)
(&/with-analysis-meta location exo-type
@@ -126,21 +126,6 @@
(&/with-location location
(&&lux/analyse-def-alias ?alias ?original)))
- "lux def type tagged"
- (|let [(&/$Item [_ (&/$Identifier "" ?name)]
- (&/$Item ?value
- (&/$Item ?labels
- (&/$Item exported?
- (&/$End)))
- )) parameters]
- (&/with-location location
- (|case ?labels
- [_ (&/$Variant ?tags)]
- (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value false ?tags exported?)
-
- [_ (&/$Tuple ?slots)]
- (&&lux/analyse-def-type-tagged analyse optimize eval! compile-def ?name ?value true ?slots exported?))))
-
"lux def module"
(|let [(&/$Item ?imports (&/$End)) parameters]
(&/with-location location
diff --git a/lux-bootstrapper/src/lux/analyser/case.clj b/lux-bootstrapper/src/lux/analyser/case.clj
index ef339587b..42ab446ca 100644
--- a/lux-bootstrapper/src/lux/analyser/case.clj
+++ b/lux-bootstrapper/src/lux/analyser/case.clj
@@ -356,8 +356,8 @@
(&/$None)
(analyse-tuple-pattern analyse-pattern pattern value-type ?members kont)))
- (&/$Variant (&/$Item [_ (&/$Nat idx)] (&/$Item [_ (&/$Bit right?)] ?values)))
- (let [idx (if right? (inc idx) idx)]
+ (&/$Variant (&/$Item [_ (&/$Nat lefts)] (&/$Item [_ (&/$Bit right?)] ?values)))
+ (let [idx (if right? (inc lefts) lefts)]
(|do [value-type* (adjust-type value-type)
case-type (&type/sum-at idx value-type*)
[=test =kont] (case (int (&/|length ?values))
@@ -365,25 +365,34 @@
1 (analyse-pattern &/$None case-type (&/|head ?values) kont)
;; 1+
(analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$Tuple ?values)]) kont))]
- (return (&/T [($VariantTestAC (&/T [idx (&/|length (&type/flatten-sum value-type*)) =test])) =kont]))))
+ (return (&/T [($VariantTestAC (&/T [lefts right? =test])) =kont]))))
(&/$Variant (&/$Item [_ (&/$Identifier ?ident)] ?values))
(|do [[=module =name] (&&/resolved-ident ?ident)
must-infer? (&type/unknown? value-type)
- [_exported? variant-type** group idx] (&module/find-tag =module =name)
+ [_exported? [label* variant-type**]] (&module/find-tag =module =name)
+ [lefts right?] (return (|case label*
+ (&/$Some [lefts right? family])
+ (&/T [lefts right?])
+
+ (&/$None)
+ (&/T [0 false])))
variant-type (if must-infer?
(|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)
- case-type (&type/sum-at idx value-type*)
+ case-type (let [idx (if right?
+ (inc lefts)
+ lefts)]
+ (&type/sum-at idx value-type*))
[=test =kont] (case (int (&/|length ?values))
0 (analyse-pattern &/$None case-type unit-tuple kont)
1 (analyse-pattern &/$None case-type (&/|head ?values) kont)
;; 1+
(analyse-pattern &/$None case-type (&/T [(&/T ["" -1 -1]) (&/$Tuple ?values)]) kont))]
- (return (&/T [($VariantTestAC (&/T [idx (&/|length group) =test])) =kont])))
+ (return (&/T [($VariantTestAC (&/T [lefts right? =test])) =kont])))
_
(&/fail-with-loc (str "[Pattern-matching Error] Unrecognized pattern syntax: " (&/show-ast pattern)))
@@ -394,238 +403,245 @@
(&&/analyse-1 analyse exo-type body))]
(return (&/$Item pattern+body patterns))))
-(defn ^:private merge-total [struct test+body]
- (|let [[test ?body] test+body]
- (|case [struct test]
- [($DefaultTotal total?) ($NoTestAC)]
- (return ($DefaultTotal true))
-
- [($BitTotal total? ?values) ($NoTestAC)]
- (return ($BitTotal true ?values))
-
- [($NatTotal total? ?values) ($NoTestAC)]
- (return ($NatTotal true ?values))
-
- [($IntTotal total? ?values) ($NoTestAC)]
- (return ($IntTotal true ?values))
-
- [($RevTotal total? ?values) ($NoTestAC)]
- (return ($RevTotal true ?values))
-
- [($FracTotal total? ?values) ($NoTestAC)]
- (return ($FracTotal true ?values))
-
- [($TextTotal total? ?values) ($NoTestAC)]
- (return ($TextTotal true ?values))
-
- [($TupleTotal total? ?values) ($NoTestAC)]
- (return ($TupleTotal true ?values))
-
- [($VariantTotal total? ?values) ($NoTestAC)]
- (return ($VariantTotal true ?values))
+;; (defn ^:private merge-total [struct test+body]
+;; (|let [[test ?body] test+body]
+;; (|case [struct test]
+;; [($DefaultTotal total?) ($NoTestAC)]
+;; (return ($DefaultTotal true))
- [($DefaultTotal total?) ($StoreTestAC ?idx)]
- (return ($DefaultTotal true))
+;; [($BitTotal total? ?values) ($NoTestAC)]
+;; (return ($BitTotal true ?values))
- [($BitTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($BitTotal true ?values))
+;; [($NatTotal total? ?values) ($NoTestAC)]
+;; (return ($NatTotal true ?values))
- [($NatTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($NatTotal true ?values))
+;; [($IntTotal total? ?values) ($NoTestAC)]
+;; (return ($IntTotal true ?values))
- [($IntTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($IntTotal true ?values))
+;; [($RevTotal total? ?values) ($NoTestAC)]
+;; (return ($RevTotal true ?values))
- [($RevTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($RevTotal true ?values))
+;; [($FracTotal total? ?values) ($NoTestAC)]
+;; (return ($FracTotal true ?values))
- [($FracTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($FracTotal true ?values))
+;; [($TextTotal total? ?values) ($NoTestAC)]
+;; (return ($TextTotal true ?values))
- [($TextTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($TextTotal true ?values))
+;; [($TupleTotal total? ?values) ($NoTestAC)]
+;; (return ($TupleTotal true ?values))
- [($TupleTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($TupleTotal true ?values))
+;; [($VariantTotal total? ?values) ($NoTestAC)]
+;; (return ($VariantTotal true ?values))
- [($VariantTotal total? ?values) ($StoreTestAC ?idx)]
- (return ($VariantTotal true ?values))
+;; [($DefaultTotal total?) ($StoreTestAC ?idx)]
+;; (return ($DefaultTotal true))
- [($DefaultTotal total?) ($BitTestAC ?value)]
- (return ($BitTotal total? (&/|list ?value)))
+;; [($BitTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($BitTotal true ?values))
- [($BitTotal total? ?values) ($BitTestAC ?value)]
- (return ($BitTotal total? (&/$Item ?value ?values)))
+;; [($NatTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($NatTotal true ?values))
- [($DefaultTotal total?) ($NatTestAC ?value)]
- (return ($NatTotal total? (&/|list ?value)))
+;; [($IntTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($IntTotal true ?values))
- [($NatTotal total? ?values) ($NatTestAC ?value)]
- (return ($NatTotal total? (&/$Item ?value ?values)))
+;; [($RevTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($RevTotal true ?values))
- [($DefaultTotal total?) ($IntTestAC ?value)]
- (return ($IntTotal total? (&/|list ?value)))
+;; [($FracTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($FracTotal true ?values))
- [($IntTotal total? ?values) ($IntTestAC ?value)]
- (return ($IntTotal total? (&/$Item ?value ?values)))
+;; [($TextTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($TextTotal true ?values))
- [($DefaultTotal total?) ($RevTestAC ?value)]
- (return ($RevTotal total? (&/|list ?value)))
+;; [($TupleTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($TupleTotal true ?values))
- [($RevTotal total? ?values) ($RevTestAC ?value)]
- (return ($RevTotal total? (&/$Item ?value ?values)))
+;; [($VariantTotal total? ?values) ($StoreTestAC ?idx)]
+;; (return ($VariantTotal true ?values))
- [($DefaultTotal total?) ($FracTestAC ?value)]
- (return ($FracTotal total? (&/|list ?value)))
+;; [($DefaultTotal total?) ($BitTestAC ?value)]
+;; (return ($BitTotal total? (&/|list ?value)))
- [($FracTotal total? ?values) ($FracTestAC ?value)]
- (return ($FracTotal total? (&/$Item ?value ?values)))
+;; [($BitTotal total? ?values) ($BitTestAC ?value)]
+;; (return ($BitTotal total? (&/$Item ?value ?values)))
- [($DefaultTotal total?) ($TextTestAC ?value)]
- (return ($TextTotal total? (&/|list ?value)))
+;; [($DefaultTotal total?) ($NatTestAC ?value)]
+;; (return ($NatTotal total? (&/|list ?value)))
- [($TextTotal total? ?values) ($TextTestAC ?value)]
- (return ($TextTotal total? (&/$Item ?value ?values)))
+;; [($NatTotal total? ?values) ($NatTestAC ?value)]
+;; (return ($NatTotal total? (&/$Item ?value ?values)))
- [($DefaultTotal total?) ($TupleTestAC ?tests)]
- (|do [structs (&/map% (fn [t]
- (merge-total ($DefaultTotal total?) (&/T [t ?body])))
- ?tests)]
- (return ($TupleTotal total? structs)))
+;; [($DefaultTotal total?) ($IntTestAC ?value)]
+;; (return ($IntTotal total? (&/|list ?value)))
- [($TupleTotal total? ?values) ($TupleTestAC ?tests)]
- (if (.equals ^Object (&/|length ?values) (&/|length ?tests))
- (|do [structs (&/map2% (fn [v t]
- (merge-total v (&/T [t ?body])))
- ?values ?tests)]
- (return ($TupleTotal total? structs)))
- (&/fail-with-loc (str "[Pattern-matching Error] Inconsistent tuple-size.\n"
- "Expected: " (&/|length ?values) "\n"
- " Actual: " (&/|length ?tests))))
+;; [($IntTotal total? ?values) ($IntTestAC ?value)]
+;; (return ($IntTotal total? (&/$Item ?value ?values)))
- [($DefaultTotal total?) ($VariantTestAC ?tag ?count ?test)]
- (|do [sub-struct (merge-total ($DefaultTotal total?)
- (&/T [?test ?body]))
- structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count ($DefaultTotal total?)))
- (&/$Some list)
- (return list)
+;; [($DefaultTotal total?) ($RevTestAC ?value)]
+;; (return ($RevTotal total? (&/|list ?value)))
- (&/$None)
- (assert false))]
- (return ($VariantTotal total? structs)))
+;; [($RevTotal total? ?values) ($RevTestAC ?value)]
+;; (return ($RevTotal total? (&/$Item ?value ?values)))
- [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?count ?test)]
- (|do [sub-struct (merge-total (|case (&/|at ?tag ?branches)
- (&/$Some sub)
- sub
-
- (&/$None)
- ($DefaultTotal total?))
- (&/T [?test ?body]))
- structs (|case (&/|list-put ?tag sub-struct ?branches)
- (&/$Some list)
- (return list)
+;; [($DefaultTotal total?) ($FracTestAC ?value)]
+;; (return ($FracTotal total? (&/|list ?value)))
- (&/$None)
- (assert false))]
- (return ($VariantTotal total? structs)))
- )))
-
-(defn check-totality+ [check-totality]
- (fn [?token]
- (&type/with-var
- (fn [$var]
- (|do [=output (check-totality $var ?token)
- ?type (&type/deref+ $var)
- =type (&type/clean $var ?type)]
- (return (&/T [=output =type])))))))
-
-(defn ^:private check-totality [value-type struct]
- (|case struct
- ($DefaultTotal ?total)
- (return ?total)
-
- ($BitTotal ?total ?values)
- (|do [_ (&type/check value-type &type/Bit)]
- (return (or ?total
- (= #{true false} (set (&/->seq ?values))))))
-
- ($NatTotal ?total _)
- (|do [_ (&type/check value-type &type/Nat)]
- (return ?total))
-
- ($IntTotal ?total _)
- (|do [_ (&type/check value-type &type/Int)]
- (return ?total))
-
- ($RevTotal ?total _)
- (|do [_ (&type/check value-type &type/Rev)]
- (return ?total))
-
- ($FracTotal ?total _)
- (|do [_ (&type/check value-type &type/Frac)]
- (return ?total))
+;; [($FracTotal total? ?values) ($FracTestAC ?value)]
+;; (return ($FracTotal total? (&/$Item ?value ?values)))
- ($TextTotal ?total _)
- (|do [_ (&type/check value-type &type/Text)]
- (return ?total))
+;; [($DefaultTotal total?) ($TextTestAC ?value)]
+;; (return ($TextTotal total? (&/|list ?value)))
- ($TupleTotal ?total ?structs)
- (|case ?structs
- (&/$End)
- (|do [value-type* (resolve-type value-type)]
- (if (&type/type= &type/Any value-type*)
- (return true)
- (&/fail-with-loc "[Pattern-maching Error] Unit is not total.")))
-
- _
- (|do [unknown? (&type/unknown? value-type)]
- (if unknown?
- (|do [=structs (&/map% (check-totality+ check-totality) ?structs)
- _ (&type/check value-type (|case (->> (&/|map &/|second =structs) (&/|reverse))
- (&/$Item last prevs)
- (&/fold (fn [right left] (&/$Product left right))
- last prevs)))]
- (return (or ?total
- (&/fold #(and %1 %2) true (&/|map &/|first =structs)))))
- (if ?total
- (return true)
- (|do [value-type* (resolve-type value-type)]
- (|case value-type*
- (&/$Product _)
- (|let [num-elems (&/|length ?structs)
- [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?structs) value-type*)
- _ (&/assert! (= num-elems _shorter)
- (&/fail-with-loc (str "[Pattern-maching Error] Tuple-mismatch. Require tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?structs) "]")))]
- (|do [totals (&/map2% check-totality _tuple-types ?structs)]
- (return (&/fold #(and %1 %2) true totals))))
-
- _
- (&/fail-with-loc (str "[Pattern-maching Error] Tuple is not total." " - " (&type/show-type value-type*)))))))))
-
- ($VariantTotal ?total ?structs)
- (if ?total
- (return true)
- (|do [value-type* (resolve-type value-type)]
- (|case value-type*
- (&/$Sum _)
- (|do [totals (&/map2% check-totality
- (&type/flatten-sum value-type*)
- ?structs)]
- (return (&/fold #(and %1 %2) true totals)))
-
- _
- (&/fail-with-loc "[Pattern-maching Error] Variant is not total."))))
- ))
+;; [($TextTotal total? ?values) ($TextTestAC ?value)]
+;; (return ($TextTotal total? (&/$Item ?value ?values)))
+
+;; [($DefaultTotal total?) ($TupleTestAC ?tests)]
+;; (|do [structs (&/map% (fn [t]
+;; (merge-total ($DefaultTotal total?) (&/T [t ?body])))
+;; ?tests)]
+;; (return ($TupleTotal total? structs)))
+
+;; [($TupleTotal total? ?values) ($TupleTestAC ?tests)]
+;; (if (.equals ^Object (&/|length ?values) (&/|length ?tests))
+;; (|do [structs (&/map2% (fn [v t]
+;; (merge-total v (&/T [t ?body])))
+;; ?values ?tests)]
+;; (return ($TupleTotal total? structs)))
+;; (&/fail-with-loc (str "[Pattern-matching Error] Inconsistent tuple-size.\n"
+;; "Expected: " (&/|length ?values) "\n"
+;; " Actual: " (&/|length ?tests))))
+
+;; [($DefaultTotal total?) ($VariantTestAC ?tag ?count ?test)]
+;; (|do [sub-struct (merge-total ($DefaultTotal total?)
+;; (&/T [?test ?body]))
+;; structs (|case (&/|list-put ?tag sub-struct (&/|repeat ?count ($DefaultTotal total?)))
+;; (&/$Some list)
+;; (return list)
+
+;; (&/$None)
+;; (assert false))]
+;; (return ($VariantTotal total? structs)))
+
+;; [($VariantTotal total? ?branches) ($VariantTestAC ?tag ?count ?test)]
+;; (|do [sub-struct (merge-total (|case (&/|at ?tag ?branches)
+;; (&/$Some sub)
+;; sub
+
+;; (&/$None)
+;; ($DefaultTotal total?))
+;; (&/T [?test ?body]))
+;; structs (|case (&/|list-put ?tag sub-struct ?branches)
+;; (&/$Some list)
+;; (return list)
+
+;; (&/$None)
+;; (assert false))]
+;; (return ($VariantTotal total? structs)))
+;; )))
+
+;; (defn check-totality+ [check-totality]
+;; (fn [?token]
+;; (&type/with-var
+;; (fn [$var]
+;; (|do [=output (check-totality $var ?token)
+;; ?type (&type/deref+ $var)
+;; =type (&type/clean $var ?type)]
+;; (return (&/T [=output =type])))))))
+
+;; (defn ^:private check-totality [value-type struct]
+;; (|case struct
+;; ($DefaultTotal ?total)
+;; (return ?total)
+
+;; ($BitTotal ?total ?values)
+;; (|do [_ (&type/check value-type &type/Bit)]
+;; (return (or ?total
+;; (= #{true false} (set (&/->seq ?values))))))
+
+;; ($NatTotal ?total _)
+;; (|do [_ (&type/check value-type &type/Nat)]
+;; (return ?total))
+
+;; ($IntTotal ?total _)
+;; (|do [_ (&type/check value-type &type/Int)]
+;; (return ?total))
+
+;; ($RevTotal ?total _)
+;; (|do [_ (&type/check value-type &type/Rev)]
+;; (return ?total))
+
+;; ($FracTotal ?total _)
+;; (|do [_ (&type/check value-type &type/Frac)]
+;; (return ?total))
+
+;; ($TextTotal ?total _)
+;; (|do [_ (&type/check value-type &type/Text)]
+;; (return ?total))
+
+;; ($TupleTotal ?total ?structs)
+;; (|case ?structs
+;; (&/$End)
+;; (|do [value-type* (resolve-type value-type)]
+;; (if (&type/type= &type/Any value-type*)
+;; (return true)
+;; (&/fail-with-loc "[Pattern-maching Error] Unit is not total.")))
+
+;; _
+;; (|do [unknown? (&type/unknown? value-type)]
+;; (if unknown?
+;; (|do [=structs (&/map% (check-totality+ check-totality) ?structs)
+;; _ (&type/check value-type (|case (->> (&/|map &/|second =structs) (&/|reverse))
+;; (&/$Item last prevs)
+;; (&/fold (fn [right left] (&/$Product left right))
+;; last prevs)))]
+;; (return (or ?total
+;; (&/fold #(and %1 %2) true (&/|map &/|first =structs)))))
+;; (if ?total
+;; (return true)
+;; (|do [value-type* (resolve-type value-type)]
+;; (|case value-type*
+;; (&/$Product _)
+;; (|let [num-elems (&/|length ?structs)
+;; [_shorter _tuple-types] (&type/tuple-types-for (&/|length ?structs) value-type*)
+;; _ (&/assert! (= num-elems _shorter)
+;; (&/fail-with-loc (str "[Pattern-maching Error] Tuple-mismatch. Require tuple[" (&/|length (&type/flatten-prod value-type*)) "]. Given tuple [" (&/|length ?structs) "]")))]
+;; (|do [totals (&/map2% check-totality _tuple-types ?structs)]
+;; (return (&/fold #(and %1 %2) true totals))))
+
+;; _
+;; (&/fail-with-loc (str "[Pattern-maching Error] Tuple is not total." " - " (&type/show-type value-type*)))))))))
+
+;; ($VariantTotal ?total ?structs)
+;; (if ?total
+;; (return true)
+;; (|do [value-type* (resolve-type value-type)]
+;; (|case value-type*
+;; (&/$Sum _)
+;; (|do [totals (&/map2% check-totality
+;; (&type/flatten-sum value-type*)
+;; ?structs)]
+;; (return (&/fold #(and %1 %2) true totals)))
+
+;; _
+;; (&/fail-with-loc "[Pattern-maching Error] Variant is not total."))))
+;; ))
;; [Exports]
(defn analyse-branches [analyse exo-type var?? value-type branches]
- (|do [patterns (&/fold% (fn [patterns branch]
- (|let [[pattern body] branch]
- (analyse-branch analyse exo-type var?? value-type pattern body patterns)))
- &/$End
- branches)
- struct (&/fold% merge-total ($DefaultTotal false) patterns)
- ? (check-totality value-type struct)
- _ (&/assert! ? "[Pattern-maching Error] Pattern-matching is not total.")]
- (return patterns)))
+ (&/fold% (fn [patterns branch]
+ (|let [[pattern body] branch]
+ (analyse-branch analyse exo-type var?? value-type pattern body patterns)))
+ &/$End
+ branches)
+ ;; (|do [patterns (&/fold% (fn [patterns branch]
+ ;; (|let [[pattern body] branch]
+ ;; (analyse-branch analyse exo-type var?? value-type pattern body patterns)))
+ ;; &/$End
+ ;; branches)
+ ;; ;; struct (&/fold% merge-total ($DefaultTotal false) patterns)
+ ;; ;; ? (check-totality value-type struct)
+ ;; ;; _ (&/assert! ? "[Pattern-maching Error] Pattern-matching is not total.")
+ ;; ]
+ ;; (return patterns))
+ )
diff --git a/lux-bootstrapper/src/lux/analyser/lux.clj b/lux-bootstrapper/src/lux/analyser/lux.clj
index 0ae77b537..d28a92051 100644
--- a/lux-bootstrapper/src/lux/analyser/lux.clj
+++ b/lux-bootstrapper/src/lux/analyser/lux.clj
@@ -174,7 +174,7 @@
_
(&/fail-with-loc "[Analyser Error] Macro cannot expand to more than 1 output."))))
-(defn analyse-variant [analyse ?exo-type idx is-last? ?values]
+(defn analyse-variant [analyse ?exo-type lefts right? ?values]
(|case ?exo-type
(&/$Left exo-type)
(|do [exo-type* (&type/actual-type exo-type)]
@@ -183,7 +183,7 @@
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
- [[variant-type variant-location] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) idx is-last? ?values))
+ [[variant-type variant-location] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left exo-type**) lefts right? ?values))
=var (&type/resolve-type $var)
inferred-type (|case =var
(&/$Var iid)
@@ -198,7 +198,7 @@
variant-analysis))))))
_
- (analyse-variant analyse (&/$Right exo-type*) idx is-last? ?values)))
+ (analyse-variant analyse (&/$Right exo-type*) lefts right? ?values)))
(&/$Right exo-type)
(|do [exo-type* (|case exo-type
@@ -213,56 +213,61 @@
(&/with-attempt
(|case exo-type*
(&/$Sum _)
- (|do [vtype (&type/sum-at idx exo-type*)
+ (|do [:let [idx (if right?
+ (inc lefts)
+ lefts)]
+ vtype (&type/sum-at idx exo-type*)
=value (analyse-variant-body analyse vtype ?values)
_location &/location]
(if (= 1 (&/|length (&type/flatten-sum exo-type*)))
(return (&/|list =value))
- (return (&/|list (&&/|meta exo-type _location (&&/$variant idx is-last? =value))))
+ (return (&/|list (&&/|meta exo-type _location (&&/$variant idx right? =value))))
))
(&/$UnivQ _)
(|do [$var &type/existential
exo-type** (&type/apply-type exo-type* $var)]
- (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values))
+ (analyse-variant analyse (&/$Right exo-type**) lefts right? ?values))
(&/$ExQ _)
(&type/with-var
(fn [$var]
(|do [exo-type** (&type/apply-type exo-type* $var)
- =exprs (analyse-variant analyse (&/$Right exo-type**) idx is-last? ?values)]
+ =exprs (analyse-variant analyse (&/$Right exo-type**) lefts right? ?values)]
(&/map% (partial &&/clean-analysis $var) =exprs))))
_
- (&/fail-with-loc (str "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type exo-type*) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))
+ (&/fail-with-loc (str "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type exo-type*) " " lefts " " right? " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))
(fn [err]
(|case exo-type
(&/$Var ?id)
(|do [=exo-type (&type/deref ?id)]
- (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type =exo-type) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))
+ (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type =exo-type) " " lefts " " right? " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))
_
- (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type exo-type) " " idx " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
+ (&/fail-with-loc (str err "\n" "[Analyser Error] Cannot create variant if the expected type is " (&type/show-type exo-type) " " lefts " " right? " " (->> ?values (&/|map &/show-ast) (&/|interpose " ") (&/fold str "")))))))
)))
(defn analyse-variant+ [analyse exo-type module tag-name values]
- (|do [[exported? wanted-type group idx] (&&module/find-tag module tag-name)
- :let [is-last? (= idx (dec (&/|length group)))]]
- (if (= 1 (&/|length group))
+ (|do [[exported? [label* variant_type]] (&&module/find-tag module tag-name)]
+ (|case label*
+ (&/$None)
(|do [_location &/location]
(analyse exo-type (&/T [_location (&/$Tuple values)])))
+
+ (&/$Some [lefts right? family])
(|case exo-type
(&/$Var id)
(|do [? (&type/bound? id)]
(if (or ? (&&/type-tag? module tag-name))
- (analyse-variant analyse (&/$Right exo-type) idx is-last? values)
- (|do [wanted-type* (&type/instantiate-inference wanted-type)
- [[variant-type variant-location] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left wanted-type*) idx is-last? values))
+ (analyse-variant analyse (&/$Right exo-type) lefts right? values)
+ (|do [variant_type* (&type/instantiate-inference variant_type)
+ [[variant-type variant-location] variant-analysis] (&&/cap-1 (analyse-variant analyse (&/$Left variant_type*) lefts right? values))
_ (&type/check exo-type variant-type)]
(return (&/|list (&&/|meta exo-type variant-location variant-analysis))))))
_
- (analyse-variant analyse (&/$Right exo-type) idx is-last? values)))))
+ (analyse-variant analyse (&/$Right exo-type) lefts right? values)))))
(defn analyse-record [analyse exo-type ?elems]
(|do [rec-members&rec-type (&&record/order-record false ?elems)]
@@ -577,7 +582,7 @@
(&&/analyse-1 analyse type code))]
(eval! (optimize analysis))))
-(defn analyse-def* [analyse optimize eval! compile-def ?name ?value exported? type? & [?expected-type]]
+(defn analyse-def* [analyse optimize eval! compile-def ?name ?value exported? & [?expected-type]]
(|do [_ &/ensure-declaration
module-name &/get-module-name
_ (ensure-undefined! module-name ?name)
@@ -588,7 +593,7 @@
(&&/analyse-1 analyse ?expected-type ?value))
(&&/analyse-1+ analyse ?value))))
==exported? (eval analyse optimize eval! &type/Bit exported?)
- def-value (compile-def ?name (optimize =value) ==exported? type?)
+ def-value (compile-def ?name (optimize =value) ==exported?)
_ &type/reset-mappings
:let [def-type (&&/expr-type* =value)
_ (println 'DEF (str module-name &/+name-separator+ ?name
@@ -596,19 +601,7 @@
(return (&/T [module-name def-type def-value ==exported?]))))
(defn analyse-def [analyse optimize eval! compile-def ?name ?value exported?]
- (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value exported? &/$None)]
- (return &/$End)))
-
-(defn analyse-def-type-tagged [analyse optimize eval! compile-def ?name ?value 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 exported? (&/$Some (&/T [record? labels])) &type/Type)]
+ (|do [_ (analyse-def* analyse optimize eval! compile-def ?name ?value exported?)]
(return &/$End)))
(defn analyse-def-alias [?alias ?original]
diff --git a/lux-bootstrapper/src/lux/analyser/module.clj b/lux-bootstrapper/src/lux/analyser/module.clj
index eebac2d80..426d0bfb6 100644
--- a/lux-bootstrapper/src/lux/analyser/module.clj
+++ b/lux-bootstrapper/src/lux/analyser/module.clj
@@ -110,18 +110,7 @@
(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]))))
- 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))
+ state)))
((&/fail-with-loc (str "[Analyser Error] Unknown definition: " (&/ident->text (&/T [module name]))))
state))
((&/fail-with-loc (str "[Analyser Error] Unknown module: " module))
@@ -181,24 +170,13 @@
state)
(&/$DefinitionG $def*)
- (return* state (&/T [(&/T [module name]) $def*]))
-
- (&/$TypeG [exported? ?value labels])
- (return* state (&/T [(&/T [module name])
- (&/T [exported? &type/Type ?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))
+ (return* state (&/T [(&/T [module name]) $def*])))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def!] Definition does not exist: " (&/ident->text (&/T [module name]))
+ " at module: " (pr-str current-module)))
state))
- ((&/fail-with-loc (str "[Analyser Error @ find-def!] Module does not exist: " module
- " at module: " current-module))
+ ((&/fail-with-loc (str "[Analyser Error @ find-def!] Module does not exist: " (pr-str module)
+ " for symbol: " (&/ident->text (&/T [module name]))
+ " at module: " (pr-str current-module)))
state)))))
(defn find-def [quoted_module module name]
@@ -225,27 +203,7 @@
(&/T [exported? ?type ?value])]))
((&/fail-with-loc (str "[Analyser Error @ find-def] Cannot use private definition: " (str module &/+name-separator+ name)
" at module: " current-module))
- state))
-
- (&/$TypeG [exported? ?value labels])
- (if (or (.equals ^Object current-module module)
- (and exported?
- (or (.equals ^Object &/prelude module)
- (.equals ^Object quoted_module module)
- (imports? state module current-module))))
- (return* state (&/T [(&/T [module name])
- (&/T [exported? &type/Type ?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))
+ state)))
((&/fail-with-loc (str "[Analyser Error @ find-def] Definition does not exist: " (str module &/+name-separator+ name)
" at module: " current-module))
state))
@@ -260,10 +218,7 @@
(if-let [$def (->> $module (&/get$ $defs) (&/|get name))]
(|case $def
(&/$AliasG [?r-module ?r-name]) (return* state $def)
- (&/$DefinitionG _) (return* state $def)
- (&/$TypeG _) (return* state $def)
- (&/$TagG _) (return* state $def)
- (&/$SlotG _) (return* state $def))
+ (&/$DefinitionG _) (return* state $def))
((&/fail-with-loc (str "[Analyser Error @ find-def] Global does not exist: " (str module &/+name-separator+ name)
" at module: " current-module))
state))
@@ -271,7 +226,21 @@
" at module: " current-module))
state)))))
-(do-template [<tag> <find!> <find>]
+(defn label
+ "(-> Text Nat (List Text) Type
+ Label)"
+ [module index group type]
+ (let [max_size (&/|length group)]
+ (if (= 1 max_size)
+ (&/T [&/$None type])
+ (let [right? (= index (dec max_size))
+ lefts (if right?
+ (dec index)
+ index)]
+ (&/T [(&/$Some (&/T [lefts right? (&/|map (fn [it] (&/T [module it])) group)]))
+ type])))))
+
+(do-template [<find!> <find> <definition_type>]
(do (defn <find!> [module name]
(|do [current-module &/get-module-name]
(fn [state]
@@ -282,9 +251,6 @@
((<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!>)))
@@ -311,12 +277,17 @@
" at module: " current-module
" @ " (quote <find>)))
state))
-
- (<tag> [exported? type group index])
+
+ (&/$DefinitionG [exported? ?type ?value])
(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)
+ (if (&type/type= <definition_type> ?type)
+ (return* state (&/T [exported? ?value]))
+ ((&/fail-with-loc (str "[Analyser Error] Invalid type for label: " (str module &/+name-separator+ name)
+ " at module: " current-module
+ " @ " (quote <find>)))
+ state))
+ ((&/fail-with-loc (str "[Analyser Error] Cannot use private definition: " (str module &/+name-separator+ name)
" at module: " current-module
" @ " (quote <find>)))
state))
@@ -334,8 +305,8 @@
" @ " (quote <find>)))
state))))))
- &/$TagG find-tag! find-tag
- &/$SlotG find-slot! find-slot
+ find-tag! find-tag &type/Tag
+ find-slot! find-slot &type/Slot
)
(defn if_not_defined [module name then]
@@ -426,81 +397,6 @@
((&/fail-with-loc (str "[Analyser Error] Cannot create a new global definition outside of a global environment: " (str module &/+name-separator+ name)))
state)))))
-(do-template [<name> <tag>]
- (defn <name> [module name exported? type group index]
- (if_not_defined
- module name
- (fn [state]
- (|case (&/get$ &/$scopes state)
- (&/$Item ?env (&/$End))
- (return* (->> state
- (&/update$ &/$modules
- (fn [ms]
- (&/|update module
- (fn [m]
- (&/update$ $defs
- #(&/|put name (<tag> (&/T [exported? type group index])) %)
- m))
- ms))))
- nil)
-
- _
- ((&/fail-with-loc (str "[Analyser Error] Cannot create a new global outside of a global environment: " (str module &/+name-separator+ name)))
- state)))))
-
- define_tag &/$TagG
- define_slot &/$SlotG
- )
-
-(defn declare-labels
- "(-> Text (List Text) Bit Type (Lux Null))"
- [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 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 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 label-name was-exported? type label-names index)))
- (&/enumerate label-names))))))
-
-(defn define-type [module name exported? def-value record? labels]
- (if_not_defined
- module name
- (|case labels
- (&/$End)
- (define module name exported? &type/Type 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]
(fn [state]
diff --git a/lux-bootstrapper/src/lux/analyser/record.clj b/lux-bootstrapper/src/lux/analyser/record.clj
index 913de4a64..d65211623 100644
--- a/lux-bootstrapper/src/lux/analyser/record.clj
+++ b/lux-bootstrapper/src/lux/analyser/record.clj
@@ -6,74 +6,124 @@
(lux.analyser [base :as &&]
[module :as &&module])))
-(defn head_slot [slot0]
+(defn ^:private record_slot [slot0]
(|do [[module name] (&&/resolved-ident slot0)
- _exported?&type&slots&_index (fn [lux]
- (|case ((&&module/find-slot module name) lux)
- (&/$Left error)
- (&/$Right (&/T [lux &/$None]))
-
- (&/$Right [lux* output])
- (&/$Right (&/T [lux* (&/$Some output)]))))]
- (return (|case _exported?&type&slots&_index
- (&/$Some [_exported? type slots _index])
- (&/$Some (&/T [module slots type]))
+ exported?&label (fn [lux]
+ (|case ((&&module/find-slot module name) lux)
+ (&/$Left error)
+ (&/$Right (&/T [lux &/$None]))
+
+ (&/$Right [lux* output])
+ (&/$Right (&/T [lux* (&/$Some output)]))))]
+ (return (|case exported?&label
+ (&/$Some [exported? [label* type]])
+ (&/$Some (&/T [label* type]))
(&/$None)
&/$None))))
+(defn ^:private slot_type
+ "(-> [Label Code] Type)"
+ [it]
+ (|let [[[label* type] value] it]
+ type))
+
+(defn ^:private same_record?
+ "(-> (List [Label Code]) Bit)"
+ [it]
+ (|case it
+ (&/$Item head tail)
+ (|let [expected (slot_type head)]
+ (&/|every? (fn [it] (->> it slot_type (&type/type= expected)))
+ tail))
+
+ (&/$End)
+ false))
+
+(defn ^:private complete_record?
+ "(-> (List [Label Code]) Bit)"
+ [it]
+ (loop [expected_lefts 0
+ remaining it]
+ (|case remaining
+ (&/$Item [[label* type] value] (&/$End))
+ (|case label*
+ (&/$Some [lefts true family])
+ (= (dec expected_lefts) lefts)
+
+ (&/$None)
+ (= 0 expected_lefts))
+
+ (&/$Item [[(&/$Some [lefts false family]) type] value] tail)
+ (and (= expected_lefts lefts)
+ (recur (inc expected_lefts) tail))
+
+ _
+ false)))
+
;; [Exports]
(defn order-record
"(-> (List Syntax) (Lux (Maybe (List Syntax))))"
[pattern_matching? pairs]
- (if (even? (&/|length pairs))
- (let [pairs (&/|as-pairs pairs)]
- (|do [module&slot-group&slot-type (|case pairs
- (&/$End)
- (|do [module &/get-module-name]
- (return (&/$Some (&/T [module &/$End &type/Any]))))
-
- (&/$Item [[_ (&/$Identifier slot0)] _] _)
- (|case slot0
- ["" short0]
- (if pattern_matching?
- (return &/$None)
- (|do [local? (&&module/find_local short0)]
- (|case local?
- (&/$None)
- (head_slot slot0)
-
- (&/$Some [local _inner _outer])
- (return &/$None))))
-
- [module0 short0]
- (head_slot slot0))
-
- _
- (return &/$None))]
- (|case module&slot-group&slot-type
- (&/$Some [module slot-group slot-type])
- (|do [=pairs (&/map% (fn [kv]
- (|case kv
- [[_ (&/$Identifier k)] v]
- (|do [=k (&&/resolved-ident k)]
- (return (&/T [(&/ident->text =k) v])))
-
- _
- (&/fail-with-loc "[Analyser Error] Wrong syntax for records. Odd elements must be slots.")))
- pairs)
- _ (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 [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 (&/$Some (&/T [=members slot-type]))))
-
- (&/$None)
+ (let [arity (&/|length pairs)]
+ (cond (= 0 arity)
+ (return &/$None)
+
+ (even? arity)
+ (let [pairs (&/|as-pairs pairs)]
+ (|do [resolved_slots* (&/map% (fn [pair]
+ (|case pair
+ [[_ (&/$Identifier slot0)] value]
+ (|case slot0
+ ["" short0]
+ (if pattern_matching?
+ (return &/$None)
+ (|do [local? (&&module/find_local short0)]
+ (|case local?
+ (&/$None)
+ (|do [slot (record_slot slot0)]
+ (return (|case slot
+ (&/$Some slot*)
+ (&/$Some (&/T [slot* value]))
+
+ (&/$None)
+ &/$None)))
+
+ (&/$Some [local _inner _outer])
+ (return &/$None))))
+
+ [module0 short0]
+ (|do [slot (record_slot slot0)]
+ (return (|case slot
+ (&/$Some slot*)
+ (&/$Some (&/T [slot* value]))
+
+ (&/$None)
+ &/$None))))
+
+ _
+ (return &/$None)))
+ pairs)]
+ (|case (&/all_maybe resolved_slots*)
+ (&/$Some resolved_slots)
+ (|do [:let [sorted_slots (->> resolved_slots
+ &/->seq
+ (sort (fn [left right]
+ (|let [[[(&/$Some [leftsL right?L familyL]) typeL] valueL] left
+ [[(&/$Some [leftsR right?R familyR]) typeR] valueR] right]
+ (if (= leftsL leftsR)
+ (not right?L)
+ (< leftsL leftsR)))))
+ &/->list)]
+ _ (&/assert! (same_record? sorted_slots)
+ "[Analyser Error] Slots correspond to different record types.")
+ _ (&/assert! (complete_record? sorted_slots)
+ "[Analyser Error] Missing record slots.")]
+ (return (&/$Some (&/T [(&/|map &/|second sorted_slots)
+ (slot_type (&/|head sorted_slots))]))))
+
+ (&/$None)
+ (return &/$None))))
+
+ true
(return &/$None))))
- (return &/$None)))
diff --git a/lux-bootstrapper/src/lux/base.clj b/lux-bootstrapper/src/lux/base.clj
index 39806f73f..8e99d8cde 100644
--- a/lux-bootstrapper/src/lux/base.clj
+++ b/lux-bootstrapper/src/lux/base.clj
@@ -150,9 +150,6 @@
(defvariant
("DefinitionG" 1)
- ("TypeG" 1)
- ("TagG" 1)
- ("SlotG" 1)
("AliasG" 1))
(deftuple
@@ -1520,3 +1517,25 @@
($Left ^String msg)
(fail* msg)))))
+
+(defn all_maybe
+ "(All (_ value)
+ (-> (List (Maybe value))
+ (Maybe (List value))))"
+ [it]
+ (|case it
+ ($Item head tail)
+ (|case head
+ ($Some head*)
+ (|case (all_maybe tail)
+ ($Some tail*)
+ ($Some ($Item head* tail*))
+
+ ($None)
+ $None)
+
+ ($None)
+ $None)
+
+ ($End)
+ ($Some $End)))
diff --git a/lux-bootstrapper/src/lux/compiler/cache.clj b/lux-bootstrapper/src/lux/compiler/cache.clj
index 931b6a165..301ddb7ef 100644
--- a/lux-bootstrapper/src/lux/compiler/cache.clj
+++ b/lux-bootstrapper/src/lux/compiler/cache.clj
@@ -81,23 +81,6 @@
[def-type _] (&&&type/deserialize-type _type)]
(|do [def-value (load-def-value module _name)]
(&a-module/define module _name (= "1" _exported?) def-type 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?)
- 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]
diff --git a/lux-bootstrapper/src/lux/compiler/core.clj b/lux-bootstrapper/src/lux/compiler/core.clj
index 5ba14e3ed..f3fefdc74 100644
--- a/lux-bootstrapper/src/lux/compiler/core.clj
+++ b/lux-bootstrapper/src/lux/compiler/core.clj
@@ -61,48 +61,7 @@
datum-separator (if exported? "1" "0")
datum-separator (&&&type/serialize-type ?def-type)
;; 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 "")))
- )))
+ entry-separator def-entries))))
""
defs)
import-entries (->> imports
diff --git a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj
index 4617f7e2e..eabda4265 100644
--- a/lux-bootstrapper/src/lux/compiler/jvm/lux.clj
+++ b/lux-bootstrapper/src/lux/compiler/jvm/lux.clj
@@ -252,7 +252,7 @@
(str base "\n\n" "Caused by: " (throwable->text cause))
base)))
-(defn ^:private install-def! [class-loader current-class module-name ?name ?body exported? type?]
+(defn ^:private install-def! [class-loader current-class module-name ?name ?body exported?]
(|do [_ (return nil)
:let [def-class (&&/load-class! class-loader (&host-generics/->class-name current-class))
def-type (&a/expr-type* ?body)]
@@ -262,17 +262,12 @@
(str "Error during value initialization:\n"
(throwable->text t)))))
_ (&/without-repl-closure
- (|case type?
- (&/$Some [record? labels])
- (&a-module/define-type module-name ?name exported? def-value record? labels)
-
- (&/$None)
- (&a-module/define module-name ?name exported? def-type def-value)))]
+ (&a-module/define module-name ?name exported? def-type 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 exported? type?]
+ (defn compile-def [compile ?name ?body exported?]
(|do [module-name &/get-module-name
class-loader &/loader]
(|case (de-ann ?body)
@@ -303,7 +298,7 @@
(return nil)))
:let [_ (.visitEnd =class)]
_ (&&/save-class! def-name (.toByteArray =class))
- def-value (install-def! class-loader current-class module-name ?name ?body exported? type?)]
+ def-value (install-def! class-loader current-class module-name ?name ?body exported?)]
(return def-value)))
_
@@ -329,7 +324,7 @@
(return nil)))
:let [_ (.visitEnd =class)]
_ (&&/save-class! def-name (.toByteArray =class))
- def-value (install-def! class-loader current-class module-name ?name ?body exported? type?)]
+ def-value (install-def! class-loader current-class module-name ?name ?body exported?)]
(return def-value))))))
(defn compile-program [compile ?program]
diff --git a/lux-bootstrapper/src/lux/optimizer.clj b/lux-bootstrapper/src/lux/optimizer.clj
index b8095fa22..1c40ac68b 100644
--- a/lux-bootstrapper/src/lux/optimizer.clj
+++ b/lux-bootstrapper/src/lux/optimizer.clj
@@ -198,10 +198,10 @@
(&/|list ($TextPM _value)
$PopPM)
- (&a-case/$VariantTestAC _idx _num-options _sub-test)
- (&/|++ (&/|list ($VariantPM (if (= _idx (dec _num-options))
- (&/$Right _idx)
- (&/$Left _idx))))
+ (&a-case/$VariantTestAC lefts right? _sub-test)
+ (&/|++ (&/|list ($VariantPM (if right?
+ (&/$Right (inc lefts))
+ (&/$Left lefts))))
(&/|++ (transform-pm* _sub-test)
(&/|list $PopPM)))
@@ -1049,7 +1049,7 @@
;; (not (contains-self-reference? _body)))
;; (inline-loop meta _register-offset _scope _captured =args _body)
;; (&/T [meta ($apply =func =args)]))
-
+
;; _
;; (&/T [meta ($apply =func =args)]))
)
diff --git a/lux-bootstrapper/src/lux/type.clj b/lux-bootstrapper/src/lux/type.clj
index 657eb3077..35a9a4b8e 100644
--- a/lux-bootstrapper/src/lux/type.clj
+++ b/lux-bootstrapper/src/lux/type.clj
@@ -28,17 +28,13 @@
(def I64 (&/$Named (&/T [&/prelude "I64"])
(&/$UnivQ empty-env
(&/$Primitive "#I64" (&/|list (&/$Parameter 1))))))
-(def Nat* (&/$Primitive &&host/nat-data-tag &/$End))
-(def Rev* (&/$Primitive &&host/rev-data-tag &/$End))
-(def Int* (&/$Primitive &&host/int-data-tag &/$End))
-
(def Bit (&/$Named (&/T [&/prelude "Bit"]) (&/$Primitive "#Bit" &/$End)))
-(def Nat (&/$Named (&/T [&/prelude "Nat"]) (&/$Apply Nat* I64)))
-(def Rev (&/$Named (&/T [&/prelude "Rev"]) (&/$Apply Rev* I64)))
-(def Int (&/$Named (&/T [&/prelude "Int"]) (&/$Apply Int* I64)))
+(def Nat (&/$Named (&/T [&/prelude "Nat"]) (&/$Primitive "#I64" (&/|list (&/$Primitive &&host/nat-data-tag &/$End)))))
+(def Int (&/$Named (&/T [&/prelude "Int"]) (&/$Primitive "#I64" (&/|list (&/$Primitive &&host/int-data-tag &/$End)))))
+(def Rev (&/$Named (&/T [&/prelude "Rev"]) (&/$Primitive "#I64" (&/|list (&/$Primitive &&host/rev-data-tag &/$End)))))
(def Frac (&/$Named (&/T [&/prelude "Frac"]) (&/$Primitive "#Frac" &/$End)))
(def Text (&/$Named (&/T [&/prelude "Text"]) (&/$Primitive "#Text" &/$End)))
-(def Ident (&/$Named (&/T [&/prelude "Ident"]) (&/$Product Text Text)))
+(def Symbol (&/$Named (&/T [&/prelude "Symbol"]) (&/$Product Text Text)))
(def Array &&host/Array)
@@ -81,10 +77,10 @@
(def Type
(&/$Named (&/T [&/prelude "Type"])
- (let [Type (&/$Apply (&/$Parameter 1) (&/$Parameter 0))
+ (let [Type (&/$Apply (&/$Primitive "" &/$End) (&/$Parameter 0))
TypeList (&/$Apply Type List)
TypePair (&/$Product Type Type)]
- (&/$Apply Nothing
+ (&/$Apply (&/$Primitive "" &/$End)
(&/$UnivQ empty-env
(&/$Sum
;; Primitive
@@ -117,13 +113,21 @@
;; App
TypePair
;; Named
- (&/$Product Ident Type)))))))))))
+ (&/$Product Symbol Type)))))))))))
)))))
(def Macro
(&/$Named (&/T [&/prelude "Macro"])
(&/$Primitive "#Macro" &/$End)))
+(def Tag
+ (&/$Named (&/T [&/prelude "Tag"])
+ (&/$Primitive "#Tag" &/$End)))
+
+(def Slot
+ (&/$Named (&/T [&/prelude "Slot"])
+ (&/$Primitive "#Slot" &/$End)))
+
(defn bound? [id]
(fn [state]
(if-let [type (->> state (&/get$ &/$type-context) (&/get$ &/$var-bindings) (&/|get id))]
@@ -818,7 +822,7 @@
))
(defn type-name
- "(-> Type (Lux Ident))"
+ "(-> Type (Lux Symbol))"
[type]
(|case type
(&/$Named name _)
diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux
index f35ba4250..d5c43cc7f 100644
--- a/stdlib/source/library/lux.lux
+++ b/stdlib/source/library/lux.lux
@@ -36,32 +36,11 @@
{4 #0 1}}})
#1)
-... (type .public (List a)
-... (Variant
-... {#End}
-... {#Item a (List a)}))
-("lux def type tagged" List
- {9 #1
- [..prelude "List"]
- {7 #0
- {0 #0}
- {1 #0
- ... End
- Any
- ... Item
- {2 #0
- {4 #0 1}
- {9 #0
- {4 #0 1}
- {4 #0 0}}}}}}
- {"#End" "#Item"}
- #1)
-
("lux def" Bit
("lux type check type"
{9 #1
[..prelude "Bit"]
- {0 #0 "#Bit" {#End}}})
+ {0 #0 "#Bit" {0 #0}}})
#1)
("lux def" I64
@@ -70,42 +49,42 @@
[..prelude "I64"]
{7 #0
{0 #0}
- {0 #0 "#I64" {#Item {4 #0 1} {#End}}}}})
+ {0 #0 "#I64" {0 #1 {4 #0 1} {0 #0}}}}})
#1)
("lux def" Nat
("lux type check type"
{9 #1
[..prelude "Nat"]
- {0 #0 "#I64" {#Item {0 #0 "#Nat" {#End}} {#End}}}})
+ {0 #0 "#I64" {0 #1 {0 #0 "#Nat" {0 #0}} {0 #0}}}})
#1)
("lux def" Int
("lux type check type"
{9 #1
[..prelude "Int"]
- {0 #0 "#I64" {#Item {0 #0 "#Int" {#End}} {#End}}}})
+ {0 #0 "#I64" {0 #1 {0 #0 "#Int" {0 #0}} {0 #0}}}})
#1)
("lux def" Rev
("lux type check type"
{9 #1
[..prelude "Rev"]
- {0 #0 "#I64" {#Item {0 #0 "#Rev" {#End}} {#End}}}})
+ {0 #0 "#I64" {0 #1 {0 #0 "#Rev" {0 #0}} {0 #0}}}})
#1)
("lux def" Frac
("lux type check type"
{9 #1
[..prelude "Frac"]
- {0 #0 "#Frac" {#End}}})
+ {0 #0 "#Frac" {0 #0}}})
#1)
("lux def" Text
("lux type check type"
{9 #1
[..prelude "Text"]
- {0 #0 "#Text" {#End}}})
+ {0 #0 "#Text" {0 #0}}})
#1)
("lux def" Symbol
@@ -115,21 +94,82 @@
{2 #0 Text Text}})
#1)
+... (type .public (List a)
+... (Variant
+... {#End}
+... {#Item a (List a)}))
+("lux def" List
+ ("lux type check type"
+ {9 #1
+ [..prelude "List"]
+ {7 #0
+ {0 #0}
+ {1 #0
+ ... End
+ Any
+ ... Item
+ {2 #0
+ {4 #0 1}
+ {9 #0
+ {4 #0 1}
+ {4 #0 0}}}}}})
+ #1)
+
+... (type .public Tag
+... (Primitive "#Tag"))
+("lux def" Tag
+ ("lux type check type"
+ {9 #1 [..prelude "Tag"]
+ {0 #0 "#Tag" {0 #0}}})
+ #1)
+
+... (type .public Slot
+... (Primitive "#Slot"))
+("lux def" Slot
+ ("lux type check type"
+ {9 #1 [..prelude "Slot"]
+ {0 #0 "#Slot" {0 #0}}})
+ #1)
+
+("lux def" Label'
+ ("lux type check type"
+ {1 #0 [Any {2 #0 [Nat {2 #0 [Bit {9 #0 Symbol List}]}]}]})
+ #0)
+
+("lux def" list_tags
+ ("lux type check"
+ {9 #0 Symbol List}
+ {0 #1 [[..prelude "#End"]
+ {0 #1 [[..prelude "#Item"]
+ {0 #0}]}]})
+ #0)
+("lux def" #End ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #0 ..list_tags]}) List]) #1)
+("lux def" #Item ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #1 ..list_tags]}) List]) #1)
+
... (type .public (Maybe a)
... {#None}
... {#Some a})
-("lux def type tagged" Maybe
- {9 #1
- [..prelude "Maybe"]
- {7 #0
- {#End}
- {1 #0
- ... None
- Any
- ... Some
- {4 #0 1}}}}
- {"#None" "#Some"}
+("lux def" Maybe
+ ("lux type check type"
+ {9 #1
+ [..prelude "Maybe"]
+ {7 #0
+ {#End}
+ {1 #0
+ ... None
+ Any
+ ... Some
+ {4 #0 1}}}})
#1)
+("lux def" maybe_tags
+ ("lux type check"
+ {9 #0 Symbol List}
+ {0 #1 [[..prelude "#None"]
+ {0 #1 [[..prelude "#Some"]
+ {0 #0}]}]})
+ #0)
+("lux def" #None ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #0 ..maybe_tags]}) Maybe]) #1)
+("lux def" #Some ("lux type as" Tag [("lux type check" Label' {0 #1 [0 #1 ..maybe_tags]}) Maybe]) #1)
... (type .public Type
... (Rec Type
@@ -145,77 +185,149 @@
... {#ExQ (List Type) Type}
... {#Apply Type Type}
... {#Named Symbol Type})))
-("lux def type tagged" Type
- {9 #1 [..prelude "Type"]
- ({Type
- ({Type_List
- ({Type_Pair
- {9 #0
- {0 #0 ["" {#End}]}
- {7 #0
- {#End}
- {1 #0
- ... Primitive
- {2 #0 Text Type_List}
- {1 #0
- ... Sum
- Type_Pair
- {1 #0
- ... Product
- Type_Pair
- {1 #0
- ... Function
- Type_Pair
- {1 #0
- ... Parameter
- Nat
- {1 #0
- ... Var
- Nat
- {1 #0
- ... Ex
- Nat
- {1 #0
- ... UnivQ
- {2 #0 Type_List Type}
- {1 #0
- ... ExQ
- {2 #0 Type_List Type}
- {1 #0
- ... Apply
- Type_Pair
- ... Named
- {2 #0 Symbol Type}}}}}}}}}}}}}}
- ("lux type check type" {2 #0 Type Type}))}
- ("lux type check type" {9 #0 Type List}))}
- ("lux type check type" {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))}
- {"#Primitive" "#Sum" "#Product" "#Function" "#Parameter" "#Var" "#Ex" "#UnivQ" "#ExQ" "#Apply" "#Named"}
+("lux def" Type
+ ("lux type check type"
+ {9 #1 [..prelude "Type"]
+ ({Type
+ ({Type_List
+ ({Type_Pair
+ {9 #0
+ {0 #0 ["" {#End}]}
+ {7 #0
+ {#End}
+ {1 #0
+ ... Primitive
+ {2 #0 Text Type_List}
+ {1 #0
+ ... Sum
+ Type_Pair
+ {1 #0
+ ... Product
+ Type_Pair
+ {1 #0
+ ... Function
+ Type_Pair
+ {1 #0
+ ... Parameter
+ Nat
+ {1 #0
+ ... Var
+ Nat
+ {1 #0
+ ... Ex
+ Nat
+ {1 #0
+ ... UnivQ
+ {2 #0 Type_List Type}
+ {1 #0
+ ... ExQ
+ {2 #0 Type_List Type}
+ {1 #0
+ ... Apply
+ Type_Pair
+ ... Named
+ {2 #0 Symbol Type}}}}}}}}}}}}}}
+ ("lux type check type" {2 #0 Type Type}))}
+ ("lux type check type" {9 #0 Type List}))}
+ ("lux type check type" {9 #0 {0 #0 ["" {#End}]} {4 #0 0}}))})
+ #1)
+
+("lux def" type_tags
+ ("lux type check"
+ {9 #0 Symbol List}
+ {0 #1 [[..prelude "#Primitive"]
+ {0 #1 [[..prelude "#Sum"]
+ {0 #1 [[..prelude "#Product"]
+ {0 #1 [[..prelude "#Function"]
+ {0 #1 [[..prelude "#Parameter"]
+ {0 #1 [[..prelude "#Var"]
+ {0 #1 [[..prelude "#Ex"]
+ {0 #1 [[..prelude "#UnivQ"]
+ {0 #1 [[..prelude "#ExQ"]
+ {0 #1 [[..prelude "#Apply"]
+ {0 #1 [[..prelude "#Named"]
+ {0 #0}]}]}]}]}]}]}]}]}]}]}]})
+ #0)
+("lux def" #Primitive ("lux type as" Tag [("lux type check" Label' {#Some [0 #0 ..type_tags]}) Type]) #1)
+("lux def" #Sum ("lux type as" Tag [("lux type check" Label' {#Some [1 #0 ..type_tags]}) Type]) #1)
+("lux def" #Product ("lux type as" Tag [("lux type check" Label' {#Some [2 #0 ..type_tags]}) Type]) #1)
+("lux def" #Function ("lux type as" Tag [("lux type check" Label' {#Some [3 #0 ..type_tags]}) Type]) #1)
+("lux def" #Parameter ("lux type as" Tag [("lux type check" Label' {#Some [4 #0 ..type_tags]}) Type]) #1)
+("lux def" #Var ("lux type as" Tag [("lux type check" Label' {#Some [5 #0 ..type_tags]}) Type]) #1)
+("lux def" #Ex ("lux type as" Tag [("lux type check" Label' {#Some [6 #0 ..type_tags]}) Type]) #1)
+("lux def" #UnivQ ("lux type as" Tag [("lux type check" Label' {#Some [7 #0 ..type_tags]}) Type]) #1)
+("lux def" #ExQ ("lux type as" Tag [("lux type check" Label' {#Some [8 #0 ..type_tags]}) Type]) #1)
+("lux def" #Apply ("lux type as" Tag [("lux type check" Label' {#Some [9 #0 ..type_tags]}) Type]) #1)
+("lux def" #Named ("lux type as" Tag [("lux type check" Label' {#Some [9 #1 ..type_tags]}) Type]) #1)
+
+... (type .public Label
+... [(Maybe [Nat Bit (List Symbol)]) Type])
+("lux def" Label
+ ("lux type check"
+ Type
+ {#Named [..prelude "Label"]
+ {#Product {#Apply {#Product Nat {#Product Bit {#Apply Symbol List}}} Maybe}
+ Type}})
#1)
+("lux def" tag
+ ("lux type check"
+ {#Function Label Tag}
+ ([_ it] ("lux type as" Tag it)))
+ #0)
+
+("lux def" slot
+ ("lux type check"
+ {#Function Label Slot}
+ ([_ it] ("lux type as" Slot it)))
+ #0)
+
... (type .public Location
... (Record
... [#module Text
... #line Nat
... #column Nat]))
-("lux def type tagged" Location
- {#Named [..prelude "Location"]
- {#Product Text {#Product Nat Nat}}}
- ["#module" "#line" "#column"]
+("lux def" Location
+ ("lux type check"
+ Type
+ {#Named [..prelude "Location"]
+ {#Product Text {#Product Nat Nat}}})
#1)
+("lux def" location_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#module"]
+ {#Item [..prelude "#line"]
+ {#Item [..prelude "#column"]
+ {#End}}}})
+ #0)
+("lux def" #module (slot [{#Some [0 #0 ..location_slots]} Location]) #1)
+("lux def" #line (slot [{#Some [1 #0 ..location_slots]} Location]) #1)
+("lux def" #column (slot [{#Some [1 #1 ..location_slots]} Location]) #1)
... (type .public (Ann m v)
... (Record
... [#meta m
... #datum v]))
-("lux def type tagged" Ann
- {#Named [..prelude "Ann"]
- {#UnivQ {#End}
- {#UnivQ {#End}
- {#Product
- {#Parameter 3}
- {#Parameter 1}}}}}
- ["#meta" "#datum"]
+("lux def" Ann
+ ("lux type check"
+ Type
+ {#Named [..prelude "Ann"]
+ {#UnivQ {#End}
+ {#UnivQ {#End}
+ {#Product
+ {#Parameter 3}
+ {#Parameter 1}}}}})
#1)
+("lux def" ann_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#meta"]
+ {#Item [..prelude "#datum"]
+ {#End}}})
+ #0)
+("lux def" #meta (slot [{#Some [0 #0 ..ann_slots]} Ann]) #1)
+("lux def" #datum (slot [{#Some [0 #1 ..ann_slots]} Ann]) #1)
... (type .public (Code' w)
... (Variant
@@ -229,57 +341,88 @@
... {#Form (List (w (Code' w)))}
... {#Variant (List (w (Code' w)))}
... {#Tuple (List (w (Code' w)))}))
-("lux def type tagged" Code'
- {#Named [..prelude "Code'"]
- ({Code
- ({Code_List
- {#UnivQ {#End}
- {#Sum
- ... Bit
- Bit
+("lux def" Code'
+ ("lux type check"
+ Type
+ {#Named [..prelude "Code'"]
+ ({Code
+ ({Code_List
+ {#UnivQ {#End}
{#Sum
- ... Nat
- Nat
+ ... Bit
+ Bit
{#Sum
- ... Int
- Int
+ ... Nat
+ Nat
{#Sum
- ... Rev
- Rev
+ ... Int
+ Int
{#Sum
- ... Frac
- Frac
+ ... Rev
+ Rev
{#Sum
- ... Text
- Text
+ ... Frac
+ Frac
{#Sum
- ... Symbol
- Symbol
+ ... Text
+ Text
{#Sum
- ... Form
- Code_List
+ ... Symbol
+ Symbol
{#Sum
- ... Variant
+ ... Form
Code_List
- ... Tuple
- Code_List
- }}}}}}}}}
- }}
- ("lux type check type" {#Apply Code List}))}
- ("lux type check type" {#Apply {#Apply {#Parameter 1}
- {#Parameter 0}}
- {#Parameter 1}}))}
- {"#Bit" "#Nat" "#Int" "#Rev" "#Frac" "#Text" "#Symbol" "#Form" "#Variant" "#Tuple"}
+ {#Sum
+ ... Variant
+ Code_List
+ ... Tuple
+ Code_List
+ }}}}}}}}}
+ }}
+ ("lux type check"
+ Type
+ {#Apply Code List}))}
+ ("lux type check"
+ Type
+ {#Apply {#Apply {#Parameter 1}
+ {#Parameter 0}}
+ {#Parameter 1}}))})
#1)
+("lux def" code'_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Bit"]
+ {#Item [..prelude "#Nat"]
+ {#Item [..prelude "#Int"]
+ {#Item [..prelude "#Rev"]
+ {#Item [..prelude "#Frac"]
+ {#Item [..prelude "#Text"]
+ {#Item [..prelude "#Symbol"]
+ {#Item [..prelude "#Form"]
+ {#Item [..prelude "#Variant"]
+ {#Item [..prelude "#Tuple"]
+ {#End}}}}}}}}}}})
+ #0)
+("lux def" #Bit (tag [{#Some [0 #0 ..code'_tags]} Code']) #1)
+("lux def" #Nat (tag [{#Some [1 #0 ..code'_tags]} Code']) #1)
+("lux def" #Int (tag [{#Some [2 #0 ..code'_tags]} Code']) #1)
+("lux def" #Rev (tag [{#Some [3 #0 ..code'_tags]} Code']) #1)
+("lux def" #Frac (tag [{#Some [4 #0 ..code'_tags]} Code']) #1)
+("lux def" #Text (tag [{#Some [5 #0 ..code'_tags]} Code']) #1)
+("lux def" #Symbol (tag [{#Some [6 #0 ..code'_tags]} Code']) #1)
+("lux def" #Form (tag [{#Some [7 #0 ..code'_tags]} Code']) #1)
+("lux def" #Variant (tag [{#Some [8 #0 ..code'_tags]} Code']) #1)
+("lux def" #Tuple (tag [{#Some [8 #1 ..code'_tags]} Code']) #1)
... (type .public Code
... (Ann Location (Code' (Ann Location))))
("lux def" Code
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Code"]
({w
{#Apply {#Apply w Code'} w}}
- ("lux type check type" {#Apply Location Ann}))})
+ ("lux type check" Type {#Apply Location Ann}))})
#1)
("lux def" private
@@ -307,64 +450,76 @@
#0)
("lux def" bit$
- ("lux type check" {#Function Bit Code}
+ ("lux type check"
+ {#Function Bit Code}
([_ value] (_ann {#Bit value})))
#0)
("lux def" nat$
- ("lux type check" {#Function Nat Code}
+ ("lux type check"
+ {#Function Nat Code}
([_ value] (_ann {#Nat value})))
#0)
("lux def" int$
- ("lux type check" {#Function Int Code}
+ ("lux type check"
+ {#Function Int Code}
([_ value] (_ann {#Int value})))
#0)
("lux def" rev$
- ("lux type check" {#Function Rev Code}
+ ("lux type check"
+ {#Function Rev Code}
([_ value] (_ann {#Rev value})))
#0)
("lux def" frac$
- ("lux type check" {#Function Frac Code}
+ ("lux type check"
+ {#Function Frac Code}
([_ value] (_ann {#Frac value})))
#0)
("lux def" text$
- ("lux type check" {#Function Text Code}
+ ("lux type check"
+ {#Function Text Code}
([_ text] (_ann {#Text text})))
#0)
("lux def" symbol$
- ("lux type check" {#Function Symbol Code}
+ ("lux type check"
+ {#Function Symbol Code}
([_ name] (_ann {#Symbol name})))
#0)
("lux def" local$
- ("lux type check" {#Function Text Code}
+ ("lux type check"
+ {#Function Text Code}
([_ name] (_ann {#Symbol ["" name]})))
#0)
("lux def" form$
- ("lux type check" {#Function {#Apply Code List} Code}
+ ("lux type check"
+ {#Function {#Apply Code List} Code}
([_ tokens] (_ann {#Form tokens})))
#0)
("lux def" variant$
- ("lux type check" {#Function {#Apply Code List} Code}
+ ("lux type check"
+ {#Function {#Apply Code List} Code}
([_ tokens] (_ann {#Variant tokens})))
#0)
("lux def" tuple$
- ("lux type check" {#Function {#Apply Code List} Code}
+ ("lux type check"
+ {#Function {#Apply Code List} Code}
([_ tokens] (_ann {#Tuple tokens})))
#0)
... (type .public Definition
... [Bit Type Any])
("lux def" Definition
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Definition"]
{#Product Bit {#Product Type Any}}})
.public)
@@ -372,94 +527,128 @@
... (type .public Alias
... Symbol)
("lux def" Alias
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Alias"]
Symbol})
.public)
-... (type .public Label
-... [Bit Type (List Text) Nat])
-("lux def" Label
- ("lux type check type"
- {#Named [..prelude "Label"]
- {#Product Bit {#Product Type {#Product {#Apply Text List} Nat}}}})
- .public)
-
... (type .public Global
... (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 [..prelude "Global"]
- {#Sum Definition
- {#Sum ({labels
- {#Product Bit {#Product Type {#Sum labels labels}}}}
- {#Product Text {#Apply Text List}})
- {#Sum Label
- {#Sum Label
- Alias}}}}}
- {"#Definition" "#Type" "#Tag" "#Slot" "#Alias"}
+("lux def" Global
+ ("lux type check"
+ Type
+ {#Named [..prelude "Global"]
+ {#Sum Definition
+ Alias}})
.public)
+("lux def" global_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Definition"]
+ {#Item [..prelude "#Alias"]
+ {#End}}})
+ #0)
+("lux def" #Definition (tag [{#Some [0 #0 ..global_tags]} Global]) .public)
+("lux def" #Alias (tag [{#Some [0 #1 ..global_tags]} Global]) .public)
+
... (type .public (Bindings k v)
... (Record
... [#counter Nat
... #mappings (List [k v])]))
-("lux def type tagged" Bindings
- {#Named [..prelude "Bindings"]
- {#UnivQ {#End}
- {#UnivQ {#End}
- {#Product
- ... counter
- Nat
- ... mappings
- {#Apply {#Product {#Parameter 3}
- {#Parameter 1}}
- List}}}}}
- ["#counter" "#mappings"]
+("lux def" Bindings
+ ("lux type check"
+ Type
+ {#Named [..prelude "Bindings"]
+ {#UnivQ {#End}
+ {#UnivQ {#End}
+ {#Product
+ ... counter
+ Nat
+ ... mappings
+ {#Apply {#Product {#Parameter 3}
+ {#Parameter 1}}
+ List}}}}})
.public)
+("lux def" bindings_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#counter"]
+ {#Item [..prelude "#mappings"]
+ {#End}}})
+ #0)
+("lux def" #counter (slot [{#Some [0 #0 ..bindings_slots]} Bindings]) .public)
+("lux def" #mappings (slot [{#Some [0 #1 ..bindings_slots]} Bindings]) .public)
+
... (type .public Ref
... {#Local Nat}
... {#Captured Nat})
-("lux def type tagged" Ref
- {#Named [..prelude "Ref"]
- {#Sum
- ... Local
- Nat
- ... Captured
- Nat}}
- {"#Local" "#Captured"}
+("lux def" Ref
+ ("lux type check"
+ Type
+ {#Named [..prelude "Ref"]
+ {#Sum
+ ... Local
+ Nat
+ ... Captured
+ Nat}})
.public)
-... TODO: Get rid of both #name & #inner
+("lux def" ref_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Local"]
+ {#Item [..prelude "#Captured"]
+ {#End}}})
+ #0)
+("lux def" #Local (tag [{#Some [0 #0 ..ref_tags]} Ref]) .public)
+("lux def" #Captured (tag [{#Some [0 #1 ..ref_tags]} Ref]) .public)
+
+... TODO: Get rid of both #scope_name & #inner_scopes
... (type .public Scope
... (Record
-... [#name (List Text)
-... #inner Nat
-... #locals (Bindings Text [Type Nat])
+... [#scope_name (List Text)
+... #inner_scopes Nat
+... #locals (Bindings Text [Type Nat])
... #captured (Bindings Text [Type Ref])]))
-("lux def type tagged" Scope
- {#Named [..prelude "Scope"]
- {#Product
- ... name
- {#Apply Text List}
+("lux def" Scope
+ ("lux type check"
+ Type
+ {#Named [..prelude "Scope"]
{#Product
- ... inner
- Nat
+ ... name
+ {#Apply Text List}
{#Product
- ... locals
- {#Apply {#Product Type Nat} {#Apply Text Bindings}}
- ... captured
- {#Apply {#Product Type Ref} {#Apply Text Bindings}}}}}}
- ["#name" "#inner" "#locals" "#captured"]
+ ... inner
+ Nat
+ {#Product
+ ... locals
+ {#Apply {#Product Type Nat} {#Apply Text Bindings}}
+ ... captured
+ {#Apply {#Product Type Ref} {#Apply Text Bindings}}}}}})
.public)
+("lux def" scope_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#scope_name"]
+ {#Item [..prelude "#inner_scopes"]
+ {#Item [..prelude "#locals"]
+ {#Item [..prelude "#captured"]
+ {#End}}}}})
+ #0)
+("lux def" #scope_name (slot [{#Some [0 #0 ..scope_slots]} Scope]) .public)
+("lux def" #inner_scopes (slot [{#Some [1 #0 ..scope_slots]} Scope]) .public)
+("lux def" #locals (slot [{#Some [2 #0 ..scope_slots]} Scope]) .public)
+("lux def" #captured (slot [{#Some [2 #1 ..scope_slots]} Scope]) .public)
+
("lux def" Code_List
- ("lux type check type"
+ ("lux type check"
+ Type
{#Apply Code List})
#0)
@@ -467,22 +656,34 @@
... (Variant
... {#Left l}
... {#Right r}))
-("lux def type tagged" Either
- {#Named [..prelude "Either"]
- {#UnivQ {#End}
- {#UnivQ {#End}
- {#Sum
- ... Left
- {#Parameter 3}
- ... Right
- {#Parameter 1}}}}}
- {"#Left" "#Right"}
+("lux def" Either
+ ("lux type check"
+ Type
+ {#Named [..prelude "Either"]
+ {#UnivQ {#End}
+ {#UnivQ {#End}
+ {#Sum
+ ... Left
+ {#Parameter 3}
+ ... Right
+ {#Parameter 1}}}}})
.public)
+("lux def" either_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Left"]
+ {#Item [..prelude "#Right"]
+ {#End}}})
+ #0)
+("lux def" #Left (tag [{#Some [0 #0 ..either_tags]} Either]) .public)
+("lux def" #Right (tag [{#Some [0 #1 ..either_tags]} Either]) .public)
+
... (type .public Source
... [Location Nat Text])
("lux def" Source
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Source"]
{#Product Location {#Product Nat Text}}})
.public)
@@ -492,19 +693,32 @@
... #Active
... #Compiled
... #Cached))
-("lux def type tagged" Module_State
- {#Named [..prelude "Module_State"]
- {#Sum
- ... #Active
- Any
+("lux def" Module_State
+ ("lux type check"
+ Type
+ {#Named [..prelude "Module_State"]
{#Sum
- ... #Compiled
+ ... #Active
Any
- ... #Cached
- Any}}}
- {"#Active" "#Compiled" "#Cached"}
+ {#Sum
+ ... #Compiled
+ Any
+ ... #Cached
+ Any}}})
.public)
+("lux def" module_state_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Active"]
+ {#Item [..prelude "#Compiled"]
+ {#Item [..prelude "#Cached"]
+ {#End}}}})
+ #0)
+("lux def" #Active (tag [{#Some [0 #0 ..module_state_tags]} Module_State]) .public)
+("lux def" #Compiled (tag [{#Some [1 #0 ..module_state_tags]} Module_State]) .public)
+("lux def" #Cached (tag [{#Some [1 #1 ..module_state_tags]} Module_State]) .public)
+
... (type .public Module
... (Record
... [#module_hash Nat
@@ -512,80 +726,141 @@
... #definitions (List [Text Global])
... #imports (List Text)
... #module_state Module_State]))
-("lux def type tagged" Module
- {#Named [..prelude "Module"]
- {#Product
- ... module_hash
- Nat
+("lux def" Module
+ ("lux type check"
+ Type
+ {#Named [..prelude "Module"]
{#Product
- ... module_aliases
- {#Apply {#Product Text Text} List}
+ ... module_hash
+ Nat
{#Product
- ... definitions
- {#Apply {#Product Text Global} List}
+ ... module_aliases
+ {#Apply {#Product Text Text} List}
{#Product
- ... imports
- {#Apply Text List}
- ... module_state
- Module_State
- }}}}}
- ["#module_hash" "#module_aliases" "#definitions" "#imports" "#module_state"]
+ ... definitions
+ {#Apply {#Product Text Global} List}
+ {#Product
+ ... imports
+ {#Apply Text List}
+ ... module_state
+ Module_State
+ }}}}})
.public)
+("lux def" module_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#module_hash"]
+ {#Item [..prelude "#module_aliases"]
+ {#Item [..prelude "#definitions"]
+ {#Item [..prelude "#imports"]
+ {#Item [..prelude "#module_state"]
+ {#End}}}}}})
+ #0)
+("lux def" #module_hash (slot [{#Some [0 #0 ..module_slots]} Module]) .public)
+("lux def" #module_aliases (slot [{#Some [1 #0 ..module_slots]} Module]) .public)
+("lux def" #definitions (slot [{#Some [2 #0 ..module_slots]} Module]) .public)
+("lux def" #imports (slot [{#Some [3 #0 ..module_slots]} Module]) .public)
+("lux def" #module_state (slot [{#Some [3 #1 ..module_slots]} Module]) .public)
+
... (type .public Type_Context
... (Record
... [#ex_counter Nat
... #var_counter Nat
... #var_bindings (List [Nat (Maybe Type)])]))
-("lux def type tagged" Type_Context
- {#Named [..prelude "Type_Context"]
- {#Product ... ex_counter
- Nat
- {#Product ... var_counter
+("lux def" Type_Context
+ ("lux type check"
+ Type
+ {#Named [..prelude "Type_Context"]
+ {#Product ... ex_counter
Nat
- ... var_bindings
- {#Apply {#Product Nat {#Apply Type Maybe}}
- List}}}}
- ["#ex_counter" "#var_counter" "#var_bindings"]
+ {#Product ... var_counter
+ Nat
+ ... var_bindings
+ {#Apply {#Product Nat {#Apply Type Maybe}}
+ List}}}})
.public)
+("lux def" type_context_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#ex_counter"]
+ {#Item [..prelude "#var_counter"]
+ {#Item [..prelude "#var_bindings"]
+ {#End}}}})
+ #0)
+("lux def" #ex_counter (slot [{#Some [0 #0 ..type_context_slots]} Type_Context]) .public)
+("lux def" #var_counter (slot [{#Some [1 #0 ..type_context_slots]} Type_Context]) .public)
+("lux def" #var_bindings (slot [{#Some [1 #1 ..type_context_slots]} Type_Context]) .public)
+
... (type .public Mode
-... #Build
-... #Eval
-... #Interpreter)
-("lux def type tagged" Mode
- {#Named [..prelude "Mode"]
- {#Sum ... Build
- Any
- {#Sum ... Eval
+... (Variant
+... {#Build}
+... {#Eval}
+... {#Interpreter}))
+("lux def" Mode
+ ("lux type check"
+ Type
+ {#Named [..prelude "Mode"]
+ {#Sum
+ ... Build
Any
- ... Interpreter
- Any}}}
- {"#Build" "#Eval" "#Interpreter"}
+ {#Sum
+ ... Eval
+ Any
+ ... Interpreter
+ Any}}})
.public)
+("lux def" mode_tags
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#Build"]
+ {#Item [..prelude "#Eval"]
+ {#Item [..prelude "#Interpreter"]
+ {#End}}}})
+ #0)
+("lux def" #Build (tag [{#Some [0 #0 ..mode_tags]} Mode]) .public)
+("lux def" #Eval (tag [{#Some [1 #0 ..mode_tags]} Mode]) .public)
+("lux def" #Interpreter (tag [{#Some [1 #1 ..mode_tags]} Mode]) .public)
+
... (type .public Info
... (Record
... [#target Text
... #version Text
... #mode Mode
... #configuration (List [Text Text])]))
-("lux def type tagged" Info
- {#Named [..prelude "Info"]
- {#Product
- ... target
- Text
+("lux def" Info
+ ("lux type check"
+ Type
+ {#Named [..prelude "Info"]
{#Product
- ... version
+ ... target
Text
{#Product
- ... mode
- Mode
- ... configuration
- {#Apply {#Product Text Text} List}}}}}
- ["#target" "#version" "#mode" "#configuration"]
+ ... version
+ Text
+ {#Product
+ ... mode
+ Mode
+ ... configuration
+ {#Apply {#Product Text Text} List}}}}})
.public)
+("lux def" info_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#target"]
+ {#Item [..prelude "#version"]
+ {#Item [..prelude "#mode"]
+ {#Item [..prelude "#configuration"]
+ {#End}}}}})
+ #0)
+("lux def" #target (slot [{#Some [0 #0 ..info_slots]} Info]) .public)
+("lux def" #version (slot [{#Some [1 #0 ..info_slots]} Info]) .public)
+("lux def" #mode (slot [{#Some [2 #0 ..info_slots]} Info]) .public)
+("lux def" #configuration (slot [{#Some [2 #1 ..info_slots]} Info]) .public)
+
... (type .public Lux
... (Rec Lux
... (Record
@@ -602,60 +877,94 @@
... #extensions Any
... #eval (-> Type Code (-> Lux (Either Text [Lux Any])))
... #host Any])))
-("lux def type tagged" Lux
- {#Named [..prelude "Lux"]
- ({Lux
- {#Apply {0 #0 ["" {#End}]}
- {#UnivQ {#End}
- {#Product
- ... info
- Info
+("lux def" Lux
+ ("lux type check"
+ Type
+ {#Named [..prelude "Lux"]
+ ({Lux
+ {#Apply {0 #0 ["" {#End}]}
+ {#UnivQ {#End}
{#Product
- ... source
- Source
+ ... info
+ Info
{#Product
- ... location
- Location
+ ... source
+ Source
{#Product
- ... current_module
- {#Apply Text Maybe}
+ ... location
+ Location
{#Product
- ... modules
- {#Apply {#Product Text Module} List}
+ ... current_module
+ {#Apply Text Maybe}
{#Product
- ... scopes
- {#Apply Scope List}
+ ... modules
+ {#Apply {#Product Text Module} List}
{#Product
- ... type_context
- Type_Context
+ ... scopes
+ {#Apply Scope List}
{#Product
- ... expected
- {#Apply Type Maybe}
+ ... type_context
+ Type_Context
{#Product
- ... seed
- Nat
+ ... expected
+ {#Apply Type Maybe}
{#Product
- ... scope_type_vars
- {#Apply Nat List}
+ ... seed
+ Nat
{#Product
- ... extensions
- Any
+ ... scope_type_vars
+ {#Apply Nat List}
{#Product
- ... eval
- {#Function Type
- {#Function Code
- {#Function Lux
- {#Sum Text {#Product Lux Any}}}}}
- ... host
- Any}}}}}}}}}}}}}}}
- {#Apply {0 #0 ["" {#End}]} {#Parameter 0}})}
- ["#info" "#source" "#location" "#current_module" "#modules" "#scopes" "#type_context" "#expected" "#seed" "#scope_type_vars" "#extensions" "#eval" "#host"]
+ ... extensions
+ Any
+ {#Product
+ ... eval
+ {#Function Type
+ {#Function Code
+ {#Function Lux
+ {#Sum Text {#Product Lux Any}}}}}
+ ... host
+ Any}}}}}}}}}}}}}}}
+ {#Apply {0 #0 ["" {#End}]} {#Parameter 0}})})
.public)
+("lux def" lux_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#info"]
+ {#Item [..prelude "#source"]
+ {#Item [..prelude "#location"]
+ {#Item [..prelude "#current_module"]
+ {#Item [..prelude "#modules"]
+ {#Item [..prelude "#scopes"]
+ {#Item [..prelude "#type_context"]
+ {#Item [..prelude "#expected"]
+ {#Item [..prelude "#seed"]
+ {#Item [..prelude "#scope_type_vars"]
+ {#Item [..prelude "#extensions"]
+ {#Item [..prelude "#eval"]
+ {#Item [..prelude "#host"]
+ {#End}}}}}}}}}}}}}})
+ #0)
+("lux def" #info (slot [{#Some [0 #0 ..lux_slots]} Lux]) .public)
+("lux def" #source (slot [{#Some [1 #0 ..lux_slots]} Lux]) .public)
+("lux def" #location (slot [{#Some [2 #0 ..lux_slots]} Lux]) .public)
+("lux def" #current_module (slot [{#Some [3 #0 ..lux_slots]} Lux]) .public)
+("lux def" #modules (slot [{#Some [4 #0 ..lux_slots]} Lux]) .public)
+("lux def" #scopes (slot [{#Some [5 #0 ..lux_slots]} Lux]) .public)
+("lux def" #type_context (slot [{#Some [6 #0 ..lux_slots]} Lux]) .public)
+("lux def" #expected (slot [{#Some [7 #0 ..lux_slots]} Lux]) .public)
+("lux def" #seed (slot [{#Some [8 #0 ..lux_slots]} Lux]) .public)
+("lux def" #scope_type_vars (slot [{#Some [9 #0 ..lux_slots]} Lux]) .public)
+("lux def" #extensions (slot [{#Some [10 #0 ..lux_slots]} Lux]) .public)
+("lux def" #eval (slot [{#Some [11 #0 ..lux_slots]} Lux]) .public)
+("lux def" #host (slot [{#Some [11 #1 ..lux_slots]} Lux]) .public)
+
... (type .public (Meta a)
... (-> Lux (Either Text [Lux a])))
("lux def" Meta
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Meta"]
{#UnivQ {#End}
{#Function Lux
@@ -666,7 +975,8 @@
... (type .public Macro'
... (-> (List Code) (Meta (List Code))))
("lux def" Macro'
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Macro'"]
{#Function Code_List {#Apply Code_List Meta}}})
.public)
@@ -674,7 +984,8 @@
... (type .public Macro
... (Primitive "#Macro"))
("lux def" Macro
- ("lux type check type"
+ ("lux type check"
+ Type
{#Named [..prelude "Macro"]
{#Primitive "#Macro" {#End}}})
.public)
@@ -783,19 +1094,22 @@
#0)
("lux def" as_def
- ("lux type check" {#Function Code {#Function Code {#Function Code Code}}}
+ ("lux type check"
+ {#Function Code {#Function Code {#Function Code Code}}}
(function'' [name value export_policy]
(form$ {#Item (text$ "lux def") {#Item name {#Item value {#Item export_policy {#End}}}}})))
#0)
("lux def" as_checked
- ("lux type check" {#Function Code {#Function Code Code}}
+ ("lux type check"
+ {#Function Code {#Function Code Code}}
(function'' [type value]
(form$ {#Item (text$ "lux type check") {#Item type {#Item value {#End}}}})))
#0)
("lux def" as_function
- ("lux type check" {#Function Code {#Function {#Apply Code List} {#Function Code Code}}}
+ ("lux type check"
+ {#Function Code {#Function {#Apply Code List} {#Function Code Code}}}
(function'' as_function [self inputs output]
({{#End}
output
@@ -808,7 +1122,8 @@
#0)
("lux def" as_macro
- ("lux type check" {#Function Code Code}
+ ("lux type check"
+ {#Function Code Code}
(function'' [expression]
(form$ {#Item (text$ "lux type as")
{#Item (symbol$ [..prelude "Macro"])
@@ -894,8 +1209,9 @@
(def' .private (list#reversed list)
{#UnivQ {#End}
{#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}
- (list#mix ("lux type check" {#UnivQ {#End}
- {#Function {#Parameter 1} {#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}}
+ (list#mix ("lux type check"
+ {#UnivQ {#End}
+ {#Function {#Parameter 1} {#Function ($ List {#Parameter 1}) ($ List {#Parameter 1})}}}
(function'' [head tail] {#Item head tail}))
{#End}
list))
@@ -1108,7 +1424,7 @@
..#scope_type_vars _ ..#eval _]
(list#mix (function'' [scope verdict]
({[#1] #1
- _ ({[..#name _ ..#inner _ ..#captured _
+ _ ({[..#scope_name _ ..#inner_scopes _ ..#captured _
..#locals [..#counter _
..#mappings locals]]
(list#mix (function'' [local verdict]
@@ -1197,7 +1513,8 @@
Macro
(macro (_ tokens)
({{#Item output inputs}
- (meta#in {#Item (list#mix ("lux type check" {#Function Code {#Function Code Code}}
+ (meta#in {#Item (list#mix ("lux type check"
+ {#Function Code {#Function Code Code}}
(function'' [i o] (variant$ {#Item (symbol$ [..prelude "#Function"]) {#Item i {#Item o {#End}}}})))
output
inputs)
@@ -1305,8 +1622,9 @@
(macro (_ tokens)
({{#Item [_ {#Tuple bindings}] {#Item body {#End}}}
({{#Some bindings}
- (meta#in (list (list#mix ("lux type check" (-> (Tuple Code Code) Code
- Code)
+ (meta#in (list (list#mix ("lux type check"
+ (-> (Tuple Code Code) Code
+ Code)
(function' [binding body]
({[label value]
(form$ (list (variant$ (list label body)) value))}
@@ -1408,17 +1726,27 @@
... #in)
... (is (All (_ a b) (-> (-> a (m b)) (m a) (m b)))
... #then)))
-("lux def type tagged" Monad
- {#Named [..prelude "Monad"]
- (All (_ !)
- (Tuple (All (_ a)
- (-> a ($ ! a)))
- (All (_ a b)
- (-> (-> a ($ ! b))
- ($ ! a)
- ($ ! b)))))}
- ["#in" "#then"]
+("lux def" Monad
+ ("lux type check"
+ Type
+ {#Named [..prelude "Monad"]
+ (All (_ !)
+ (Tuple (All (_ a)
+ (-> a ($ ! a)))
+ (All (_ a b)
+ (-> (-> a ($ ! b))
+ (-> ($ ! a) ($ ! b))))))})
+ #0)
+
+("lux def" monad_slots
+ ("lux type check"
+ {#Apply Symbol List}
+ {#Item [..prelude "#in"]
+ {#Item [..prelude "#then"]
+ {#End}}})
#0)
+("lux def" #in (slot [{#Some [0 #0 ..monad_slots]} Monad]) .private)
+("lux def" #then (slot [{#Some [0 #1 ..monad_slots]} Monad]) .private)
(def' .private maybe#monad
($ Monad Maybe)
@@ -1427,8 +1755,11 @@
#then
(function' [f ma]
- ({{#None} {#None}
- {#Some a} (f a)}
+ ({{#None}
+ {#None}
+
+ {#Some a}
+ (f a)}
ma))])
(def' .private meta#monad
@@ -1455,7 +1786,8 @@
({{#Some bindings}
(let' [g!in (local$ "in")
g!then (local$ " then ")
- body' (list#mix ("lux type check" (-> (Tuple Code Code) Code Code)
+ body' (list#mix ("lux type check"
+ (-> (Tuple Code Code) Code Code)
(function' [binding body']
(let' [[var value] binding]
({[_ {#Symbol [module short]}]
@@ -1571,10 +1903,8 @@
..#scope_type_vars scope_type_vars ..#eval _eval] state]
({{#Some [..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _]}
({{#Some constant}
- ({{#Definition _} {#Right [state full_name]}
- {#Tag _} {#Right [state full_name]}
- {#Slot _} {#Right [state full_name]}
- {#Type _} {#Right [state full_name]}
+ ({{#Definition _}
+ {#Right [state full_name]}
{#Alias real_name}
{#Right [state real_name]}}
@@ -1648,8 +1978,8 @@
(list#one ("lux type check"
(-> Scope ($ Maybe Type))
(function' [env]
- (let' [[..#name _
- ..#inner _
+ (let' [[..#scope_name _
+ ..#inner_scopes _
..#locals [..#counter _ ..#mappings locals]
..#captured _] env]
(list#one ("lux type check"
@@ -1707,18 +2037,7 @@
{#Definition [exported? def_type def_value]}
(if (available? expected_module current_module exported?)
{#Right [state [def_type def_value]]}
- {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})
-
- {#Type [exported? type labels]}
- (if (available? expected_module current_module exported?)
- {#Right [state [..Type type]]}
- {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})
-
- {#Tag _}
- {#Left (text#composite "Unknown definition: " (symbol#encoded name))}
-
- {#Slot _}
- {#Left (text#composite "Unknown definition: " (symbol#encoded name))}}
+ {#Left (text#composite "Unavailable definition: " (symbol#encoded name))})}
definition)}
(property#value expected_short definitions))}
(property#value expected_module modules))))
@@ -1742,7 +2061,7 @@
(definition_value global lux)}
module))))
-(def' .private (bit#and left right)
+(def' .private (and' left right)
(-> Bit Bit Bit)
(if left
right
@@ -1752,7 +2071,7 @@
(-> Symbol Symbol Bit)
(let' [[moduleL shortL] left
[moduleR shortR] right]
- (all bit#and
+ (all and'
(text#= moduleL moduleR)
(text#= shortL shortR))))
@@ -1779,29 +2098,29 @@
(def' .private (type#= left right)
(-> Type Type Bit)
({[{#Primitive nameL parametersL} {#Primitive nameR parametersR}]
- (all bit#and
+ (all and'
(text#= nameL nameR)
("lux i64 =" (list#size parametersL) (list#size parametersR))
(every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR)))
(zipped_2 parametersL parametersR)))
[{#Sum leftL rightL} {#Sum leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
[{#Product leftL rightL} {#Product leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
[{#Function leftL rightL} {#Function leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
[{#Apply leftL rightL} {#Apply leftR rightR}]
- (all bit#and
+ (all and'
(type#= leftL leftR)
(type#= rightL rightR))
@@ -1815,21 +2134,21 @@
("lux i64 =" idL idR)
[{#UnivQ envL bodyL} {#UnivQ envR bodyR}]
- (all bit#and
+ (all and'
("lux i64 =" (list#size envL) (list#size envR))
(every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR)))
(zipped_2 envL envR))
(type#= bodyL bodyR))
[{#ExQ envL bodyL} {#ExQ envR bodyR}]
- (all bit#and
+ (all and'
("lux i64 =" (list#size envL) (list#size envR))
(every? (function' [l,r] (let' [[itL itR] l,r] (type#= itL itR)))
(zipped_2 envL envR))
(type#= bodyL bodyR))
[{#Named nameL anonL} {#Named nameR anonR}]
- (all bit#and
+ (all and'
(symbol#= nameL nameR)
(type#= anonL anonR))
@@ -2109,7 +2428,8 @@
Macro
(macro (_ tokens)
({{#Item [init apps]}
- (meta#in (list (list#mix ("lux type check" (-> Code Code Code)
+ (meta#in (list (list#mix ("lux type check"
+ (-> Code Code Code)
(function' [app acc]
({[_ {#Variant parts}]
(variant$ (list#composite parts (list acc)))
@@ -2134,7 +2454,8 @@
Macro
(macro (_ tokens)
({{#Item [init apps]}
- (meta#in (list (list#mix ("lux type check" (-> Code Code Code)
+ (meta#in (list (list#mix ("lux type check"
+ (-> Code Code Code)
(function' [app acc]
({[_ {#Variant parts}]
(variant$ (list#composite parts (list acc)))
@@ -2254,7 +2575,8 @@
(macro (_ tokens)
({{#Item [[_ {#Tuple bindings}] {#Item [[_ {#Tuple templates}] data]}]}
({[{#Some bindings'} {#Some data'}]
- (let' [apply ("lux type check" (-> Replacement_Environment ($ List Code))
+ (let' [apply ("lux type check"
+ (-> Replacement_Environment ($ List Code))
(function' [env] (list#each (realized_template env) templates)))
num_bindings (list#size bindings')]
(if (every? (function' [size] ("lux i64 =" num_bindings size))
@@ -2321,7 +2643,8 @@
(def' .private (nat#encoded value)
(-> Nat Text)
({[0] "0"
- _ (let' [loop ("lux type check" (-> Nat Text Text)
+ _ (let' [loop ("lux type check"
+ (-> Nat Text Text)
(function' again [input output]
(if ("lux i64 =" 0 input)
output
@@ -2344,7 +2667,8 @@
(let' [sign (if ("lux i64 <" value +0)
"+"
"-")]
- (("lux type check" (-> Int Text Text)
+ (("lux type check"
+ (-> Int Text Text)
(function' again [input output]
(if ("lux i64 =" +0 input)
(text#composite sign output)
@@ -2389,16 +2713,7 @@
(if (text#= module current_module)
{#Some ("lux type as" Macro def_value)}
{#None}))
- {#None})
-
- {#Type [exported? type labels]}
- {#None}
-
- {#Tag _}
- {#None}
-
- {#Slot _}
- {#None}}
+ {#None})}
("lux type check" Global gdef))))
(def' .private (named_macro full_name)
@@ -2654,7 +2969,8 @@
(do meta#monad
[type_fn (normal_type type_fn)
args (monad#each meta#monad normal_type args)]
- (in (list#mix ("lux type check" (-> Code Code Code)
+ (in (list#mix ("lux type check"
+ (-> Code Code Code)
(function' [arg type_fn] (` {.#Apply (, arg) (, type_fn)})))
type_fn
args)))
@@ -2713,8 +3029,8 @@
..#source source/pre
..#current_module current_module/pre
..#modules modules/pre
- ..#scopes (list#partial [#name (list)
- #inner 0
+ ..#scopes (list#partial [#scope_name (list)
+ #inner_scopes 0
#locals [#counter 0
#mappings (list [..quantification_level [.Nat ("lux type as" Nat -1)]])]
#captured [#counter 0
@@ -2817,9 +3133,9 @@
(macro (_ tokens)
({{#Item value actions}
(let' [dummy (local$ "")]
- (meta#in (list (list#mix ("lux type check" (-> Code Code Code)
- (function' [pre post] (` ({(, dummy) (, post)}
- (, pre)))))
+ (meta#in (list (list#mix ("lux type check"
+ (-> Code Code Code)
+ (function' [pre post] (` ({(, dummy) (, post)} (, pre)))))
value
actions))))
@@ -2855,12 +3171,13 @@
(def' .private (type#encoded type)
(-> Type Text)
({{#Primitive name params}
- ({{#End}
- name
-
- _
- (all text#composite "(" name " " (|> params (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) ")")}
- params)
+ (all text#composite
+ "(Primitive " (text#encoded name)
+ (|> params
+ (list#each (function' [it] (|> it type#encoded (text#composite " "))))
+ list#reversed
+ (list#mix text#composite ""))
+ ")")
{#Sum _}
(all text#composite "{" (|> (flat_variant type) (list#each type#encoded) (list#interposed " ") list#reversed (list#mix text#composite "")) "}")
@@ -2943,6 +3260,12 @@
{#Primitive "#I64" {#Item {#Primitive "#Rev" {#End}} {#End}}}
(in (rev$ (as Rev value)))
+
+ {#Primitive "#Tag" {#End}}
+ (in (symbol$ name))
+
+ {#Primitive "#Slot" {#End}}
+ (in (symbol$ name))
_
(failure (all text#composite
@@ -3621,7 +3944,7 @@
{#Left (all text#composite "Unknown module: " name)}))))
(def (type_slot [module name])
- (-> Symbol (Meta [Nat (List Symbol) Bit Type]))
+ (-> Symbol (Meta [Bit Label]))
(do meta#monad
[=module (..module module)
.let [[..#module_hash _
@@ -3630,17 +3953,50 @@
..#imports _
..#module_state _] =module]]
(when (property#value name definitions)
- {#Some {#Slot [exported type group index]}}
- (meta#in [index
- (list#each (function (_ slot)
- [module slot])
- group)
- exported
- type])
+ {#Some {#Definition [exported type value]}}
+ (meta#in [exported (as Label value)])
_
(failure (text#composite "Unknown slot: " (symbol#encoded [module name]))))))
+(def (slot_family expected_module expected_record)
+ (-> Text Type (Meta (Maybe (List Symbol))))
+ (do meta#monad
+ [module (..module expected_module)
+ actual_module ..current_module_name
+ .let [[..#module_hash _
+ ..#module_aliases _
+ ..#definitions definitions
+ ..#imports _
+ ..#module_state _] module]]
+ (in ((is (-> (List [Text Global])
+ (Maybe (List Symbol)))
+ (function (again remaining)
+ (when remaining
+ {#Item [slot head] tail}
+ (when head
+ {#Definition [exported? type value]}
+ (if (and (type#= Slot type)
+ (or exported?
+ (text#= expected_module actual_module)))
+ (let [[label actual_record] (as Label value)]
+ (if (type#= expected_record actual_record)
+ (when label
+ {#Some [lefts right? family]}
+ {#Some family}
+
+ {#None}
+ {#Some (list [expected_module slot])})
+ (again tail)))
+ (again tail))
+
+ _
+ (again tail))
+
+ {#End}
+ {#None})))
+ definitions))))
+
(def (record_slots type)
(-> Type (Meta (Maybe [(List Symbol) (List Type)])))
(when type
@@ -3662,15 +4018,17 @@
..#imports _
..#module_state _] =module]]
(when (property#value name definitions)
- {#Some {#Type [exported? {#Named _ _type} {#Right slots}]}}
- (when (interface_methods _type)
- {#Some members}
- (meta#in {#Some [(list#each (function (_ slot) [module slot])
- {#Item slots})
- members]})
+ {#Some {#Definition [exported? type value]}}
+ (if (type#= Type type)
+ (do meta#monad
+ [slots (slot_family module (as Type value))]
+ (when [slots (interface_methods (as Type value))]
+ [{#Some slots} {#Some members}]
+ (in {#Some [slots members]})
- _
- (meta#in {#None}))
+ _
+ (record_slots unnamed)))
+ (in {#None}))
_
(record_slots unnamed)))
@@ -3867,6 +4225,51 @@
(meta#in [type {#None}])}
it))
+(def (enumeration' idx xs)
+ (All (_ a)
+ (-> Nat (List a) (List [Nat a])))
+ (when xs
+ {#Item x xs'}
+ {#Item [idx x] (enumeration' ("lux i64 +" 1 idx) xs')}
+
+ {#End}
+ {#End}))
+
+(def (enumeration xs)
+ (All (_ a)
+ (-> (List a) (List [Nat a])))
+ (enumeration' 0 xs))
+
+(def (label_definitions module export_policy associated_type label_type family labels)
+ (-> Text Code Code Code Code (List Text) (List Code))
+ (when (list#reversed labels)
+ (list single)
+ (list (` (def (, export_policy) (, (local$ single))
+ (<| (as (, label_type))
+ (is Label)
+ [{#None} (, associated_type)]))))
+
+ (list#partial right lefts)
+ (list#partial
+ (` (def (, family)
+ (List Symbol)
+ (list (,* (list#each (function (_ it)
+ (` [(, (text$ module)) (, (text$ it))]))
+ labels)))))
+ (` (def (, export_policy) (, (local$ right))
+ (<| (as (, label_type))
+ (is Label)
+ [{#Some [(, (nat$ ("lux i64 -" 1 (list#size lefts)))) #1 (, family)]} (, associated_type)])))
+ (list#each (function (_ [lefts it])
+ (` (def (, export_policy) (, (local$ it))
+ (<| (as (, label_type))
+ (is Label)
+ [{#Some [(, (nat$ lefts)) #0 (, family)]} (, associated_type)]))))
+ (enumeration (list#reversed lefts))))
+
+ _
+ (list)))
+
(def .public type
(macro (_ tokens)
(when (typeP tokens)
@@ -3874,6 +4277,7 @@
(do meta#monad
[type+labels?? (..type_declaration type_codes)
module_name current_module_name
+ g!family (..generated_symbol "g!family")
.let' [type_name (local$ name)
[type labels??] type+labels??
type' (is (Maybe Code)
@@ -3889,23 +4293,22 @@
(let [typeC (` {.#Named [(, (text$ module_name))
(, (text$ name))]
(..type_literal (, type''))})]
- (meta#in (list (when labels??
- {#Some labels}
- (` ("lux def type tagged" (, type_name)
- (, typeC)
- (, (when labels
- {#Left tags}
- (` {(,* (list#each text$ tags))})
-
- {#Right slots}
- (` [(,* (list#each text$ slots))])))
- (, export_policy)))
-
- _
- (` ("lux def" (, type_name)
- ("lux type check type"
- (, typeC))
- (, export_policy)))))))
+ (in (when labels??
+ {#Some labels}
+ (list#partial (` (def (, export_policy) (, type_name)
+ Type
+ (, typeC)))
+ (when labels
+ {#Left tags}
+ (label_definitions module_name export_policy type_name (` Tag) g!family tags)
+
+ {#Right slots}
+ (label_definitions module_name export_policy type_name (` Slot) g!family slots)))
+
+ _
+ (list (` (def (, export_policy) (, type_name)
+ Type
+ (, typeC)))))))
{#None}
(failure (..wrong_syntax_error (symbol ..type)))))
@@ -4141,18 +4544,7 @@
{#Definition [exported? def_type def_value]}
(if exported?
(list name)
- (list))
-
- {#Type [exported? type labels]}
- (if exported?
- (list name)
- (list))
-
- {#Tag _}
- (list)
-
- {#Slot _}
- (list))))
+ (list)))))
(let [[..#module_hash _ ..#module_aliases _ ..#definitions definitions ..#imports _ ..#module_state _] =module]
definitions))]
{#Right state (list#conjoint to_alias)})
@@ -4284,16 +4676,7 @@
(definition_type real_name state)
{#Definition [exported? def_type def_value]}
- {#Some def_type}
-
- {#Type [exported? type labels]}
- {#Some ..Type}
-
- {#Tag _}
- {#None}
-
- {#Slot _}
- {#None})))))
+ {#Some def_type})))))
(def (type_variable idx bindings)
(-> Nat (List [Nat (Maybe Type)]) (Maybe Type))
@@ -4505,20 +4888,32 @@
_
(failure (..wrong_syntax_error (symbol ..cond))))))
-(def (enumeration' idx xs)
- (All (_ a)
- (-> Nat (List a) (List [Nat a])))
- (when xs
- {#Item x xs'}
- {#Item [idx x] (enumeration' ("lux i64 +" 1 idx) xs')}
+(type (Try value)
+ (Variant
+ {#Failure Text}
+ {#Success value}))
+
+(def (access_pattern g!_ g!output lefts right? members)
+ (-> Code Code Nat Bit (List Type) (Try (List Code)))
+ (when ((is (-> Nat (List Type) (List Code)
+ (List Code))
+ (function (again index input output)
+ (when input
+ (list#partial head tail)
+ (if ("lux i64 =" index (if right?
+ ("lux i64 +" 1 lefts)
+ lefts))
+ (list#reversed (list#partial g!output output))
+ (again ("lux i64 +" 1 index) tail (list#partial g!_ output)))
+
+ (list)
+ (list))))
+ 0 members (list))
+ (list)
+ {#Failure "Cannot synthesize access pattern."}
- {#End}
- {#End}))
-
-(def (enumeration xs)
- (All (_ a)
- (-> (List a) (List [Nat a])))
- (enumeration' 0 xs))
+ pattern
+ {#Success pattern}))
(def .public the
(macro (_ tokens)
@@ -4527,24 +4922,27 @@
(do meta#monad
[slot (normal slot')
output (..type_slot slot)
- .let [[idx tags exported? type] output]
- g!_ (..generated_symbol "_")
- g!output (..generated_symbol "")]
- (when (interface_methods type)
- {#Some members}
- (let [pattern (|> (zipped_2 tags (enumeration members))
- (list#each (is (-> [Symbol [Nat Type]] (List Code))
- (function (_ [[r_module r_name] [r_idx r_type]])
- (list (symbol$ [r_module r_name])
- (if ("lux i64 =" idx r_idx)
- g!output
- g!_)))))
- list#conjoint
- tuple$)]
- (meta#in (list (` ({(, pattern) (, g!output)} (, record))))))
-
- _
- (failure "the can only use records.")))
+ .let [[exported? [label' type]] output]]
+ (when label'
+ {.#None}
+ (in (list record))
+
+ {.#Some [lefts right? family]}
+ (do meta#monad
+ [g!_ (..generated_symbol "_")
+ g!output (..generated_symbol "")
+ .let [idx (if right?
+ (is Nat ("lux i64 +" 1 lefts))
+ lefts)
+ pattern (|> (enumeration family)
+ (list#each (is (-> [Nat Symbol] (List Code))
+ (function (_ [r_idx slot])
+ (list (symbol$ slot)
+ (if ("lux i64 =" idx r_idx)
+ g!output
+ g!_)))))
+ list#conjoint)]]
+ (in (list (` ({[(,* pattern)] (, g!output)} (, record))))))))
(list [_ {#Tuple slots}] record)
(meta#in (list (list#mix (is (-> Code Code Code)
@@ -4757,37 +5155,38 @@
(do meta#monad
[slot (normal slot')
output (..type_slot slot)
- .let [[idx tags exported? type] output]]
- (when (interface_methods type)
- {#Some members}
+ .let [[exported? [label' type]] output]]
+ (when label'
+ {.#None}
+ (in (list value))
+
+ {.#Some [lefts right? family]}
(do meta#monad
[pattern' (monad#each meta#monad
- (is (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code]))
- (function (_ [r_slot_name [r_idx r_type]])
+ (is (-> [Nat Symbol] (Meta [Symbol Nat Code]))
+ (function (_ [r_idx r_slot_name])
(do meta#monad
[g!slot (..generated_symbol "")]
- (meta#in [r_slot_name r_idx g!slot]))))
- (zipped_2 tags (enumeration members)))]
- (let [pattern (|> pattern'
+ (in [r_slot_name r_idx g!slot]))))
+ (enumeration family))
+ .let [pattern (|> pattern'
+ (list#each (is (-> [Symbol Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (symbol$ r_slot_name)
+ r_var))))
+ list#conjoint)
+ idx (if right?
+ (is Nat ("lux i64 +" 1 lefts))
+ lefts)
+ output (|> pattern'
(list#each (is (-> [Symbol Nat Code] (List Code))
(function (_ [r_slot_name r_idx r_var])
(list (symbol$ r_slot_name)
- r_var))))
- list#conjoint
- tuple$)
- output (|> pattern'
- (list#each (is (-> [Symbol Nat Code] (List Code))
- (function (_ [r_slot_name r_idx r_var])
- (list (symbol$ r_slot_name)
- (if ("lux i64 =" idx r_idx)
- value
- r_var)))))
- list#conjoint
- tuple$)]
- (meta#in (list (` ({(, pattern) (, output)} (, record)))))))
-
- _
- (failure "has can only use records.")))
+ (if ("lux i64 =" idx r_idx)
+ value
+ r_var)))))
+ list#conjoint)]]
+ (in (list (` ({[(,* pattern)] [(,* output)]} (, record))))))))
(list [_ {#Tuple slots}] value record)
(when slots
@@ -4841,37 +5240,38 @@
(do meta#monad
[slot (normal slot')
output (..type_slot slot)
- .let [[idx tags exported? type] output]]
- (when (interface_methods type)
- {#Some members}
+ .let [[exported? [label' type]] output]]
+ (when label'
+ {.#None}
+ (in (list (` ((, fun) (, record)))))
+
+ {.#Some [lefts right? family]}
(do meta#monad
[pattern' (monad#each meta#monad
- (is (-> [Symbol [Nat Type]] (Meta [Symbol Nat Code]))
- (function (_ [r_slot_name [r_idx r_type]])
+ (is (-> [Nat Symbol] (Meta [Symbol Nat Code]))
+ (function (_ [r_idx r_slot_name])
(do meta#monad
[g!slot (..generated_symbol "")]
- (meta#in [r_slot_name r_idx g!slot]))))
- (zipped_2 tags (enumeration members)))]
- (let [pattern (|> pattern'
+ (in [r_slot_name r_idx g!slot]))))
+ (enumeration family))
+ .let [pattern (|> pattern'
+ (list#each (is (-> [Symbol Nat Code] (List Code))
+ (function (_ [r_slot_name r_idx r_var])
+ (list (symbol$ r_slot_name)
+ r_var))))
+ list#conjoint)
+ idx (if right?
+ (is Nat ("lux i64 +" 1 lefts))
+ lefts)
+ output (|> pattern'
(list#each (is (-> [Symbol Nat Code] (List Code))
(function (_ [r_slot_name r_idx r_var])
(list (symbol$ r_slot_name)
- r_var))))
- list#conjoint
- tuple$)
- output (|> pattern'
- (list#each (is (-> [Symbol Nat Code] (List Code))
- (function (_ [r_slot_name r_idx r_var])
- (list (symbol$ r_slot_name)
- (if ("lux i64 =" idx r_idx)
- (` ((, fun) (, r_var)))
- r_var)))))
- list#conjoint
- tuple$)]
- (meta#in (list (` ({(, pattern) (, output)} (, record)))))))
-
- _
- (failure "revised can only use records.")))
+ (if ("lux i64 =" idx r_idx)
+ (` ((, fun) (, r_var)))
+ r_var)))))
+ list#conjoint)]]
+ (in (list (` ({[(,* pattern)] [(,* output)]} (, record))))))))
(list [_ {#Tuple slots}] fun record)
(when slots
diff --git a/stdlib/source/library/lux/data/format/tar.lux b/stdlib/source/library/lux/data/format/tar.lux
index e682544bc..cc6317ae5 100644
--- a/stdlib/source/library/lux/data/format/tar.lux
+++ b/stdlib/source/library/lux/data/format/tar.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Mode and)
+ [lux (.except Mode #mode and)
[ffi (.only)]
[abstract
[monad (.only do)]]
@@ -32,7 +32,7 @@
[macro
["^" pattern]]
[type
- [primitive (.except)]]]
+ [primitive (.except #name)]]]
[world
["[0]" file]
[time
diff --git a/stdlib/source/library/lux/data/format/xml.lux b/stdlib/source/library/lux/data/format/xml.lux
index 0978967f1..120c0a4dc 100644
--- a/stdlib/source/library/lux/data/format/xml.lux
+++ b/stdlib/source/library/lux/data/format/xml.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except symbol)
+ [lux (.except Tag #Text symbol)
[abstract
[monad (.only do)]
[equivalence (.only Equivalence)]
diff --git a/stdlib/source/library/lux/documentation.lux b/stdlib/source/library/lux/documentation.lux
index af0d07a07..ca27859fd 100644
--- a/stdlib/source/library/lux/documentation.lux
+++ b/stdlib/source/library/lux/documentation.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Definition Module)
+ [lux (.except Definition Module #Definition #module)
[abstract
[monad (.only do)]
["[0]" enum]]
diff --git a/stdlib/source/library/lux/ffi/export.jvm.lux b/stdlib/source/library/lux/ffi/export.jvm.lux
index 9c16d04a4..af5ab079a 100644
--- a/stdlib/source/library/lux/ffi/export.jvm.lux
+++ b/stdlib/source/library/lux/ffi/export.jvm.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except function)
+ [lux (.except #Function function)
[control
["<>" parser]]
[data
diff --git a/stdlib/source/library/lux/meta.lux b/stdlib/source/library/lux/meta.lux
index 2b68b7e89..8f5195d1f 100644
--- a/stdlib/source/library/lux/meta.lux
+++ b/stdlib/source/library/lux/meta.lux
@@ -12,7 +12,7 @@
["[0]" product]
["[0]" text (.use "[1]#[0]" monoid order)]
[collection
- ["[0]" list (.use "[1]#[0]" monoid monad)
+ ["[0]" list (.use "[1]#[0]" monoid monad mix)
["[0]" property]]]]
[math
[number
@@ -185,16 +185,7 @@
{.#Definition [exported? def_type def_value]}
(if (macro_type? def_type)
{.#Some (as Macro def_value)}
- {.#None})
-
- {.#Type [exported? type labels]}
- {.#None}
-
- {.#Tag _}
- {.#None}
-
- {.#Slot _}
- {.#None}))))
+ {.#None})))))
{try.#Failure error}
{.#None})]}))))
@@ -328,23 +319,13 @@
(the .#definitions)
(list.all (function (_ [def_name global])
(`` (when global
- (,, (with_template [<pattern>]
- [<pattern>
- (if (and exported?
- (text#= normal_short def_name))
- {.#Some (symbol#encoded [module_name def_name])}
- {.#None})]
-
- [{.#Definition [exported? _]}]
- [{.#Type [exported? _]}]))
+ {.#Definition [exported? _]}
+ (if (and exported?
+ (text#= normal_short def_name))
+ {.#Some (symbol#encoded [module_name def_name])}
+ {.#None})
{.#Alias _}
- {.#None}
-
- {.#Tag _}
- {.#None}
-
- {.#Slot _}
{.#None})))))))
list.together
(list.sorted text#<)
@@ -383,24 +364,9 @@
(in definition)
(failure (all text#composite "Definition is not an export: " (symbol#encoded name)))))))
- {.#Type [exported? type labels]}
- (if exported?
- (in [exported? .Type type])
- (failure (all text#composite "Type is not an export: " (symbol#encoded name))))
-
{.#Alias de_aliased}
(failure (all text#composite
"Aliases are not considered exports: "
- (symbol#encoded name)))
-
- {.#Tag _}
- (failure (all text#composite
- "Tags are not considered exports: "
- (symbol#encoded name)))
-
- {.#Slot _}
- (failure (all text#composite
- "Slots are not considered exports: "
(symbol#encoded name))))))
(def .public (definition_type name)
@@ -412,20 +378,7 @@
(definition_type de_aliased)
{.#Definition [exported? def_type def_value]}
- (clean_type def_type)
-
- {.#Type [exported? type labels]}
- (in .Type)
-
- {.#Tag _}
- (failure (all text#composite
- "Tags have no type: "
- (symbol#encoded name)))
-
- {.#Slot _}
- (failure (all text#composite
- "Slots have no type: "
- (symbol#encoded name))))))
+ (clean_type def_type))))
(def .public (type name)
(-> Symbol (Meta Type))
@@ -452,16 +405,7 @@
(type_code .Type)
(type_code def_type)))
(in (as Type def_value))
- (..failure (all text#composite "Definition is not a type: " (symbol#encoded name)))))
-
- {.#Type [exported? type labels]}
- (in type)
-
- {.#Tag _}
- (..failure (all text#composite "Tag is not a type: " (symbol#encoded name)))
-
- {.#Slot _}
- (..failure (all text#composite "Slot is not a type: " (symbol#encoded name))))))
+ (..failure (all text#composite "Definition is not a type: " (symbol#encoded name))))))))
(def .public (globals module)
(-> Text (Meta (List [Text Global])))
@@ -482,16 +426,7 @@
{.#None}
{.#Definition definition}
- {.#Some [name definition]}
-
- {.#Type [exported? type labels]}
- {.#Some [name [exported? .Type type]]}
-
- {.#Tag _}
- {.#None}
-
- {.#Slot _}
- {.#None})))
+ {.#Some [name definition]})))
(..globals module)))
(def .public (exports module_name)
@@ -512,24 +447,40 @@
[lux]
{try.#Success})))
-(`` (def .public (tags_of type_name)
- (-> Symbol (Meta (Maybe (List Symbol))))
- (do ..monad
- [.let [[module_name name] type_name]
- module (..module module_name)]
- (when (property.value name (the .#definitions module))
- {.#Some {.#Type [exported? type labels]}}
- (when labels
- (,, (with_template [<pattern>]
- [<pattern>
- (in {.#Some (list#each (|>> [module_name])
- {.#Item labels})})]
+(def type#=
+ (`` ("lux in-module" (,, (static .prelude)) .type#=)))
+
+(def type#encoded
+ (`` ("lux in-module" (,, (static .prelude)) .type#encoded)))
- [{.#Left labels}]
- [{.#Right labels}])))
+(def .public (tags_of type_name)
+ (-> Symbol (Meta (Maybe (List Symbol))))
+ (do ..monad
+ [.let [[module_name name] type_name]
+ module (..module module_name)]
+ (in (list.one (function (_ [short global])
+ (when global
+ {.#Definition [exported? type value]}
+ (if (type#= Slot type)
+ (let [[label type] (as Label value)]
+ (when type
+ {.#Named actual_name anonymous}
+ (if (symbol#= type_name actual_name)
+ {.#Some (when label
+ {.#Some [lefts right? family]}
+ family
+
+ {.#None}
+ (list [module_name short]))}
+ {.#None})
+
+ _
+ {.#None}))
+ {.#None})
- _
- (in {.#None})))))
+ _
+ {.#None}))
+ (the .#definitions module)))))
(def .public location
(Meta Location)
@@ -564,26 +515,28 @@
(|>> (the .#imports) (list.any? (text#= import)))
..current_module))
-(with_template [<name> <tag> <description>]
+(with_template [<name> <description> <type>]
[(def .public (<name> label_name)
- (-> Symbol (Meta [Nat (List Symbol) Type]))
+ (-> Symbol (Meta Label))
(do ..monad
[.let [[module name] label_name]
=module (..module module)
this_module_name ..current_module_name]
(when (property.value name (the .#definitions =module))
- {.#Some {<tag> [exported? type group idx]}}
+ {.#Some {.#Definition [exported? def_type def_value]}}
(if (or (text#= this_module_name module)
exported?)
- (in [idx (list#each (|>> [module]) group) type])
+ (if (type#= <type> def_type)
+ (in (as Label def_value))
+ (..failure (all text#composite "Invalid type for " <description> " " (symbol#encoded label_name) " : " (type#encoded def_type))))
(..failure (all text#composite "Cannot access " <description> ": " (symbol#encoded label_name) " from module " this_module_name)))
_
(..failure (all text#composite
"Unknown " <description> ": " (symbol#encoded label_name))))))]
- [tag .#Tag "tag"]
- [slot .#Slot "slot"]
+ [tag "tag" .Tag]
+ [slot "slot" .Slot]
)
(def .public (tag_lists module)
@@ -591,24 +544,32 @@
(do ..monad
[=module (..module module)
this_module_name ..current_module_name]
- (in (list.all (function (_ [short global])
- (when global
- {.#Type [exported? type labels]}
- (if (or exported?
- (text#= this_module_name module))
- {.#Some [(list#each (|>> [module])
- (when labels
- {.#Left tags}
- {.#Item tags}
-
- {.#Right slots}
- {.#Item slots}))
- type]}
- {.#None})
-
- _
- {.#None}))
- (the .#definitions =module)))))
+ (in (property.values
+ (list#mix (function (_ [short global] output)
+ (when global
+ {.#Definition [exported? type value]}
+ (if (and (type#= Slot type)
+ (or exported?
+ (text#= this_module_name module)))
+ (let [[label type] (as Label value)]
+ (when label
+ {.#Some [lefts right? family]}
+ (when family
+ (list.partial [_ short] _)
+ (property.has short [family type] output)
+
+ (list)
+ (property.has short [(list [module short]) type] output))
+
+ {.#None}
+ (property.has short [(list [module short]) type] output)))
+ output)
+
+ _
+ output))
+ (is (property.List [(List Symbol) Type])
+ (list))
+ (the .#definitions =module))))))
(def .public locals
(Meta (List (List [Text Type])))
@@ -633,15 +594,6 @@
real_def_name
{.#Definition _}
- def_name
-
- {.#Type _}
- def_name
-
- {.#Tag _}
- def_name
-
- {.#Slot _}
def_name))))
(def .public compiler_state
diff --git a/stdlib/source/library/lux/meta/compiler.lux b/stdlib/source/library/lux/meta/compiler.lux
index 64f5a38fd..5f2d00605 100644
--- a/stdlib/source/library/lux/meta/compiler.lux
+++ b/stdlib/source/library/lux/meta/compiler.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Module Code)
+ [lux (.except Module Code #module)
[control
["<>" parser (.only)]
["[0]" try (.only Try)]
diff --git a/stdlib/source/library/lux/meta/compiler/default/platform.lux b/stdlib/source/library/lux/meta/compiler/default/platform.lux
index 1d60192d3..427625283 100644
--- a/stdlib/source/library/lux/meta/compiler/default/platform.lux
+++ b/stdlib/source/library/lux/meta/compiler/default/platform.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Module)
+ [lux (.except Module #host)
["[0]" debug]
[abstract
["[0]" monad (.only Monad do)]]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux.lux
index 14adeb6d6..1176afc91 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux.lux
@@ -24,21 +24,11 @@
(Format .Module)
(let [definition (is (Format Definition)
(all _.and _.bit _.type _.any))
- labels (is (Format [Text (List Text)])
- (_.and _.text (_.list _.text)))
- global_type (is (Format [Bit Type (Either [Text (List Text)]
- [Text (List Text)])])
- (all _.and _.bit _.type (_.or labels labels)))
- global_label (is (Format .Label)
- (all _.and _.bit _.type (_.list _.text) _.nat))
alias (is (Format Alias)
(_.and _.text _.text))
global (is (Format Global)
(all _.or
definition
- global_type
- global_label
- global_label
alias))]
(all _.and
... #module_hash
@@ -59,22 +49,6 @@
<binary>.bit
<binary>.type
<binary>.any))
- labels (is (Parser [Text (List Text)])
- (all <>.and
- <binary>.text
- (<binary>.list <binary>.text)))
- global_type (is (Parser [Bit Type (Either [Text (List Text)]
- [Text (List Text)])])
- (all <>.and
- <binary>.bit
- <binary>.type
- (<binary>.or labels labels)))
- global_label (is (Parser .Label)
- (all <>.and
- <binary>.bit
- <binary>.type
- (<binary>.list <binary>.text)
- <binary>.nat))
alias (is (Parser Alias)
(all <>.and
<binary>.text
@@ -82,9 +56,6 @@
global (is (Parser Global)
(all <binary>.or
definition
- global_type
- global_label
- global_label
alias))]
(all <>.and
... #module_hash
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux
index 7df0d6232..2b8a26b2b 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Tuple Variant Pattern nat int rev when local except)
+ [lux (.except Tuple Variant Pattern #Function #Apply nat int rev when local except)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux
index 40d90f729..7d3f9f1cf 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/complex.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Tuple Variant)
+ [lux (.except Tag Tuple Variant #Variant #Tuple)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux
index 8799f8b57..c4c6da56d 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/coverage.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Variant Pattern)
+ [lux (.except Variant Pattern #Bit #Nat #Int #Rev #Frac #Text #Variant)
[abstract
[equivalence (.except)]
["[0]" monad (.only do)]]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux
index e6f531191..98df6e6ad 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/module.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Label with)
+ [lux (.except with)
["[0]" meta]
[abstract
["[0]" monad (.only do)]]
@@ -21,25 +21,11 @@
[///
["[1]" phase]]]])
-(type .public Label
- Text)
-
(exception.def .public (unknown_module module)
(Exception Text)
(exception.report
(list ["Module" module])))
-(with_template [<name>]
- [(exception.def .public (<name> [labels owner])
- (Exception [(List Label) Type])
- (exception.report
- (list ["Labels" (text.interposed " " labels)]
- ["Type" (%.type owner)])))]
-
- [cannot_declare_labels_for_anonymous_type]
- [cannot_declare_labels_for_foreign_type]
- )
-
(exception.def .public (cannot_define_more_than_once [name already_existing])
(Exception [Symbol Global])
(exception.report
@@ -49,16 +35,7 @@
(format "alias " (%.symbol alias))
{.#Definition definition}
- (format "definition " (%.symbol name))
-
- {.#Type _}
- (format "type " (%.symbol name))
-
- {.#Tag _}
- (format "tag " (%.symbol name))
-
- {.#Slot _}
- (format "slot " (%.symbol name)))])))
+ (format "definition " (%.symbol name)))])))
(exception.def .public (can_only_change_state_of_active_module [module state])
(Exception [Text Module_State])
@@ -207,22 +184,3 @@
[set_compiled compiled? .#Compiled]
[set_cached cached? .#Cached]
)
-
-(def .public (declare_labels record? labels exported? type)
- (-> Bit (List Label) Bit Type (Operation Any))
- (do [! ///.monad]
- [self_name (///extension.lifted meta.current_module_name)
- [type_module type_name] (when type
- {.#Named type_name _}
- (in type_name)
-
- _
- (/.except ..cannot_declare_labels_for_anonymous_type [labels type]))
- _ (///.assertion ..cannot_declare_labels_for_foreign_type [labels type]
- (text#= self_name type_module))]
- (monad.each ! (function (_ [index short])
- (..define short
- (if record?
- {.#Slot [exported? type labels index]}
- {.#Tag [exported? type labels index]})))
- (list.enumeration labels))))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux
index ba360a38b..833bb997c 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/scope.lux
@@ -144,9 +144,9 @@
(let [bindings (is Bindings
[.#counter 0
.#mappings (list)])]
- [.#name (list)
- .#inner 0
- .#locals bindings
+ [.#scope_name (list)
+ .#inner_scopes 0
+ .#locals bindings
.#captured bindings]))
(def .public (reset action)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux
index 239bb848c..b848b2a4e 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/analysis/simple.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #Bit #Nat #Int #Rev #Frac #Text)
[abstract
[equivalence (.only Equivalence)]]
[data
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux
index 1f2b4505a..8eff3ed65 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/declaration.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Module)
+ [lux (.except Module #module #imports)
[abstract
[monad (.only do)]]
[control
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux
index 93e1420f8..78587f280 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/generation.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except symbol)
+ [lux (.except #module #counter #host symbol)
[abstract
[monad (.only do)]]
[control
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux
index 21c5fba14..885f2c364 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/complex.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except Tag)
[abstract
["[0]" monad (.only do)]]
[control
@@ -21,7 +21,7 @@
["[0]" meta (.only)
["[0]" symbol]
["[0]" code]
- ["[0]" type (.only)
+ ["[0]" type (.use "[1]#[0]" equivalence)
["[0]" check]]]]]
["[0]" //
["[1][0]" simple]
@@ -74,6 +74,17 @@
["Tag" (%.symbol tag)]
["Expression" (%.code code)])))
+(exception.def .public (cannot_order_record [@ code])
+ (Exception [Code (List [Symbol Code])])
+ (exception.report
+ (list ["@" (%.code @)]
+ ["Expression" (|> code
+ (list#each (function (_ [slot value])
+ (list (code.symbol slot) value)))
+ list#conjoint
+ code.tuple
+ %.code)])))
+
(exception.def .public (cannot_repeat_slot [key record])
(Exception [Symbol (List [Symbol Code])])
(exception.report
@@ -176,9 +187,13 @@
(-> Phase Symbol Phase)
(do [! ///.monad]
[tag (///extension.lifted (meta.normal tag))
- [idx group variantT] (///extension.lifted (meta.tag tag))
- .let [case_size (list.size group)
- [lefts right?] (/complex.choice case_size idx)]
+ [lefts,right? variantT] (///extension.lifted (meta.tag tag))
+ [lefts right?] (when lefts,right?
+ {.#Some [lefts right? family]}
+ (in [lefts right?])
+
+ {.#None}
+ (in [0 false]))
expectedT (///extension.lifted meta.expected_type)]
(when expectedT
{.#Var _}
@@ -323,45 +338,83 @@
(list.any? (list.any? (|>> product.left (text#= name))))
meta.locals))
+(def (slot it)
+ (-> Symbol (Meta Label))
+ (do meta.monad
+ [it (meta.normal it)]
+ (meta.slot it)))
+
+(def (slot_type [[_ it] _])
+ (-> [Label Code] Type)
+ it)
+
+(def (same_record? it)
+ (-> (List [Label Code]) Bit)
+ (when it
+ (list.partial head tail)
+ (let [expected (slot_type head)]
+ (list.every? (|>> slot_type (type#= expected)) tail))
+
+ (list)
+ false))
+
+(def (complete_record? it)
+ (-> (List [Label Code]) Bit)
+ (loop (again [expected_lefts 0
+ remaining it])
+ (when remaining
+ {.#Item [[{.#Some [lefts .true family]} type] value] {.#End}}
+ (n.= (-- expected_lefts) lefts)
+
+ {.#Item [[{.#None} type] value] {.#End}}
+ (n.= 0 expected_lefts)
+
+ {.#Item [[{.#Some [lefts .false family]} type] value] tail}
+ (and (n.= expected_lefts lefts)
+ (again (++ expected_lefts) tail))
+
+ _
+ false)))
+
+(def sorted_record
+ (-> (List [Label Code]) (List [Label Code]))
+ (list.sorted (function (_ left right)
+ (when [left right]
+ [[[{.#Some [leftsL right?L familyL]} typeL] valueL]
+ [[{.#Some [leftsR right?R familyR]} typeR] valueR]]
+ (if (n.= leftsL leftsR)
+ (not right?R)
+ (n.< leftsL leftsR))
+
+ _
+ false))))
+
... Lux already possesses the means to analyse tuples, so
... re-implementing the same functionality for records makes no sense.
... Records, thus, get transformed into tuples by ordering the elements.
-(def (order' head_k record)
+(def (order' head_k original_record)
(-> Symbol (List [Symbol Code]) (Operation (Maybe [Nat (List Code) Type])))
(do [! ///.monad]
- [slotH' (///extension.lifted
- (do meta.monad
- [head_k (meta.normal head_k)]
- (meta.try (meta.slot head_k))))]
- (when slotH'
- {try.#Success [_ slot_set recordT]}
+ [record (<| ///extension.lifted
+ meta.try
+ (monad.each ! (function (_ [slot value])
+ (do !
+ [slot (..slot slot)]
+ (in [slot value])))
+ original_record))]
+ (when record
+ {try.#Success record}
(do !
- [.let [size_record (list.size record)
- size_ts (list.size slot_set)]
- _ (if (n.= size_ts size_record)
- (in [])
- (/.except ..record_size_mismatch [size_ts size_record recordT record]))
- .let [tuple_range (list.indices size_ts)
- tag->idx (dictionary.of_list symbol.hash (list.zipped_2 slot_set tuple_range))]
- idx->val (monad.mix !
- (function (_ [key val] idx->val)
- (do !
- [key (///extension.lifted (meta.normal key))]
- (when (dictionary.value key tag->idx)
- {.#Some idx}
- (if (dictionary.key? idx->val idx)
- (/.except ..cannot_repeat_slot [key record])
- (in (dictionary.has idx val idx->val)))
-
- {.#None}
- (/.except ..slot_does_not_belong_to_record [key recordT]))))
- (is (Dictionary Nat Code)
- (dictionary.empty n.hash))
- record)
- .let [ordered_tuple (list#each (function (_ idx)
- (maybe.trusted (dictionary.value idx idx->val)))
- tuple_range)]]
- (in {.#Some [size_ts ordered_tuple recordT]}))
+ [.let [record (sorted_record record)]
+ _ (///.assertion ..cannot_order_record [(` same_record?) original_record]
+ (same_record? record))
+ _ (///.assertion ..cannot_order_record [(` complete_record?) original_record]
+ (complete_record? record))]
+ (in (do maybe.monad
+ [[[_ :record:] _] (list.head record)]
+ (in [(list.size record)
+ (list#each product.right record)
+ :record:]))))
{try.#Failure error}
(in {.#None}))))
@@ -402,10 +455,13 @@
[head_k (///extension.lifted (meta.normal pseudo_slot))
slot (///extension.lifted (meta.try (meta.slot head_k)))]
(when slot
- {try.#Success [_ slot_set recordT]}
- (when (list.size slot_set)
- 1 (analyse archive singletonC)
- _ (..product analyse archive members))
+ {try.#Success [lefts,right? recordT]}
+ (when lefts,right?
+ {.#None}
+ (analyse archive singletonC)
+
+ _
+ (..product analyse archive members))
_
(..product analyse archive members)))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux
index 51816df59..26831fe0a 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/reference.lux
@@ -63,29 +63,7 @@
(text#= quoted_module ::module))
<return>
(/.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name])))
- (/.except ..definition_has_not_been_exported def_name))))
-
- {.#Type [exported? value labels]}
- (do !
- [_ (/type.inference .Type)
- (^.let 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 (or imported!
- (text#= quoted_module ::module))
- <return>
- (/.except ..foreign_module_has_not_been_imported [current ::module quoted_module def_name])))
- (/.except ..definition_has_not_been_exported def_name))))
-
- {.#Tag _}
- (/.except ..labels_are_not_definitions [def_name])
-
- {.#Slot _}
- (/.except ..labels_are_not_definitions [def_name])))))
+ (/.except ..definition_has_not_been_exported def_name))))))))
(def (variable var_name)
(-> Text (Operation (Maybe Analysis)))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux
index 84fd24cc2..3378f2a4c 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/analysis/when.lux
@@ -160,7 +160,7 @@
(def (tuple_pattern_analysis pattern_analysis :input: sub_patterns next)
(All (_ a)
- (-> (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a]))
+ (-> (-> Type Code (Operation a) (Operation [Pattern a]))
Type (List Code) (Operation a) (Operation [Pattern a])))
(do [! ///.monad]
[[@ex_var+ :input:'] (/type.check (..tuple :input:))]
@@ -194,9 +194,9 @@
(Operation [(List Pattern) a])))
(function (_ [memberT memberC] then)
(do !
- [[memberP [memberP+ thenA]] ((as (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
+ [[memberP [memberP+ thenA]] ((as (All (_ a) (-> Type Code (Operation a) (Operation [Pattern a])))
pattern_analysis)
- {.#None} memberT memberC then)]
+ memberT memberC then)]
(in [(list.partial memberP memberP+) thenA]))))
(do !
[nextA next]
@@ -225,8 +225,8 @@
... body expressions.
... That is why the body must be analysed in the context of the
... pattern, and not separately.
-(def (pattern_analysis num_tags :input: pattern next)
- (All (_ a) (-> (Maybe Nat) Type Code (Operation a) (Operation [Pattern a])))
+(def (pattern_analysis :input: pattern next)
+ (All (_ a) (-> Type Code (Operation a) (Operation [Pattern a])))
(.when pattern
[location {.#Symbol ["" name]}]
(/.with_location location
@@ -248,7 +248,7 @@
[Any {.#Tuple {.#End}} {/simple.#Unit}])
[location {.#Tuple (list singleton)}]
- (pattern_analysis {.#None} :input: singleton next)
+ (pattern_analysis :input: singleton next)
[location {.#Tuple sub_patterns}]
(/.with_location location
@@ -276,7 +276,7 @@
(in []))]
(.when members
(list singleton)
- (pattern_analysis {.#None} :input: singleton next)
+ (pattern_analysis :input: singleton next)
_
(..tuple_pattern_analysis pattern_analysis :input: members next)))
@@ -292,19 +292,17 @@
{.#Sum _}
(let [flat_sum (type.flat_variant :input:')
size_sum (list.size flat_sum)
- num_cases (maybe.else size_sum num_tags)
idx (/complex.tag right? lefts)]
(.when (list.item idx flat_sum)
(^.multi {.#Some caseT}
- (n.< num_cases idx))
+ (n.< size_sum idx))
(do ///.monad
- [[testP nextA] (if (and (n.> num_cases size_sum)
- (n.= (-- num_cases) idx))
- (pattern_analysis {.#None}
- (type.variant (list.after (-- num_cases) flat_sum))
+ [[testP nextA] (if (and (n.> size_sum size_sum)
+ (n.= (-- size_sum) idx))
+ (pattern_analysis (type.variant (list.after (-- size_sum) flat_sum))
(` [(,* values)])
next)
- (pattern_analysis {.#None} caseT (` [(,* values)]) next))
+ (pattern_analysis caseT (` [(,* values)]) next))
_ (/type.check (monad.each check.monad check.forget! @ex_var+))]
(in [(/pattern.variant [lefts right? testP])
nextA]))
@@ -315,8 +313,7 @@
{.#UnivQ _}
(do ///.monad
[[ex_id exT] (/type.check check.existential)
- it (pattern_analysis num_tags
- (maybe.trusted (type.applied (list exT) :input:'))
+ it (pattern_analysis (maybe.trusted (type.applied (list exT) :input:'))
pattern
next)
_ (/type.check (monad.each check.monad check.forget! @ex_var+))]
@@ -329,10 +326,15 @@
(/.with_location location
(do ///.monad
[tag (///extension.lifted (meta.normal tag))
- [idx group variantT] (///extension.lifted (meta.tag tag))
- _ (/type.check (check.check :input: variantT))
- .let [[lefts right?] (/complex.choice (list.size group) idx)]]
- (pattern_analysis {.#Some (list.size group)} :input: (` {(, (code.nat lefts)) (, (code.bit right?)) (,* values)}) next)))
+ [lefts,right? variantT] (///extension.lifted (meta.tag tag))
+ [lefts right?] (in (.when lefts,right?
+ {.#Some [lefts right? family]}
+ [lefts right?]
+
+ {.#None}
+ [0 false]))
+ _ (/type.check (check.check :input: variantT))]
+ (pattern_analysis :input: (` {(, (code.nat lefts)) (, (code.bit right?)) (,* values)}) next)))
_
(/.except ..invalid [pattern])
@@ -345,10 +347,10 @@
(do [! ///.monad]
[[:input: inputA] (<| /type.inferring
(analyse archive inputC))
- outputH (pattern_analysis {.#None} :input: patternH (analyse archive bodyH))
+ outputH (pattern_analysis :input: patternH (analyse archive bodyH))
outputT (monad.each !
(function (_ [patternT bodyT])
- (pattern_analysis {.#None} :input: patternT (analyse archive bodyT)))
+ (pattern_analysis :input: patternT (analyse archive bodyT)))
branchesT)
outputHC (|> outputH product.left /coverage.coverage /.of_try)
outputTC (monad.each ! (|>> product.left /coverage.coverage /.of_try) outputT)
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
index 050c6263d..2ea6deb7d 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/phase/extension/declaration/lux.lux
@@ -262,53 +262,6 @@
_
(phase.except ///.invalid_syntax [extension_name %.code inputsC+]))))
-(def (announce_labels! labels owner)
- (All (_ anchor expression declaration)
- (-> (List Text) Type (Operation anchor expression declaration (List Any))))
- (/////declaration.lifted_generation
- (monad.each phase.monad
- (function (_ tag)
- (/////generation.log! (format tag " : Tag of " (%.type owner))))
- labels)))
-
-(def (def_type_tagged expander host_analysis)
- (-> Expander /////analysis.Bundle Handler)
- (..custom
- [(all <>.and <code>.local <code>.any
- (<>.or (<code>.variant (<>.some <code>.text))
- (<code>.tuple (<>.some <code>.text)))
- <code>.any)
- (function (_ extension_name phase archive [short_name valueC labels exported?C])
- (do phase.monad
- [current_module (/////declaration.lifted_analysis
- (///.lifted meta.current_module_name))
- .let [full_name [current_module short_name]]
- [_ _ exported?] (evaluate! archive Bit exported?C)
- .let [exported? (as Bit exported?)]
- [type valueT value] (..definition archive full_name {.#Some .Type} valueC)
- labels (/////declaration.lifted_analysis
- (do phase.monad
- [.let [[record? labels] (when labels
- {.#Left tags}
- [false tags]
-
- {.#Right slots}
- [true slots])]
- _ (when labels
- {.#End}
- (moduleA.define short_name {.#Definition [exported? type value]})
-
- {.#Item labels}
- (moduleA.define short_name {.#Type [exported? (as .Type value) (if record?
- {.#Right labels}
- {.#Left labels})]}))
- _ (moduleA.declare_labels record? labels exported? (as .Type value))]
- (in labels)))
- _ (..refresh expander host_analysis)
- _ (..announce_definition! short_name type)
- _ (..announce_labels! labels (as Type value))]
- (in /////declaration.no_requirements)))]))
-
(def imports
(Parser (List Import))
(|> (<code>.tuple (<>.and <code>.text <code>.text))
@@ -339,12 +292,6 @@
["Foreign alias" (%.symbol foreign)]
["Target definition" (%.symbol target)])))
-(exception.def .public (cannot_alias_a_label [local foreign])
- (Exception [Alias Alias])
- (exception.report
- (list ["Alias" (%.symbol local)]
- ["Label" (%.symbol foreign)])))
-
(def (define_alias alias original)
(-> Text Symbol (/////analysis.Operation Any))
(do phase.monad
@@ -354,13 +301,8 @@
{.#Alias de_aliased}
(phase.except ..cannot_alias_an_alias [[current_module alias] original de_aliased])
- (^.or {.#Definition _}
- {.#Type _})
- (moduleA.define alias {.#Alias original})
-
- (^.or {.#Tag _}
- {.#Slot _})
- (phase.except ..cannot_alias_a_label [[current_module alias] original]))))
+ {.#Definition _}
+ (moduleA.define alias {.#Alias original}))))
(def defalias
Handler
@@ -491,7 +433,6 @@
(|> ///bundle.empty
(dictionary.has "module" defmodule)
(dictionary.has "alias" defalias)
- (dictionary.has "type tagged" (def_type_tagged expander host_analysis))
(dictionary.has "analysis" (def_analysis anchorT,expressionT,declarationT extender))
(dictionary.has "synthesis" (def_synthesis anchorT,expressionT,declarationT extender))
(dictionary.has "generation" (def_generation anchorT,expressionT,declarationT extender))
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux
index 29b3604b8..377e232b1 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Scope i64)
+ [lux (.except Scope #Function #Apply #locals i64)
[abstract
[monad (.only do)]
[equivalence (.only Equivalence)]
diff --git a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux
index a44021d1f..80d6447b9 100644
--- a/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux
+++ b/stdlib/source/library/lux/meta/compiler/language/lux/synthesis/simple.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #Bit #Text)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]]
diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/archive.lux
index 994b6cd4b..46ede92f0 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/archive.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/archive.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Module has)
+ [lux (.except Module #module has)
[abstract
["[0]" equivalence (.only Equivalence)]
["[0]" monad (.only do)]]
diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux
index 0afb9adc5..5c547a425 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/archive/artifact/category.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Definition)
+ [lux (.except Definition #Definition)
[abstract
[equivalence (.only Equivalence)]]
[control
diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/signature.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/signature.lux
index e9220d028..5d3ff086c 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/archive/signature.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/archive/signature.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #version)
[abstract
[equivalence (.only Equivalence)]]
[control
diff --git a/stdlib/source/library/lux/meta/compiler/meta/archive/unit.lux b/stdlib/source/library/lux/meta/compiler/meta/archive/unit.lux
index 82d29c16b..5f7b20e00 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/archive/unit.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/archive/unit.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #module)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]]
diff --git a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux
index 60e4af536..9b8f0934a 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/cache/dependency/module.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #module #imports)
[abstract
["[0]" monad (.only do)]]
[control
diff --git a/stdlib/source/library/lux/meta/compiler/meta/cli.lux b/stdlib/source/library/lux/meta/compiler/meta/cli.lux
index 37adb69f4..1c590b24b 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/cli.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/cli.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Module Source)
+ [lux (.except Module Source #module #target #configuration)
[abstract
[monad (.only do)]
[equivalence (.only Equivalence)]]
diff --git a/stdlib/source/library/lux/meta/compiler/meta/context.lux b/stdlib/source/library/lux/meta/compiler/meta/context.lux
index 668d828e2..ef520917a 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/context.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/context.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #host #target)
[meta
["@" target (.only Target)]]
[world
diff --git a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
index 29b8539ac..1d1aaca4b 100644
--- a/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
+++ b/stdlib/source/library/lux/meta/compiler/meta/io/archive.lux
@@ -221,12 +221,8 @@
content (document.content $.key document)
definitions (monad.each ! (function (_ [def_name def_global])
(when def_global
- (^.with_template [<tag>]
- [{<tag> payload}
- (in [def_name {<tag> payload}])])
- ([.#Alias]
- [.#Tag]
- [.#Slot])
+ {.#Alias payload}
+ (in [def_name def_global])
{.#Definition [exported? type _]}
(|> definitions
@@ -234,14 +230,7 @@
try.of_maybe
(at ! each (|>> [exported? type]
{.#Definition}
- [def_name])))
-
- {.#Type [exported? _ labels]}
- (|> definitions
- (dictionary.value def_name)
- try.of_maybe
- (at ! each (function (_ def_value)
- [def_name {.#Type [exported? (as .Type def_value) labels]}])))))
+ [def_name])))))
(the .#definitions content))]
(in [(document.document $.key (has .#definitions definitions content))
bundles])))
diff --git a/stdlib/source/library/lux/meta/compiler/phase.lux b/stdlib/source/library/lux/meta/compiler/phase.lux
index b5d04c40e..77574a4aa 100644
--- a/stdlib/source/library/lux/meta/compiler/phase.lux
+++ b/stdlib/source/library/lux/meta/compiler/phase.lux
@@ -108,7 +108,7 @@
(try#each (|>> [state]) error)))
(def .public assertion
- (template (assertion exception message test)
+ (template (_ exception message test)
[(if test
(at ..monad in [])
(..except exception message))]))
diff --git a/stdlib/source/library/lux/meta/compiler/reference/variable.lux b/stdlib/source/library/lux/meta/compiler/reference/variable.lux
index 0e038ed06..7de1dee16 100644
--- a/stdlib/source/library/lux/meta/compiler/reference/variable.lux
+++ b/stdlib/source/library/lux/meta/compiler/reference/variable.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #Local)
[abstract
[equivalence (.only Equivalence)]
[hash (.only Hash)]]
diff --git a/stdlib/source/library/lux/meta/target/jvm/attribute.lux b/stdlib/source/library/lux/meta/target/jvm/attribute.lux
index c6ff2472f..21578c4e5 100644
--- a/stdlib/source/library/lux/meta/target/jvm/attribute.lux
+++ b/stdlib/source/library/lux/meta/target/jvm/attribute.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Info Code Type)
+ [lux (.except Info Code Type #info)
[abstract
[monad (.only do)]
["[0]" equivalence (.only Equivalence)]]
diff --git a/stdlib/source/library/lux/meta/target/jvm/constant.lux b/stdlib/source/library/lux/meta/target/jvm/constant.lux
index d05df9511..7c23d49c7 100644
--- a/stdlib/source/library/lux/meta/target/jvm/constant.lux
+++ b/stdlib/source/library/lux/meta/target/jvm/constant.lux
@@ -23,7 +23,7 @@
["^" pattern]
["[0]" template]]
[type
- [primitive (.except)]]]]]
+ [primitive (.except #name)]]]]]
["[0]" /
["[1][0]" tag]
["/[1]" //
diff --git a/stdlib/source/library/lux/meta/target/jvm/constant/tag.lux b/stdlib/source/library/lux/meta/target/jvm/constant/tag.lux
index bcd1d4209..f6917a5d0 100644
--- a/stdlib/source/library/lux/meta/target/jvm/constant/tag.lux
+++ b/stdlib/source/library/lux/meta/target/jvm/constant/tag.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except Tag)
[abstract
[equivalence (.only Equivalence)]]
[control
diff --git a/stdlib/source/library/lux/meta/target/jvm/type.lux b/stdlib/source/library/lux/meta/target/jvm/type.lux
index f9944b0eb..aabf16518 100644
--- a/stdlib/source/library/lux/meta/target/jvm/type.lux
+++ b/stdlib/source/library/lux/meta/target/jvm/type.lux
@@ -16,7 +16,7 @@
["n" nat]]]
[meta
[type
- [primitive (.except)]]]]]
+ [primitive (.except #name)]]]]]
["[0]" //
[encoding
["[1][0]" name (.only External)]]]
diff --git a/stdlib/source/library/lux/meta/type/implicit.lux b/stdlib/source/library/lux/meta/type/implicit.lux
index df5da5767..f265ac780 100644
--- a/stdlib/source/library/lux/meta/type/implicit.lux
+++ b/stdlib/source/library/lux/meta/type/implicit.lux
@@ -99,13 +99,13 @@
tag_lists)]]
(when candidates
{.#End}
- (///.failure (format "Unknown tag: " (%.symbol member)))
+ (///.failure (format "Unknown slot: " (%.symbol member)))
{.#Item winner {.#End}}
(in winner)
_
- (///.failure (format "Too many candidate tags: " (%.list %.symbol candidates))))))
+ (///.failure (format "Too many candidate slots: " (%.list %.symbol candidates))))))
_
(at ///.monad in member)))
@@ -114,8 +114,16 @@
(-> Symbol (Meta [Nat Type]))
(do ///.monad
[member (member_name member)
- [idx tag_list sig_type] (///.slot member)]
- (in [idx sig_type])))
+ [lefts,right? sig_type] (///.slot member)]
+ (when lefts,right?
+ {.#Some [lefts right? family]}
+ (in [(if right?
+ (++ lefts)
+ lefts)
+ sig_type])
+
+ {.#None}
+ (in [0 sig_type]))))
(def (compatible_type? interface candidate)
(-> Type Type Bit)
diff --git a/stdlib/source/library/lux/meta/type/row.lux b/stdlib/source/library/lux/meta/type/row.lux
index 1966a4768..a51add3cd 100644
--- a/stdlib/source/library/lux/meta/type/row.lux
+++ b/stdlib/source/library/lux/meta/type/row.lux
@@ -1,7 +1,7 @@
... https://en.wikipedia.org/wiki/Row_polymorphism
(.require
[library
- [lux (.except macro type the has revised)
+ [lux (.except Slot macro type the has revised)
[abstract
["[0]" monad (.only do)]]
[control
diff --git a/stdlib/source/library/lux/test/tally.lux b/stdlib/source/library/lux/test/tally.lux
index afbab607a..7c587d688 100644
--- a/stdlib/source/library/lux/test/tally.lux
+++ b/stdlib/source/library/lux/test/tally.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except and)
+ [lux (.except #expected and)
[data
[collection
["[0]" set (.only Set)]]]
diff --git a/stdlib/source/library/lux/world/locale/language.lux b/stdlib/source/library/lux/world/locale/language.lux
index ae11c87b1..f5ceb4852 100644
--- a/stdlib/source/library/lux/world/locale/language.lux
+++ b/stdlib/source/library/lux/world/locale/language.lux
@@ -10,7 +10,7 @@
[macro
["[0]" template]]
[type
- [primitive (.except)]]]]])
+ [primitive (.except #name)]]]]])
... https://en.wikipedia.org/wiki/List_of_ISO_639-2_codes
(primitive .public Language
diff --git a/stdlib/source/library/lux/world/locale/territory.lux b/stdlib/source/library/lux/world/locale/territory.lux
index 74c30fce6..9cd72ae2a 100644
--- a/stdlib/source/library/lux/world/locale/territory.lux
+++ b/stdlib/source/library/lux/world/locale/territory.lux
@@ -10,7 +10,7 @@
[macro
["[0]" template]]
[type
- [primitive (.except)]]]]])
+ [primitive (.except #name)]]]]])
... https://en.wikipedia.org/wiki/ISO_3166-1
(primitive .public Territory
diff --git a/stdlib/source/library/lux/world/net/http.lux b/stdlib/source/library/lux/world/net/http.lux
index 0582c9192..0ca8327aa 100644
--- a/stdlib/source/library/lux/world/net/http.lux
+++ b/stdlib/source/library/lux/world/net/http.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except #version #host)
[control
[try (.only Try)]
[concurrency
diff --git a/stdlib/source/parser/lux/data/format/xml.lux b/stdlib/source/parser/lux/data/format/xml.lux
index ce03568f6..603cfe6c5 100644
--- a/stdlib/source/parser/lux/data/format/xml.lux
+++ b/stdlib/source/parser/lux/data/format/xml.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except)
+ [lux (.except Tag)
[abstract
[monad (.only do)]]
[control
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index 0b5dca612..e04705902 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -1,6 +1,6 @@
(.require
[library
- [lux (.except Variant Record)
+ [lux (.except Variant Record #Bit #Text #Frac)
[abstract
[codec (.except)]
[monad (.only do)]
diff --git a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux
index 58a2e03fa..7442e7a3c 100644
--- a/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux
+++ b/stdlib/source/test/lux/meta/compiler/language/lux/analysis/module.lux
@@ -269,80 +269,6 @@
{try.#Failure _} true)))))
)))
-(def test|label
- Test
- (do [! random.monad]
- [lux ..random_state
- .let [state [/extension.#bundle /extension.empty
- /extension.#state lux]]
- module_name (random.lower_case 1)
- hash random.nat
- def_name (random.lower_case 2)
- foreign_module (random.lower_case 3)
-
- public? random.bit
- def_type ..primitive
- arity (at ! each (|>> (n.% 10) ++) random.nat)
- labels|head (random.lower_case 1)
- labels|tail (|> (random.lower_case 1)
- (random.only (|>> (text#= labels|head) not))
- (random.set text.hash (-- arity))
- (at ! each set.list))]
- (all _.and
- (_.coverage [/.declare_labels]
- (`` (and (,, (with_template [<side> <record?> <query> <on_success>]
- [(|> (/.with hash module_name
- (do [! /phase.monad]
- [.let [it {.#Named [module_name def_name] def_type}]
- _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})
- _ (/.declare_labels <record?> (list.partial labels|head labels|tail) public? it)]
- (monad.each ! (|>> [module_name] <query> /extension.lifted)
- (list.partial labels|head labels|tail))))
- (/phase.result state)
- (pipe.when
- {try.#Success _} <on_success>
- {try.#Failure _} (not <on_success>)))]
-
- [.#Left false meta.tag true]
- [.#Left false meta.slot false]
- [.#Right true meta.slot true]
- [.#Right true meta.tag false])))))
- (_.coverage [/.cannot_declare_labels_for_anonymous_type]
- (`` (and (,, (with_template [<side> <record?>]
- [(|> (/.with hash module_name
- (do [! /phase.monad]
- [.let [it def_type]
- _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})]
- (/.declare_labels <record?> (list.partial labels|head labels|tail) public? it)))
- (/phase.result state)
- (pipe.when
- {try.#Success _}
- false
-
- {try.#Failure error}
- (text.contains? (the exception.#label /.cannot_declare_labels_for_anonymous_type) error)))]
-
- [.#Left false]
- [.#Right true])))))
- (_.coverage [/.cannot_declare_labels_for_foreign_type]
- (`` (and (,, (with_template [<side> <record?>]
- [(|> (/.with hash module_name
- (do [! /phase.monad]
- [.let [it {.#Named [foreign_module def_name] def_type}]
- _ (/.define def_name {.#Type [public? it {<side> [labels|head labels|tail]}]})]
- (/.declare_labels <record?> (list.partial labels|head labels|tail) public? it)))
- (/phase.result state)
- (pipe.when
- {try.#Success _}
- false
-
- {try.#Failure error}
- (text.contains? (the exception.#label /.cannot_declare_labels_for_foreign_type) error)))]
-
- [.#Left false]
- [.#Right true])))))
- )))
-
(def .public test
Test
(<| (_.covering /._)
@@ -350,6 +276,4 @@
..test|module
..test|state
..test|definition
- (_.for [/.Label]
- ..test|label)
)))
diff --git a/stdlib/source/test/lux/meta/macro/context.lux b/stdlib/source/test/lux/meta/macro/context.lux
index 095fed836..49ebbe6db 100644
--- a/stdlib/source/test/lux/meta/macro/context.lux
+++ b/stdlib/source/test/lux/meta/macro/context.lux
@@ -113,19 +113,12 @@
[_ (/.revised {.#None} ++ <real_stack>)]
(in (list)))))))
(_.coverage [/.not_a_definition]
- (and (<| (text.contains? (the exception.#label /.not_a_definition))
- macro_error
- static.expansion
- (do meta.monad
- [actual (/.peek' [<real_stack> (symbol <fake_stack>)])]
- (in (list))))
- (with_expansions [<expected> (static.random_nat)]
- (<| (text.contains? (the exception.#label /.not_a_definition))
- macro_error
- static.expansion
- (do meta.monad
- [_ (/.push' <expected> [<real_stack> (symbol .#Item)])]
- (in (list)))))))
+ (<| (text.contains? (the exception.#label /.not_a_definition))
+ macro_error
+ static.expansion
+ (do meta.monad
+ [actual (/.peek' [<real_stack> (symbol <fake_stack>)])]
+ (in (list)))))
(_.coverage [/.not_a_global]
(with_expansions [<expected> (static.random_nat)]
(<| (text.contains? (the exception.#label /.not_a_global))